raise ErrorMsg.Error
else
Eval.exec (Defaults.eInit ()) body'
- | NONE => raise ErrorMsg.Error
+ | NONE => ()
fun eval' fname =
case reduce fname of
raise ErrorMsg.Error
else
ignore (Eval.exec' (Defaults.eInit ()) body')
- | NONE => raise ErrorMsg.Error
+ | NONE => ()
val dispatcher =
Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort
val (_, files) = Order.order (SOME b) files
val _ = if !ErrorMsg.anyErrors then
- raise ErrorMsg.Error
+ (print "J\n";raise ErrorMsg.Error)
else
()
before OpenSSL.close bio
end
+fun requestDescribe dom =
+ let
+ val (_, bio) = requestBio (fn () => ())
+ in
+ Msg.send (bio, MsgDescribe dom);
+ case Msg.recv bio of
+ NONE => print "Server closed connection unexpectedly.\n"
+ | SOME m =>
+ case m of
+ MsgDescription s => print s
+ | MsgError s => print ("Description failed: " ^ s ^ "\n")
+ | _ => print "Unexpected server reply.\n";
+ OpenSSL.close bio
+ end
+
+structure SS = StringSet
+
+fun domainList dname =
+ let
+ val dir = Posix.FileSys.opendir dname
+
+ fun visitNode dset =
+ case Posix.FileSys.readdir dir of
+ NONE => dset
+ | SOME node =>
+ let
+ val path = OS.Path.joinDirFile {dir = dname,
+ file = node}
+
+ fun visitDomains (path, bfor, dset) =
+ let
+ val dir = Posix.FileSys.opendir path
+
+ fun loop dset =
+ case Posix.FileSys.readdir dir of
+ NONE => dset
+ | SOME dname =>
+ let
+ val path = OS.Path.joinDirFile {dir = path,
+ file = dname}
+ in
+ if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
+ let
+ val bfor = dname :: bfor
+ in
+ loop (visitDomains (path, bfor,
+ SS.add (dset,
+ String.concatWith "." bfor)))
+ end
+ else
+ loop dset
+ end
+ in
+ loop dset
+ before Posix.FileSys.closedir dir
+ end
+ in
+ visitNode (visitDomains (path, [], dset))
+ end
+ in
+ visitNode SS.empty
+ before Posix.FileSys.closedir dir
+ end
+
fun regenerateEither tc checker context =
let
+ val () = print "Starting regeneration....\n"
+
+ val domainsBefore =
+ if tc then
+ SS.empty
+ else
+ domainList Config.resultRoot
+
fun ifReal f =
if tc then
()
val b = basis ()
val () = Tycheck.disallowExterns ()
- val () = ifReal Domain.resetGlobal
+ val () = ifReal (fn () =>
+ (ignore (OS.Process.system ("rm -rf " ^ Config.oldResultRoot ^ "/*"));
+ ignore (OS.Process.system ("cp -r " ^ Config.resultRoot
+ ^ "/* " ^ Config.oldResultRoot ^ "/"));
+ Domain.resetGlobal ()))
val ok = ref true
in
if !ErrorMsg.anyErrors then
(ErrorMsg.reset ();
- print ("User " ^ user ^ "'s configuration has errors!\n"))
+ print ("User " ^ user ^ "'s configuration has errors!\n");
+ ok := false)
else
- app checker files
+ ();
+ app checker files
end
else
()
ifReal (fn () => (app contactNode Config.nodeIps;
Env.pre ()));
app doUser (Acl.users ());
- ifReal Env.post;
+ ifReal (fn () =>
+ let
+ val domainsAfter = domainList Config.resultRoot
+ val domainsGone = SS.difference (domainsBefore, domainsAfter)
+ in
+ if SS.isEmpty domainsGone then
+ ()
+ else
+ (print "Domains to kill:";
+ SS.app (fn s => (print " "; print s)) domainsGone;
+ print "\n";
+
+ Domain.rmdom' Config.oldResultRoot (SS.listItems domainsGone));
+
+ Env.post ()
+ end);
!ok
end
SOME "Script execution failed."))
(fn () => ())
+ | MsgDescribe dom =>
+ doIt (fn () => if not (Domain.validDomain dom) then
+ ("Requested description of invalid domain " ^ dom,
+ SOME "Invalid domain name")
+ else if not (Domain.yourDomain dom
+ orelse Acl.query {user = user, class = "priv", value = "all"}) then
+ ("Requested description of " ^ dom ^ ", but not allowed access",
+ SOME "Access denied")
+ else
+ (Msg.send (bio, MsgDescription (Domain.describe dom));
+ ("Sent description of domain " ^ dom,
+ NONE)))
+ (fn () => ())
+
| _ =>
doIt (fn () => ("Unexpected command",
SOME "Unexpected command"))
OpenSSL.close bio
handle OpenSSL.OpenSSL _ => ();
loop ())
+ | OS.Path.InvalidArc =>
+ (print "Invalid arc\n";
+ OpenSSL.close bio
+ handle OpenSSL.OpenSSL _ => ();
+ loop ())
| e =>
(print "Unknown exception in main loop!\n";
app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e);
| _ => (OpenSSL.close bio;
loop ())
end handle OpenSSL.OpenSSL s =>
- (print ("OpenSSL error: "^ s ^ "\n");
+ (print ("OpenSSL error: " ^ s ^ "\n");
OpenSSL.close bio
handle OpenSSL.OpenSSL _ => ();
loop ())
OpenSSL.close bio
handle OpenSSL.OpenSSL _ => ();
loop ())
+ | IO.Io {function, name, ...} =>
+ (print ("IO error: " ^ function ^ ": " ^ name ^ "\n");
+ OpenSSL.close bio
+ handle OpenSSL.OpenSSL _ => ();
+ loop ())
+ | e =>
+ (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
+ print "Uncaught exception!\n";
+ OpenSSL.close bio
+ handle OpenSSL.OpenSSL _ => ();
+ loop ())
in
loop ();
OpenSSL.shutdown sock