1(***********************************************************************) 2(* *) 3(* Htmlc *) 4(* *) 5(* Pierre Weis, INRIA Rocquencourt *) 6(* *) 7(* Copyright 2009, *) 8(* Institut National de Recherche en Informatique et en Automatique. *) 9(* Distributed only by permission. *) 10(* *) 11(***********************************************************************) 12 13(* $Id: execute.ml,v 1.1 2009/02/19 20:28:11 weis Exp $ *) 14 15(** {3 Operating system level execution} *) 16 17(** {6 Executing a system command and registering its ouput in a buffer} *) 18 19let htmlc_command htmlc_add_string src_name ob command_name = 20 let ic = Unix.open_process_in command_name in 21 let ib = Bytes.create Configuration.line_buffer_length in 22 let status = 23 let rec loop () = 24 let n = input ic ib 0 Configuration.line_buffer_length in 25 if n > 0 then (htmlc_add_string ob (Bytes.sub_string ib 0 n); loop ()) 26 else raise End_of_file in 27 try loop () with 28 | End_of_file -> 29 (match Unix.close_process_in ic with 30 | Unix.WEXITED n -> n 31 | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> 2) in 32 if status <> 0 then 33 Debug.failwith 34 (Printf.sprintf 35 "file %s: command %s failed to execute properly." 36 src_name command_name) 37;; 38 39let command command_name = 40 let ob = Buffer.create Configuration.line_buffer_length in 41 htmlc_command Buffer.add_string "<abstract>" ob command_name; 42 Buffer.contents ob 43;; 44 45(** {6 Executing a CGI command and registering its ouput in a buffer} *) 46let htmlc_cgi _htmlc_add_string src_name _ob _cgi_name = 47 Debug.failwith (Printf.sprintf "file %s: cgi not yet implemented" src_name) 48;; 49 50let cgi cgi_name = 51 let ob = Buffer.create Configuration.line_buffer_length in 52 ignore (htmlc_cgi Buffer.add_string "<abstract>" ob cgi_name); 53 Buffer.contents ob 54;; 55