l4/pkg/ocaml/contrib/otherlibs/win32unix/lockf.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*  Contributed by Tracy Camp, PolyServe Inc., <campt@polyserve.com>   */
   6 /*  Further improvements by Reed Wilson                                */
   7 /*                                                                     */
   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.         */
  13 /*                                                                     */
  14 /***********************************************************************/
  15
  16 /* $Id: lockf.c 9078 2008-10-08 13:05:48Z xleroy $ */
  17
  18 #include <errno.h>
  19 #include <fcntl.h>
  20 #include <mlvalues.h>
  21 #include <memory.h>
  22 #include <fail.h>
  23 #include "unixsupport.h"
  24 #include <stdio.h>
  25 #include <signals.h>
  26
  27 #ifndef INVALID_SET_FILE_POINTER
  28 #define INVALID_SET_FILE_POINTER (-1)
  29 #endif
  30
  31 /* Sets handle h to a position based on gohere */
  32 /* output, if set, is changed to the new location */
  33
  34 static void set_file_pointer(HANDLE h, LARGE_INTEGER gohere,
  35                              PLARGE_INTEGER output, DWORD method)
  36 {
  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();
  41     if(err != NO_ERROR) {
  42       win32_maperr(err);
  43       uerror("lockf", Nothing);
  44     }
  45   }
  46   if(output != NULL) {
  47     output->LowPart = ret;
  48     output->HighPart = high;
  49   }
  50 }
  51
  52 CAMLprim value unix_lockf(value fd, value cmd, value span)
  53 {
  54   CAMLparam3(fd, cmd, span);
  55   OVERLAPPED overlap;
  56   intnat l_len;
  57   HANDLE h;
  58   OSVERSIONINFO version;
  59   LARGE_INTEGER cur_position;
  60   LARGE_INTEGER beg_position;
  61   LARGE_INTEGER lock_len;
  62   LARGE_INTEGER zero;
  63   DWORD err = NO_ERROR;
  64
  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.");
  68   }
  69   if(version.dwPlatformId != VER_PLATFORM_WIN32_NT) {
  70     invalid_argument("lockf only supported on WIN32_NT platforms");
  71   }
  72
  73   h = Handle_val(fd);
  74
  75   l_len = Long_val(span);
  76
  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);
  80
  81   /* All unused fields must be set to zero */
  82   memset(&overlap, 0, sizeof(overlap));
  83
  84   if(l_len == 0) {
  85     /* Lock from cur to infinity */
  86     lock_len.QuadPart = -1;
  87     overlap.OffsetHigh = cur_position.HighPart;
  88     overlap.Offset     = cur_position.LowPart ;
  89   }
  90   else if(l_len > 0) {
  91     /* Positive file offset */
  92     lock_len.QuadPart = l_len;
  93     overlap.OffsetHigh = cur_position.HighPart;
  94     overlap.Offset     = cur_position.LowPart ;
  95   }
  96   else {
  97     /* Negative file offset */
  98     lock_len.QuadPart = - l_len;
  99     if (lock_len.QuadPart > cur_position.QuadPart) {
 100       errno = EINVAL;
 101       uerror("lockf", Nothing);
 102     }
 103     beg_position.QuadPart = cur_position.QuadPart - lock_len.QuadPart;
 104     overlap.OffsetHigh = beg_position.HighPart;
 105     overlap.Offset     = beg_position.LowPart ;
 106   }
 107
 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();
 113     break;
 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();
 120     break;
 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();
 125     break;
 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);
 135     } else {
 136       err = GetLastError();
 137     }
 138     break;
 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();
 145     break;
 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();
 150     break;
 151   default:
 152     errno = EINVAL;
 153     uerror("lockf", Nothing);
 154   }
 155   if (err != NO_ERROR) {
 156     win32_maperr(err);
 157     uerror("lockf", Nothing);
 158   }
 159   CAMLreturn(Val_unit);
 160 }