Ajout operations sur gros fichiers

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4474 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
author: Xavier Leroy <xavier.leroy@inria.fr> 2002-03-02 09:16:39 +0000
committer: Xavier Leroy <xavier.leroy@inria.fr> 2002-03-02 09:16:39 +0000
commit: bddfe5d0cecccc8aa995fe95c4af5cbc41743747 (patch)
tree: 5ca9135daa03b182b678b4ca01092f103be27549 /otherlibs/unix
parent: 00d7dbf924dccb864a839fdfa86001e9fe48142e (diff)
9 files changed, 216 insertions, 4 deletions
diff --git a/otherlibs/unix/Makefile b/otherlibs/unix/Makefile
index bea9c8026..b3d39e29b 100644
--- a/otherlibs/unix/Makefile
+++ b/otherlibs/unix/Makefile
@@ -19,7 +19,7 @@ include ../../config/Makefile
 
 # Compilation options
 CC=$(BYTECC)
-CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS)
+CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -D_FILE_OFFSET_BITS=64
 CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib
 CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib
 MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
diff --git a/otherlibs/unix/ftruncate.c b/otherlibs/unix/ftruncate.c
index 259404362..8fe041b47 100644
--- a/otherlibs/unix/ftruncate.c
+++ b/otherlibs/unix/ftruncate.c
@@ -13,8 +13,13 @@
 
 /* $Id$ */
 
+#include <sys/types.h>
 #include <mlvalues.h>
+#include <io.h>
 #include "unixsupport.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
 
 #ifdef HAS_TRUNCATE
 
@@ -25,6 +30,13 @@ CAMLprim value unix_ftruncate(value fd, value len)
   return Val_unit;
 }
 
+CAMLprim value unix_ftruncate_64(value fd, value len)
+{
+  if (ftruncate(Int_val(fd), File_offset_val(len)) == -1)
+    uerror("ftruncate", Nothing);
+  return Val_unit;
+}
+
 #else
 
 CAMLprim value unix_ftruncate(value fd, value len)
diff --git a/otherlibs/unix/lseek.c b/otherlibs/unix/lseek.c
index 3f7d8e698..5dfa7e37f 100644
--- a/otherlibs/unix/lseek.c
+++ b/otherlibs/unix/lseek.c
@@ -13,7 +13,11 @@
 
 /* $Id$ */
 
+#include <errno.h>
+#include <sys/types.h>
 #include <mlvalues.h>
+#include <alloc.h>
+#include <io.h>
 #include "unixsupport.h"
 
 #ifdef HAS_UNISTD
@@ -24,15 +28,30 @@
 #define SEEK_END 2
 #endif
 
+#ifndef EOVERFLOW
+#define EOVERFLOW ERANGE
+#endif
+
 static int seek_command_table[] = {
   SEEK_SET, SEEK_CUR, SEEK_END
 };
 
 CAMLprim value unix_lseek(value fd, value ofs, value cmd)
 {
-  long ret;
+  file_offset ret;
   ret = lseek(Int_val(fd), Long_val(ofs),
                        seek_command_table[Int_val(cmd)]);
   if (ret == -1) uerror("lseek", Nothing);
+  if (ret > Max_long) unix_error(EOVERFLOW, "lseek", Nothing);
   return Val_long(ret);
 }
+
+CAMLprim value unix_lseek_64(value fd, value ofs, value cmd)
+{
+  file_offset ret;
+  ret = lseek(Int_val(fd), File_offset_val(ofs),
+                       seek_command_table[Int_val(cmd)]);
+  if (ret == -1) uerror("lseek", Nothing);
+  return Val_file_offset(ret);
+}
+
diff --git a/otherlibs/unix/stat.c b/otherlibs/unix/stat.c
index a0f1c04a8..db9150ad0 100644
--- a/otherlibs/unix/stat.c
+++ b/otherlibs/unix/stat.c
@@ -13,6 +13,7 @@
 
 /* $Id$ */
 
+#include <errno.h>
 #include <mlvalues.h>
 #include <memory.h>
 #include <alloc.h>
@@ -20,6 +21,7 @@
 #include "cst2constr.h"
 #include <sys/types.h>
 #include <sys/stat.h>
+#include <io.h>
 
 #ifndef S_IFLNK
 #define S_IFLNK 0
