Commit 1889ad3b authored by Erwan Jahier's avatar Erwan Jahier
Browse files

A better call-via-socket: a -server mode, better options handling, better error messages

parent 27bb4691
......@@ -6,7 +6,7 @@
OCAMLNCFLAGS = -inline 10
LIBS = unix
LIBS = unix str
CLIBS =
USE_CAMLP4 = yes
......
(*-----------------------------------------------------------------------
** Copyright (C) - Verimag.
** This file may only be copied under the terms of the GNU Library General
** Public License
**-----------------------------------------------------------------------
**
** File: call-via-socket.ml
** Author: jahier@imag.fr
*)
** Copyright (C) - Verimag.
** This file may only be copied under the terms of the GNU Library General
** Public License
**-----------------------------------------------------------------------
**
** File: call-via-socket.ml
** Author: jahier@imag.fr
*)
(* Launching a program using socket instead of stdin/stdout *)
(* Launch prog and connect its stdin/stdout to sockets *)
let usage = "call-via-socket <inet address> <port> <prog> <arg>*
nb : stderr is redirected to a log file.
let usage = "call-via-socket -addr <inet address> -port <port> [-serveur] \"<prog> <args>\"
Launch prog args connecting its stdin/stdout to a socket and stderr is to a log file.
Fails (with exit code 2) if the port is not available.
"
let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 ;;
let log_file = (Sys.argv.(3) ^ "-via-sockets-stderr.log")
let client_mode = ref true
let inet_addr = ref (Unix.inet_addr_of_string "127.0.0.1")
let port = ref 2000
let rec speclist =
[
"-addr", Arg.String(fun str -> inet_addr := Unix.inet_addr_of_string str),
"<string>\tSocket inet address (127.0.0.1 by default)";
"-port", Arg.Int(fun str -> port := str),
"<int>\tSocket port (2000 by default)";
"-server", Arg.Unit(fun () -> client_mode := false),
"\tThe prog plays the role of the server (and the role if the client if unset)";
"--help", Arg.Unit (fun _ -> (Arg.usage speclist usage ; exit 0)),
"\tDisplay this list of options." ;
"-help", Arg.Unit (fun _ -> (Arg.usage speclist usage ; exit 0)),
"";
"-h", Arg.Unit (fun _ -> (Arg.usage speclist usage ; exit 0)),
""
]
(* Parsing command line args *)
let prog, args =
try
let prog = ref "" in
let set_prog str = prog := !prog ^ " " ^ str in
let prog =
Arg.parse speclist set_prog usage;
(Str.split (Str.regexp "[ \t]+") !prog)
in
List.hd prog, Array.of_list prog
with
| Failure(e) -> output_string stdout e; flush_all(); exit 2
| e -> output_string stdout (Printexc.to_string e); flush_all(); exit 2
let log_file = (prog ^ "-via-sockets-stderr.log")
let log = open_out log_file
let _ =
......@@ -33,8 +72,13 @@ let _ =
exit 2
)
let inet_addr = Unix.inet_addr_of_string (Sys.argv.(1))
let port = int_of_string (Sys.argv.(2))
(*****************************************************************************)
(* Socket administration stuff *)
let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0
let inet_addr = !inet_addr
let inet_addr_str = Unix.string_of_inet_addr inet_addr
let port = !port
let rec connect_loop sock addr k =
try Unix.connect sock addr
......@@ -47,55 +91,64 @@ let rec connect_loop sock addr k =
else
failwith "call-via-socket: cannot connect to the socket"
let (sock_in,sock_out) =
try
connect_loop sock (Unix.ADDR_INET(inet_addr, port)) 10 ;
(* connect ne marche que si il y a un accept en attente cot
serveur. Cela entraine une course critique entre le serveur
et le client. Pour y remdier, on essaie 10 fois en attendant
une seconde chaque essai. *)
(Unix.in_channel_of_descr sock, Unix.out_channel_of_descr sock)
let (sock_in, sock_out) =
try
if !client_mode then
(
connect_loop sock (Unix.ADDR_INET(inet_addr, port)) 100 ;
(* connect ne marche que si il y a un accept en attente cot
serveur. Cela entraine une course critique entre le serveur
et le client. Pour y remdier, on essaie 10 fois en attendant
une seconde chaque essai. *)
Printf.fprintf log "call-via-socket: sock connection on %s:%d succeeded " inet_addr_str port;
(Unix.in_channel_of_descr sock, Unix.out_channel_of_descr sock)
)
else
( (* Serveur mode *)
Unix.bind sock (Unix.ADDR_INET(inet_addr, port));
Unix.listen sock 1;
let sock,_ = Unix.accept sock (* bloquant *) in
Printf.fprintf log "call-via-socket -server: sock connection on %s:%d accepted.\n" inet_addr_str port;
(Unix.in_channel_of_descr sock, Unix.out_channel_of_descr sock)
)
with
Unix.Unix_error(errcode, funcstr, paramstr) ->
print_string "call-via-socket connect failure: ";
print_string (Unix.error_message errcode);
print_string ("(" ^ funcstr ^ " " ^ paramstr ^")\n");
flush stdout;
output_string log "call-via-socket connect failure: ";
output_string log (Unix.error_message errcode);
output_string log ("(" ^ funcstr ^ " " ^ paramstr ^")\n");
flush log;
exit 2
let prog = Sys.argv.(3)
let args = Array.make ((Array.length Sys.argv) - 3) prog
let _ =
for i = 3 to Array.length Sys.argv - 1 do
args.(i-3) <- Sys.argv.(i)
done
(*****************************************************************************)
(* Forking *)
let pid =
output_string log (" call-via-socket "^Sys.argv.(3)^":");
output_string log ("call-via-socket "^prog^":");
output_string log " create child process with '";
for i = 0 to Array.length args -1 do
output_string log (" " ^args.(i));
output_string log (args.(i)^ " ");
done;
output_string log "'\n";
flush log;
Unix.create_process prog args
Unix.create_process prog args
(Unix.descr_of_in_channel sock_in)
(Unix.descr_of_out_channel sock_out)
(Unix.descr_of_out_channel log)
let _ =
output_string log ("call-via-socket "^prog^": the process creation succeeded.\n");
flush log;
let pid, pstatus = (Unix.waitpid [] pid) in
(* ignore(Unix.wait()); *)
output_string log (" call-via-socket "^Sys.argv.(3)^":");
output_string log ("call-via-socket "^prog^":");
(match pstatus with
Unix.WEXITED i -> output_string log (
" the process terminated exit " ^ (string_of_int i) ^"\n")
" the process terminated with exit code " ^ (string_of_int i) ^"\n")
| Unix.WSIGNALED i -> output_string log (
" the process was killed by signal " ^ (string_of_int i) ^"\n")
| Unix.WSTOPPED i -> output_string log (
" the process was stopped by signal " ^ (string_of_int i) ^"\n")
);
output_string log (" call-via-socket "^Sys.argv.(3)^": bye. \n");
output_string log ("call-via-socket "^prog^": bye. \n");
flush log;
close_out log
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment