Ameliorations de Filename.temp_file (creation en mode 600; utilisation d'un PRNG) et ajout de Filename.open_temp_file

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4653 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

stdlib/filename.ml

@@ -182,19 +182,40 @@ let chop_extension name =
 
 external open_desc: string -> open_flag list -> int -> int = "sys_open"
 external close_desc: int -> unit = "sys_close"
+external random_seed: unit -> int = "sys_random_seed"
+
+let temp_file_counter = ref 0
+
+let temp_file_name prefix suffix =
+  if !temp_file_counter = 0 then temp_file_counter := random_seed();
+  let name =
+    concat temporary_directory
+           (Printf.sprintf "%s%06x%s"
+                           prefix (!temp_file_counter land 0xFFFFFF) suffix) in
+  (* Linear congruential PRNG *)
+  temp_file_counter := !temp_file_counter * 69069 + 25173;
+  name
 
 let temp_file prefix suffix =
   let rec try_name counter =
     if counter >= 1000 then
-      invalid_arg "Filename.temp_file: temp dir nonexistent or full"
+      invalid_arg "Filename.temp_file: temp dir nonexistent or full";
-    else begin
+    let name = temp_file_name prefix suffix in
-      let name =
+    try
-        concat temporary_directory (prefix ^ string_of_int counter ^ suffix) in
+      close_desc(open_desc name [Open_wronly; Open_creat; Open_excl] 0o600);
-      try
+      name
-        close_desc(open_desc name [Open_wronly; Open_creat; Open_excl] 0o666);
+    with Sys_error _ ->
-        name
+      try_name (counter + 1)
-      with Sys_error _ ->
-        try_name (counter + 1)
-    end
   in try_name 0
 
+let open_temp_file ?(mode = [Open_text]) prefix suffix =
+  let rec try_name counter =
+    if counter >= 1000 then
+      invalid_arg "Filename.open_temp_file: temp dir nonexistent or full";
+    let name = temp_file_name prefix suffix in
+    try
+      (name,
+       open_out_gen (Open_wronly::Open_creat::Open_excl::mode) 0o600 name)
+    with Sys_error _ ->
+      try_name (counter + 1)
+  in try_name 0

stdlib/filename.mli

@@ -69,9 +69,10 @@ val temp_file : string -> string -> string
    fresh temporary file in the temporary directory.
    The base name of the temporary file is formed by concatenating
    [prefix], then a suitably chosen integer number, then [suffix].
-   The temporary file is created empty, and is guaranteed to be
+   The temporary file is created empty, with permissions [0o600]
-   different from any other file that existed when [temp_file]
+   (readable and writable only by the file owner).  The file is
-   was called.
+   guaranteed to be different from any other file that existed when
+   [temp_file] was called.
    Under Unix, the temporary directory is [/tmp] by default; if set,
    the value of the environment variable [TMPDIR] is used instead.
    Under Windows, the name of the temporary directory is the
@@ -81,6 +82,17 @@ val temp_file : string -> string -> string
    by the environment variable [TempFolder]; if not set,
    temporary files are created in the current directory. *)
 
+val open_temp_file :
+      ?mode: open_flag list -> string -> string -> string * out_channel
+(** Same as {!temp_file}, but returns both the name of a fresh
+   temporary file, and an output channel opened (atomically) on
+   this file.  This function is more secure than [temp_file]: there
+   is no risk that the temporary file will be modified (e.g. replaced
+   by a symbolic link) before the program opens it.  The optional argument
+   [mode] is a list of additional flags to control the opening of the file.
+   It can contain one or several of [Open_append], [Open_binary],
+   and [Open_text].  The default is [[Open_text]] (open in text mode). *)
+
 val quote : string -> string
 (** Return a quoted version of a file name, suitable for use as
    one argument in a shell command line, escaping all shell