@@ -34,6 +36,10 @@
 #define S_IFBLK 0
 #endif
 
+#ifndef EOVERFLOW
+#define EOVERFLOW ERANGE
+#endif
+
 static int file_kind_table[] = {
   S_IFREG, S_IFDIR, S_IFCHR, S_IFBLK, S_IFLNK, S_IFIFO, S_IFSOCK
 };
@@ -71,6 +77,7 @@ CAMLprim value unix_stat(value path)
   struct stat buf;
   ret = stat(String_val(path), &buf);
   if (ret == -1) uerror("stat", path);
+  if (buf.st_size > Max_long) unix_error(EOVERFLOW, "stat", path);
   return stat_aux(&buf);
 }
 
@@ -84,6 +91,7 @@ CAMLprim value unix_lstat(value path)
   ret = stat(String_val(path), &buf);
 #endif
   if (ret == -1) uerror("lstat", path);
+  if (buf.st_size > Max_long) unix_error(EOVERFLOW, "lstat", path);
   return stat_aux(&buf);
 }
 
@@ -93,5 +101,65 @@ CAMLprim value unix_fstat(value fd)
   struct stat buf;
   ret = fstat(Int_val(fd), &buf);
   if (ret == -1) uerror("fstat", Nothing);
+  if (buf.st_size > Max_long) unix_error(EOVERFLOW, "fstat", Nothing);
   return stat_aux(&buf);
 }
+
+static value stat_aux_64(struct stat *buf)
+{
+  value v;
+  value atime = Val_unit, mtime = Val_unit, ctime = Val_unit;
+
+  Begin_roots3(atime,mtime,ctime)
+    atime = copy_double((double) buf->st_atime);
+    mtime = copy_double((double) buf->st_mtime);
+    ctime = copy_double((double) buf->st_ctime);
+    v = alloc_small(12, 0);
+    Field (v, 0) = Val_int (buf->st_dev);
+    Field (v, 1) = Val_int (buf->st_ino);
+    Field (v, 2) = cst_to_constr(buf->st_mode & S_IFMT, file_kind_table,
+                                 sizeof(file_kind_table) / sizeof(int), 0);
+    Field (v, 3) = Val_int(buf->st_mode & 07777);
+    Field (v, 4) = Val_int (buf->st_nlink);
+    Field (v, 5) = Val_int (buf->st_uid);
+    Field (v, 6) = Val_int (buf->st_gid);
+    Field (v, 7) = Val_int (buf->st_rdev);
+    Field (v, 8) = Val_file_offset (buf->st_size);
+    Field (v, 9) = atime;
+    Field (v, 10) = mtime;
+    Field (v, 11) = ctime;
+  End_roots();
+  return v;
+}
+
+CAMLprim value unix_stat_64(value path)
+{
+  int ret;
+  struct stat buf;
+  ret = stat(String_val(path), &buf);
+  if (ret == -1) uerror("stat", path);
+  return stat_aux_64(&buf);
+}
+
+CAMLprim value unix_lstat_64(value path)
+{
+  int ret;
+  struct stat buf;
+#ifdef HAS_SYMLINK
+  ret = lstat(String_val(path), &buf);
+#else
+  ret = stat(String_val(path), &buf);
+#endif
+  if (ret == -1) uerror("lstat", path);
+  return stat_aux_64(&buf);
+}
+
+CAMLprim value unix_fstat_64(value fd)
+{
+  int ret;
+  struct stat buf;
+  ret = fstat(Int_val(fd), &buf);
+  if (ret == -1) uerror("fstat", Nothing);
+  return stat_aux_64(&buf);
+}
+
diff --git a/otherlibs/unix/truncate.c b/otherlibs/unix/truncate.c
index a3812ae56..009d3c0e5 100644
--- a/otherlibs/unix/truncate.c
+++ b/otherlibs/unix/truncate.c
@@ -13,8 +13,13 @@
 
 /* $Id$ */
 
+#include <sys/types.h>
 #include <mlvalues.h>
+#include <io.h>
 #include "unixsupport.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
 
 #ifdef HAS_TRUNCATE
 
@@ -25,6 +30,13 @@ CAMLprim value unix_truncate(value path, value len)
   return Val_unit;
 }
 
