X-Git-Url: https://git.hcoop.net/hcoop/zz_old/domtool2-proto.git/blobdiff_plain/96afa703b8b5d75b6183e5039cbbf33da6a8b687..c685120e835d7db22ad923120036f6249db59dfb:/src/main.sml

diff --git a/src/main.sml b/src/main.sml
index ef6e563..f9b2c9f 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -510,6 +510,27 @@ fun requestSaSet p =
 	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 ()
@@ -897,6 +918,18 @@ fun service () =
 							     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"))