Commits

camlspotter  committed 7e625d6

mkdir, mkdtemp, with_dtemp, process_status

  • Participants
  • Parent commits 4549aa4

Comments (0)

Files changed (2)

File lib/xunix.ml

     
 module Process_status = struct
 
-  type t = Unix.process_status
+  type t = [ `Exited of int | `Signaled of int | `Stopped of int ]  
 
   let failwith ?name = 
     let name = match name with None -> "" | Some n -> n ^ ": " in
     function
-      | WEXITED n   -> Exn.failwithf "%sprocess exited with id %d" name n
-      | WSIGNALED n -> Exn.failwithf "%sprocess killed by signal %d" name n
-      | WSTOPPED n  -> Exn.failwithf "%sprocess stopped by signal %d" name n
+      | `Exited n   -> Exn.failwithf "%sprocess exited with id %d" name n
+      | `Signaled n -> Exn.failwithf "%sprocess killed by signal %d" name n
+      | `Stopped n  -> Exn.failwithf "%sprocess stopped by signal %d" name n
 
+  let convert = function
+    | WEXITED n   -> `Exited n
+    | WSIGNALED n -> `Signaled n
+    | WSTOPPED n  -> `Stopped n
 end
 
 let open_proc_full cmdargs input output error toclose =
       [out, buf_out, [fun stat s -> f stat (`Out, s)];
        err, buf_err, [fun stat s -> f stat (`Err, s)]] stat 
     in
-    snd (waitpid_non_intr pid), stat
+    Process_status.convert & snd & waitpid_non_intr pid, 
+    stat
   with
   | e ->
       (* kill really ? *)
 
 let cmp p1 p2 = 
   match command ["cmp"; p1; p2] ~f:ignore with
-  | WEXITED 0 -> `Same
-  | WEXITED 1 -> `Different
-  | WEXITED 2 -> `Error
+  | `Exited 0 -> `Same
+  | `Exited 1 -> `Different
+  | `Exited 2 -> `Error
   | _ -> `Error (* something extremely wrong happened *)
 
 let gen_timed get minus f v = 
   }
   let timed f v = gen_timed Unix.times (-) f v
 end
+
+let file path = 
+  match 
+    command' ["/usr/bin/file"; path] ~init:[] & fun revls -> function
+      | `Out, `Read s -> s::revls
+      | _ -> revls
+  with
+  | `Exited 0, [] -> `Error `Empty_result
+  | `Exited 0, lines -> `Ok (Xlist.last lines)
+  | st, _ -> `Error st
+
+let mkdir ?(perm=0o700) s =
+  match File.Test._d' s with
+  | `Error ENOENT -> 
+      begin try
+	mkdir s perm; (* CR jfuruse: use umask? *)
+	`Ok
+      with
+      | Unix_error (e,_,_) -> `Error e
+      end
+  | `TRUE st -> `Already_exists st (* CR jfuruse: perm check ? *)
+  | `FALSE st -> `Not_a_directory st
+  | `Error e -> `Error e
+;;
+
+let mkdtemp template =
+  match Xstring.is_postfix' "XXXXXX" template with
+  | None -> 
+      Exn.invalid_argf "Unix.mkdtemp must take an argument whose postfix is \"XXXXXX\""
+  | Some prefix ->
+      let rec find () =
+        let d = !% "%s%06d" prefix & Random.int 1000000 in
+        if Sys.file_exists d then find ()
+        else d
+      in
+      let d = find () in
+      Unix.mkdir d 0o700;
+      d
+
+let with_dtemp template f =
+  let d = mkdtemp template in
+  Exn.protect' (fun () -> f d) ~finally:(fun () ->
+    if ksprintf Sys.command "/bin/rm -rf %s" d <> 0 then
+      Exn.failwithf "Unix.with_dtemp: cleaning tempdir %s failed" d)
+  

File lib/xunix.mli

 
 module Process_status : sig
 
-  type t = Unix.process_status
+  type t = [ `Exited of int | `Signaled of int | `Stopped of int ]  
 
-  val failwith : ?name:string -> t -> 'a
+  val failwith : ?name:string -> [< t ] -> 'a
 
+  val convert : Unix.process_status -> [> t ]
+  (** Constructors of [Unix.process_status] are hard to remember,
+      we here convert them to polyvars *)
 end
 
 val shell_command :
   ?f: ([> `Out | `Err] * [ `Read of string | `EOF ] -> unit) 
   -> string 
-  -> Unix.process_status
+  -> [> Process_status.t ]
 (** Execute a shell command using /bin/sh *)
 
 val command :
   ?f: ([> `Out | `Err] * [ `Read of string | `EOF ] -> unit) 
   -> string list
-  -> Unix.process_status
+  -> [> Process_status.t ]
 (** Same as [shell_command] but it takes the command and arguments as a list of string,
     then directly executed by [Unix.execvp]. *)
 
   string 
   -> ('st -> [> `Out | `Err] * [ `Read of string | `EOF ] -> 'st) 
   -> init: 'st 
-  -> Unix.process_status * 'st
+  -> [> Process_status.t ] * 'st
 (** Execute a shell command using /bin/sh *)
 
 val command' :
   string list
   -> ('st -> [> `Out | `Err] * [ `Read of string | `EOF ] -> 'st) 
   -> init: 'st
-  -> Unix.process_status * 'st
+  -> [> Process_status.t ] * 'st
 (** Same as [shell_command] but it takes the command and arguments as a list of string,
     then directly executed by [Unix.execvp]. *)
 
 val shell_command_stdout :
-  string -> Unix.process_status * string list
+  string -> [> Process_status.t ] * string list
 (** Execute a shell command using /bin/sh
     Err is printed to stderr.
  *)
 val cmp : string -> string -> [`Same | `Different | `Error]
 (** Execute "cmp", the file comparison unix command by execvp *)
   
+val file : string -> [> `Error of [> `Empty_result 
+                                  | Process_status.t ]
+                     | `Ok of string ]
+(** Execute "file path" *)
+
 val gen_timed : (unit -> 't) -> ('t -> 't -> 't) -> ('a -> 'b) -> 'a -> 'b * 't
 
 val timed : ('a -> 'b) -> 'a -> 'b * float
   val timed : ('a -> 'b) -> 'a -> 'b * t
 end
 
+val mkdir : ?perm:Unix.file_perm -> string -> 
+  [> `Ok 
+  | `Already_exists of Unix.stats
+  | `Error of Unix.error
+  | `Not_a_directory of Unix.stats ]
+  (** Create a directory of the given name. Does nothing if the
+      directory exists already. 
+
+      Bug: No chmod if the directroy already exists.
+  *)
+
+val mkdtemp : string -> string
+(** Like mkdtemp(3). It must take a template whose postfix is "XXXXXX".
+    It creates a new directory name by replacing "XXXXXX" by random number then creates a directory
+    of permission 0o700 
+*)
+
+val with_dtemp : string -> (string -> 'a) -> 'a
+(** [with_dtemp template f] creates a temp directory [dir] using 
+    [mkdtemp template] then runs [f dir]. 
+    The temp directory [dir] is automatically removed 
+    (even if it is not empty) after [f dir].
+*)
+