+CAMLprim value unix_truncate_64(value path, value len)
+{
+  if (truncate(String_val(path), File_offset_val(len)) == -1)
+    uerror("truncate", path);
+  return Val_unit;
+}
+
 #else
 
 CAMLprim value unix_truncate(value path, value len)
diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml
index 332669abf..5065a47ae 100644
--- a/otherlibs/unix/unix.ml
+++ b/otherlibs/unix/unix.ml
@@ -81,6 +81,7 @@ type error =
   | EHOSTDOWN
   | EHOSTUNREACH
   | ELOOP
+  | EOVERFLOW
   | EUNKNOWNERR of int
 
 exception Unix_error of error * string * string
@@ -213,6 +214,30 @@ external unlink : string -> unit = "unix_unlink"
 external rename : string -> string -> unit = "unix_rename"
 external link : string -> string -> unit = "unix_link"
 
+module LargeFile =
+  struct
+    external lseek : file_descr -> int64 -> seek_command -> int = "unix_lseek_64"
+    external truncate : string -> int64 -> unit = "unix_truncate_64"
+    external ftruncate : file_descr -> int64 -> unit = "unix_ftruncate_64"
+    type stats =
+      { st_dev : int;
+        st_ino : int;
+        st_kind : file_kind;
+        st_perm : file_perm;
+        st_nlink : int;
+        st_uid : int;
+        st_gid : int;
+        st_rdev : int;
+        st_size : int64;
+        st_atime : float;
+        st_mtime : float;
+        st_ctime : float;
+      }
+    external stat : string -> stats = "unix_stat_64"
+    external lstat : string -> stats = "unix_lstat_64"
+    external fstat : file_descr -> stats = "unix_fstat_64"
+  end
+
 type access_permission =
     R_OK
   | W_OK
diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli
index b4d021bce..f4060ea80 100644
--- a/otherlibs/unix/unix.mli
+++ b/otherlibs/unix/unix.mli
@@ -87,11 +87,12 @@ type error =
   | EHOSTDOWN           (** Host is down *)
   | EHOSTUNREACH        (** No route to host *)
   | ELOOP               (** Too many levels of symbolic links *)
+  | EOVERFLOW           (** File size or position not representable *)
 
   | EUNKNOWNERR of int  (** Unknown error *)
 (** The type of error codes. 
    Errors defined in the POSIX standard
-   and additional errors, mostly BSD.
+   and additional errors from UNIX98 and BSD.
    All other errors are mapped to EUNKNOWNERR.
 *)
 
@@ -337,6 +338,42 @@ val fstat : file_descr -> stats
    descriptor. *)
 
 
