Print on start of mysql-fixperms in domtool-server

[hcoop/domtool2.git] / src / main.sml

diff --git a/src/main.sml b/src/main.sml
index 02bb485..9b9d296 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -251,21 +251,37 @@ fun requestSlaveBio' printErr =
 
 fun requestSlaveBio () = requestSlaveBio' true
 
-fun request fname =
+fun request (fname, libOpt) =
     let
-       val (user, bio) = requestBio (fn () => ignore (check (basis ()) fname))
-
-       val inf = TextIO.openIn fname
+       val (user, bio) = requestBio (fn () =>
+                                        let
+                                            val env = basis ()
+                                            val env = case libOpt of
+                                                          NONE => env
+                                                        | SOME lib => #1 (check env lib)
+                                        in
+                                            ignore (check env fname)
+                                        end)
+
+       fun readFile fname =
+           let
+               val inf = TextIO.openIn fname
 
-       fun loop lines =
-           case TextIO.inputLine inf of
-               NONE => String.concat (List.rev lines)
-             | SOME line => loop (line :: lines)
+               fun loop lines =
+                   case TextIO.inputLine inf of
+                       NONE => String.concat (rev lines)
+                     | SOME line => loop (line :: lines)
+           in
+               loop []
+               before TextIO.closeIn inf
+           end
 
-       val code = loop []
+       val code = readFile fname
+       val msg = case libOpt of
+                     NONE => MsgConfig code
+                   | SOME fname' => MsgMultiConfig [readFile fname', code]
     in
-       TextIO.closeIn inf;
-       Msg.send (bio, MsgConfig code);
+       Msg.send (bio, msg);
        case Msg.recv bio of
            NONE => print "Server closed connection unexpectedly.\n"
          | SOME m =>
@@ -1128,10 +1144,12 @@ fun describeQuery q =
 
 fun service () =
     let
+       val host = Slave.hostname ()
+
        val () = Acl.read Config.aclFile
-       
-       val context = context (Config.serverCert,
-                              Config.serverKey,
+
+       val context = context (Config.certDir ^ "/" ^ host ^ ".pem",
+                              Config.keyDir ^ "/" ^ host ^ "/key.pem",
                               Config.trustStore)
        val _ = Domain.set_context context
 
@@ -1537,14 +1555,15 @@ fun service () =
                                      (fn () => ())
 
                               | MsgMysqlFixperms =>
-                                doIt (fn () => if OS.Process.isSuccess
-                                                      (OS.Process.system "/usr/bin/sudo -H /afs/hcoop.net/common/etc/scripts/mysql-grant-table-drop") then
-                                                   ("Requested mysql-fixperms",
-                                                    NONE)
+                                (print "Starting mysql-fixperms\n";
+                                 doIt (fn () => if OS.Process.isSuccess
+                                                       (OS.Process.system "/usr/bin/sudo -H /afs/hcoop.net/common/etc/scripts/mysql-grant-table-drop") then
+                                                    ("Requested mysql-fixperms",
+                                                     NONE)
                                                 else
                                                     ("Requested mysql-fixperms, but execution failed!",
                                                      SOME "Script execution failed."))
-                                     (fn () => ())
+                                      (fn () => ()))
 
                               | MsgDescribe dom =>
                                 doIt (fn () => if not (Domain.validDomain dom) then