Remove dnsKerberos, at mwolson's request

[hcoop/domtool2.git] / src / main.sml

diff --git a/src/main.sml b/src/main.sml
index 9bc87cd..b2f59b5 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -25,16 +25,32 @@ open Ast MsgTypes Print
 structure SM = StringMap
 
 fun init () = Acl.read Config.aclFile
-           
+
+fun isLib fname = OS.Path.file fname = "lib.dtl"
+
+fun wrapFile (fname, file) =
+    case (isLib fname, file) of
+       (true, (comment, ds, SOME e)) =>
+       let
+           val (_, loc) = e
+       in
+           (comment, ds, SOME (ELocal (e, (ESkip, loc)), loc))
+       end
+      | _ => file
+
 fun check' G fname =
     let
        val prog = Parse.parse fname
+       val prog = wrapFile (fname, prog)
     in
        if !ErrorMsg.anyErrors then
            G
        else
-           (Option.app (Unused.check G) (#3 prog);
-            Tycheck.checkFile G (Defaults.tInit ()) prog)
+           (if isLib fname then
+                ()
+            else
+                Option.app (Unused.check G) (#3 prog);
+            Tycheck.checkFile G (Defaults.tInit prog) prog)
     end
 
 fun basis () =
@@ -64,12 +80,12 @@ fun basis () =
             before Tycheck.disallowExterns ())
     end
 
-fun check fname =
+(* val b = basis () *)
+
+fun check G fname =
     let
        val _ = ErrorMsg.reset ()
        val _ = Env.preTycheck ()
-
-       val b = basis ()
     in
        if !ErrorMsg.anyErrors then
            raise ErrorMsg.Error
@@ -78,17 +94,21 @@ fun check fname =
                val _ = Tycheck.disallowExterns ()
                val _ = ErrorMsg.reset ()
                val prog = Parse.parse fname
+               val prog = wrapFile (fname, prog)
            in
                if !ErrorMsg.anyErrors then
                    raise ErrorMsg.Error
                else
                    let
-                       val G' = Tycheck.checkFile b (Defaults.tInit ()) prog
+                       val G' = Tycheck.checkFile G (Defaults.tInit prog) prog
                    in
                        if !ErrorMsg.anyErrors then
                            raise ErrorMsg.Error
                        else
-                           (Option.app (Unused.check b) (#3 prog);
+                           (if isLib fname then
+                                ()
+                            else
+                                Option.app (Unused.check G) (#3 prog);
                             (G', #3 prog))
                    end
            end
@@ -150,9 +170,9 @@ fun checkDir dname =
     (setupUser ();
      checkDir' dname)
 
-fun reduce fname =
+fun reduce G fname =
     let
-       val (G, body) = check fname
+       val (G, body) = check G fname
     in
        if !ErrorMsg.anyErrors then
            NONE
@@ -166,28 +186,25 @@ fun reduce fname =
                                         [PD.string "Result:",
                                          PD.space 1,
                                          p_exp body']))*)
-                   SOME body'
+                   SOME (G, body')
                end
              | _ => NONE
     end
 
-fun eval fname =
-    case reduce fname of
-       (SOME body') =>
-       if !ErrorMsg.anyErrors then
-           raise ErrorMsg.Error
-       else
-           Eval.exec (Defaults.eInit ()) body'
-      | NONE => ()
+(*(Defaults.eInit ())*)
 
-fun eval' fname =
-    case reduce fname of
-       (SOME body') =>
+fun eval G evs fname =
+    case reduce G fname of
+       SOME (G, body') =>
        if !ErrorMsg.anyErrors then
            raise ErrorMsg.Error
        else
-           ignore (Eval.exec' (Defaults.eInit ()) body')
-      | NONE => ()
+           let
+               val evs' = Eval.exec' evs body'
+           in
+               (G, evs')
+           end
+      | NONE => (G, evs)
 
 val dispatcher =
     Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort
@@ -232,7 +249,7 @@ fun requestSlaveBio () =
 
 fun request fname =
     let
-       val (user, bio) = requestBio (fn () => ignore (check fname))
+       val (user, bio) = requestBio (fn () => ignore (check (basis ()) fname))
 
        val inf = TextIO.openIn fname
 
@@ -1017,6 +1034,9 @@ fun regenerateEither tc checker context =
 
                        val files = loop []
                        val (_, files) = Order.order (SOME b) files
+
+                       fun checker' (file, (G, evs)) =
+                           checker G evs file
                    in
                        if !ErrorMsg.anyErrors then
                            (ErrorMsg.reset ();
@@ -1024,10 +1044,13 @@ fun regenerateEither tc checker context =
                             ok := false)
                        else
                            ();
-                       app checker files
+                       ignore (foldl checker' (basis (), Defaults.eInit ()) files)
                    end
+               else if String.isSuffix "_admin" user then
+                   ()    
                else
-                   ()
+                   (print ("Couldn't access " ^ user ^ "'s ~/.domtool directory.\n");
+                    ok := false)
            end
            handle IO.Io {name, function, ...} =>
                   (print ("IO error processing user " ^ user ^ ": " ^ function ^ ": " ^ name ^ "\n");
@@ -1062,8 +1085,10 @@ fun regenerateEither tc checker context =
        !ok
     end
 
-val regenerate = regenerateEither false eval'
-val regenerateTc = regenerateEither true (ignore o check)
+val regenerate = regenerateEither false eval
+val regenerateTc = regenerateEither true
+                                   (fn G => fn evs => fn file =>
+                                                         (#1 (check G file), evs))
 
 fun rmuser user =
     let
@@ -1162,17 +1187,17 @@ fun service () =
 
                             val outname = OS.FileSys.tmpName ()
 
-                            fun doOne code =
+                            fun doOne (code, (G, evs)) =
                                 let
                                     val outf = TextIO.openOut outname
                                 in
                                     TextIO.output (outf, code);
                                     TextIO.closeOut outf;
-                                    eval' outname
+                                    eval G evs outname
                                 end
                         in
                             doIt (fn () => (Env.pre ();
-                                            app doOne codes;
+                                            ignore (foldl doOne (basis (), Defaults.eInit ()) codes);
                                             Env.post ();
                                             Msg.send (bio, MsgOk);
                                             ("Configuration complete.", NONE)))