+(** {6 Seeking, truncating and statistics on large files} *)
+
+
+module LargeFile :
+  sig
+    val lseek : file_descr -> int64 -> seek_command -> int
+    val truncate : string -> int64 -> unit
+    val ftruncate : file_descr -> int64 -> unit
+    type stats =
+      { st_dev : int;               (** Device number *)
+        st_ino : int;               (** Inode number *)
+        st_kind : file_kind;        (** Kind of the file *)
+        st_perm : file_perm;        (** Access rights *)
+        st_nlink : int;             (** Number of links *)
+        st_uid : int;               (** User id of the owner *)
+        st_gid : int;               (** Group ID of the file's group *)
+        st_rdev : int;              (** Device minor number *)
+        st_size : int64;            (** Size in bytes *)
+        st_atime : float;           (** Last access time *)
+        st_mtime : float;           (** Last modification time *)
+        st_ctime : float;           (** Last status change time *) 
+      }
+    val stat : string -> stats
+    val lstat : string -> stats
+    val fstat : file_descr -> stats
+  end
+(** This sub-module provides 64-bit variants of the functions
+  {!Unix.lseek} (for positioning a file descriptor),
+  {!Unix.truncate} and {!Unix.ftruncate} (for changing the size of a file),
+  and {!Unix.stat}, {!Unix.lstat} and {!Unix.fstat} (for obtaining
+  information on files).  These alternate functions represent
+  positions and sizes by 64-bit integers (type [int64]) instead of
+  regular integers (type [int]), thus allowing operating on files
+  whose sizes are greater than [max_int]. *)
+
+
 (** {6 Operations on file names} *)
 
 
diff --git a/otherlibs/unix/unixLabels.mli b/otherlibs/unix/unixLabels.mli
index c0353112b..069a2f9a8 100644
--- a/otherlibs/unix/unixLabels.mli
+++ b/otherlibs/unix/unixLabels.mli
@@ -90,6 +90,7 @@ type error =
     | EHOSTDOWN           (** Host is down *)
     | EHOSTUNREACH        (** No route to host *)
     | ELOOP               (** Too many levels of symbolic links *)
+    | EOVERFLOW           (** File size or position not representable *)
 
     | EUNKNOWNERR of int  (** Unknown error *)
 (** The type of error codes. 
@@ -341,6 +342,41 @@ val fstat : file_descr -> stats
 (** Return the information for the file associated with the given
    descriptor. *)
 
+(** {6 Seeking, truncating and statistics on large files} *)
+
+
+module LargeFile :
+  sig
+    val lseek : file_descr -> int64 -> mode:seek_command -> int
+    val truncate : string -> len:int64 -> unit
+    val ftruncate : file_descr -> len:int64 -> unit
+    type stats = Unix.LargeFile.stats =
+      { st_dev : int;               (** Device number *)
+        st_ino : int;               (** Inode number *)
+        st_kind : file_kind;        (** Kind of the file *)
+        st_perm : file_perm;        (** Access rights *)
+        st_nlink : int;             (** Number of links *)
+        st_uid : int;               (** User id of the owner *)
+        st_gid : int;               (** Group ID of the file's group *)
+        st_rdev : int;              (** Device minor number *)
+        st_size : int64;            (** Size in bytes *)
+        st_atime : float;           (** Last access time *)
+        st_mtime : float;           (** Last modification time *)
+        st_ctime : float;           (** Last status change time *) 
+      }
+    val stat : string -> stats
+    val lstat : string -> stats
+    val fstat : file_descr -> stats
+  end
+(** This sub-module provides 64-bit variants of the functions
+  {!UnixLabels.lseek} (for positioning a file descriptor),
+  {!UnixLabels.truncate} and {!UnixLabels.ftruncate} 
+  (for changing the size of a file),
+  and {!UnixLabels.stat}, {!UnixLabels.lstat} and {!UnixLabels.fstat}
+  (for obtaining information on files).  These alternate functions represent
+  positions and sizes by 64-bit integers (type [int64]) instead of
+  regular integers (type [int]), thus allowing operating on files
+  whose sizes are greater than [max_int]. *)
 
 
 (** {6 Operations on file names} *)
diff --git a/otherlibs/unix/unixsupport.c b/otherlibs/unix/unixsupport.c
index 247f722a2..2a723924c 100644
--- a/otherlibs/unix/unixsupport.c
+++ b/otherlibs/unix/unixsupport.c
@@ -227,6 +227,9 @@
 #ifndef ELOOP
 #define ELOOP (-1)
 #endif
+#ifndef EOVERFLOW
+#define EOVERFLOW (-1)
+#endif
 
 int error_table[] = {
   E2BIG, EACCES, EAGAIN, EBADF, EBUSY, ECHILD, EDEADLK, EDOM,
@@ -239,7 +242,7 @@ int error_table[] = {
   EAFNOSUPPORT, EADDRINUSE, EADDRNOTAVAIL, ENETDOWN, ENETUNREACH,
   ENETRESET, ECONNABORTED, ECONNRESET, ENOBUFS, EISCONN, ENOTCONN,
   ESHUTDOWN, ETOOMANYREFS, ETIMEDOUT, ECONNREFUSED, EHOSTDOWN,
-  EHOSTUNREACH, ELOOP /*, EUNKNOWNERR */
+  EHOSTUNREACH, ELOOP, EOVERFLOW /*, EUNKNOWNERR */
 };
 
 static value * unix_error_exn = NULL;
author	Xavier Leroy <xavier.leroy@inria.fr>	2002-03-02 09:16:39 +0000
committer	Xavier Leroy <xavier.leroy@inria.fr>	2002-03-02 09:16:39 +0000
commit	bddfe5d0cecccc8aa995fe95c4af5cbc41743747 (patch)
tree	5ca9135daa03b182b678b4ca01092f103be27549 /otherlibs/unix
parent	00d7dbf924dccb864a839fdfa86001e9fe48142e (diff)