1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006-2009, Adam Chlipala
4 * This program is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU General Public License
6 * as published by the Free Software Foundation; either version 2
7 * of the License, or (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
21 structure Main :> MAIN = struct
23 open Ast MsgTypes Print
25 structure SM = StringMap
27 fun init () = Acl.read Config.aclFile
29 fun isLib fname = OS.Path.file fname = "lib.dtl"
31 fun wrapFile (fname, file) =
32 case (isLib fname, file) of
33 (true, (comment, ds, SOME e)) =>
37 (comment, ds, SOME (ELocal (e, (ESkip, loc)), loc))
43 val prog = Parse.parse fname
44 val prog = wrapFile (fname, prog)
46 if !ErrorMsg.anyErrors then
52 Option.app (Unused.check G) (#3 prog);
53 Tycheck.checkFile G (Defaults.tInit prog) prog)
58 val dir = Posix.FileSys.opendir Config.libRoot
61 case Posix.FileSys.readdir dir of
62 NONE => (Posix.FileSys.closedir dir;
65 if String.isSuffix ".dtl" fname then
66 loop (OS.Path.joinDirFile {dir = Config.libRoot,
73 val (_, files) = Order.order NONE files
75 if !ErrorMsg.anyErrors then
78 (Tycheck.allowExterns ();
79 foldl (fn (fname, G) => check' G fname) Env.empty files
80 before Tycheck.disallowExterns ())
83 (* val b = basis () *)
87 val _ = ErrorMsg.reset ()
88 val _ = Env.preTycheck ()
90 if !ErrorMsg.anyErrors then
94 val _ = Tycheck.disallowExterns ()
95 val _ = ErrorMsg.reset ()
96 val prog = Parse.parse fname
97 val prog = wrapFile (fname, prog)
99 if !ErrorMsg.anyErrors then
103 val G' = Tycheck.checkFile G (Defaults.tInit prog) prog
105 if !ErrorMsg.anyErrors then
111 Option.app (Unused.check G) (#3 prog);
118 String.sub (s, 0) <> #"."
119 andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-") s
124 case Posix.ProcEnv.getenv "DOMTOOL_USER" of
127 val uid = Posix.ProcEnv.getuid ()
129 Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid)
133 Acl.read Config.aclFile;
138 fun checkDir' dname =
142 val dir = Posix.FileSys.opendir dname
145 case Posix.FileSys.readdir dir of
146 NONE => (Posix.FileSys.closedir dir;
150 loop (OS.Path.joinDirFile {dir = dname,
157 val (_, files) = Order.order (SOME b) files
159 if !ErrorMsg.anyErrors then
162 (foldl (fn (fname, G) => check' G fname) b files;
163 if !ErrorMsg.anyErrors then
175 val (G, body) = check G fname
177 if !ErrorMsg.anyErrors then
183 val body' = Reduce.reduceExp G body
185 (*printd (PD.hovBox (PD.PPS.Rel 0,
186 [PD.string "Result:",
194 (*(Defaults.eInit ())*)
196 fun eval G evs fname =
197 case reduce G fname of
199 if !ErrorMsg.anyErrors then
203 val evs' = Eval.exec' evs body'
207 | (G, NONE) => (G, evs)
210 Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort
213 "localhost:" ^ Int.toString Config.slavePort
216 (OpenSSL.context false x)
217 handle e as OpenSSL.OpenSSL s =>
218 (print "Couldn't find your certificate.\nYou probably haven't been given any Domtool privileges.\n";
219 print ("I looked in: " ^ #1 x ^ "\n");
220 print ("Additional information: " ^ s ^ "\n");
223 fun requestContext f =
225 val user = setupUser ()
229 val context = context (Config.certDir ^ "/" ^ user ^ ".pem",
230 Config.keyDir ^ "/" ^ user ^ "/key.pem",
236 fun requestBio' printErr f =
238 val (user, context) = requestContext f
240 (user, OpenSSL.connect printErr (context, dispatcher))
243 val requestBio = requestBio' true
245 fun requestSlaveBio' printErr =
247 val (user, context) = requestContext (fn () => ())
249 (user, OpenSSL.connect printErr (context, self))
252 fun requestSlaveBio () = requestSlaveBio' true
254 fun request (fname, libOpt) =
256 val (user, bio) = requestBio (fn () =>
259 val env = case libOpt of
261 | SOME lib => #1 (check env lib)
263 ignore (check env fname)
268 val inf = TextIO.openIn fname
271 case TextIO.inputLine inf of
272 NONE => String.concat (rev lines)
273 | SOME line => loop (line :: lines)
276 before TextIO.closeIn inf
279 val code = readFile fname
280 val msg = case libOpt of
281 NONE => MsgConfig code
282 | SOME fname' => MsgMultiConfig [readFile fname', code]
286 NONE => print "Server closed connection unexpectedly.\n"
289 MsgOk => print "Configuration succeeded.\n"
290 | MsgError s => print ("Configuration failed: " ^ s ^ "\n")
291 | _ => print "Unexpected server reply.\n";
294 handle ErrorMsg.Error => ()
296 fun requestDir dname =
298 val _ = if Posix.FileSys.access (dname, []) then
301 (print ("Can't access " ^ dname ^ ".\n");
302 print "Did you mean to run domtool on a specific file, instead of asking for all\n";
303 print "files in your ~/.domtool directory?\n";
304 OS.Process.exit OS.Process.failure)
306 val _ = ErrorMsg.reset ()
308 val (user, bio) = requestBio (fn () => checkDir' dname)
312 val dir = Posix.FileSys.opendir dname
315 case Posix.FileSys.readdir dir of
316 NONE => (Posix.FileSys.closedir dir;
320 loop (OS.Path.joinDirFile {dir = dname,
327 val (_, files) = Order.order (SOME b) files
329 val _ = if !ErrorMsg.anyErrors then
334 val codes = map (fn fname =>
336 val inf = TextIO.openIn fname
339 case TextIO.inputLine inf of
340 NONE => String.concat (rev lines)
341 | SOME line => loop (line :: lines)
344 before TextIO.closeIn inf
347 if !ErrorMsg.anyErrors then
350 (Msg.send (bio, MsgMultiConfig codes);
352 NONE => print "Server closed connection unexpectedly.\n"
355 MsgOk => print "Configuration succeeded.\n"
356 | MsgError s => print ("Configuration failed: " ^ s ^ "\n")
357 | _ => print "Unexpected server reply.\n";
360 handle ErrorMsg.Error => ()
364 val (_, bio) = requestBio' false (fn () => ())
369 handle _ => OS.Process.failure
371 fun requestShutdown () =
373 val (_, bio) = requestBio (fn () => ())
375 Msg.send (bio, MsgShutdown);
380 MsgOk => print "Shutdown begun.\n"
381 | MsgError s => print ("Shutdown failed: " ^ s ^ "\n")
382 | _ => print "Unexpected server reply.\n";
386 fun requestSlavePing () =
388 val (_, bio) = requestSlaveBio' false
393 handle _ => OS.Process.failure
395 fun requestSlaveShutdown () =
397 val (_, bio) = requestSlaveBio ()
399 Msg.send (bio, MsgShutdown);
404 MsgOk => print "Shutdown begun.\n"
405 | MsgError s => print ("Shutdown failed: " ^ s ^ "\n")
406 | _ => print "Unexpected server reply.\n";
410 fun requestGrant acl =
412 val (user, bio) = requestBio (fn () => ())
414 Msg.send (bio, MsgGrant acl);
416 NONE => print "Server closed connection unexpectedly.\n"
419 MsgOk => print "Grant succeeded.\n"
420 | MsgError s => print ("Grant failed: " ^ s ^ "\n")
421 | _ => print "Unexpected server reply.\n";
425 fun requestRevoke acl =
427 val (user, bio) = requestBio (fn () => ())
429 Msg.send (bio, MsgRevoke acl);
431 NONE => print "Server closed connection unexpectedly.\n"
434 MsgOk => print "Revoke succeeded.\n"
435 | MsgError s => print ("Revoke failed: " ^ s ^ "\n")
436 | _ => print "Unexpected server reply.\n";
440 fun requestListPerms user =
442 val (_, bio) = requestBio (fn () => ())
444 Msg.send (bio, MsgListPerms user);
445 (case Msg.recv bio of
446 NONE => (print "Server closed connection unexpectedly.\n";
450 MsgPerms perms => SOME perms
451 | MsgError s => (print ("Listing failed: " ^ s ^ "\n");
453 | _ => (print "Unexpected server reply.\n";
455 before OpenSSL.close bio
458 fun requestWhoHas perm =
460 val (_, bio) = requestBio (fn () => ())
462 Msg.send (bio, MsgWhoHas perm);
463 (case Msg.recv bio of
464 NONE => (print "Server closed connection unexpectedly.\n";
468 MsgWhoHasResponse users => SOME users
469 | MsgError s => (print ("whohas failed: " ^ s ^ "\n");
471 | _ => (print "Unexpected server reply.\n";
473 before OpenSSL.close bio
476 fun requestRegen () =
478 val (_, bio) = requestBio (fn () => ())
480 Msg.send (bio, MsgRegenerate);
482 NONE => print "Server closed connection unexpectedly.\n"
485 MsgOk => print "Regeneration succeeded.\n"
486 | MsgError s => print ("Regeneration failed: " ^ s ^ "\n")
487 | _ => print "Unexpected server reply.\n";
491 fun requestRegenTc () =
493 val (_, bio) = requestBio (fn () => ())
495 Msg.send (bio, MsgRegenerateTc);
497 NONE => print "Server closed connection unexpectedly.\n"
500 MsgOk => print "All configuration validated.\n"
501 | MsgError s => print ("Configuration validation failed: " ^ s ^ "\n")
502 | _ => print "Unexpected server reply.\n";
506 fun requestRmdom dom =
508 val (_, bio) = requestBio (fn () => ())
510 Msg.send (bio, MsgRmdom dom);
512 NONE => print "Server closed connection unexpectedly.\n"
515 MsgOk => print "Removal succeeded.\n"
516 | MsgError s => print ("Removal failed: " ^ s ^ "\n")
517 | _ => print "Unexpected server reply.\n";
521 fun requestRmuser user =
523 val (_, bio) = requestBio (fn () => ())
525 Msg.send (bio, MsgRmuser user);
527 NONE => print "Server closed connection unexpectedly.\n"
530 MsgOk => print "Removal succeeded.\n"
531 | MsgError s => print ("Removal failed: " ^ s ^ "\n")
532 | _ => print "Unexpected server reply.\n";
536 fun requestDbUser dbtype =
538 val (_, context) = requestContext (fn () => ())
539 val bio = OpenSSL.connect true (context,
540 Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
542 Msg.send (bio, MsgCreateDbUser dbtype);
544 NONE => print "Server closed connection unexpectedly.\n"
547 MsgOk => print "Your user has been created.\n"
548 | MsgError s => print ("Creation failed: " ^ s ^ "\n")
549 | _ => print "Unexpected server reply.\n";
553 fun requestDbPasswd rc =
555 val (_, context) = requestContext (fn () => ())
556 val bio = OpenSSL.connect true (context,
557 Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
559 Msg.send (bio, MsgDbPasswd rc);
561 NONE => print "Server closed connection unexpectedly.\n"
564 MsgOk => print "Your password has been changed.\n"
565 | MsgError s => print ("Password set failed: " ^ s ^ "\n")
566 | _ => print "Unexpected server reply.\n";
570 fun requestDbTable p =
572 val (user, context) = requestContext (fn () => ())
573 val bio = OpenSSL.connect true (context,
574 Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
576 Msg.send (bio, MsgCreateDb p);
578 NONE => print "Server closed connection unexpectedly.\n"
581 MsgOk => print ("Your database " ^ user ^ "_" ^ #dbname p ^ " has been created.\n")
582 | MsgError s => print ("Creation failed: " ^ s ^ "\n")
583 | _ => print "Unexpected server reply.\n";
587 fun requestDbDrop p =
589 val (user, context) = requestContext (fn () => ())
590 val bio = OpenSSL.connect true (context,
591 Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
593 Msg.send (bio, MsgDropDb p);
595 NONE => print "Server closed connection unexpectedly.\n"
598 MsgOk => print ("Your database " ^ user ^ "_" ^ #dbname p ^ " has been dropped.\n")
599 | MsgError s => print ("Drop failed: " ^ s ^ "\n")
600 | _ => print "Unexpected server reply.\n";
604 fun requestDbGrant p =
606 val (user, context) = requestContext (fn () => ())
607 val bio = OpenSSL.connect true (context,
608 Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
610 Msg.send (bio, MsgGrantDb p);
612 NONE => print "Server closed connection unexpectedly.\n"
615 MsgOk => print ("You've been granted all allowed privileges to database " ^ user ^ "_" ^ #dbname p ^ ".\n")
616 | MsgError s => print ("Grant failed: " ^ s ^ "\n")
617 | _ => print "Unexpected server reply.\n";
621 fun requestListMailboxes domain =
623 val (_, bio) = requestBio (fn () => ())
625 Msg.send (bio, MsgListMailboxes domain);
626 (case Msg.recv bio of
627 NONE => Vmail.Error "Server closed connection unexpectedly."
630 MsgMailboxes users => (Msg.send (bio, MsgOk);
632 | MsgError s => Vmail.Error ("Listing failed: " ^ s)
633 | _ => Vmail.Error "Unexpected server reply.")
634 before OpenSSL.close bio
637 fun requestNewMailbox p =
639 val (_, bio) = requestBio (fn () => ())
641 Msg.send (bio, MsgNewMailbox p);
643 NONE => print "Server closed connection unexpectedly.\n"
646 MsgOk => print ("A mapping for " ^ #user p ^ "@" ^ #domain p ^ " has been created.\n")
647 | MsgError s => print ("Creation failed: " ^ s ^ "\n")
648 | _ => print "Unexpected server reply.\n";
652 fun requestPasswdMailbox p =
654 val (_, bio) = requestBio (fn () => ())
656 Msg.send (bio, MsgPasswdMailbox p);
658 NONE => print "Server closed connection unexpectedly.\n"
661 MsgOk => print ("The password for " ^ #user p ^ "@" ^ #domain p ^ " has been changed.\n")
662 | MsgError s => print ("Set failed: " ^ s ^ "\n")
663 | _ => print "Unexpected server reply.\n";
667 fun requestRmMailbox p =
669 val (_, bio) = requestBio (fn () => ())
671 Msg.send (bio, MsgRmMailbox p);
673 NONE => print "Server closed connection unexpectedly.\n"
676 MsgOk => print ("The mapping for mailbox " ^ #user p ^ "@" ^ #domain p ^ " has been deleted.\n")
677 | MsgError s => print ("Remove failed: " ^ s ^ "\n")
678 | _ => print "Unexpected server reply.\n";
682 fun requestSaQuery addr =
684 val (_, bio) = requestBio (fn () => ())
686 Msg.send (bio, MsgSaQuery addr);
687 (case Msg.recv bio of
688 NONE => print "Server closed connection unexpectedly.\n"
691 MsgSaStatus b => (print ("SpamAssassin filtering for " ^ addr ^ " is "
692 ^ (if b then "ON" else "OFF") ^ ".\n");
693 Msg.send (bio, MsgOk))
694 | MsgError s => print ("Query failed: " ^ s ^ "\n")
695 | _ => print "Unexpected server reply.\n")
696 before OpenSSL.close bio
701 val (_, bio) = requestBio (fn () => ())
703 Msg.send (bio, MsgSaSet p);
705 NONE => print "Server closed connection unexpectedly.\n"
708 MsgOk => print ("SpamAssassin filtering for " ^ #1 p ^ " is now "
709 ^ (if #2 p then "ON" else "OFF") ^ ".\n")
710 | MsgError s => print ("Set failed: " ^ s ^ "\n")
711 | _ => print "Unexpected server reply.\n";
715 fun requestSmtpLog domain =
717 val (_, bio) = requestBio (fn () => ())
719 val _ = Msg.send (bio, MsgSmtpLogReq domain)
723 NONE => print "Server closed connection unexpectedly.\n"
727 | MsgSmtpLogRes line => (print line;
729 | MsgError s => print ("Log search failed: " ^ s ^ "\n")
730 | _ => print "Unexpected server reply.\n"
736 fun requestMysqlFixperms () =
738 val (_, context) = requestContext (fn () => ())
739 val bio = OpenSSL.connect true (context,
740 Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
742 Msg.send (bio, MsgMysqlFixperms);
744 NONE => print "Server closed connection unexpectedly.\n"
747 MsgOk => print "Permissions granted.\n"
748 | MsgError s => print ("Failed: " ^ s ^ "\n")
749 | _ => print "Unexpected server reply.\n";
753 fun requestApt {node, pkg} =
755 val (user, context) = requestContext (fn () => ())
756 val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
759 Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
761 val _ = Msg.send (bio, MsgQuery (QApt pkg))
765 NONE => (print "Server closed connection unexpectedly.\n";
769 MsgYes => (print "Package is installed.\n";
771 | MsgNo => (print "Package is not installed.\n";
773 | MsgError s => (print ("APT query failed: " ^ s ^ "\n");
775 | _ => (print "Unexpected server reply.\n";
779 before OpenSSL.close bio
782 fun requestAptExists {node, pkg} =
784 val (user, context) = requestContext (fn () => ())
785 val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
788 Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
790 val _ = Msg.send (bio, MsgQuery (QAptExists pkg))
794 NONE => (print "Server closed connection unexpectedly.\n";
798 MsgYes => (print "Package exists.\n";
800 | MsgNo => (print "Package does not exist.\n";
802 | MsgError s => (print ("APT existence query failed: " ^ s ^ "\n");
804 | _ => (print "Unexpected server reply.\n";
808 before OpenSSL.close bio
811 fun requestCron {node, uname} =
813 val (user, context) = requestContext (fn () => ())
814 val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
817 Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
819 val _ = Msg.send (bio, MsgQuery (QCron uname))
823 NONE => (print "Server closed connection unexpectedly.\n";
827 MsgYes => (print "User has cron permissions.\n";
829 | MsgNo => (print "User does not have cron permissions.\n";
831 | MsgError s => (print ("Cron query failed: " ^ s ^ "\n");
833 | _ => (print "Unexpected server reply.\n";
837 before OpenSSL.close bio
840 fun requestFtp {node, uname} =
842 val (user, context) = requestContext (fn () => ())
843 val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
846 Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
848 val _ = Msg.send (bio, MsgQuery (QFtp uname))
852 NONE => (print "Server closed connection unexpectedly.\n";
856 MsgYes => (print "User has FTP permissions.\n";
858 | MsgNo => (print "User does not have FTP permissions.\n";
860 | MsgError s => (print ("FTP query failed: " ^ s ^ "\n");
862 | _ => (print "Unexpected server reply.\n";
866 before OpenSSL.close bio
869 fun requestTrustedPath {node, uname} =
871 val (user, context) = requestContext (fn () => ())
872 val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
875 Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
877 val _ = Msg.send (bio, MsgQuery (QTrustedPath uname))
881 NONE => (print "Server closed connection unexpectedly.\n";
885 MsgYes => (print "User has trusted path restriction.\n";
887 | MsgNo => (print "User does not have trusted path restriction.\n";
889 | MsgError s => (print ("Trusted path query failed: " ^ s ^ "\n");
891 | _ => (print "Unexpected server reply.\n";
895 before OpenSSL.close bio
898 fun requestSocketPerm {node, uname} =
900 val (user, context) = requestContext (fn () => ())
901 val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
904 Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
906 val _ = Msg.send (bio, MsgQuery (QSocket uname))
910 NONE => (print "Server closed connection unexpectedly.\n";
914 MsgSocket p => (case p of
916 | Client => print "Client\n"
917 | Server => print "Server\n"
918 | Nada => print "Nada\n";
920 | MsgError s => (print ("Socket permission query failed: " ^ s ^ "\n");
922 | _ => (print "Unexpected server reply.\n";
926 before OpenSSL.close bio
929 fun requestFirewall {node, uname} =
931 val (user, context) = requestContext (fn () => ())
932 val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
935 Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
937 val _ = Msg.send (bio, MsgQuery (QFirewall uname))
941 NONE => (print "Server closed connection unexpectedly.\n";
945 MsgFirewall ls => (app (fn s => (print s; print "\n")) ls;
947 | MsgError s => (print ("Firewall query failed: " ^ s ^ "\n");
949 | _ => (print "Unexpected server reply.\n";
953 before OpenSSL.close bio
956 fun requestDescribe dom =
958 val (_, bio) = requestBio (fn () => ())
960 Msg.send (bio, MsgDescribe dom);
962 NONE => print "Server closed connection unexpectedly.\n"
965 MsgDescription s => print s
966 | MsgError s => print ("Description failed: " ^ s ^ "\n")
967 | _ => print "Unexpected server reply.\n";
971 fun requestReUsers () =
973 val (_, bio) = requestBio (fn () => ())
975 Msg.send (bio, MsgReUsers);
977 NONE => print "Server closed connection unexpectedly.\n"
980 MsgOk => print "Callbacks run.\n"
981 | MsgError s => print ("Failed: " ^ s ^ "\n")
982 | _ => print "Unexpected server reply.\n";
986 fun requestFirewallRegen node =
988 val (user, context) = requestContext (fn () => ())
989 val bio = OpenSSL.connect true (context, Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
990 (* Only supporting on slave nodes *)
992 val _ = Msg.send (bio, MsgFirewallRegen)
994 fun handleResult () =
996 NONE => (print "Server closed connection unexpectedly.\n";
1000 MsgOk => (print "Firewall regenerated.\n";
1002 | MsgError s => (print ("Firewall regeneration failed: " ^ s ^ "\n");
1004 | _ => (print "Unexpected server reply.\n";
1008 before OpenSSL.close bio
1011 structure SS = StringSet
1013 fun domainList dname =
1015 val dir = Posix.FileSys.opendir dname
1017 fun visitNode dset =
1018 case Posix.FileSys.readdir dir of
1022 val path = OS.Path.joinDirFile {dir = dname,
1025 fun visitDomains (path, bfor, dset) =
1027 val dir = Posix.FileSys.opendir path
1030 case Posix.FileSys.readdir dir of
1034 val path = OS.Path.joinDirFile {dir = path,
1037 if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
1039 val bfor = dname :: bfor
1041 loop (visitDomains (path, bfor,
1043 String.concatWith "." bfor)))
1050 before Posix.FileSys.closedir dir
1053 visitNode (visitDomains (path, [], dset))
1057 before Posix.FileSys.closedir dir
1060 fun regenerateEither tc checker context =
1062 val () = print "Starting regeneration....\n"
1068 domainList Config.resultRoot
1076 val _ = ErrorMsg.reset ()
1079 val () = Tycheck.disallowExterns ()
1081 val () = ifReal (fn () =>
1082 (ignore (OS.Process.system ("rm -rf " ^ Config.oldResultRoot ^ "/*"));
1083 ignore (OS.Process.system ("cp -r " ^ Config.resultRoot
1084 ^ "/* " ^ Config.oldResultRoot ^ "/"));
1085 Domain.resetGlobal ()))
1089 fun contactNode (node, ip) =
1090 if node = Config.defaultNode then
1091 Domain.resetLocal ()
1093 val bio = OpenSSL.connect true (context,
1096 ^ Int.toString Config.slavePort)
1098 Msg.send (bio, MsgRegenerate);
1099 case Msg.recv bio of
1100 NONE => print "Slave closed connection unexpectedly\n"
1103 MsgOk => print ("Slave " ^ node ^ " pre-regeneration finished\n")
1104 | MsgError s => print ("Slave " ^ node
1105 ^ " returned error: " ^
1107 | _ => print ("Slave " ^ node
1108 ^ " returned unexpected command\n");
1111 handle OpenSSL.OpenSSL s => print ("OpenSSL error: " ^ s ^ "\n")
1115 val _ = Domain.setUser user
1116 val _ = ErrorMsg.reset ()
1118 val dname = Config.domtoolDir user
1120 if Posix.FileSys.access (dname, []) then
1122 val dir = Posix.FileSys.opendir dname
1125 case Posix.FileSys.readdir dir of
1126 NONE => (Posix.FileSys.closedir dir;
1129 if notTmp fname then
1130 loop (OS.Path.joinDirFile {dir = dname,
1137 val (_, files) = Order.order (SOME b) files
1139 fun checker' (file, (G, evs)) =
1142 if !ErrorMsg.anyErrors then
1144 print ("User " ^ user ^ "'s configuration has errors!\n");
1148 ignore (foldl checker' (basis (), Defaults.eInit ()) files)
1150 else if String.isSuffix "_admin" user then
1153 (print ("Couldn't access " ^ user ^ "'s ~/.domtool directory.\n");
1156 handle IO.Io {name, function, ...} =>
1157 (print ("IO error processing user " ^ user ^ ": " ^ function ^ ": " ^ name ^ "\n");
1159 | exn as OS.SysErr (s, _) => (print ("System error processing user " ^ user ^ ": " ^ s ^ "\n");
1161 | ErrorMsg.Error => (ErrorMsg.reset ();
1162 print ("User " ^ user ^ " had a compilation error.\n");
1164 | _ => (print "Unknown exception during regeneration!\n";
1167 ifReal (fn () => (app contactNode Config.nodeIps;
1169 app doUser (Acl.users ());
1172 val domainsAfter = domainList Config.resultRoot
1173 val domainsGone = SS.difference (domainsBefore, domainsAfter)
1175 if SS.isEmpty domainsGone then
1178 (print "Domains to kill:";
1179 SS.app (fn s => (print " "; print s)) domainsGone;
1182 Domain.rmdom' Config.oldResultRoot (SS.listItems domainsGone));
1189 val regenerate = regenerateEither false eval
1190 val regenerateTc = regenerateEither true
1191 (fn G => fn evs => fn file =>
1192 (#1 (check G file), evs))
1194 fun usersChanged () =
1195 (Domain.onUsersChange ();
1196 ignore (OS.Process.system Config.publish_reusers))
1200 val doms = Acl.class {user = user, class = "domain"}
1201 val doms = List.filter (fn dom =>
1202 case Acl.whoHas {class = "domain", value = dom} of
1204 | _ => false) (StringSet.listItems doms)
1211 fun now () = Date.toString (Date.fromTimeUniv (Time.now ()))
1215 QApt pkg => if Apt.installed pkg then MsgYes else MsgNo
1216 | QAptExists pkg => if Apt.exists pkg then MsgYes else MsgNo
1217 | QCron user => if Cron.allowed user then MsgYes else MsgNo
1218 | QFtp user => if Ftp.allowed user then MsgYes else MsgNo
1219 | QTrustedPath user => if TrustedPath.query user then MsgYes else MsgNo
1220 | QSocket user => MsgSocket (SocketPerm.query user)
1221 | QFirewall user => MsgFirewall (Firewall.query user)
1223 fun describeQuery q =
1225 QApt pkg => "Requested installation status of package " ^ pkg
1226 | QAptExists pkg => "Requested if package " ^ pkg ^ " exists"
1227 | QCron user => "Asked about cron permissions for user " ^ user
1228 | QFtp user => "Asked about FTP permissions for user " ^ user
1229 | QTrustedPath user => "Asked about trusted path settings for user " ^ user
1230 | QSocket user => "Asked about socket permissions for user " ^ user
1231 | QFirewall user => "Asked about firewall rules for user " ^ user
1233 fun doIt' loop bio f cleanup =
1235 (msgLocal, SOME msgRemote) =>
1238 Msg.send (bio, MsgError msgRemote))
1239 | (msgLocal, NONE) =>
1242 Msg.send (bio, MsgOk)))
1243 handle e as (OpenSSL.OpenSSL s) =>
1244 (print ("OpenSSL error: " ^ s ^ "\n");
1245 app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e);
1246 Msg.send (bio, MsgError ("OpenSSL error: " ^ s))
1247 handle OpenSSL.OpenSSL _ => ())
1248 | OS.SysErr (s, _) =>
1249 (print "System error: ";
1252 Msg.send (bio, MsgError ("System error: " ^ s))
1253 handle OpenSSL.OpenSSL _ => ())
1258 Msg.send (bio, MsgError ("Failure: " ^ s))
1259 handle OpenSSL.OpenSSL _ => ())
1261 (print "Compilation error\n";
1262 Msg.send (bio, MsgError "Error during configuration evaluation")
1263 handle OpenSSL.OpenSSL _ => ());
1265 ignore (OpenSSL.readChar bio);
1267 handle OpenSSL.OpenSSL _ => ();
1272 val host = Slave.hostname ()
1274 val () = Acl.read Config.aclFile
1276 val context = context (Config.certDir ^ "/" ^ host ^ ".pem",
1277 Config.keyDir ^ "/" ^ host ^ "/key.pem",
1279 val _ = Domain.set_context context
1281 val sock = OpenSSL.listen (context, Config.dispatcherPort)
1284 (case OpenSSL.accept sock of
1288 val user = OpenSSL.peerCN bio
1289 val () = print ("\nConnection from " ^ user ^ " at " ^ now () ^ "\n")
1290 val () = Domain.setUser user
1291 val doIt = doIt' loop bio
1293 fun doConfig codes =
1295 val _ = print "Configuration:\n"
1296 val _ = app (fn s => (print s; print "\n")) codes
1299 val outname = OS.FileSys.tmpName ()
1301 fun doOne (code, (G, evs)) =
1303 val outf = TextIO.openOut outname
1305 TextIO.output (outf, code);
1306 TextIO.closeOut outf;
1310 doIt (fn () => (Env.pre ();
1311 ignore (foldl doOne (basis (), Defaults.eInit ()) codes);
1313 Msg.send (bio, MsgOk);
1314 ("Configuration complete.", NONE)))
1315 (fn () => OS.FileSys.remove outname)
1319 case String.fields (fn ch => ch = #"@") s of
1321 if user = user' then
1325 | [user', domain] =>
1326 if Domain.validEmailUser user' andalso Domain.yourDomain domain then
1327 SOME (SetSA.Email s)
1333 case Msg.recv bio of
1334 NONE => (OpenSSL.close bio
1335 handle OpenSSL.OpenSSL _ => ();
1339 MsgConfig code => doConfig [code]
1340 | MsgMultiConfig codes => doConfig codes
1343 if Acl.query {user = user, class = "priv", value = "all"}
1344 orelse Acl.query {user = user, class = "priv", value = "shutdown"} then
1345 print ("Domtool dispatcher shutting down at " ^ now () ^ "\n\n")
1347 (print "Unauthorized shutdown command!\n";
1349 handle OpenSSL.OpenSSL _ => ();
1354 if Acl.query {user = user, class = "priv", value = "all"} then
1356 Acl.write Config.aclFile;
1357 if #class acl = "user" then
1361 ("Granted permission " ^ #value acl ^ " to " ^ #user acl ^ " in " ^ #class acl ^ ".",
1364 ("Unauthorized user asked to grant a permission!",
1365 SOME "Not authorized to grant privileges"))
1370 if Acl.query {user = user, class = "priv", value = "all"} then
1372 Acl.write Config.aclFile;
1373 ("Revoked permission " ^ #value acl ^ " from " ^ #user acl ^ " in " ^ #class acl ^ ".",
1376 ("Unauthorized user asked to revoke a permission!",
1377 SOME "Not authorized to revoke privileges"))
1380 | MsgListPerms user =>
1382 (Msg.send (bio, MsgPerms (Acl.queryAll user));
1383 ("Sent permission list for user " ^ user ^ ".",
1389 (Msg.send (bio, MsgWhoHasResponse (Acl.whoHas perm));
1390 ("Sent whohas response for " ^ #class perm ^ " / " ^ #value perm ^ ".",
1396 if Acl.query {user = user, class = "priv", value = "all"}
1397 orelse List.all (fn dom => Domain.validDomain dom
1398 andalso Acl.queryDomain {user = user, domain = dom}) doms then
1401 Acl.revokeFromAll {class = "domain", value = dom}) doms;
1402 Acl.write Config.aclFile;*)
1403 ("Removed domains" ^ foldl (fn (d, s) => s ^ " " ^ d) "" doms ^ ".",
1406 ("Unauthorized user asked to remove a domain!",
1407 SOME "Not authorized to remove that domain"))
1412 if Acl.query {user = user, class = "priv", value = "regen"}
1413 orelse Acl.query {user = user, class = "priv", value = "all"} then
1414 (if regenerate context then
1415 ("Regenerated all configuration.",
1418 ("Error regenerating configuration!",
1419 SOME "Error regenerating configuration! Consult /var/log/domtool.log."))
1421 ("Unauthorized user asked to regenerate!",
1422 SOME "Not authorized to regenerate"))
1425 | MsgRegenerateTc =>
1427 if Acl.query {user = user, class = "priv", value = "regen"}
1428 orelse Acl.query {user = user, class = "priv", value = "all"} then
1429 (if regenerateTc context then
1430 ("Checked all configuration.",
1433 ("Found a compilation error!",
1434 SOME "Found a compilation error! Consult /var/log/domtool.log."))
1436 ("Unauthorized user asked to regenerate -tc!",
1437 SOME "Not authorized to regenerate -tc"))
1440 | MsgRmuser user' =>
1442 if Acl.query {user = user, class = "priv", value = "all"} then
1444 Acl.write Config.aclFile;
1445 ("Removed user " ^ user' ^ ".",
1448 ("Unauthorized user asked to remove a user!",
1449 SOME "Not authorized to remove users"))
1452 | MsgListMailboxes domain =>
1454 if not (Domain.yourDomain domain) then
1455 ("User wasn't authorized to list mailboxes for " ^ domain,
1456 SOME "You're not authorized to configure that domain.")
1458 case Vmail.list domain of
1459 Vmail.Listing users => (Msg.send (bio, MsgMailboxes users);
1460 ("Sent mailbox list for " ^ domain,
1462 | Vmail.Error msg => ("Error listing mailboxes for " ^ domain ^ ": " ^ msg,
1466 | MsgNewMailbox {domain, user = emailUser, passwd, mailbox} =>
1468 if not (Domain.yourDomain domain) then
1469 ("User wasn't authorized to add a mailbox to " ^ domain,
1470 SOME "You're not authorized to configure that domain.")
1471 else if not (Domain.validEmailUser emailUser) then
1472 ("Invalid e-mail username " ^ emailUser,
1473 SOME "Invalid e-mail username")
1474 else if not (CharVector.all Char.isGraph passwd) then
1475 ("Invalid password",
1476 SOME "Invalid password; may only contain printable, non-space characters")
1477 else if not (Domain.yourPath mailbox) then
1478 ("User wasn't authorized to add a mailbox at " ^ mailbox,
1479 SOME ("You're not authorized to use that mailbox location. ("
1482 case Vmail.add {requester = user,
1483 domain = domain, user = emailUser,
1484 passwd = passwd, mailbox = mailbox} of
1485 NONE => ("Added mailbox " ^ emailUser ^ "@" ^ domain ^ " at " ^ mailbox,
1487 | SOME msg => ("Error adding mailbox " ^ emailUser ^ "@" ^ domain ^ ": " ^ msg,
1491 | MsgPasswdMailbox {domain, user = emailUser, passwd} =>
1493 if not (Domain.yourDomain domain) then
1494 ("User wasn't authorized to change password of a mailbox for " ^ domain,
1495 SOME "You're not authorized to configure that domain.")
1496 else if not (Domain.validEmailUser emailUser) then
1497 ("Invalid e-mail username " ^ emailUser,
1498 SOME "Invalid e-mail username")
1499 else if not (CharVector.all Char.isGraph passwd) then
1500 ("Invalid password",
1501 SOME "Invalid password; may only contain printable, non-space characters")
1503 case Vmail.passwd {domain = domain, user = emailUser,
1505 NONE => ("Changed password of mailbox " ^ emailUser ^ "@" ^ domain,
1507 | SOME msg => ("Error changing mailbox password for " ^ emailUser ^ "@" ^ domain ^ ": " ^ msg,
1511 | MsgRmMailbox {domain, user = emailUser} =>
1513 if not (Domain.yourDomain domain) then
1514 ("User wasn't authorized to change password of a mailbox for " ^ domain,
1515 SOME "You're not authorized to configure that domain.")
1516 else if not (Domain.validEmailUser emailUser) then
1517 ("Invalid e-mail username " ^ emailUser,
1518 SOME "Invalid e-mail username")
1520 case Vmail.rm {domain = domain, user = emailUser} of
1521 NONE => ("Deleted mailbox " ^ emailUser ^ "@" ^ domain,
1523 | SOME msg => ("Error deleting mailbox " ^ emailUser ^ "@" ^ domain ^ ": " ^ msg,
1527 | MsgSaQuery addr =>
1529 case checkAddr addr of
1530 NONE => ("User tried to query SA filtering for " ^ addr,
1531 SOME "You aren't allowed to configure SA filtering for that recipient.")
1532 | SOME addr' => (Msg.send (bio, MsgSaStatus (SetSA.query addr'));
1533 ("Queried SA filtering status for " ^ addr,
1537 | MsgSaSet (addr, b) =>
1539 case checkAddr addr of
1540 NONE => ("User tried to set SA filtering for " ^ addr,
1541 SOME "You aren't allowed to configure SA filtering for that recipient.")
1542 | SOME addr' => (SetSA.set (addr', b);
1543 Msg.send (bio, MsgOk);
1544 ("Set SA filtering status for " ^ addr ^ " to "
1545 ^ (if b then "ON" else "OFF"),
1549 | MsgSmtpLogReq domain =>
1551 if not (Domain.yourDomain domain) then
1552 ("Unauthorized user tried to request SMTP logs for " ^ domain,
1553 SOME "You aren't authorized to configure that domain.")
1555 (SmtpLog.search (fn line => Msg.send (bio, MsgSmtpLogRes line))
1557 ("Requested SMTP logs for " ^ domain,
1562 doIt (fn () => (Msg.send (bio, answerQuery q);
1566 | MsgDescribe dom =>
1567 doIt (fn () => if not (Domain.validDomain dom) then
1568 ("Requested description of invalid domain " ^ dom,
1569 SOME "Invalid domain name")
1570 else if not (Domain.yourDomain dom
1571 orelse Acl.query {user = user, class = "priv", value = "all"}) then
1572 ("Requested description of " ^ dom ^ ", but not allowed access",
1573 SOME "Access denied")
1575 (Msg.send (bio, MsgDescription (Domain.describe dom));
1576 ("Sent description of domain " ^ dom,
1581 doIt (fn () => if Acl.query {user = user, class = "priv", value = "regen"}
1582 orelse Acl.query {user = user, class = "priv", value = "all"} then
1584 ("Users change callbacks run", NONE))
1586 ("Unauthorized user asked to reusers!",
1587 SOME "You aren't authorized to regenerate files."))
1591 doIt (fn () => ("Unexpected command",
1592 SOME "Unexpected command"))
1597 handle e as (OpenSSL.OpenSSL s) =>
1598 (print ("OpenSSL error: " ^ s ^ "\n");
1599 app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e);
1601 handle OpenSSL.OpenSSL _ => ();
1603 | OS.SysErr (s, _) =>
1604 (print ("System error: " ^ s ^ "\n");
1606 handle OpenSSL.OpenSSL _ => ();
1608 | IO.Io {name, function, cause} =>
1609 (print ("IO error: " ^ function ^ " for " ^ name ^ "\n");
1610 app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory cause);
1612 handle OpenSSL.OpenSSL _ => ();
1614 | OS.Path.InvalidArc =>
1615 (print "Invalid arc\n";
1617 handle OpenSSL.OpenSSL _ => ();
1620 (print "Unknown exception in main loop!\n";
1621 app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e);
1623 handle OpenSSL.OpenSSL _ => ();
1625 handle e as (OpenSSL.OpenSSL s) =>
1626 (print ("OpenSSL error: " ^ s ^ "\n");
1627 app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e);
1629 | OS.SysErr (s, _) =>
1630 (print ("System error: " ^ s ^ "\n");
1632 | IO.Io {name, function, cause} =>
1633 (print ("IO error: " ^ function ^ " for " ^ name ^ "\n");
1634 app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory cause);
1637 (print "Unknown exception in main loop!\n";
1638 app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e);
1641 print ("Domtool dispatcher starting up at " ^ now () ^ "\n");
1642 print "Listening for connections....\n";
1644 OpenSSL.shutdown sock
1649 val host = Slave.hostname ()
1651 val context = context (Config.certDir ^ "/" ^ host ^ ".pem",
1652 Config.keyDir ^ "/" ^ host ^ "/key.pem",
1655 val sock = OpenSSL.listen (context, Config.slavePort)
1657 val _ = print ("Slave server starting at " ^ now () ^ "\n")
1660 (case OpenSSL.accept sock of
1664 val peer = OpenSSL.peerCN bio
1665 val () = print ("\nConnection from " ^ peer ^ " at " ^ now () ^ "\n")
1667 if peer = Config.dispatcherName then let
1669 case Msg.recv bio of
1670 NONE => print "Dispatcher closed connection unexpectedly\n"
1673 MsgFile file => loop' (file :: files)
1674 | MsgDoFiles => (Slave.handleChanges files;
1675 Msg.send (bio, MsgOk))
1676 | MsgRegenerate => (Domain.resetLocal ();
1677 Msg.send (bio, MsgOk))
1678 | MsgVmailChanged => (if Vmail.doChanged () then
1679 Msg.send (bio, MsgOk)
1681 Msg.send (bio, MsgError "userdb update failed"))
1682 | _ => (print "Dispatcher sent unexpected command\n";
1683 Msg.send (bio, MsgError "Unexpected command"))
1686 ignore (OpenSSL.readChar bio);
1690 else if peer = "domtool" then
1691 case Msg.recv bio of
1692 SOME MsgShutdown => (OpenSSL.close bio;
1693 print ("Shutting down at " ^ now () ^ "\n\n"))
1694 | _ => (OpenSSL.close bio;
1698 val doIt = doIt' loop bio
1701 case Msg.recv bio of
1702 NONE => (OpenSSL.close bio
1703 handle OpenSSL.OpenSSL _ => ();
1707 (MsgQuery q) => (print (describeQuery q ^ "\n");
1708 Msg.send (bio, answerQuery q);
1709 ignore (OpenSSL.readChar bio);
1712 | MsgCreateDbUser {dbtype, passwd} =>
1714 case Dbms.lookup dbtype of
1715 NONE => ("Database user creation request with unknown datatype type " ^ dbtype,
1716 SOME ("Unknown database type " ^ dbtype))
1718 case #adduser handler {user = user, passwd = passwd} of
1719 NONE => ("Added " ^ dbtype ^ " user " ^ user ^ ".",
1722 ("Error adding a " ^ dbtype ^ " user " ^ user ^ ": " ^ msg,
1723 SOME ("Error adding user: " ^ msg)))
1726 | MsgDbPasswd {dbtype, passwd} =>
1728 case Dbms.lookup dbtype of
1729 NONE => ("Database passwd request with unknown datatype type " ^ dbtype,
1730 SOME ("Unknown database type " ^ dbtype))
1732 case #passwd handler {user = user, passwd = passwd} of
1733 NONE => ("Changed " ^ dbtype ^ " password of user " ^ user ^ ".",
1736 ("Error setting " ^ dbtype ^ " password of user " ^ user ^ ": " ^ msg,
1737 SOME ("Error adding user: " ^ msg)))
1740 | MsgCreateDb {dbtype, dbname, encoding} =>
1742 if Dbms.validDbname dbname then
1743 case Dbms.lookup dbtype of
1744 NONE => ("Database creation request with unknown datatype type " ^ dbtype,
1745 SOME ("Unknown database type " ^ dbtype))
1747 if not (Dbms.validEncoding encoding) then
1748 ("Invalid encoding " ^ valOf encoding ^ " requested for database creation.",
1749 SOME "Invalid encoding")
1751 case #createdb handler {user = user, dbname = dbname, encoding = encoding} of
1752 NONE => ("Created database " ^ user ^ "_" ^ dbname ^ ".",
1754 | SOME msg => ("Error creating database " ^ user ^ "_" ^ dbname ^ ": " ^ msg,
1755 SOME ("Error creating database: " ^ msg))
1757 ("Invalid database name " ^ user ^ "_" ^ dbname,
1758 SOME ("Invalid database name " ^ dbname)))
1761 | MsgDropDb {dbtype, dbname} =>
1763 if Dbms.validDbname dbname then
1764 case Dbms.lookup dbtype of
1765 NONE => ("Database drop request with unknown datatype type " ^ dbtype,
1766 SOME ("Unknown database type " ^ dbtype))
1768 case #dropdb handler {user = user, dbname = dbname} of
1769 NONE => ("Drop database " ^ user ^ "_" ^ dbname ^ ".",
1771 | SOME msg => ("Error dropping database " ^ user ^ "_" ^ dbname ^ ": " ^ msg,
1772 SOME ("Error dropping database: " ^ msg))
1774 ("Invalid database name " ^ user ^ "_" ^ dbname,
1775 SOME ("Invalid database name " ^ dbname)))
1778 | MsgGrantDb {dbtype, dbname} =>
1780 if Dbms.validDbname dbname then
1781 case Dbms.lookup dbtype of
1782 NONE => ("Database drop request with unknown datatype type " ^ dbtype,
1783 SOME ("Unknown database type " ^ dbtype))
1785 case #grant handler {user = user, dbname = dbname} of
1786 NONE => ("Grant permissions to database " ^ user ^ "_" ^ dbname ^ ".",
1788 | SOME msg => ("Error granting permissions to database " ^ user ^ "_" ^ dbname ^ ": " ^ msg,
1789 SOME ("Error granting permissions to database: " ^ msg))
1791 ("Invalid database name " ^ user ^ "_" ^ dbname,
1792 SOME ("Invalid database name " ^ dbname)))
1794 | MsgMysqlFixperms =>
1795 (print "Starting mysql-fixperms\n";
1796 doIt (fn () => if OS.Process.isSuccess
1797 (OS.Process.system "/usr/bin/sudo -H /afs/hcoop.net/common/etc/scripts/mysql-grant-table-drop") then
1798 ("Requested mysql-fixperms",
1801 ("Requested mysql-fixperms, but execution failed!",
1802 SOME "Script execution failed."))
1804 | MsgFirewallRegen =>
1805 doIt (fn () => (Acl.read Config.aclFile;
1806 if Acl.query {user = user, class = "priv", value = "all"} then
1807 if List.exists (fn x => x = host) Config.Firewall.firewallNodes then
1808 if (Firewall.generateFirewallConfig (Firewall.parseRules ()) andalso Firewall.publishConfig ())
1810 ("Firewall rules regenerated.", NONE)
1812 ("Rules regeneration failed!", SOME "Script execution failed.")
1813 else ("Node not controlled by domtool firewall.", SOME (host))
1815 ("Not authorized to regenerate firewall.", SOME ("Unauthorized user " ^ user ^ " attempted to regenerated firewall"))))
1818 | _ => (OpenSSL.close bio;
1821 end handle OpenSSL.OpenSSL s =>
1822 (print ("OpenSSL error: " ^ s ^ "\n");
1824 handle OpenSSL.OpenSSL _ => ();
1826 | e as OS.SysErr (s, _) =>
1827 (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
1828 print ("System error: "^ s ^ "\n");
1830 handle OpenSSL.OpenSSL _ => ();
1832 | IO.Io {function, name, ...} =>
1833 (print ("IO error: " ^ function ^ ": " ^ name ^ "\n");
1835 handle OpenSSL.OpenSSL _ => ();
1838 (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
1839 print "Uncaught exception!\n";
1841 handle OpenSSL.OpenSSL _ => ();
1843 handle OpenSSL.OpenSSL s =>
1844 (print ("OpenSSL error: " ^ s ^ "\n");
1847 (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
1848 print "Uncaught exception!\n";
1852 OpenSSL.shutdown sock
1857 val dir = Posix.FileSys.opendir Config.libRoot
1860 case Posix.FileSys.readdir dir of
1861 NONE => (Posix.FileSys.closedir dir;
1864 if String.isSuffix ".dtl" fname then
1865 loop (OS.Path.joinDirFile {dir = Config.libRoot,
1874 fun autodocBasis outdir =
1875 Autodoc.autodoc {outdir = outdir, infiles = listBasis ()}