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

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 2002 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../../LICENSE.  */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id: stat.c 9199 2009-03-28 16:39:50Z xleroy $ */
  15
  16 #include <errno.h>
  17 #include <mlvalues.h>
  18 #include <memory.h>
  19 #include <alloc.h>
  20 #include "unixsupport.h"
  21 #include "cst2constr.h"
  22 #define _INTEGRAL_MAX_BITS 64
  23 #include <sys/types.h>
  24 #include <sys/stat.h>
  25
  26 #ifndef S_IFLNK
  27 #define S_IFLNK 0
  28 #endif
  29 #ifndef S_IFIFO
  30 #define S_IFIFO 0
  31 #endif
  32 #ifndef S_IFSOCK
  33 #define S_IFSOCK 0
  34 #endif
  35 #ifndef S_IFBLK
  36 #define S_IFBLK 0
  37 #endif
  38
  39 static int file_kind_table[] = {
  40   S_IFREG, S_IFDIR, S_IFCHR, S_IFBLK, S_IFLNK, S_IFIFO, S_IFSOCK
  41 };
  42
  43 static value stat_aux(int use_64, struct _stati64 *buf)
  44 {
  45   CAMLparam0 ();
  46   CAMLlocal1 (v);
  47
  48   v = caml_alloc (12, 0);
  49   Store_field (v, 0, Val_int (buf->st_dev));
  50   Store_field (v, 1, Val_int (buf->st_ino));
  51   Store_field (v, 2, cst_to_constr (buf->st_mode & S_IFMT, file_kind_table,
  52                                     sizeof(file_kind_table) / sizeof(int), 0));
  53   Store_field (v, 3, Val_int(buf->st_mode & 07777));
  54   Store_field (v, 4, Val_int (buf->st_nlink));
  55   Store_field (v, 5, Val_int (buf->st_uid));
  56   Store_field (v, 6, Val_int (buf->st_gid));
  57   Store_field (v, 7, Val_int (buf->st_rdev));
  58   Store_field (v, 8,
  59                use_64 ? copy_int64(buf->st_size) : Val_int (buf->st_size));
  60   Store_field (v, 9, copy_double((double) buf->st_atime));
  61   Store_field (v, 10, copy_double((double) buf->st_mtime));
  62   Store_field (v, 11, copy_double((double) buf->st_ctime));
  63   CAMLreturn (v);
  64 }
  65
  66 CAMLprim value unix_stat(value path)
  67 {
  68   int ret;
  69   struct _stati64 buf;
  70
  71   ret = _stati64(String_val(path), &buf);
  72   if (ret == -1) uerror("stat", path);
  73   if (buf.st_size > Max_long) {
  74     win32_maperr(ERROR_ARITHMETIC_OVERFLOW);
  75     uerror("stat", path);
  76   }
  77   return stat_aux(0, &buf);
  78 }
  79
  80 CAMLprim value unix_stat_64(value path)
  81 {
  82   int ret;
  83   struct _stati64 buf;
  84   ret = _stati64(String_val(path), &buf);
  85   if (ret == -1) uerror("stat", path);
  86   return stat_aux(1, &buf);
  87 }
  88
  89 CAMLprim value unix_fstat(value handle)
  90 {
  91   int ret;
  92   struct _stati64 buf;
  93
  94   ret = _fstati64(win_CRT_fd_of_filedescr(handle), &buf);
  95   if (ret == -1) uerror("fstat", Nothing);
  96   if (buf.st_size > Max_long) {
  97     win32_maperr(ERROR_ARITHMETIC_OVERFLOW);
  98     uerror("fstat", Nothing);
  99   }
 100   return stat_aux(0, &buf);
 101 }
 102
 103 CAMLprim value unix_fstat_64(value handle)
 104 {
 105   int ret;
 106   struct _stati64 buf;
 107
 108   ret = _fstati64(win_CRT_fd_of_filedescr(handle), &buf);
 109   if (ret == -1) uerror("fstat", Nothing);
 110   return stat_aux(1, &buf);
 111 }