1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
/***********************************************************************/
/* */
/* OCaml */
/* */
/* Contributed by Tracy Camp, PolyServe Inc., <campt@polyserve.com> */
/* Further improvements by Reed Wilson */
/* */
/* Copyright 2002 Institut National de Recherche en Informatique et */
/* en Automatique. All rights reserved. This file is distributed */
/* under the terms of the GNU Library General Public License, with */
/* the special exception on linking described in file ../../LICENSE. */
/* under the terms of the GNU Library General Public License. */
/* */
/***********************************************************************/
/* $Id$ */
#include <errno.h>
#include <fcntl.h>
#include <mlvalues.h>
#include <memory.h>
#include <fail.h>
#include "unixsupport.h"
#include <stdio.h>
#include <signals.h>
#ifndef INVALID_SET_FILE_POINTER
#define INVALID_SET_FILE_POINTER (-1)
#endif
/* Sets handle h to a position based on gohere */
/* output, if set, is changed to the new location */
static void set_file_pointer(HANDLE h, LARGE_INTEGER gohere,
PLARGE_INTEGER output, DWORD method)
{
LONG high = gohere.HighPart;
DWORD ret = SetFilePointer(h, gohere.LowPart, &high, method);
if(ret == INVALID_SET_FILE_POINTER) {
DWORD err = GetLastError();
if(err != NO_ERROR) {
win32_maperr(err);
uerror("lockf", Nothing);
}
}
if(output != NULL) {
output->LowPart = ret;
output->HighPart = high;
}
}
CAMLprim value unix_lockf(value fd, value cmd, value span)
{
CAMLparam3(fd, cmd, span);
OVERLAPPED overlap;
intnat l_len;
HANDLE h;
OSVERSIONINFO version;
LARGE_INTEGER cur_position;
LARGE_INTEGER beg_position;
LARGE_INTEGER lock_len;
LARGE_INTEGER zero;
DWORD err = NO_ERROR;
version.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
if(GetVersionEx(&version) == 0) {
invalid_argument("lockf only supported on WIN32_NT platforms: could not determine current platform.");
}
if(version.dwPlatformId != VER_PLATFORM_WIN32_NT) {
invalid_argument("lockf only supported on WIN32_NT platforms");
}
h = Handle_val(fd);
l_len = Long_val(span);
/* No matter what, we need the current position in the file */
zero.HighPart = zero.LowPart = 0;
set_file_pointer(h, zero, &cur_position, FILE_CURRENT);
/* All unused fields must be set to zero */
memset(&overlap, 0, sizeof(overlap));
if(l_len == 0) {
/* Lock from cur to infinity */
lock_len.QuadPart = -1;
overlap.OffsetHigh = cur_position.HighPart;
overlap.Offset = cur_position.LowPart ;
}
else if(l_len > 0) {
/* Positive file offset */
lock_len.QuadPart = l_len;
overlap.OffsetHigh = cur_position.HighPart;
overlap.Offset = cur_position.LowPart ;
}
else {
/* Negative file offset */
lock_len.QuadPart = - l_len;
if (lock_len.QuadPart > cur_position.QuadPart) {
errno = EINVAL;
uerror("lockf", Nothing);
}
beg_position.QuadPart = cur_position.QuadPart - lock_len.QuadPart;
overlap.OffsetHigh = beg_position.HighPart;
overlap.Offset = beg_position.LowPart ;
}
switch(Int_val(cmd)) {
case 0: /* F_ULOCK - unlock */
if (! UnlockFileEx(h, 0,
lock_len.LowPart, lock_len.HighPart, &overlap))
err = GetLastError();
break;
case 1: /* F_LOCK - blocking write lock */
enter_blocking_section();
if (! LockFileEx(h, LOCKFILE_EXCLUSIVE_LOCK, 0,
lock_len.LowPart, lock_len.HighPart, &overlap))
err = GetLastError();
leave_blocking_section();
break;
case 2: /* F_TLOCK - non-blocking write lock */
if (! LockFileEx(h, LOCKFILE_FAIL_IMMEDIATELY | LOCKFILE_EXCLUSIVE_LOCK, 0,
lock_len.LowPart, lock_len.HighPart, &overlap))
err = GetLastError();
break;
case 3: /* F_TEST - check whether a write lock can be obtained */
/* I'm doing this by aquiring an immediate write
* lock and then releasing it. It is not clear that
* this behavior matches anything in particular, but
* it is not clear the nature of the lock test performed
* by ocaml (unix) currently. */
if (LockFileEx(h, LOCKFILE_FAIL_IMMEDIATELY | LOCKFILE_EXCLUSIVE_LOCK, 0,
lock_len.LowPart, lock_len.HighPart, &overlap)) {
UnlockFileEx(h, 0, lock_len.LowPart, lock_len.HighPart, &overlap);
} else {
err = GetLastError();
}
break;
case 4: /* F_RLOCK - blocking read lock */
enter_blocking_section();
if (! LockFileEx(h, 0, 0,
lock_len.LowPart, lock_len.HighPart, &overlap))
err = GetLastError();
leave_blocking_section();
break;
case 5: /* F_TRLOCK - non-blocking read lock */
if (! LockFileEx(h, LOCKFILE_FAIL_IMMEDIATELY, 0,
lock_len.LowPart, lock_len.HighPart, &overlap))
err = GetLastError();
break;
default:
errno = EINVAL;
uerror("lockf", Nothing);
}
if (err != NO_ERROR) {
win32_maperr(err);
uerror("lockf", Nothing);
}
CAMLreturn(Val_unit);
}
|
