[Xen-API] [PATCH] Merge Stunnel.attempt_one_connect_new into Stunnel.attempt_one_connect and other minor improvements

[Zheng Li <dev@xxxxxxxx>]

Signed-off-by: Zheng Li <dev@xxxxxxxx>


 stunnel/stunnel.ml |  183 ++++++++++++++++++++-------------------------
 1 files changed, 80 insertions(+), 103 deletions(-)


diff -r 30faec648dfb -r 704a6cc45f4b stunnel/stunnel.ml
--- a/stunnel/stunnel.ml        Tue Mar 23 00:39:58 2010 +0000
+++ b/stunnel/stunnel.ml        Wed Mar 31 10:26:20 2010 +0100
@@ -29,6 +29,7 @@
 let new_stunnel_path = "/usr/sbin/stunnelng"
 
 let cached_stunnel_path = ref None
+let stunnel_logger = ref ignore
 
 let init_stunnel_path () =
   try cached_stunnel_path := Some (Unix.getenv "XE_STUNNEL")
@@ -142,112 +143,83 @@
    exception instead *)
 exception Stunnel_initialisation_failed
 
-let attempt_one_connect_new ?unique_id ?(use_external_fd_wrapper = true) 
?(write_to_log = fun _ -> ()) verify_cert extended_diagnosis host port = 
-  assert (not verify_cert); (* !!! Unimplemented *)
-  assert (not extended_diagnosis); (* !!! Unimplemented *)
-  let data_out,data_in = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
-  let args = [ "-m"; "client"; "-s"; "-"; "-d"; Printf.sprintf "%s:%d" host 
port ] in
-  let t = { pid = Nopid; fd = data_out; host = host; port = port; 
-           connected_time = Unix.gettimeofday (); unique_id = unique_id;
-           logfile = "" } in
-  let to_close = ref [ data_in ] in
-  let result = Forkhelpers.with_logfile_fd "stunnel" (fun logfd ->
-    let fdops = [
-      Unsafe.Dup2(data_in, Unix.stdin);
-      Unsafe.Dup2(data_in, Unix.stdout);
-      Unsafe.Dup2(logfd, Unix.stderr)
-    ] in
-    let fds_needed = [ Unix.stdin; Unix.stdout; Unix.stderr ] in
-    t.pid <- (
-      if use_external_fd_wrapper then
-        FEFork (Forkhelpers.safe_close_and_exec (Some data_in) (Some data_in) 
(Some logfd) [] (stunnel_path ()) args)
-      else
-               StdFork(Unsafe.fork_and_exec ~pre_exec:(fun _ -> 
-          List.iter Unsafe.do_fd_operation fdops;
-          Unixext.close_all_fds_except fds_needed
-               
-               ) ((stunnel_path ()) :: args))
-    );
-    List.iter Unix.close [ data_in ];
-  ) in
-  List.iter Unix.close !to_close; 
-  match result with
-  | Forkhelpers.Failure(log, exn) ->
-      write_to_log ("failed: Log from stunnel: [" ^ log ^ "]");
-      disconnect t;
-      raise exn
-  | Forkhelpers.Success(log, _) -> 
-      write_to_log ("success: Log from stunnel: [" ^ log ^ "]");
-      t
 
 (* Internal function which may throw Stunnel_initialisation_failed *)
