diff options
Diffstat (limited to 'otherlibs/win32unix/lockf.c')
| -rw-r--r-- | otherlibs/win32unix/lockf.c | 205 |
1 files changed, 205 insertions, 0 deletions
diff --git a/otherlibs/win32unix/lockf.c b/otherlibs/win32unix/lockf.c new file mode 100644 index 000000000..84ed2476e --- /dev/null +++ b/otherlibs/win32unix/lockf.c @@ -0,0 +1,205 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Contributed by Tracy Camp, PolyServe Inc., <campt@polyserve.com> */ +/* */ +/* 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 "unixsupport.h" +#include <stdio.h> + +/* + +Commands for Unix.lockf: + +type lock_command = + + | F_ULOCK (* Unlock a region *) + + | F_LOCK (* Lock a region for writing, and block if already locked *) + + | F_TLOCK (* Lock a region for writing, or fail if already locked *) + + | F_TEST (* Test a region for other process locks *) + + | F_RLOCK (* Lock a region for reading, and block if already locked *) + + | F_TRLOCK (* Lock a region for reading, or fail if already locked *) + + +val lockf : file_descr -> lock_command -> int -> unitlockf fd cmd size + +puts a lock on a region of the file opened as fd. The region starts at the current + read/write position for fd (as set by Unix.lseek), and extends size bytes + forward if size is positive, size bytes backwards if size is negative, or + to the end of the file if size is zero. A write lock (set with F_LOCK or + F_TLOCK) prevents any other process from acquiring a read or write lock on + the region. A read lock (set with F_RLOCK or F_TRLOCK) prevents any other + process from acquiring a write lock on the region, but lets other processes + acquire read locks on it. +*/ + +#ifndef INVALID_SET_FILE_POINTER +#define INVALID_SET_FILE_POINTER (-1) +#endif + +static void set_file_pointer(HANDLE h, LARGE_INTEGER dest, + PLARGE_INTEGER cur, DWORD method) +{ + LONG high = dest.HighPart; + DWORD ret = SetFilePointer(h, dest.LowPart, &high, method); + if (ret == INVALID_SET_FILE_POINTER) { + long err = GetLastError(); + if (err != NO_ERROR) { win32_maperr(err); uerror("lockf", Nothing); } + } + if (cur != NULL) { cur->LowPart = ret; cur->HighPart = high; } +} + +CAMLprim value unix_lockf(value fd, value cmd, value span) +{ + int ret; + OVERLAPPED overlap; + DWORD l_start; + DWORD l_len; + HANDLE h; + OSVERSIONINFO VersionInfo; + LARGE_INTEGER cur_position; + LARGE_INTEGER end_position; + LARGE_INTEGER offset_position; + + VersionInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); + if(GetVersionEx(&VersionInfo) == 0) + { + return invalid_argument("lockf only supported on WIN32_NT platforms: could not determine current platform."); + } +/* file locking only exists on NT versions */ + if(VersionInfo.dwPlatformId != VER_PLATFORM_WIN32_NT) + { + return invalid_argument("lockf only supported on WIN32_NT platforms"); + } + + h = Handle_val(fd); + + overlap.Offset = 0; + overlap.OffsetHigh = 0; + overlap.hEvent = 0; + l_len = Long_val(span); + + offset_position.HighPart = 0; + cur_position.HighPart = 0; + end_position.HighPart = 0; + offset_position.LowPart = 0; + cur_position.LowPart = 0; + end_position.LowPart = 0; + + if(l_len == 0) + { +/* save current pointer */ + set_file_pointer(h,offset_position,&cur_position,FILE_CURRENT); +/* set to end and query */ + set_file_pointer(h,offset_position,&end_position,FILE_END); + l_len = end_position.LowPart; +/* restore previous current pointer */ + set_file_pointer(h,cur_position,NULL,FILE_BEGIN); + } + else + { + if (l_len < 0) + { + set_file_pointer(h,offset_position,&cur_position,FILE_CURRENT); + l_len = abs(l_len); + if(l_len > cur_position.LowPart) + { + errno = EINVAL; + uerror("lockf", Nothing); + return Val_unit; + } + overlap.Offset = cur_position.LowPart - l_len; + } + } + switch (Int_val(cmd)) + { + case 0: /* F_ULOCK */ + if(UnlockFileEx(h, 0, l_len,0,&overlap) == 0) + { + errno = EACCES; + ret = -1; + } + break; + case 1: /* F_LOCK */ +/* this should block until write lock is obtained */ + if(LockFileEx(h,LOCKFILE_EXCLUSIVE_LOCK,0,l_len,0,&overlap) == 0) + { + errno = EACCES; + ret = -1; + } + break; + case 2: /* F_TLOCK */ +/* + * this should return immediately if write lock can-not + * be obtained. + */ + if(LockFileEx(h,LOCKFILE_FAIL_IMMEDIATELY | LOCKFILE_EXCLUSIVE_LOCK,0,l_len,0,&overlap) == 0) + { + errno = EACCES; + ret = -1; + } + break; + case 3: /* F_TEST */ +/* + * 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,l_len,0,&overlap) == 0) + { + errno = EACCES; + ret = -1; + } + else + { + UnlockFileEx(h, 0, l_len,0,&overlap); + ret = 0; + } + break; + case 4: /* F_RLOCK */ +/* this should block until read lock is obtained */ + if(LockFileEx(h,0,0,l_len,0,&overlap) == 0) + { + errno = EACCES; + ret = -1; + } + break; + case 5: /* F_TRLOCK */ +/* + * this should return immediately if read lock can-not + * be obtained. + */ + if(LockFileEx(h,LOCKFILE_FAIL_IMMEDIATELY,0,l_len,0,&overlap) == 0) + { + errno = EACCES; + ret = -1; + } + break; + default: + errno = EINVAL; + ret = -1; + } + if (ret == -1) uerror("lockf", Nothing); + return Val_unit; +} + |