From 4356ee2e1a539506c28d90bc171cfffe8e1998b4 Mon Sep 17 00:00:00 2001 From: Claudio Sacerdoti Coen Date: Thu, 15 May 2003 12:11:52 +0000 Subject: [PATCH] New: two new methods added * /newsession to create a new session on a given port (i.e. to fork a new UWOBO that starts listening on the new given port) * /kill to ask an UWOBO to finish the execution --- helm/uwobo/Makefile | 2 +- helm/uwobo/log/.cvsignore | 1 + helm/uwobo/uwobo.ml | 134 ++++++++++++++++++++++++++++++++----- helm/uwobo/uwobo_common.ml | 8 +++ 4 files changed, 128 insertions(+), 17 deletions(-) create mode 100644 helm/uwobo/log/.cvsignore diff --git a/helm/uwobo/Makefile b/helm/uwobo/Makefile index 8c59123e6..5aa0ed962 100644 --- a/helm/uwobo/Makefile +++ b/helm/uwobo/Makefile @@ -1,7 +1,7 @@ VERSION = 0.2.0 DISTDIR = uwobo-$(VERSION) DISTTARBALL = $(DISTDIR).tar.gz -REQUIRES = http gdome2 gdome2-xslt pcre unix +REQUIRES = http gdome2 gdome2-xslt pcre unix netclient COMMONOPTS = -package "$(REQUIRES)" -pp camlp4o OCAMLFIND = ocamlfind OCAMLC = $(OCAMLFIND) ocamlc $(COMMONOPTS) diff --git a/helm/uwobo/log/.cvsignore b/helm/uwobo/log/.cvsignore new file mode 100644 index 000000000..397b4a762 --- /dev/null +++ b/helm/uwobo/log/.cvsignore @@ -0,0 +1 @@ +*.log diff --git a/helm/uwobo/uwobo.ml b/helm/uwobo/uwobo.ml index 729c5c017..450449ec4 100644 --- a/helm/uwobo/uwobo.ml +++ b/helm/uwobo/uwobo.ml @@ -37,24 +37,31 @@ Http_common.debug := false ;; (* other settings *) let daemon_name = "UWOBO OCaml" ;; -let default_log_file = "uwobo.log" ;; (* relative to execution dir *) +let default_log_base_file = "log/uwobo_" ;; (* relative to execution dir *) +let default_log_extension = ".log" ;; let default_port = 58080 ;; let port_env_var = "UWOBO_PORT" ;; +let log_env_var = "UWOBO_LOG_FILE" ;; let default_media_type = "text/html" ;; let default_encoding = "utf8" ;; -let logfile = - Some (try Sys.getenv "UWOBO_LOG_FILE" with Not_found -> default_log_file) -;; -let logfile_perm = 0o640 ;; let port = try int_of_string (Sys.getenv port_env_var) with | Not_found -> default_port | Failure "int_of_string" -> - prerr_endline "Warning: invalid port, reverting to default"; - default_port + prerr_endline "Warning: invalid port number" ; + exit (-1) +;; +let logfilename_of_port ~use_log_env_var port = + (try + if use_log_env_var then Sys.getenv log_env_var else raise Not_found + with + Not_found -> + default_log_base_file ^ (string_of_int port) ^ default_log_extension) ;; +let logfile = logfilename_of_port true port;; +let logfile_perm = 0o640 ;; let respond_html body outchan = Http_daemon.respond ~body ~headers:["Content-Type", "text/html"] outchan @@ -162,8 +169,9 @@ let short_circuit_grandfather_and_client ~cmd ~cmd_pipe ~res_pipe outchan = return_error "Timeout!" outchan) ;; -let (add_cmd_RE, remove_cmd_RE, reload_cmd_RE) = - (Pcre.regexp "^add ", Pcre.regexp "^remove ", Pcre.regexp "^reload ") +let (add_cmd_RE, remove_cmd_RE, reload_cmd_RE, kill_cmd_RE) = + (Pcre.regexp "^add ", Pcre.regexp "^remove ", Pcre.regexp "^reload ", + Pcre.regexp "^kill") ;; (** raised by child processes when HTTP daemon process have to be restarted *) @@ -181,6 +189,61 @@ let log_libxslt_msgs logger libxslt_logger = (* LibXSLT logger *) let veillogger = new Uwobo_common.libXsltLogger ;; + (* start_new_session cmd_pipe_exit res_pipe_entrance outchan port logfile + @param cmd_pipe Pipe to be closed before forking + @param res_pipe Pipe to be closed before forking + @param outchan To be closed before forking + @param port The port to be used + @param logfile The logfile to redirect the stdout and sterr to + *) + (* It can raise Failure "Connection refused" *) + (* It can raise Failure "Port already in use" *) +let start_new_session cmd_pipe res_pipe outchan port logfile = + let environment = + (* Here I am loosing the current value of port_env_var; *) + (* this should not matter *) + Unix.putenv port_env_var (string_of_int port) ; + Unix.environment () + in + (* Let's check that the port is free *) + (try + ignore + (Http_client.Convenience.http_head_message + ("http://127.0.0.1:" ^ string_of_int port ^ "/help")) ; + raise (Failure "Port already in use") + with + Failure "Connection refused" -> () + ) ; + match Unix.fork () with + 0 -> + (* 1. We close all the open pipes to avoid duplicating them *) + Unix.close (Unix.descr_of_out_channel cmd_pipe) ; + Unix.close (Unix.descr_of_in_channel res_pipe) ; + Unix.close (Unix.descr_of_out_channel outchan) ; + (* 2. We redirect stdout and stderr to the logfile *) + Unix.close Unix.stdout ; + assert + (Unix.openfile logfile [Unix.O_WRONLY ; Unix.O_APPEND ; Unix.O_CREAT] + 0o664 = Unix.stdout) ; + Unix.close Unix.stderr ; + assert + (Unix.openfile logfile [Unix.O_WRONLY ; Unix.O_APPEND ; Unix.O_CREAT] + 0o664 = Unix.stderr) ; + prerr_endline "***** Starting a new session" ; + (* 3. We exec a new copy of uwobo *) + Unix.execve Sys.executable_name [||] environment ; + (* It should never reach this point *) + assert false + | child when child > 0 -> + (* let's check if the new UWOBO started correctly *) + Unix.sleep 5 ; + (* It can raise Failure "Connection refused" *) + ignore + (Http_client.Convenience.http_head_message + ("http://127.0.0.1:" ^ string_of_int port ^ "/help")) + | _ -> failwith "Can't fork :-(" +;; + (* request handler action @param syslogger Uwobo_logger.sysLogger instance used for logginf @param styles Uwobo_styles.styles instance which keeps the stylesheets list @@ -204,6 +267,48 @@ let callback let cmd = sprintf "add %s" (String.concat ";" bindings) in short_circuit_grandfather_and_client ~cmd ~cmd_pipe ~res_pipe outchan end) + | "/kill" -> + let logger = new Uwobo_logger.processingLogger () in + logger#log "Exiting" ; + respond_html logger#asHtml outchan ; + let cmd = "kill" in + short_circuit_grandfather_and_client ~cmd ~cmd_pipe ~res_pipe outchan + | "/newsession" -> + let logger = new Uwobo_logger.processingLogger () in + let port = int_of_string (req#param "port") in + let logfile = logfilename_of_port false port in + (try + start_new_session cmd_pipe res_pipe outchan port logfile ; + logger#log (sprintf "New session started: port = %d" port) ; + respond_html logger#asHtml outchan + with + Failure "int_of_string" -> + logger#log (sprintf "Invalid port number") ; + respond_html logger#asHtml outchan + | Failure "Port already in use" -> + Uwobo_common.return_error "port already in use" outchan + | Failure "Connection refused" -> + let log = ref [] in + (try + let ch = open_in logfile in + while true do log := (input_line ch ^ "\n") :: !log ; done + with + Sys_error _ + | End_of_file -> () + ) ; + let rec get_last_lines acc = + function + (n,he::tl) when n > 0 -> + get_last_lines (he ^ "
" ^ acc) (n-1,tl) + | _ -> acc + in + (* we just show the last 10 lines of the log file *) + let msg = + (if List.length !log > 0 then "
...
" else "
") ^ + get_last_lines "" (10,!log) + in + Uwobo_common.return_error "daemon not initialized" + ~body:msg outchan) | "/remove" -> let cmd = sprintf "remove %s" (req#param "keys") in short_circuit_grandfather_and_client ~cmd ~cmd_pipe ~res_pipe outchan @@ -275,13 +380,8 @@ let callback let main () = (* (1) system logger *) let logger_outchan = - match logfile with - | None -> - debug_print "Logging to standard error"; - stderr - | Some f -> - debug_print (sprintf "Logging to file %s" f); - open_out_gen [Open_wronly; Open_append; Open_creat] logfile_perm f + debug_print (sprintf "Logging to file %s" logfile); + open_out_gen [Open_wronly; Open_append; Open_creat] logfile_perm logfile in let syslogger = new Uwobo_logger.sysLogger ~level:debug_level ~outchan:logger_outchan () @@ -337,6 +437,8 @@ let main () = output_string res_pipe "UWOBOmaster: Hello, world!\n"; flush res_pipe; raise Restart_HTTP_daemon + | line when Pcre.pmatch ~rex:kill_cmd_RE line -> (* /kill *) + exit 0 | line when Pcre.pmatch ~rex:add_cmd_RE line -> (* /add *) let bindings = Pcre.split ~pat:";" (Pcre.replace ~rex:add_cmd_RE line) diff --git a/helm/uwobo/uwobo_common.ml b/helm/uwobo/uwobo_common.ml index 7ae0260ae..f7790923c 100644 --- a/helm/uwobo/uwobo_common.ml +++ b/helm/uwobo/uwobo_common.ml @@ -72,6 +72,14 @@ let usage_string = help
display this help message

+

+ newsession?port=p
+ starts a new daemon on a given port p +

+

+ kill
+ kills the daemon. The log file is mantained. +

add?bind=key,uri[&bind=key,uri[&...]]
load a new stylesheet, specified by uri, and bind it to key -- 2.39.5