add password, send back data

ocluster.ml

@@ -19,8 +19,8 @@ let show_process_status fmt = function
 
 type answer = {
     id : int;
-    stdout : string;
-    stderr : string;
+    stdout : string option;
+    stderr : string option;
     ret_code : Unix.process_status; [@printer show_process_status]
     pass : string;
 }
@@ -34,8 +34,8 @@ let run_computation (computation:computation) =
   Lwt_process.exec ?timeout:computation.time ~stdin:`Close ~stdout:(`FD_move write_stdout)
     ~stderr:(`FD_move write_stderr) (Lwt_process.shell computation.script)
   >>= fun ret_code ->
-  let%lwt stdout = Lwt_io.read_line (Lwt_io.of_fd ~mode:Lwt_io.input read_stdout) and
-    stderr = Lwt_io.read_line (Lwt_io.of_fd ~mode:Lwt_io.input read_stderr) in
+  let%lwt stdout = Lwt_io.read_line_opt (Lwt_io.of_fd ~mode:Lwt_io.input read_stdout) and
+    stderr = Lwt_io.read_line_opt (Lwt_io.of_fd ~mode:Lwt_io.input read_stderr) in
   Lwt.return { id = computation.id; stdout; stderr; ret_code; pass = computation.pass }
 
 let getinetaddrbyname name =
@@ -45,7 +45,7 @@ let getinetaddrbyname name =
 let stat oc =
   Lwt_io.write_value oc OK
 
-let server_handler port sockaddr (ic, oc) =
+let server_handler pass port sockaddr (ic, oc) =
   let sockaddr = match sockaddr with
     | Unix.ADDR_INET (a,_) -> Unix.ADDR_INET (a,port)
     | s -> s
@@ -54,12 +54,15 @@ let server_handler port sockaddr (ic, oc) =
     | Result.Ok query -> begin
         match query with
         | COMPUTATION computation ->
-          Lwt_io.write_value oc true
-          <&> Lwt_log.debug (Printf.sprintf "Receive computation: %s" (show_computation computation))
-          >>= fun () -> run_computation computation
-          >>= fun answer -> Lwt_io.with_connection sockaddr
-            (fun (ic, oc) -> Lwt_io.write_value oc answer)
-          >>= fun _ -> Lwt_log.debug (Printf.sprintf "End computation %i" computation.id)
+          if pass = computation.pass then begin
+            Lwt_io.write_value oc true
+            <&> Lwt_log.debug (Printf.sprintf "Receive computation: %s" (show_computation computation))
+            >>= fun () ->  run_computation computation
+            >>= fun answer -> Lwt_io.with_connection sockaddr
+              (fun (ic, oc) -> Lwt_io.write_value oc answer)
+            >>= fun () -> Lwt_log.debug (Printf.sprintf "End computation %i" computation.id)
+          end
+          else Lwt_io.write_value oc false <&> Lwt_log.warning "Wrong password"
         | STAT -> stat oc
                     <&> Lwt_log.debug "Receive a stat command"
       end
@@ -70,14 +73,20 @@ let server_handler port sockaddr (ic, oc) =
   Lwt_unix.sleep 2.
 ;;
 
-let main port =
+let stop_server resolver server _ = Lwt.wakeup_later resolver server
+
+let main pass port =
+  let promise, resolver = Lwt.task () in
   let template = "$(date).$(milliseconds) $(name)[$(pid)]: $(message)" in
   Lwt_log.file ~template ~perm:0o600 ~file_name:"test.log" ()
-  >>= fun x -> Lwt.return (Lwt_log.default := Lwt_log.broadcast [Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr (); x])
-  >>= fun () -> Lwt_io.establish_server_with_client_address (Unix.ADDR_INET (Unix.inet_addr_any, port)) (server_handler port)
-  >>= fun server -> Lwt_unix.sleep 200.
+  >|= (fun x -> Lwt_log.default := Lwt_log.broadcast [Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr (); x])
+  >>= fun () -> Lwt_io.establish_server_with_client_address (Unix.ADDR_INET (Unix.inet_addr_any, port)) (server_handler pass port)
+  >>= fun server -> let _ = Lwt_unix.on_signal 15 (stop_server resolver server) and
+    _ = Lwt_unix.on_signal 2 (stop_server resolver server) and
+    _ = Lwt_unix.on_signal 15 (stop_server resolver server) in promise
+  >>= fun server -> Lwt_io.shutdown_server server <&> Lwt_log.info "Shuting down server"
 
 let _ =
-  Lwt_main.run (main 2121)
+  Lwt_main.run (main "plopissecured" 2121)
 
 (*Lwt_io.with_connection (Lwt_unix.ADDR_INET (Unix.inet_addr_of_string "127.0.0.1", 2121)) (fun (ic,oc) -> Lwt_io.write_value oc (COMPUTATION {id = 0; script = "#echo penis\necho plop\nls"; time = None; pass = "wesh"}));;*)