Update of /cvsroot/hcoop/domtool2/src
In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv5446/src
Modified Files:
main.sml
Log Message:
Catch OpenSSL exceptions on slave connection acceptance
Index: main.sml
===================================================================
RCS file: /cvsroot/hcoop/domtool2/src/main.sml,v
retrieving revision 1.109
retrieving revision 1.110
diff -C2 -d -r1.109 -r1.110
*** main.sml 17 Feb 2009 16:46:03 -0000 1.109
--- main.sml 19 Feb 2009 14:19:56 -0000 1.110
***************
*** 1684,1750 ****
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 ())
in
loop ();
--- 1684,1757 ----
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 ()))
! 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 ();
------------------------------------------------------------------------------
Open Source Business Conference (OSBC), March 24-25, 2009, San Francisco, CA
-OSBC tackles the biggest issue in open source: Open Sourcing the Enterprise
-Strategies to boost innovation and cut costs with open source participation
-Receive a $600 discount off the registration fee with the source code: SFAD
http://p.sf.net/sfu/XcvMzF8H
_______________________________________________
hcoop-cvs mailing list
hcoop-cvs@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/hcoop-cvs
