libmojave/cutil/lm_unix_cutil.c

   1 /*
   2  * System info.
   3  *
   4  * ----------------------------------------------------------------
   5  *
   6  * @begin[license]
   7  * Copyright (C) 2003-2006 Mojave Group, Caltech
   8  *
   9  * This library is free software; you can redistribute it and/or
  10  * modify it under the terms of the GNU Lesser General Public
  11  * License as published by the Free Software Foundation,
  12  * version 2.1 of the License.
  13  *
  14  * This library is distributed in the hope that it will be useful,
  15  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17  * Lesser General Public License for more details.
  18  *
  19  * You should have received a copy of the GNU Lesser General Public
  20  * License along with this library; if not, write to the Free Software
  21  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  22  *
  23  * Additional permission is given to link this library with the
  24  * OpenSSL project's "OpenSSL" library, and with the OCaml runtime,
  25  * and you may distribute the linked executables.  See the file
  26  * LICENSE.libmojave for more details.
  27  *
  28  * Author: Jason Hickey
  29  * @email{jyh@cs.caltech.edu}
  30  * @end[license]
  31  */
  32 #include <stdio.h>
  33 #include <caml/signals.h>
  34 #include <caml/mlvalues.h>
  35 #include <caml/alloc.h>
  36 #include <caml/memory.h>
  37 #include <caml/custom.h>
  38 #include <caml/fail.h>
  39
  40 #if defined(WIN32) || defined(_WIN32)
  41 /* Disable some of the warnings */
  42 #pragma warning( disable : 4100 4201 4127 4189 4702 4996 )
  43 #endif
  44
  45 /*
  46  * Lock codes.
  47  */
  48 #define LM_LOCK_UN      0
  49 #define LM_LOCK_SH      1
  50 #define LM_LOCK_EX      2
  51 #define LM_LOCK_TSH     3
  52 #define LM_LOCK_TEX     5
  53
  54 #define FLOCK_LEN       ((unsigned int) ~0 >> 2)
  55
  56 /*
  57  * Print the stack pointer for debugging.
  58  */
  59 value lm_print_stack_pointer(value v_arg)
  60 {
  61     int sp;
  62
  63     fprintf(stderr, "Stack pointer: 0x%08lx\n", (unsigned long) &sp);
  64     return Val_unit;
  65 }
  66
  67 #ifdef WIN32
  68 #include <windows.h>
  69 #include <winerror.h>
  70 #include <shlobj.h>
  71 #include "lm_compat_win32.h"
  72
  73 /*
  74  * File descriptor.
  75  */
  76 value int_of_fd(value fd)
  77 {
  78     return Val_long((long) *(HANDLE *)Data_custom_val(fd));
  79 }
  80
  81 /*
  82  * Home directory on Win32.
  83  */
  84 value home_win32(value v_unit)
  85 {
  86     CAMLparam1(v_unit);
  87     TCHAR path[MAX_PATH];
  88
  89     if(SUCCEEDED(CompatSHGetFolderPath(NULL, CSIDL_LOCAL_APPDATA | CSIDL_FLAG_CREATE, NULL, 0, path)))
  90         CAMLreturn(copy_string(path));
  91
  92     failwith("home_win32");
  93     return Val_unit;
  94 }
  95
  96 /*
  97  * File locking.
  98  */
  99 #define F_ULOCK         0
 100 #define F_LOCK          1
 101 #define F_TLOCK         2
 102 #define F_TEST          3
 103 #define F_RLOCK         4
 104 #define F_TRLOCK        5
 105
 106 value lockf_win32(value v_fd, value v_kind, value v_len)
 107 {
 108     HANDLE fd = *(HANDLE *)Data_custom_val(v_fd);
 109     int kind = Int_val(v_kind);
 110     int len = Int_val(v_len);
 111     OVERLAPPED overlapped;
 112     int code, flags = 0;
 113     DWORD pos, error = 0;
 114
 115     /* Get the current position in the file */
 116     pos = SetFilePointer(fd, 0, 0, FILE_CURRENT);
 117
 118     /* XXX: HACK: we should probably compute this correctly */
 119     if(len == 0)
 120         len = 1;
 121
 122     /* Unlock case */
 123     if(kind == F_ULOCK)
 124         UnlockFile(fd, pos, 0, len, 0);
 125     else {
 126         /* Some kind of locking operation */
 127         switch(kind) {
 128         case F_LOCK:
 129             flags = LOCKFILE_EXCLUSIVE_LOCK;
 130             break;
 131         case F_TLOCK:
 132             flags = LOCKFILE_EXCLUSIVE_LOCK | LOCKFILE_FAIL_IMMEDIATELY;
 133             break;
 134         case F_RLOCK:
 135             flags = 0;
 136             break;
 137         case F_TRLOCK:
 138             flags = LOCKFILE_FAIL_IMMEDIATELY;
 139             break;
 140         default:
 141             invalid_argument("lockf_win32");
 142             break;
 143         }
 144
 145         /* Set the offset */
 146         memset(&overlapped, 0, sizeof(overlapped));
 147         overlapped.Offset = pos;
 148
 149         /* Perform the lock */
 150         enter_blocking_section();
 151         code = LockFileEx(fd, flags, 0, len, 0, &overlapped);
 152         if(code == 0)
 153             error = GetLastError();
 154         leave_blocking_section();
 155
 156         /* Fail if the lock was not successful */
 157         if(code == 0) {
 158             char szBuf[1024];
 159             LPVOID lpMsgBuf;
 160
 161             switch(error) {
 162             case ERROR_LOCK_FAILED:
 163             case ERROR_LOCK_VIOLATION:
 164                 /*
 165                  * XXX: HACK: this exception is being caught
 166                  *            Do not change the string w/o changing the wrapper code.
 167                  */
 168                 failwith("lockf_win32: already locked");
 169                 break;
 170             case ERROR_POSSIBLE_DEADLOCK:
 171                 /*
 172                  * XXX: HACK: this exception is being caught
 173                  *            Do not change the string w/o changing the wrapper code.
 174                  */
 175                 failwith("lockf_win32: possible deadlock");
 176                 break;
 177             default:
 178                 FormatMessage(
 179                     FORMAT_MESSAGE_ALLOCATE_BUFFER |
 180                     FORMAT_MESSAGE_FROM_SYSTEM,
 181                     NULL,
 182                     error,
 183                     MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
 184                     (LPTSTR) &lpMsgBuf,
 185                     0, NULL);
 186
 187                 sprintf(szBuf, "lockf_win32 failed with error %d: %s", error, lpMsgBuf);
 188                 LocalFree(lpMsgBuf);
 189
 190                 failwith(szBuf);
 191                 break;
 192             }
 193         }
 194     }
 195     return Val_unit;
 196 }
 197
 198 /*
 199  * Translate flock operators.
 200  */
 201 static int lockf_of_flock[] = {
 202     F_ULOCK,
 203     F_RLOCK,
 204     F_LOCK,
 205     F_TRLOCK,
 206     F_TLOCK
 207 };
 208
 209 /*
 210  * flock wrapper.
 211  */
 212 value lm_flock(value v_fd, value v_op)
 213 {
 214     value v_kind;
 215
 216     v_kind = Val_int(lockf_of_flock[Int_val(v_op)]);
 217     return lockf_win32(v_fd, v_kind, Val_int(FLOCK_LEN));
 218 }
 219
 220 /*
 221  * Truncate to the current position.
 222  */
 223 value ftruncate_win32(value v_fd)
 224 {
 225     HANDLE fd = *(HANDLE *)Data_custom_val(v_fd);
 226     SetEndOfFile(fd);
 227     return Val_unit;
 228 }
 229
 230 /************************************************************************
 231  * Registry.
 232  */
 233
 234 /*
 235  * Get the value of a registry key.
 236  */
 237 value caml_registry_find(value v_hkey, value v_subkey, value v_field)
 238 {
 239     char buffer[8192];
 240     const char *subkey, *field;
 241     DWORD len;
 242     LONG code;
 243     HKEY hkey = 0;
 244
 245     /* Get the arguments */
 246     switch(Int_val(v_hkey)) {
 247     case 0:
 248         hkey = HKEY_CLASSES_ROOT;
 249         break;
 250     case 1:
 251         hkey = HKEY_CURRENT_CONFIG;
 252         break;
 253     case 2:
 254         hkey = HKEY_CURRENT_USER;
 255         break;
 256     case 3:
 257         hkey = HKEY_LOCAL_MACHINE;
 258         break;
 259     case 4:
 260         hkey = HKEY_USERS;
 261         break;
 262     default:
 263         caml_failwith("get_registry: unknown handle");
 264         break;
 265     }
 266
 267     /* Ask Windows */
 268     subkey = String_val(v_subkey);
 269     field = String_val(v_field);
 270     len = sizeof(buffer);
 271
 272 #if 0
 273     code = RegGetValue(hkey, subkey, field, RRF_RT_REG_SZ, NULL, (LPVOID) buffer, &len);
 274     if(code != ERROR_SUCCESS)
 275         caml_raise_not_found();
 276 #else
 277     {
 278         HKEY hand;
 279
 280         code = RegOpenKeyEx(hkey, subkey, 0, KEY_QUERY_VALUE, &hand);
 281         if(code != ERROR_SUCCESS)
 282             caml_raise_not_found();
 283
 284         code = RegQueryValueEx(hand, field, NULL, NULL, (LPBYTE) buffer, &len);
 285         RegCloseKey(hand);
 286         if(code != ERROR_SUCCESS)
 287             caml_raise_not_found();
 288     }
 289 #endif
 290
 291     /* Got the value */
 292     return copy_string(buffer);
 293 }
 294
 295 #else /* WIN32 */
 296 #include <unistd.h>
 297 #include <fcntl.h>
 298 #include <sys/file.h>
 299 #include <sys/types.h>
 300 #include <pwd.h>
 301
 302 value int_of_fd(value fd)
 303 {
 304     return fd;
 305 }
 306
 307 value home_win32(value v_unit)
 308 {
 309     caml_failwith("home_win32: not to be used except on Win32");
 310     return Val_unit;
 311 }
 312
 313 value lockf_win32(value v_fd, value v_kind, value v_len)
 314 {
 315     caml_failwith("lockf_win32: not to be used except on Win32");
 316     return Val_unit;
 317 }
 318
 319 value ftruncate_win32(value v_fd)
 320 {
 321     caml_failwith("ftruncate_current_win32: not to be used except on Win32");
 322     return Val_unit;
 323 }
 324
 325 value caml_registry_find(value v_key, value v_subkey, value v_field)
 326 {
 327     caml_raise_not_found();
 328     return Val_unit;
 329 }
 330
 331 /*
 332  * Translations.
 333  */
 334 #if defined(LOCK_UN) && defined(LOCK_SH) && defined(LOCK_EX)
 335 #define FLOCK_ENABLED
 336 static int flock_of_flock[] = {
 337     LOCK_UN,
 338     LOCK_SH,
 339     LOCK_EX,
 340     LOCK_SH | LOCK_NB,
 341     LOCK_EX | LOCK_NB
 342 };
 343 #endif
 344
 345 #if defined(F_RDLCK) && defined(F_WRLCK) && defined(F_UNLCK) && defined(F_SETLK) && defined(F_SETLKW) && defined(SEEK_SET)
 346 #define FCNTL_ENABLED
 347 static int fcntl_type_of_flock[] = {
 348     F_UNLCK,
 349     F_RDLCK,
 350     F_WRLCK,
 351     F_RDLCK,
 352     F_WRLCK
 353 };
 354
 355 static int fcntl_of_flock[] = {
 356     F_SETLKW,
 357     F_SETLKW,
 358     F_SETLKW,
 359     F_SETLK,
 360     F_SETLK
 361 };
 362 #endif
 363
 364 #if defined(F_ULOCK) && defined(F_LOCK) && defined(F_TLOCK)
 365 #define LOCKF_ENABLED
 366 static int lockf_of_flock[] = {
 367     F_ULOCK,
 368     F_LOCK,
 369     F_LOCK,
 370     F_TLOCK,
 371     F_TLOCK
 372 };
 373 #endif
 374
 375 value lm_flock(value v_fd, value v_op)
 376 {
 377     int fd, op, cmd, code;
 378
 379     fd = Int_val(v_fd);
 380     op = Int_val(v_op);
 381 #if defined(FLOCK_ENABLED)
 382     cmd = flock_of_flock[op];
 383     enter_blocking_section();
 384     code = flock(fd, cmd);
 385     leave_blocking_section();
 386 #elif defined(FCNTL_ENABLED)
 387     {
 388         struct flock info;
 389         cmd = fcntl_of_flock[op];
 390         info.l_type = fcntl_type_of_flock[op];
 391         info.l_whence = SEEK_SET;
 392         info.l_start = 0;
 393         info.l_len = FLOCK_LEN;
 394         enter_blocking_section();
 395         code = fcntl(fd, cmd, &info);
 396         leave_blocking_section();
 397     }
 398 #elif defined(LOCKF_ENABLED)
 399     cmd = lockf_of_flock[op];
 400     enter_blocking_section();
 401     code = lockf(fd, cmd, FLOCK_LEN);
 402     leave_blocking_section();
 403 #else
 404     code = -1;
 405 #endif
 406     if(code < 0)
 407         failwith("flock");
 408     return Val_unit;
 409 }
 410
 411 #endif /* !WIN32 */
 412
 413 /************************************************************************
 414  * Password file (only on Unix).
 415  */
 416 #ifdef WIN32
 417
 418 /*
 419  * The empty array.
 420  */
 421 value lm_getpwents(value v_unit)
 422 {
 423     return Val_emptylist;
 424 }
 425
 426 #else /* !WIN32 */
 427
 428 /*
 429  * Scan the password file.
 430  *
 431 type passwd_entry = {
 432         pw_name : string;
 433         pw_passwd : string;
 434         pw_uid : int;
 435         pw_gid : int;
 436         pw_gecos : string;
 437         pw_dir : string;
 438         pw_shell : string;
 439 }
 440  */
 441 value lm_getpwents(value v_unit)
 442 {
 443     CAMLparam1(v_unit);
 444     CAMLlocal3(users, entry, cons);
 445     struct passwd *entryp;
 446
 447     /* Create a list of users */
 448     users = Val_emptylist;
 449
 450     /* Scan the password file */
 451     setpwent();
 452     while((entryp = getpwent())) {
 453         entry = caml_alloc_tuple(7);
 454         Store_field(entry, 0, caml_copy_string(entryp->pw_name));
 455         Store_field(entry, 1, caml_copy_string(entryp->pw_passwd));
 456         Store_field(entry, 2, Val_int(entryp->pw_uid));
 457         Store_field(entry, 3, Val_int(entryp->pw_gid));
 458 #ifdef __BEOS__
 459         Store_field(entry, 4, copy_string(""));
 460 #else
 461         Store_field(entry, 4, copy_string(entryp->pw_gecos));
 462 #endif
 463         Store_field(entry, 5, copy_string(entryp->pw_dir));
 464         Store_field(entry, 6, copy_string(entryp->pw_shell));
 465         cons = caml_alloc_tuple(2);
 466         Store_field(cons, 0, entry);
 467         Store_field(cons, 1, users);
 468         users = cons;
 469     }
 470     endpwent();
 471
 472     CAMLreturn(users);
 473 }
 474
 475 #endif /* !WIN32 */
 476