Commits

camlspotter committed e562742

Largely rewritten Xunix command/shell executino

Comments (0)

Files changed (7)

 - Lazy.(!!) is also in Lazy.Open(!!)
 - Unix.mkdir can be recursive now
 - Added Shell, commands via shell commands
-* Stopped using Xunix.Process_status.t and back to Unix.process_status
-* Moved some shell based Xunix functions to Shell
+* Largely rewritten Xunix's command/shell execution.
+* Added Shell for the shell command like functions
+* Added labels to At functions.
 
 2.3.0
 ------------
 (* using good old Str *)
 open Str
 
-let replace_variables f =
+let replace_variables ~f =
   let rex = regexp "@[A-Za-z0-9_]+@" in
   let replace = 
     global_substitute rex (fun s ->
   in
   replace
 
-let replace_file f path outpath =
+let replace_file ~f path outpath =
   let ic = open_in path in
   let oc = open_out outpath in
   let rec loop () = 
     try 
       let line = input_line ic in
-      output_string oc (replace_variables f line);
+      output_string oc (replace_variables ~f line);
       output_char oc '\n';
       loop ()
     with
 
 (* Requires Str *)
 
-val replace_variables : (string -> string) -> string -> string
+val replace_variables : f:(string -> string) -> string -> string
 (** [replace_variables f s] replaces the occurrences of matches with 
     regexp "[A-Za-z0-9_]+" surrounded by '@' chars in [s] by function [f].
 
     Ex. [replace_variables String.uppercase "hello @world@" = "hello WORLD"]
 *)
 
-val replace_file : (string -> string) -> string -> string -> unit
+val replace_file : f:(string -> string) -> string -> string -> unit
 (** [replace_variables f infile outfile] replaces the occurrences of matches with 
     regexp "[A-Za-z0-9_]+" surrounded by '@' chars by function [f] in a file [infile] 
     and write the result to a file [outfile].
 open Base
 open Unix
 open Xunix
+open Command
 
-let com name ?f tokens = Xunix.command ?f (name :: tokens)
+let com name tokens = command (name :: tokens) |> print
 
-let cp ?f = com "/bin/cp" ?f
-let mv ?f = com "/bin/mv" ?f
-let rm ?f = com "/bin/rm" ?f
+let cp = com "/bin/cp"
+let mv = com "/bin/mv"
+let rm = com "/bin/rm"
+let cat = com "/bin/cat"
 
 let cmp p1 p2 = 
-  match Xunix.command ["cmp"; p1; p2] ~f:ignore with
+  match command ["cmp"; p1; p2] |> ignore_output with
   | WEXITED 0 -> `Same
   | WEXITED 1 -> `Different
   | WEXITED 2 -> `Error
 
 let file path = 
   match 
-    command' ["/usr/bin/file"; path] ~init:[] & fun revls -> function
+    command ["/usr/bin/file"; path] |> fold ~init:[] ~f:(fun revls -> function
       | `Out, `Read s -> s::revls
-      | _ -> revls
+      | _ -> revls)
   with
   | WEXITED 0, [] -> `Ok None
   | WEXITED 0, lines -> `Ok (Some (Xlist.last lines))
   | st, _ -> `Error st
 
+let grep args ~init ~f = command ("/bin/grep" :: args) |> fold ~init ~f
 
+let grep_ = grep ~init:() ~f:(fun _st _ -> ()) *> fst
+  
+
 val cp : 
-  ?f: ([> `Out | `Err] * [ `Read of string | `EOF ] -> unit) 
-  -> string list
+  string list
   -> Unix.process_status
 
 val mv :
-  ?f: ([> `Out | `Err] * [ `Read of string | `EOF ] -> unit) 
-  -> string list
+  string list
   -> Unix.process_status
 
 val rm :
-  ?f: ([> `Out | `Err] * [ `Read of string | `EOF ] -> unit) 
-  -> string list
+  string list
+  -> Unix.process_status
+
+val cat :
+  string list
   -> Unix.process_status
 
 val cmp : string -> string -> [`Same | `Different | `Error]
                      | `Ok of string option ]
 (** Execute "file path" *)
 
+val grep : 
+  string list
+  -> init:'a 
+  -> f: ('a -> [ `Err | `Out ] * [ `EOF | `Read of string ] -> 'a) 
+  -> Unix.process_status * 'a
+(** Run grep command *)
 
+val grep_ : string list -> Unix.process_status
+(** Run grep command but just returns the result *)
       | 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
+
+  let must_exit_with ?name n = function
+    | WEXITED m when n = m -> ()
+    | e -> failwith ?name e
+
+  let from_exit ?name = function
+    | WEXITED m -> m
+    | e -> failwith ?name e
+
 end
 
 let open_proc_full cmdargs input output error toclose =
     
 let open_shell_process_full cmd = open_process_full [ "/bin/sh"; "-c"; cmd ]
 
-
-let buf_flush_limit = 100000
-
-    
-let command_aux readers stat =
-  let read_buflen = 4096 in
-  let read_buf = String.create read_buflen in
-
-  let try_read_lines fd buf : (string list * bool (* eof *)) =
-    let read_bytes = 
-      try Some (read fd read_buf 0 read_buflen) with
-      | Unix_error ((EAGAIN | EWOULDBLOCK), _, _) -> None
-    in
-    match read_bytes with
-    | None -> [], false
-    | Some 0 -> (* eof *)
-        let s = Buffer.contents buf in
-        (if s = "" then [] else [s]), true
-    | Some len ->
-        let buffer_old_len = Buffer.length buf in
-        Buffer.add_substring buf read_buf 0 len;
-
-        let pos_in_buffer pos = buffer_old_len + pos in
-        
-        let rec get_lines st from_in_buffer pos =  
-          match
-            if pos >= len then None
-            else Xstring.index_from_to read_buf pos (len-1) '\n'
-          with
-          | None ->
-              let rem =
-                Buffer.sub buf
-                  from_in_buffer
-                  (Buffer.length buf - from_in_buffer)
-              in
-              Buffer.clear buf;
-              if String.length rem > buf_flush_limit then rem :: st
-              else begin
-                Buffer.add_string buf rem; st
-              end
-          | Some pos ->
-              let next_from_in_buffer = pos_in_buffer pos + 1 in
-              let line =
-                Buffer.sub buf
-                  from_in_buffer
-                  (next_from_in_buffer - from_in_buffer)
-              in
-              get_lines (line :: st) next_from_in_buffer (pos + 1)
-        in
-        List.rev (get_lines [] 0 0), false
-  in
-
-  let rec loop readers stat =
-    if readers = [] then stat (* no more reader and no need to loop *)
-    else begin
-      let fds = List.map (fun (fd, _, _) -> fd) readers in 
-      let readables, _, _ = select fds [] [](*?*) (-1.0)(*?*) in
-      let readers', stat = 
-        List.fold_right (fun (fd, buf, fs as reader) (st, stat) ->
-          if not (List.mem fd readables) then
-            (reader :: st, stat)
-          else begin
-            let rec loop stat =
-              let lines, is_eof = try_read_lines fd buf in
-              if lines <> [] then begin
-                let stat = 
-                  List.fold_left (fun stat line ->
-                    List.fold_left (fun stat f -> f stat (`Read line)) stat fs) stat lines
-                in
-                if not is_eof then loop stat else is_eof, stat
-              end else is_eof, stat 
-            in
-            match loop stat with
-            | true (*eof*), stat ->
-	        (* reached eof. remove the reader *)
-	        let stat = List.fold_left (fun stat f -> f stat `EOF) stat fs in
-                close fd; 
-	        st, stat
-            | false, stat -> reader :: st, stat
-          end) readers ([], stat)
-      in
-      loop readers' stat
-    end
-  in
-  loop readers stat
-
-
 let rec waitpid_non_intr pid =
   try 
     waitpid [] pid 
   with Unix_error (EINTR, _, _) -> waitpid_non_intr pid
 
-    
-let command_wrapper (pid, (out, in_, err)) f ~init:stat =
-  try
-    close in_;
-    set_nonblock out;
-    set_nonblock err;
-    
-    let buf_out = Buffer.create buf_flush_limit in
-    let buf_err = Buffer.create buf_flush_limit in
+module Command = struct
+  let buf_flush_limit = 100000
+  
+  let command_aux readers stat =
+    let read_buflen = 4096 in
+    let read_buf = String.create read_buflen in
+  
+    let try_read_lines fd buf : (string list * bool (* eof *)) =
+      let read_bytes = 
+        try Some (read fd read_buf 0 read_buflen) with
+        | Unix_error ((EAGAIN | EWOULDBLOCK), _, _) -> None
+      in
+      match read_bytes with
+      | None -> [], false
+      | Some 0 -> (* eof *)
+          let s = Buffer.contents buf in
+          (if s = "" then [] else [s]), true
+      | Some len ->
+          let buffer_old_len = Buffer.length buf in
+          Buffer.add_substring buf read_buf 0 len;
+  
+          let pos_in_buffer pos = buffer_old_len + pos in
+          
+          let rec get_lines st from_in_buffer pos =  
+            match
+              if pos >= len then None
+              else Xstring.index_from_to read_buf pos (len-1) '\n'
+            with
+            | None ->
+                let rem =
+                  Buffer.sub buf
+                    from_in_buffer
+                    (Buffer.length buf - from_in_buffer)
+                in
+                Buffer.clear buf;
+                if String.length rem > buf_flush_limit then rem :: st
+                else begin
+                  Buffer.add_string buf rem; st
+                end
+            | Some pos ->
+                let next_from_in_buffer = pos_in_buffer pos + 1 in
+                let line =
+                  Buffer.sub buf
+                    from_in_buffer
+                    (next_from_in_buffer - from_in_buffer)
+                in
+                get_lines (line :: st) next_from_in_buffer (pos + 1)
+          in
+          List.rev (get_lines [] 0 0), false
+    in
+  
+    let rec loop readers stat =
+      if readers = [] then stat (* no more reader and no need to loop *)
+      else begin
+        let fds = List.map (fun (fd, _, _) -> fd) readers in 
+        let readables, _, _ = select fds [] [](*?*) (-1.0)(*?*) in
+        let readers', stat = 
+          List.fold_right (fun (fd, buf, fs as reader) (st, stat) ->
+            if not (List.mem fd readables) then
+              (reader :: st, stat)
+            else begin
+              let rec loop stat =
+                let lines, is_eof = try_read_lines fd buf in
+                if lines <> [] then begin
+                  let stat = 
+                    List.fold_left (fun stat line ->
+                      List.fold_left (fun stat f -> f stat (`Read line)) stat fs) stat lines
+                  in
+                  if not is_eof then loop stat else is_eof, stat
+                end else is_eof, stat 
+              in
+              match loop stat with
+              | true (*eof*), stat ->
+  	        (* reached eof. remove the reader *)
+  	        let stat = List.fold_left (fun stat f -> f stat `EOF) stat fs in
+                  close fd; 
+  	        st, stat
+              | false, stat -> reader :: st, stat
+            end) readers ([], stat)
+        in
+        loop readers' stat
+      end
+    in
+    loop readers stat
 
-    let stat = command_aux
-      [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
-  with
-  | e ->
-      (* kill really ? *)
-      kill pid 9;
-      ignore (waitpid_non_intr pid);
-      raise e
 
+  let command_wrapper (pid, (out, in_, err)) ~f ~init:stat =
+    try
+      close in_;
+      set_nonblock out;
+      set_nonblock err;
+      
+      let buf_out = Buffer.create buf_flush_limit in
+      let buf_err = Buffer.create buf_flush_limit in
+  
+      let stat = command_aux
+        [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
+    with
+    | e ->
+        (* kill really ? *)
+        kill pid 9;
+        ignore (waitpid_non_intr pid);
+        raise e
+  
+  type 'st t = f:('st -> [`Out | `Err] * [ `Read of string | `EOF ] -> 'st) -> init:'st -> Unix.process_status * 'st 
+  
+  let command cmd = command_wrapper (open_process_full cmd)
+  let shell_command cmd = command_wrapper (open_shell_process_full cmd)
+  
+  let fold com ~init ~f = com ~f ~init
+  let iter (com : _ t) ~f = com ~f:(fun () i -> f i)  ~init:() |> fst
 
-let print_all = function
-  | `Err, `Read s -> prerr_endline & Xstring.chop_newline s
-  | `Out, `Read s -> print_endline & Xstring.chop_newline s
-  | _ -> ()
-
-let command ?(f=print_all) cmd = 
-  fst & command_wrapper (open_process_full cmd) (fun () -> f) ~init:()
-
-let shell_command ?(f=print_all) cmd = 
-  fst & command_wrapper (open_shell_process_full cmd) (fun () -> f) ~init:() 
-
-let command' cmd = command_wrapper (open_process_full cmd)
-let shell_command' cmd = command_wrapper (open_shell_process_full cmd)
-
-let shell_command_stdout cmd = 
-  match 
-    command_wrapper (open_shell_process_full cmd) ~init:[] (fun rev -> function 
-      | `Err, `Read s -> prerr_endline & Xstring.chop_newline s; rev
-      | `Out, `Read s ->  s :: rev
-      | _ -> rev)
-  with
-  | stat, rev -> stat, List.rev rev
-
+  let print com = iter com ~f:(function
+    | `Err, `Read s -> prerr_endline & Xstring.chop_newline s
+    | `Out, `Read s -> print_endline & Xstring.chop_newline s
+    | _ -> ())
+  
+  let ignore_output com = iter com ~f:(fun _ -> ())
+  
+  let shell_command_stdout cmd = 
+    match 
+      command_wrapper (open_shell_process_full cmd) 
+        ~init:[]
+        ~f: (fun rev -> function 
+          | `Err, `Read s -> prerr_endline & Xstring.chop_newline s; rev
+          | `Out, `Read s ->  s :: rev
+          | _ -> rev)
+    with
+    | stat, rev -> stat, List.rev rev
+end
 
 let gen_timed get minus f v = 
   let t1 = get () in
 module Process_status : sig
 
   val failwith : ?name:string -> Unix.process_status -> 'a
+  val must_exit_with : ?name:string -> int -> Unix.process_status -> unit
+  val from_exit : ?name:string -> Unix.process_status -> int
 
 end
 
-val shell_command :
-  ?f: ([> `Out | `Err] * [ `Read of string | `EOF ] -> unit) 
-  -> string 
-  -> Unix.process_status
-(** Execute a shell command using /bin/sh *)
+module Command : sig
 
-val command :
-  ?f: ([> `Out | `Err] * [ `Read of string | `EOF ] -> unit) 
-  -> string list
-  -> Unix.process_status
-(** Same as [shell_command] but it takes the command and arguments as a list of string,
-    then directly executed by [Unix.execvp]. *)
+  type 'st t
 
-val shell_command' :
-  string 
-  -> ('st -> [> `Out | `Err] * [ `Read of string | `EOF ] -> 'st) 
-  -> init: 'st 
-  -> Unix.process_status * 'st
-(** Execute a shell command using /bin/sh *)
+  val shell_command : string -> 'st t
+  (** 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
-(** Same as [shell_command] but it takes the command and arguments as a list of string,
-    then directly executed by [Unix.execvp]. *)
+  val command : string list -> 'st t
+  (** 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
-(** Execute a shell command using /bin/sh
-    Err is printed to stderr.
- *)
+  val fold : 
+    'st t
+    -> init:'st 
+    -> f:('st -> [`Out | `Err] * [`Read of string | `EOF] -> 'st) 
+    -> Unix.process_status * 'st
+
+  val iter : 
+    unit t
+    -> f:([`Out | `Err] * [`Read of string | `EOF] -> unit) 
+    -> Unix.process_status
+
+  val print :
+    unit t
+    -> Unix.process_status
+  (** Output to stdout and stderr of the command are sent to stdout and stderr
+      resp.ly. *)
+    
+  val ignore_output :
+    unit t
+    -> Unix.process_status
+    
+  val shell_command_stdout :
+    string -> Unix.process_status * string list
+  (** Execute a shell command using /bin/sh
+      Err is printed to stderr.
+  *)
+end
 
 val timed : ('a -> 'b) -> 'a -> 'b * float (* in sec *)