Changes to support IMAP on hopper all compile but are not tested yet
[hcoop/domtool2.git] / src / main.sml
index ac9207d..d46deac 100644 (file)
@@ -1604,8 +1604,13 @@ fun service () =
                                      (fn () => ())
 
                               | MsgReUsers =>
-                                doIt (fn () => (usersChanged ();
-                                                ("Users change callbacks run", NONE)))
+                                doIt (fn () => if Acl.query {user = user, class = "priv", value = "regen"}
+                                                  orelse Acl.query {user = user, class = "priv", value = "all"} then
+                                                   (usersChanged ();
+                                                    ("Users change callbacks run", NONE))
+                                               else
+                                                   ("Unauthorized user asked to reusers!",
+                                                    SOME "You aren't authorized to regenerate files."))
                                      (fn () => ())
 
                               | _ =>
@@ -1678,69 +1683,80 @@ fun slave () =
        val _ = print ("Slave server starting at " ^ now () ^ "\n")
 
        fun loop () =
-           case OpenSSL.accept sock of
-               NONE => ()
-             | SOME bio =>
-               let
-                   val peer = OpenSSL.peerCN bio
-                   val () = print ("\nConnection from " ^ peer ^ " at " ^ now () ^ "\n")
-               in
-                   if peer = Config.dispatcherName then let
-                           fun loop' files =
-                               case Msg.recv bio of
-                                   NONE => print "Dispatcher closed connection unexpectedly\n"
-                                 | SOME m =>
-                                   case m of
-                                       MsgFile file => loop' (file :: files)
-                                     | MsgDoFiles => (Slave.handleChanges files;
-                                                      Msg.send (bio, MsgOk))
-                                     | MsgRegenerate => (Domain.resetLocal ();
-                                                         Msg.send (bio, MsgOk))
-                                     | _ => (print "Dispatcher sent unexpected command\n";
-                                             Msg.send (bio, MsgError "Unexpected command"))
-                       in
-                           loop' [];
-                           ignore (OpenSSL.readChar bio);
-                           OpenSSL.close bio;
-                           loop ()
-                       end
-                   else if peer = "domtool" then
-                       case Msg.recv bio of
-                           SOME MsgShutdown => (OpenSSL.close bio;
-                                                print ("Shutting down at " ^ now () ^ "\n\n"))
-                         | _ => (OpenSSL.close bio;
-                                 loop ())
-                   else
-                       case Msg.recv bio of
-                           SOME (MsgQuery q) => (print (describeQuery q ^ "\n");
-                                                 Msg.send (bio, answerQuery q);
-                                                 ignore (OpenSSL.readChar bio);
-                                                 OpenSSL.close bio;
-                                                 loop ())
-                         | _ => (OpenSSL.close bio;
-                                 loop ())
-               end handle OpenSSL.OpenSSL s =>
-                          (print ("OpenSSL error: " ^ s ^ "\n");
-                           OpenSSL.close bio
-                                         handle OpenSSL.OpenSSL _ => ();
-                           loop ())
-                        | e as OS.SysErr (s, _) =>
-                          (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
-                           print ("System error: "^ s ^ "\n");
-                           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 ())
+           (case OpenSSL.accept sock of
+                NONE => ()
+              | SOME bio =>
+                let
+                    val peer = OpenSSL.peerCN bio
+                    val () = print ("\nConnection from " ^ peer ^ " at " ^ now () ^ "\n")
+                in
+                    if peer = Config.dispatcherName then let
+                            fun loop' files =
+                                case Msg.recv bio of
+                                    NONE => print "Dispatcher closed connection unexpectedly\n"
+                                  | SOME m =>
+                                    case m of
+                                        MsgFile file => loop' (file :: files)
+                                      | MsgDoFiles => (Slave.handleChanges files;
+                                                       Msg.send (bio, MsgOk))
+                                      | MsgRegenerate => (Domain.resetLocal ();
+                                                          Msg.send (bio, MsgOk))
+                                      | MsgVmailChanged => (if Vmail.doChanged () then
+                                                                Msg.send (bio, MsgOk)
+                                                            else
+                                                                Msg.send (bio, MsgError "userdb update failed"))
+                                      | _ => (print "Dispatcher sent unexpected command\n";
+                                              Msg.send (bio, MsgError "Unexpected command"))
+                        in
+                            loop' [];
+                            ignore (OpenSSL.readChar bio);
+                            OpenSSL.close bio;
+                            loop ()
+                        end
+                    else if peer = "domtool" then
+                        case Msg.recv bio of
+                            SOME MsgShutdown => (OpenSSL.close bio;
+                                                 print ("Shutting down at " ^ now () ^ "\n\n"))
+                          | _ => (OpenSSL.close bio;
+                                  loop ())
+                    else
+                        case Msg.recv bio of
+                            SOME (MsgQuery q) => (print (describeQuery q ^ "\n");
+                                                  Msg.send (bio, answerQuery q);
+                                                  ignore (OpenSSL.readChar bio);
+                                                  OpenSSL.close bio;
+                                                  loop ())
+                          | _ => (OpenSSL.close bio;
+                                  loop ())
+                end handle OpenSSL.OpenSSL s =>
+                           (print ("OpenSSL error: " ^ s ^ "\n");
+                            OpenSSL.close bio
+                            handle OpenSSL.OpenSSL _ => ();
+                            loop ())
+                         | e as OS.SysErr (s, _) =>
+                           (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
+                            print ("System error: "^ s ^ "\n");
+                            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 ()))
+           handle OpenSSL.OpenSSL s =>
+                  (print ("OpenSSL error: " ^ s ^ "\n");
+                   loop ())
+                | e =>
+                  (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
+                   print "Uncaught exception!\n";
+                   loop ())
     in
        loop ();
        OpenSSL.shutdown sock