From: Adam Chlipala <adamc@hcoop.net>
Date: Thu, 19 Feb 2009 14:19:56 +0000 (+0000)
Subject: Catch OpenSSL exceptions on slave connection acceptance
X-Git-Tag: release_2010-11-19~12
X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/commitdiff_plain/4f5a3f954f8b8f0600b712deab694472ff1a2146

Catch OpenSSL exceptions on slave connection acceptance
---

diff --git a/src/main.sml b/src/main.sml
index f19dd8a..be4191b 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -1683,69 +1683,76 @@ fun slave () =
 	val _ = print ("Slave server starting at " ^ now () ^ "\n")
 
 	fun loop () =
-	    case OpenSSL.accept sock of
-		NONE => ()
-	      | SOME bio =>
-		let
-		    val peer = OpenSSL.peerCN bio
-		    val () = print ("\nConnection from " ^ peer ^ " at " ^ now () ^ "\n")
-		in
-		    if peer = Config.dispatcherName then let
-			    fun loop' files =
-				case Msg.recv bio of
-				    NONE => print "Dispatcher closed connection unexpectedly\n"
-				  | SOME m =>
-				    case m of
-					MsgFile file => loop' (file :: files)
-				      | MsgDoFiles => (Slave.handleChanges files;
-						       Msg.send (bio, MsgOk))
-				      | MsgRegenerate => (Domain.resetLocal ();
-							  Msg.send (bio, MsgOk))
-				      | _ => (print "Dispatcher sent unexpected command\n";
-					      Msg.send (bio, MsgError "Unexpected command"))
-			in
-			    loop' [];
-			    ignore (OpenSSL.readChar bio);
-			    OpenSSL.close bio;
-			    loop ()
-			end
-		    else if peer = "domtool" then
-			case Msg.recv bio of
-			    SOME MsgShutdown => (OpenSSL.close bio;
-						 print ("Shutting down at " ^ now () ^ "\n\n"))
-			  | _ => (OpenSSL.close bio;
-				  loop ())
-		    else
-			case Msg.recv bio of
-			    SOME (MsgQuery q) => (print (describeQuery q ^ "\n");
-						  Msg.send (bio, answerQuery q);
-						  ignore (OpenSSL.readChar bio);
-						  OpenSSL.close bio;
-						  loop ())
-			  | _ => (OpenSSL.close bio;
-				  loop ())
-		end handle OpenSSL.OpenSSL s =>
-			   (print ("OpenSSL error: " ^ s ^ "\n");
-			    OpenSSL.close bio
-					  handle OpenSSL.OpenSSL _ => ();
-			    loop ())
-			 | e as OS.SysErr (s, _) =>
-			   (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
-			    print ("System error: "^ s ^ "\n");
-			    OpenSSL.close bio
-			    handle OpenSSL.OpenSSL _ => ();
-			    loop ())
-			 | IO.Io {function, name, ...} =>
-			   (print ("IO error: " ^ function ^ ": " ^ name ^ "\n");
-			    OpenSSL.close bio
-			    handle OpenSSL.OpenSSL _ => ();
-			    loop ())
-			 | e =>
-			   (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
-			    print "Uncaught exception!\n";
-			    OpenSSL.close bio
-			    handle OpenSSL.OpenSSL _ => ();
-			    loop ())
+	    (case OpenSSL.accept sock of
+		 NONE => ()
+	       | SOME bio =>
+		 let
+		     val peer = OpenSSL.peerCN bio
+		     val () = print ("\nConnection from " ^ peer ^ " at " ^ now () ^ "\n")
+		 in
+		     if peer = Config.dispatcherName then let
+			     fun loop' files =
+				 case Msg.recv bio of
+				     NONE => print "Dispatcher closed connection unexpectedly\n"
+				   | SOME m =>
+				     case m of
+					 MsgFile file => loop' (file :: files)
+				       | MsgDoFiles => (Slave.handleChanges files;
+							Msg.send (bio, MsgOk))
+				       | MsgRegenerate => (Domain.resetLocal ();
+							   Msg.send (bio, MsgOk))
+				       | _ => (print "Dispatcher sent unexpected command\n";
+					       Msg.send (bio, MsgError "Unexpected command"))
+			 in
+			     loop' [];
+			     ignore (OpenSSL.readChar bio);
+			     OpenSSL.close bio;
+			     loop ()
+			 end
+		     else if peer = "domtool" then
+			 case Msg.recv bio of
+			     SOME MsgShutdown => (OpenSSL.close bio;
+						  print ("Shutting down at " ^ now () ^ "\n\n"))
+			   | _ => (OpenSSL.close bio;
+				   loop ())
+		     else
+			 case Msg.recv bio of
+			     SOME (MsgQuery q) => (print (describeQuery q ^ "\n");
+						   Msg.send (bio, answerQuery q);
+						   ignore (OpenSSL.readChar bio);
+						   OpenSSL.close bio;
+						   loop ())
+			   | _ => (OpenSSL.close bio;
+				   loop ())
+		 end handle OpenSSL.OpenSSL s =>
+			    (print ("OpenSSL error: " ^ s ^ "\n");
+			     OpenSSL.close bio
+			     handle OpenSSL.OpenSSL _ => ();
+			     loop ())
+			  | e as OS.SysErr (s, _) =>
+			    (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
+			     print ("System error: "^ s ^ "\n");
+			     OpenSSL.close bio
+			     handle OpenSSL.OpenSSL _ => ();
+			     loop ())
+			  | IO.Io {function, name, ...} =>
+			    (print ("IO error: " ^ function ^ ": " ^ name ^ "\n");
+			     OpenSSL.close bio
+			     handle OpenSSL.OpenSSL _ => ();
+			     loop ())
+			  | e =>
+			    (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
+			     print "Uncaught exception!\n";
+			     OpenSSL.close bio
+			     handle OpenSSL.OpenSSL _ => ();
+			     loop ()))
+	    handle OpenSSL.OpenSSL s =>
+		   (print ("OpenSSL error: " ^ s ^ "\n");
+		    loop ())
+		 | e =>
+		   (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
+		    print "Uncaught exception!\n";
+		    loop ())
     in
 	loop ();
 	OpenSSL.shutdown sock