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