X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/991d8e6619bc9ff2182a39cfbeead53bee768a99..201b83c73c5a4e09dcf4c3f2f9b94ded360c78c6:/src/main.sml diff --git a/src/main.sml b/src/main.sml index 6df1525..1552791 100644 --- a/src/main.sml +++ b/src/main.sml @@ -1,5 +1,6 @@ (* HCoop Domtool (http://hcoop.sourceforge.net/) * Copyright (c) 2006-2009, Adam Chlipala + * Copyright (c) 2012,2013,2014 Clinton Ebadi * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License @@ -207,7 +208,7 @@ fun eval G evs fname = | (G, NONE) => (G, evs) val dispatcher = - Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort + Domain.nodeIp Config.dispatcherName ^ ":" ^ Int.toString Config.dispatcherPort val self = "localhost:" ^ Int.toString Config.slavePort @@ -795,10 +796,13 @@ fun requestAptExists {node, pkg} = OS.Process.failure) | SOME m => case m of - MsgYes => (print "Package exists.\n"; - OS.Process.success) + MsgAptQuery {section,description} => (print "Package exists.\n"; + print ("Section: " ^ section ^ "\n"); + print ("Description: " ^ description ^ "\n"); + OS.Process.success) | MsgNo => (print "Package does not exist.\n"; - OS.Process.failure) + OS.Process.failure + (* It might be the Wrong Thing (tm) to use MsgNo like this *)) | MsgError s => (print ("APT existence query failed: " ^ s ^ "\n"); OS.Process.failure) | _ => (print "Unexpected server reply.\n"; @@ -934,7 +938,7 @@ fun requestFirewall {node, uname} = else Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort) - val _ = Msg.send (bio, MsgQuery (QFirewall uname)) + val _ = Msg.send (bio, MsgQuery (QFirewall {node = node, user = uname})) fun loop () = case Msg.recv bio of @@ -1087,7 +1091,7 @@ fun regenerateEither tc checker context = val ok = ref true fun contactNode (node, ip) = - if node = Config.defaultNode then + if node = Config.dispatcherName then Domain.resetLocal () else let val bio = OpenSSL.connect true (context, @@ -1213,12 +1217,14 @@ fun now () = Date.toString (Date.fromTimeUniv (Time.now ())) fun answerQuery q = case q of QApt pkg => if Apt.installed pkg then MsgYes else MsgNo - | QAptExists pkg => if Apt.exists pkg then MsgYes else MsgNo + | QAptExists pkg => (case Apt.info pkg of + SOME {section, description} => MsgAptQuery {section = section, description = description} + | NONE => MsgNo) | QCron user => if Cron.allowed user then MsgYes else MsgNo | QFtp user => if Ftp.allowed user then MsgYes else MsgNo | QTrustedPath user => if TrustedPath.query user then MsgYes else MsgNo | QSocket user => MsgSocket (SocketPerm.query user) - | QFirewall user => MsgFirewall (Firewall.query user) + | QFirewall {node, user} => MsgFirewall (Firewall.query (node, user)) fun describeQuery q = case q of @@ -1228,7 +1234,7 @@ fun describeQuery q = | QFtp user => "Asked about FTP permissions for user " ^ user | QTrustedPath user => "Asked about trusted path settings for user " ^ user | QSocket user => "Asked about socket permissions for user " ^ user - | QFirewall user => "Asked about firewall rules for user " ^ user + | QFirewall {node, user} => "Asked about firewall rules on " ^ node ^ " for user " ^ user fun doIt' loop bio f cleanup = ((case f () of @@ -1657,8 +1663,7 @@ fun slave () = val _ = print ("Slave server starting at " ^ now () ^ "\n") fun loop () = - (Acl.read Config.aclFile; - case OpenSSL.accept sock of + (case OpenSSL.accept sock of NONE => () | SOME bio => let @@ -1803,16 +1808,17 @@ fun slave () = SOME "Script execution failed.")) (fn () => ())) | MsgFirewallRegen => - doIt (fn () => if Acl.query {user = user, class = "priv", value = "all"} then - if List.exists (fn x => x = host) Config.Firewall.firewallNodes then - if (Firewall.generateFirewallConfig (Firewall.parseRules ()) andalso Firewall.publishConfig ()) - then - ("Firewall rules regenerated.", NONE) - else + doIt (fn () => (Acl.read Config.aclFile; + if Acl.query {user = user, class = "priv", value = "all"} then + if List.exists (fn x => x = host) Config.Firewall.firewallNodes then + if (Firewall.generateFirewallConfig (Firewall.parseRules ()) andalso Firewall.publishConfig ()) + then + ("Firewall rules regenerated.", NONE) + else ("Rules regeneration failed!", SOME "Script execution failed.") else ("Node not controlled by domtool firewall.", SOME (host)) - else - ("Not authorized to regenerate firewall.", SOME ("Unauthorized user " ^ user ^ " attempted to regenerated firewall"))) + else + ("Not authorized to regenerate firewall.", SOME ("Unauthorized user " ^ user ^ " attempted to regenerated firewall")))) (fn () => ()) | _ => (OpenSSL.close bio;