-let attempt_one_connect ?unique_id ?(use_external_fd_wrapper = true) 
?(write_to_log = fun _ -> ()) verify_cert extended_diagnosis host port =
-  let data_out,data_in = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0
-  and config_out, config_in = Unix.pipe ()
-  in
-  let config_out_uuid = Uuid.to_string (Uuid.make_uuid ()) in
-  (* FDs we must close. NB stdin_in and stdout_out end up in our 't' record *)
-  let to_close = ref [ data_in; config_out; config_in  ] in
-  let close fd = 
-    if List.mem fd !to_close 
-    then (Unix.close fd; to_close := List.filter (fun x -> x <> fd) !to_close) 
in
-  let t = { pid = Nopid; fd = data_out; host = host; port = port; 
-           connected_time = Unix.gettimeofday (); unique_id = unique_id;
-           logfile = "" } in
+let attempt_one_connect ?unique_id ?(use_external_fd_wrapper = true)
+    ?(write_to_log = fun _ -> ()) verify_cert extended_diagnosis host port =
+  let fds_needed = ref [ Unix.stdin; Unix.stdout; Unix.stderr ] in
+  let config_in, config_out, configs, args = 
+    if !use_new_stunnel
+    then begin
+      assert (not verify_cert); (* !! Unimplemented *)
+      let args = [ "-m"; "client"; "-s"; "-"; "-d"; 
+                   Printf.sprintf "%s:%d" host port ] in
+      None, None, [], (if extended_diagnosis then "-v" :: args else args)
+    end else begin
+      let config_out, config_in = Unix.pipe () in
+      let config_out_uuid = Uuid.to_string (Uuid.make_uuid ()) in
+      let config_out_fd = 
+        string_of_int (Unixext.int_of_file_descr config_out) in
+      fds_needed := config_out :: !fds_needed;
+      Some config_in, Some config_out, [(config_out_uuid, config_out)],
+      ["-fd"; if use_external_fd_wrapper then config_out_uuid else 
config_out_fd]
+    end in
+  let data_out,data_in = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
+  let t = 
+    { pid = Nopid; fd = data_out; host = host; port = port; 
+      connected_time = Unix.gettimeofday (); unique_id = unique_id; 
+      logfile = "" } in
   let result = Forkhelpers.with_logfile_fd "stunnel"
     ~delete:(not extended_diagnosis)
     (fun logfd ->
        let path = stunnel_path() in
        let fdops = 
-        [ Unsafe.Dup2(data_in, Unix.stdin);
-          Unsafe.Dup2(data_in, Unix.stdout);
-          Unsafe.Dup2(logfd, Unix.stderr) ] in
-       let fds_needed = [ Unix.stdin; Unix.stdout; Unix.stderr; config_out ] in
-       let args_external = [ "-fd"; config_out_uuid ] in
-          let args_internal = [ "-fd"; string_of_int 
(Unixext.int_of_file_descr config_out) ] in
-       if use_external_fd_wrapper then begin
-        let cmdline = Printf.sprintf "Using commandline: %s\n" (String.concat 
" " (path::args_external)) in
-        write_to_log cmdline;
-       end;
+         [ Unsafe.Dup2(data_in, Unix.stdin);
+                Unsafe.Dup2(data_in, Unix.stdout);
+                Unsafe.Dup2(logfd, Unix.stderr) ] in
        t.pid <-
-        if use_external_fd_wrapper
-        then FEFork(Forkhelpers.safe_close_and_exec (Some data_in) (Some 
data_in) (Some logfd) [(config_out_uuid, config_out)] path args_external)
-        else StdFork(Unsafe.fork_and_exec ~pre_exec:
-                         (fun _ -> 
-                           List.iter Unsafe.do_fd_operation fdops;
-                           Unixext.close_all_fds_except fds_needed) 
-                         (path::args_internal));
-       List.iter close [ data_in; config_out; ]; 
+         if use_external_fd_wrapper then begin
+                let cmdline = Printf.sprintf "Using commandline: %s\n" 
(String.concat " " (path::args)) in
+                write_to_log cmdline;
+                FEFork(Forkhelpers.safe_close_and_exec 
+                    (Some data_in) (Some data_in) (Some logfd) configs path 
args)
+         end else
+                StdFork(Unsafe.fork_and_exec 
+                     ~pre_exec:(fun _ -> 
+                                                   List.iter 
Unsafe.do_fd_operation fdops;
+                                                   
Unixext.close_all_fds_except !fds_needed) 
+                                      (path::args));
+       (match config_out with Some fd -> Unix.close fd | _ -> ());
+       Unix.close data_in;
        (* Make sure we close config_in eventually *)
-       finally
-        (fun () ->
-
-           let pidmsg = Printf.sprintf "stunnel has pidty: %s\n" 
(string_of_pid t.pid) in
-           write_to_log pidmsg;
-
-           let config = config_file verify_cert extended_diagnosis host port in
-           (* Catch the occasional initialisation failure of stunnel: *)
-           try
-             let n = Unix.write config_in config 0 (String.length config) in
-             if n < String.length config then raise 
Stunnel_initialisation_failed
-           with Unix.Unix_error(err, fn, arg) -> 
-             write_to_log (Printf.sprintf "Caught Unix.Unix_error(%s, %s, %s); 
raising Stunnel_initialisation_failed" (Unix.error_message err) fn arg);
-             raise Stunnel_initialisation_failed)
-        (fun () -> close config_in)) in
-    (* Tidy up any remaining unclosed fds *)
-  List.iter Unix.close !to_close; 
+         finally
+              (fun () ->
+                 let pidmsg = Printf.sprintf "stunnel has pidty: %s" 
(string_of_pid t.pid) in
+                 write_to_log pidmsg;
+            match config_in with
+            | Some fd -> begin
+                     let config = config_file verify_cert extended_diagnosis 
host port in
+                     (* Catch the occasional initialisation failure of 
stunnel: *)
+                     try
+                       let n = Unix.write fd config 0 (String.length config) in
+                       if n < String.length config then raise 
Stunnel_initialisation_failed
+                     with Unix.Unix_error(err, fn, arg) -> 
+                       write_to_log (Printf.sprintf "Caught 
Unix.Unix_error(%s, %s, %s); raising Stunnel_initialisation_failed" 
(Unix.error_message err) fn arg);
+                       raise Stunnel_initialisation_failed
+              end 
+            | _ -> ())
+              (fun () -> match config_in with Some fd -> Unix.close fd | _ -> 
assert false)) in
+  (* Tidy up any remaining unclosed fds *)
   match result with
   | Forkhelpers.Success(log, _) -> 
