X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/e0b80e65c8132f096ed5c92e42d4da7d33ff369b..e1b99e23f8d30efc7842ee006e0ff3ef0347b7df:/src/main.sml diff --git a/src/main.sml b/src/main.sml index bea07af..a8cf180 100644 --- a/src/main.sml +++ b/src/main.sml @@ -170,7 +170,13 @@ val dispatcher = val self = "localhost:" ^ Int.toString Config.slavePort -fun requestContext f = +fun context x = + (OpenSSL.context false x) + handle e as OpenSSL.OpenSSL _ => + (print "Couldn't find your certificate.\nYou probably haven't been given any Domtool privileges.\n"; + raise e) + +fun setupUser () = let val user = case Posix.ProcEnv.getenv "DOMTOOL_USER" of @@ -181,15 +187,21 @@ fun requestContext f = Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid) end | SOME user => user - - val () = Acl.read Config.aclFile - val () = Domain.setUser user + in + Acl.read Config.aclFile; + Domain.setUser user; + user + end + +fun requestContext f = + let + val user = setupUser () val () = f () - val context = OpenSSL.context (Config.certDir ^ "/" ^ user ^ ".pem", - Config.keyDir ^ "/" ^ user ^ "/key.pem", - Config.trustStore) + val context = context (Config.certDir ^ "/" ^ user ^ ".pem", + Config.keyDir ^ "/" ^ user ^ "/key.pem", + Config.trustStore) in (user, context) end @@ -236,6 +248,14 @@ fun request fname = fun requestDir dname = let + val _ = if Posix.FileSys.access (dname, []) then + () + else + (print ("Can't access " ^ dname ^ ".\n"); + print "Did you mean to run domtool on a specific file, instead of asking for all\n"; + print "files in your ~/domtool directory?\n"; + OS.Process.exit OS.Process.failure) + val _ = ErrorMsg.reset () val (user, bio) = requestBio (fn () => checkDir dname) @@ -787,6 +807,8 @@ fun requestFirewall {node, uname} = fun regenerate context = let + val _ = ErrorMsg.reset () + val b = basis () val () = Tycheck.disallowExterns () @@ -840,13 +862,15 @@ fun regenerate context = val (_, files) = Order.order (SOME b) files in if !ErrorMsg.anyErrors then - print ("User " ^ user ^ "'s configuration has errors!\n") + (ErrorMsg.reset (); + print ("User " ^ user ^ "'s configuration has errors!\n")) else app eval' files end handle IO.Io _ => () | OS.SysErr (s, _) => print ("System error processing user " ^ user ^ ": " ^ s ^ "\n") - | ErrorMsg.Error => print ("User " ^ user ^ " had a compilation error.\n") + | ErrorMsg.Error => (ErrorMsg.reset (); + print ("User " ^ user ^ " had a compilation error.\n")) | _ => print "Unknown exception during regeneration!\n" in app contactNode Config.nodeIps; @@ -891,9 +915,9 @@ fun service () = let val () = Acl.read Config.aclFile - val context = OpenSSL.context (Config.serverCert, - Config.serverKey, - Config.trustStore) + val context = context (Config.serverCert, + Config.serverKey, + Config.trustStore) val _ = Domain.set_context context val sock = OpenSSL.listen (context, Config.dispatcherPort) @@ -1253,6 +1277,12 @@ fun service () = OpenSSL.close bio handle OpenSSL.OpenSSL _ => (); loop ()) + | IO.Io {name, function, cause} => + (print ("IO error: " ^ function ^ " for " ^ name ^ "\n"); + app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory cause); + OpenSSL.close bio + handle OpenSSL.OpenSSL _ => (); + loop ()) | e => (print "Unknown exception in main loop!\n"; app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e); @@ -1270,9 +1300,9 @@ fun slave () = let val host = Slave.hostname () - val context = OpenSSL.context (Config.certDir ^ "/" ^ host ^ ".pem", - Config.keyDir ^ "/" ^ host ^ "/key.pem", - Config.trustStore) + val context = context (Config.certDir ^ "/" ^ host ^ ".pem", + Config.keyDir ^ "/" ^ host ^ "/key.pem", + Config.trustStore) val sock = OpenSSL.listen (context, Config.slavePort)