X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/9ffe2f0fea48f1e2fa6a30b6a79b975b4a6f7671..2bc5ed226e9a0cba24f9d689754e1d62bb883d86:/src/main.sml

diff --git a/src/main.sml b/src/main.sml
index 4fe8124..f9b2c9f 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -422,13 +422,13 @@ fun requestListMailboxes domain =
     in
 	Msg.send (bio, MsgListMailboxes domain);
 	(case Msg.recv bio of
-	     NONE => Vmail.Error "Server closed connection unexpectedly.\n"
+	     NONE => Vmail.Error "Server closed connection unexpectedly."
 	   | SOME m =>
 	     case m of
 		 MsgMailboxes users => (Msg.send (bio, MsgOk);
 					Vmail.Listing users)
 	       | MsgError s => Vmail.Error ("Creation failed: " ^ s)
-	       | _ => Vmail.Error "Unexpected server reply.\n")
+	       | _ => Vmail.Error "Unexpected server reply.")
 	before OpenSSL.close bio
     end
 
@@ -477,6 +477,60 @@ fun requestRmMailbox p =
 	OpenSSL.close bio
     end
 
+fun requestSaQuery addr =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgSaQuery addr);
+	(case Msg.recv bio of
+	     NONE => print "Server closed connection unexpectedly.\n"
+	   | SOME m =>
+	     case m of
+		 MsgSaStatus b => (print ("SpamAssassin filtering for " ^ addr ^ " is "
+					  ^ (if b then "ON" else "OFF") ^ ".\n");
+				   Msg.send (bio, MsgOk))
+	       | MsgError s => print ("Query failed: " ^ s ^ "\n")
+	       | _ => print "Unexpected server reply.\n")
+	before OpenSSL.close bio
+    end
+
+fun requestSaSet p =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgSaSet p);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print ("SpamAssassin filtering for " ^ #1 p ^ " is now "
+				^ (if #2 p then "ON" else "OFF") ^ ".\n")
+	      | MsgError s => print ("Set failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestSmtpLog domain =
+    let
+	val (_, bio) = requestBio (fn () => ())
+
+	val _ = Msg.send (bio, MsgSmtpLogReq domain)
+
+	fun loop () =
+	    case Msg.recv bio of
+		NONE => print "Server closed connection unexpectedly.\n"
+	      | SOME m =>
+		case m of
+		    MsgOk => ()
+		  | MsgSmtpLogRes line => (print line;
+					   loop ())
+		  | MsgError s => print ("Log search failed: " ^ s ^ "\n")
+		  | _ => print "Unexpected server reply.\n"
+    in
+	loop ();
+	OpenSSL.close bio
+    end
+
 fun regenerate context =
     let
 	val b = basis ()
@@ -636,6 +690,20 @@ fun service () =
 				 (fn () => OS.FileSys.remove outname)
 			end
 
+		    fun checkAddr s =
+			case String.fields (fn ch => ch = #"@") s of
+			    [user'] =>
+			    if user = user' then
+				SOME (SetSA.User s)
+			    else
+				NONE
+			  | [user', domain] =>
+			    if Domain.validEmailUser user' andalso Domain.yourDomain domain then
+				SOME (SetSA.Email s)
+			    else
+				NONE
+			  | _ => NONE
+
 		    fun cmdLoop () =
 			case Msg.recv bio of
 			    NONE => (OpenSSL.close bio
@@ -773,7 +841,7 @@ fun service () =
 					 if not (Domain.yourDomain domain) then
 					     ("User wasn't authorized to add a mailbox to " ^ domain,
 					      SOME "You're not authorized to configure that domain.")
-					 else if not (Domain.validUser emailUser) then
+					 else if not (Domain.validEmailUser emailUser) then
 					     ("Invalid e-mail username " ^ emailUser,
 					      SOME "Invalid e-mail username")
 					 else if not (CharVector.all Char.isGraph passwd) then
@@ -797,7 +865,7 @@ fun service () =
 					 if not (Domain.yourDomain domain) then
 					     ("User wasn't authorized to change password of a mailbox for " ^ domain,
 					      SOME "You're not authorized to configure that domain.")
-					 else if not (Domain.validUser emailUser) then
+					 else if not (Domain.validEmailUser emailUser) then
 					     ("Invalid e-mail username " ^ emailUser,
 					      SOME "Invalid e-mail username")
 					 else if not (CharVector.all Char.isGraph passwd) then
@@ -817,7 +885,7 @@ fun service () =
 					 if not (Domain.yourDomain domain) then
 					     ("User wasn't authorized to change password of a mailbox for " ^ domain,
 					      SOME "You're not authorized to configure that domain.")
-					 else if not (Domain.validUser emailUser) then
+					 else if not (Domain.validEmailUser emailUser) then
 					     ("Invalid e-mail username " ^ emailUser,
 					      SOME "Invalid e-mail username")
 					 else
@@ -828,6 +896,40 @@ fun service () =
 							      SOME msg))
 				     (fn () => ())
 
+			      | MsgSaQuery addr =>
+				doIt (fn () =>
+					 case checkAddr addr of
+					     NONE => ("User tried to query SA filtering for " ^ addr,
+						      SOME "You aren't allowed to configure SA filtering for that recipient.")
+					   | SOME addr' => (Msg.send (bio, MsgSaStatus (SetSA.query addr'));
+							    ("Queried SA filtering status for " ^ addr,
+							     NONE)))
+				     (fn () => ())
+
+			      | MsgSaSet (addr, b) =>
+				doIt (fn () =>
+					 case checkAddr addr of
+					     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);
+							    Msg.send (bio, MsgOk);
+							    ("Set SA filtering status for " ^ addr ^ " to "
+							     ^ (if b then "ON" else "OFF"),
+							     NONE)))
+				     (fn () => ())
+
+			      | MsgSmtpLogReq domain =>
+				doIt (fn () =>
+					 if not (Domain.yourDomain domain) then
+					     ("Unauthorized user tried to request SMTP logs for " ^ domain,
+					      SOME "You aren't authorized to configure that domain.")
+					 else
+					     (SmtpLog.search (fn line => Msg.send (bio, MsgSmtpLogRes line))
+					      domain;
+					      ("Requested SMTP logs for " ^ domain,
+					       NONE)))
+				(fn () => ())
+
 			      | _ =>
 				doIt (fn () => ("Unexpected command",
 						SOME "Unexpected command"))