- fun loop (buf, len) =
- let
- val r = F_OpenSSL_SML_write.f' (bio, C.Ptr.inject' buf, len)
- in
- if r = len then
- ()
- else if r <= 0 then
- (C.free' buf;
- raise OpenSSL "BIO_write failed")
- else
- loop (C.Ptr.|+! C.S.uchar (buf, Int32.toInt r), Int32.- (len, r))
- end
+ val sock = OpenSSL.listen (context, Config.dispatcherPort)
+
+ fun loop () =
+ case OpenSSL.accept sock of
+ NONE => ()
+ | SOME bio =>
+ let
+ val user = OpenSSL.peerCN bio
+ val () = print ("\nConnection from " ^ user ^ "\n")
+ val () = Domain.setUser user
+
+ fun cmdLoop () =
+ case Msg.recv bio of
+ NONE => (OpenSSL.close bio
+ handle OpenSSL.OpenSSL _ => ();
+ loop ())
+ | SOME m =>
+ case m of
+ MsgConfig code =>
+ let
+ val _ = print "Configuration:\n"
+ val _ = print code
+ val _ = print "\n"
+
+ val outname = OS.FileSys.tmpName ()
+ val outf = TextIO.openOut outname
+ in
+ TextIO.output (outf, code);
+ TextIO.closeOut outf;
+ (eval outname;
+ Msg.send (bio, MsgOk))
+ handle ErrorMsg.Error =>
+ (print "Compilation error\n";
+ Msg.send (bio,
+ MsgError "Error during configuration evaluation"))
+ | OpenSSL.OpenSSL s =>
+ (print "OpenSSL error\n";
+ Msg.send (bio,
+ MsgError
+ ("Error during configuration evaluation: "
+ ^ s)));
+ OS.FileSys.remove outname;
+ (ignore (OpenSSL.readChar bio);
+ OpenSSL.close bio)
+ handle OpenSSL.OpenSSL _ => ();
+ loop ()
+ end
+ | _ =>
+ (Msg.send (bio, MsgError "Unexpected command")
+ handle OpenSSL.OpenSSL _ => ();
+ OpenSSL.close bio
+ handle OpenSSL.OpenSSL _ => ();
+ loop ())
+ in
+ cmdLoop ()
+ end