1 /***********************************************************************/
5 /* Contributed by Tracy Camp, PolyServe Inc., <campt@polyserve.com> */
6 /* Further improvements by Reed Wilson */
8 /* Copyright 2002 Institut National de Recherche en Informatique et */
9 /* en Automatique. All rights reserved. This file is distributed */
10 /* under the terms of the GNU Library General Public License, with */
11 /* the special exception on linking described in file ../../LICENSE. */
12 /* under the terms of the GNU Library General Public License. */
14 /***********************************************************************/
16 /* $Id: lockf.c 9078 2008-10-08 13:05:48Z xleroy $ */
23 #include "unixsupport.h"
27 #ifndef INVALID_SET_FILE_POINTER
28 #define INVALID_SET_FILE_POINTER (-1)
31 /* Sets handle h to a position based on gohere */
32 /* output, if set, is changed to the new location */
34 static void set_file_pointer(HANDLE h, LARGE_INTEGER gohere,
35 PLARGE_INTEGER output, DWORD method)
37 LONG high = gohere.HighPart;
38 DWORD ret = SetFilePointer(h, gohere.LowPart, &high, method);
39 if(ret == INVALID_SET_FILE_POINTER) {
40 DWORD err = GetLastError();
43 uerror("lockf", Nothing);
47 output->LowPart = ret;
48 output->HighPart = high;
52 CAMLprim value unix_lockf(value fd, value cmd, value span)
54 CAMLparam3(fd, cmd, span);
58 OSVERSIONINFO version;
59 LARGE_INTEGER cur_position;
60 LARGE_INTEGER beg_position;
61 LARGE_INTEGER lock_len;
65 version.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
66 if(GetVersionEx(&version) == 0) {
67 invalid_argument("lockf only supported on WIN32_NT platforms: could not determine current platform.");
69 if(version.dwPlatformId != VER_PLATFORM_WIN32_NT) {
70 invalid_argument("lockf only supported on WIN32_NT platforms");
75 l_len = Long_val(span);
77 /* No matter what, we need the current position in the file */
78 zero.HighPart = zero.LowPart = 0;
79 set_file_pointer(h, zero, &cur_position, FILE_CURRENT);
81 /* All unused fields must be set to zero */
82 memset(&overlap, 0, sizeof(overlap));
85 /* Lock from cur to infinity */
86 lock_len.QuadPart = -1;
87 overlap.OffsetHigh = cur_position.HighPart;
88 overlap.Offset = cur_position.LowPart ;
91 /* Positive file offset */
92 lock_len.QuadPart = l_len;
93 overlap.OffsetHigh = cur_position.HighPart;
94 overlap.Offset = cur_position.LowPart ;
97 /* Negative file offset */
98 lock_len.QuadPart = - l_len;
99 if (lock_len.QuadPart > cur_position.QuadPart) {
101 uerror("lockf", Nothing);
103 beg_position.QuadPart = cur_position.QuadPart - lock_len.QuadPart;
104 overlap.OffsetHigh = beg_position.HighPart;
105 overlap.Offset = beg_position.LowPart ;
108 switch(Int_val(cmd)) {
109 case 0: /* F_ULOCK - unlock */
110 if (! UnlockFileEx(h, 0,
111 lock_len.LowPart, lock_len.HighPart, &overlap))
112 err = GetLastError();
114 case 1: /* F_LOCK - blocking write lock */
115 enter_blocking_section();
116 if (! LockFileEx(h, LOCKFILE_EXCLUSIVE_LOCK, 0,
117 lock_len.LowPart, lock_len.HighPart, &overlap))
118 err = GetLastError();
119 leave_blocking_section();
121 case 2: /* F_TLOCK - non-blocking write lock */
122 if (! LockFileEx(h, LOCKFILE_FAIL_IMMEDIATELY | LOCKFILE_EXCLUSIVE_LOCK, 0,
123 lock_len.LowPart, lock_len.HighPart, &overlap))
124 err = GetLastError();
126 case 3: /* F_TEST - check whether a write lock can be obtained */
127 /* I'm doing this by aquiring an immediate write
128 * lock and then releasing it. It is not clear that
129 * this behavior matches anything in particular, but
130 * it is not clear the nature of the lock test performed
131 * by ocaml (unix) currently. */
132 if (LockFileEx(h, LOCKFILE_FAIL_IMMEDIATELY | LOCKFILE_EXCLUSIVE_LOCK, 0,
133 lock_len.LowPart, lock_len.HighPart, &overlap)) {
134 UnlockFileEx(h, 0, lock_len.LowPart, lock_len.HighPart, &overlap);
136 err = GetLastError();
139 case 4: /* F_RLOCK - blocking read lock */
140 enter_blocking_section();
141 if (! LockFileEx(h, 0, 0,
142 lock_len.LowPart, lock_len.HighPart, &overlap))
143 err = GetLastError();
144 leave_blocking_section();
146 case 5: /* F_TRLOCK - non-blocking read lock */
147 if (! LockFileEx(h, LOCKFILE_FAIL_IMMEDIATELY, 0,
148 lock_len.LowPart, lock_len.HighPart, &overlap))
149 err = GetLastError();
153 uerror("lockf", Nothing);
155 if (err != NO_ERROR) {
157 uerror("lockf", Nothing);
159 CAMLreturn(Val_unit);