X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/e140629ff492a6440c7b0d892d27ed443a2f9cd9..0e0442b0650ceb74175905578054db8877b1bbbd:/src/main.sml diff --git a/src/main.sml b/src/main.sml index 6cb3ef1..1816f78 100644 --- a/src/main.sml +++ b/src/main.sml @@ -194,6 +194,8 @@ fun reduce G fname = (*(Defaults.eInit ())*) +val toplevel = Env.initialDynEnvVals Reduce.reduceExp + fun eval G evs fname = case reduce G fname of (G, SOME body') => @@ -201,14 +203,14 @@ fun eval G evs fname = raise ErrorMsg.Error else let - val evs' = Eval.exec' evs body' + val evs' = Eval.exec' (toplevel G, evs) body' in (G, evs') end | (G, NONE) => (G, evs) val dispatcher = - Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort + Domain.nodeIp Config.dispatcherName ^ ":" ^ Int.toString Config.dispatcherPort val self = "localhost:" ^ Int.toString Config.slavePort @@ -665,6 +667,21 @@ fun requestPasswdMailbox p = OpenSSL.close bio end +fun requestPortalPasswdMailbox p = + let + val (_, bio) = requestBio (fn () => ()) + in + Msg.send (bio, MsgPortalPasswdMailbox p); + case Msg.recv bio of + NONE => print "Server closed connection unexpectedly.\n" + | SOME m => + case m of + MsgOk => print ("The password for " ^ #user p ^ "@" ^ #domain p ^ " has been changed.\n") + | MsgError s => print ("Set failed: " ^ s ^ "\n") + | _ => print "Unexpected server reply.\n"; + OpenSSL.close bio + end + fun requestRmMailbox p = let val (_, bio) = requestBio (fn () => ()) @@ -1091,7 +1108,7 @@ fun regenerateEither tc checker context = val ok = ref true fun contactNode (node, ip) = - if node = Config.defaultNode then + if node = Config.dispatcherName then Domain.resetLocal () else let val bio = OpenSSL.connect true (context, @@ -1150,7 +1167,7 @@ fun regenerateEither tc checker context = else (); let val basis' = basis () in - ignore (foldl checker' (basis', Env.initialDynEnvVals basis') files) + ignore (foldl checker' (basis', SM.empty) files) end end else if String.isSuffix "_admin" user then @@ -1317,7 +1334,7 @@ fun service () = in doIt (fn () => (Env.pre (); let val basis' = basis () in - ignore (foldl doOne (basis', Env.initialDynEnvVals basis') codes) + ignore (foldl doOne (basis', SM.empty) codes) end; Env.post (); Msg.send (bio, MsgOk); @@ -1518,6 +1535,27 @@ fun service () = SOME msg)) (fn () => ()) + | MsgPortalPasswdMailbox {domain, user = emailUser, oldpasswd, newpasswd} => + doIt (fn () => + if not (Acl.query {user = user, class = "priv", value = "vmail"}) then + ("User is not authorized to run portal vmail password", + SOME "You're not authorized to use the portal password command") + else if not (Domain.validEmailUser emailUser) then + ("Invalid e-mail username " ^ emailUser, + SOME "Invalid e-mail username") + else if not (CharVector.all Char.isGraph oldpasswd + andalso CharVector.all Char.isGraph newpasswd) then + ("Invalid password", + SOME "Invalid password; may only contain printable, non-space characters") + else + case Vmail.portalpasswd {domain = domain, user = emailUser, + oldpasswd = oldpasswd, newpasswd = newpasswd} of + NONE => ("Changed password of mailbox " ^ emailUser ^ "@" ^ domain, + NONE) + | SOME msg => ("Error changing mailbox password for " ^ emailUser ^ "@" ^ domain ^ ": " ^ msg, + SOME msg)) + (fn () => ()) + | MsgRmMailbox {domain, user = emailUser} => doIt (fn () => if not (Domain.yourDomain domain) then @@ -1550,6 +1588,7 @@ fun service () = NONE => ("User tried to set SA filtering for " ^ addr, SOME "You aren't allowed to configure SA filtering for that recipient.") | SOME addr' => (SetSA.set (addr', b); + SetSA.rebuild (); Msg.send (bio, MsgOk); ("Set SA filtering status for " ^ addr ^ " to " ^ (if b then "ON" else "OFF"), @@ -1689,6 +1728,10 @@ fun slave () = Msg.send (bio, MsgOk) else Msg.send (bio, MsgError "userdb update failed")) + | MsgSaChanged => (if Slave.shell [Config.SpamAssassin.postReload] then + Msg.send (bio, MsgOk) + else + Msg.send (bio, MsgError "Error reloading SpamAssassin addresses")) | _ => (print "Dispatcher sent unexpected command\n"; Msg.send (bio, MsgError "Unexpected command")) in