-      if extended_diagnosis then
-        begin
-          write_to_log "success";
-          t.logfile <- log
-        end
-      else
-        write_to_log ("success: Log from stunnel: [" ^ log ^ "]");
+      if extended_diagnosis then begin
+        write_to_log "stunnel start";
+        t.logfile <- log
+      end else
+        write_to_log ("stunnel start: Log from stunnel: [" ^ log ^ "]");
       t
   | Forkhelpers.Failure(log, exn) ->
-      write_to_log ("failed: Log from stunnel: [" ^ log ^ "]");
+      write_to_log ("stunnel abort: Log from stunnel: [" ^ log ^ "]");
       disconnect t;
       raise exn
 
@@ -274,12 +246,13 @@
                ?(extended_diagnosis=false)
                host
                port = 
-       let connect = if !use_new_stunnel then attempt_one_connect_new else 
attempt_one_connect in
        let _verify_cert = match verify_cert with
                | Some x -> x
-               | None -> Sys.file_exists verify_certificates_ctrl
-       in
-       retry (fun () -> connect ?unique_id ?use_external_fd_wrapper 
?write_to_log _verify_cert extended_diagnosis host port) 5
+               | None -> Sys.file_exists verify_certificates_ctrl in
+  let _ = match write_to_log with 
+    | Some logger -> stunnel_logger := logger
+    | None -> () in
+       retry (fun () -> attempt_one_connect ?unique_id 
?use_external_fd_wrapper ?write_to_log _verify_cert extended_diagnosis host 
port) 5
 
 let sub_after i s =
   let len = String.length s in
@@ -312,14 +285,18 @@
     
 let diagnose_failure st_proc =
   let check_line line =
-    Printf.eprintf "stunnel_failure: %s\n" line;
+    !stunnel_logger line;
     check_verify_error line;
-    check_error "Connection refused" line; 
+    check_error "Connection refused" line;
     check_error "No host resolved" line;
-    check_error "Invalid argument" line;
-  in
-    Unixext.readfile_line check_line st_proc.logfile;
-    raise (Stunnel_error (Unixext.read_whole_file_to_string st_proc.logfile))
+    check_error "Invalid argument" line in
+  Unixext.readfile_line check_line st_proc.logfile
+  (* If we reach here the whole stunnel log should have been gone through
+     (possibly printed/logged somewhere. No necessity to raise an exception,
+     since when this function being called, there is usually some exception
+     already existing in the caller's context, and it's not necessary always a
+     stunnel error.
+  *)
 
 let test host port = 
   let counter = ref 0 in

Attachment: xen-api-lib.patch
Description: Text Data

_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api