X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/5ad00addff68d8957629499e019c4a001051aca4..2ee5022632bb4c4f183991b387e4eff7f76dbad8:/src/main-admin.sml diff --git a/src/main-admin.sml b/src/main-admin.sml dissimilarity index 61% index 0af7088..201456e 100644 --- a/src/main-admin.sml +++ b/src/main-admin.sml @@ -1,59 +1,60 @@ -(* HCoop Domtool (http://hcoop.sourceforge.net/) - * Copyright (c) 2006, Adam Chlipala - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. - *) - -(* Driver for admin requests *) - -fun requestPerms user = - case Main.requestListPerms user of - NONE => () - | SOME classes => - (print ("Permissions for " ^ user ^ ":\n"); - app (fn (class, values) => - (print (class ^ ":"); - app (fn value => print (" " ^ value)) values; - print "\n")) classes) - -val _ = - case CommandLine.arguments () of - ["shutdown"] => Main.requestShutdown () - | ["grant", user, class, value] => Main.requestGrant {user = user, class = class, value = value} - | ["revoke", user, class, value] => Main.requestRevoke {user = user, class = class, value = value} - | ["perms", user] => requestPerms user - | ["perms"] => requestPerms (Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid (Posix.ProcEnv.getuid ()))) - | ["whohas", class, value] => - (case Main.requestWhoHas {class = class, value = value} of - NONE => () - | SOME users => - (print ("whohas " ^ class ^ " / " ^ value ^ ":"); - app (fn user => print (" " ^ user)) users; - print "\n")) - | "rmdom" :: doms => Main.requestRmdom doms - | ["regen"] => Main.requestRegen () - | ["regen", "-tc"] => Main.requestRegenTc () - | ["rmuser", user] => Main.requestRmuser user - | ["ping"] => OS.Process.exit (Main.requestPing ()) - | ["slave-shutdown"] => Main.requestSlaveShutdown () - | ["slave-ping"] => OS.Process.exit (Main.requestSlavePing ()) - | ["package", node, pkg] => OS.Process.exit (Main.requestApt {node = node, pkg = pkg}) - | ["cron", node, uname] => OS.Process.exit (Main.requestCron {node = node, uname = uname}) - | ["ftp", node, uname] => OS.Process.exit (Main.requestFtp {node = node, uname = uname}) - | ["tpe", node, uname] => OS.Process.exit (Main.requestTrustedPath {node = node, uname = uname}) - | ["sockperm", node, uname] => OS.Process.exit (Main.requestSocketPerm {node = node, uname = uname}) - | ["firewall", node, uname] => OS.Process.exit (Main.requestFirewall {node = node, uname = uname}) - | _ => (print "Invalid command-line arguments\n"; - print "See the documentation: http://wiki.hcoop.net/wiki/DomTool/AdminProcedures\n") +(* HCoop Domtool (http://hcoop.sourceforge.net/) + * Copyright (c) 2006, Adam Chlipala + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + *) + +(* Driver for admin requests *) + +fun requestPerms user = + case Main.requestListPerms user of + NONE => () + | SOME classes => + (print ("Permissions for " ^ user ^ ":\n"); + app (fn (class, values) => + (print (class ^ ":"); + app (fn value => print (" " ^ value)) values; + print "\n")) classes) + +val _ = + (case CommandLine.arguments () of + ["shutdown"] => Main.requestShutdown () + | ["grant", user, class, value] => Main.requestGrant {user = user, class = class, value = value} + | ["revoke", user, class, value] => Main.requestRevoke {user = user, class = class, value = value} + | ["perms", user] => requestPerms user + | ["perms"] => requestPerms (Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid (Posix.ProcEnv.getuid ()))) + | ["whohas", class, value] => + (case Main.requestWhoHas {class = class, value = value} of + NONE => () + | SOME users => + (print ("whohas " ^ class ^ " / " ^ value ^ ":"); + app (fn user => print (" " ^ user)) users; + print "\n")) + | "rmdom" :: doms => Main.requestRmdom doms + | ["regen"] => Main.requestRegen () + | ["regen", "-tc"] => Main.requestRegenTc () + | ["rmuser", user] => Main.requestRmuser user + | ["ping"] => OS.Process.exit (Main.requestPing ()) + | ["slave-shutdown"] => Main.requestSlaveShutdown () + | ["slave-ping"] => OS.Process.exit (Main.requestSlavePing ()) + | ["package", node, pkg] => OS.Process.exit (Main.requestApt {node = node, pkg = pkg}) + | ["cron", node, uname] => OS.Process.exit (Main.requestCron {node = node, uname = uname}) + | ["ftp", node, uname] => OS.Process.exit (Main.requestFtp {node = node, uname = uname}) + | ["tpe", node, uname] => OS.Process.exit (Main.requestTrustedPath {node = node, uname = uname}) + | ["sockperm", node, uname] => OS.Process.exit (Main.requestSocketPerm {node = node, uname = uname}) + | ["firewall", node, uname] => OS.Process.exit (Main.requestFirewall {node = node, uname = uname}) + | _ => (print "Invalid command-line arguments\n"; + print "See the documentation: http://wiki.hcoop.net/wiki/DomTool/AdminProcedures\n")) + handle OpenSSL.OpenSSL s => print ("OpenSSL exception: " ^ s ^ "\n")