X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/7a9616824f3478c4ba5eec100692e277e23243ab..bedd19f79e09443056d91bf1ca1e2de97006a440:/src/mail/vmail.sml

diff --git a/src/mail/vmail.sml b/src/mail/vmail.sml
index 60a3a35..1d5262d 100644
--- a/src/mail/vmail.sml
+++ b/src/mail/vmail.sml
@@ -1,5 +1,5 @@
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
- * Copyright (c) 2006, Adam Chlipala
+ * Copyright (c) 2006-2009, Adam Chlipala
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
@@ -20,7 +20,45 @@
 
 structure Vmail :> VMAIL = struct
 
-fun rebuild () = Slave.shell [Config.Courier.postReload]
+open MsgTypes
+
+fun rebuild () =
+    let
+	fun doNode (site, ok) =
+	    (print ("New vmail data for node " ^ site ^ "\n");
+	     if site = Config.defaultNode then
+		 Slave.shell [Config.Courier.postReload] andalso ok
+	     else let
+		     val bio = OpenSSL.connect true (Domain.get_context (),
+						     Domain.nodeIp site
+						     ^ ":"
+						     ^ Int.toString Config.slavePort)
+		 in
+		     Msg.send (bio, MsgVmailChanged);
+		     (case Msg.recv bio of
+			  NONE => (print "Slave closed connection unexpectedly\n";
+				   false)
+			| SOME m =>
+			  case m of
+			      MsgOk => (print ("Slave " ^ site ^ " finished\n");
+					ok)
+			    | MsgError s => (print ("Slave " ^ site
+						    ^ " returned error: " ^
+						    s ^ "\n");
+					     false)
+			    | _ => (print ("Slave " ^ site
+					   ^ " returned unexpected command\n");
+				    false))
+		     before OpenSSL.close bio
+		 end)
+    in
+	Slave.shell [Config.Courier.pushUserdb]
+	andalso foldl doNode true Config.mailNodes_all
+    end
+
+fun doChanged () =
+    Slave.shell [Config.Courier.pullUserdb]
+    andalso Slave.shell [Config.Courier.postReload]
 
 datatype listing =
 	 Error of string
@@ -28,33 +66,41 @@ datatype listing =
 
 fun list domain =
     let
-	val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
-						      file = domain})
-
-	fun loop users =
-	    case TextIO.inputLine inf of
-		NONE => Listing (rev users)
-	      | SOME line =>
-		case String.tokens Char.isSpace line of
-		    [addr, fields] =>
-		    (case String.fields (fn ch => ch = #"@") addr of
-			 [user, _] =>
-			 let
-			     fun parseFields fields =
-				 case fields of
-				     "mail" :: mailbox :: _ => loop ({user = user, mailbox = mailbox} :: users)
-				   | _ :: _ :: rest => parseFields rest
-				   | _ => Error "Invalid fields in database"
-			 in
-			     parseFields (String.fields (fn ch => ch = #"|" orelse ch = #"=") fields)
-			 end
-		       | _ => Error "Invalid e-mail address format in database")
-		  | _ => Error "Invalid entry in database"
+	val file = OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
+					file = domain}
     in
-	loop []
-	before TextIO.closeIn inf
+	if Posix.FileSys.access (file, []) then
+	    let
+		val inf = TextIO.openIn file
+
+		fun loop users =
+		    case TextIO.inputLine inf of
+			NONE => Listing (rev users)
+		      | SOME line =>
+			case String.tokens Char.isSpace line of
+			    [addr, fields] =>
+			    (case String.fields (fn ch => ch = #"@") addr of
+				 [user, _] =>
+				 let
+				     fun parseFields fields =
+					 case fields of
+					     "mail" :: mailbox :: _ => loop ({user = user, mailbox = mailbox} :: users)
+					   | _ :: _ :: rest => parseFields rest
+					   | _ => Error "Invalid fields in database"
+				 in
+				     parseFields (String.fields (fn ch => ch = #"|" orelse ch = #"=") fields)
+				 end
+			       | _ => Error "Invalid e-mail address format in database")
+			  | _ => Error "Invalid entry in database"
+	    in
+		loop []
+		before TextIO.closeIn inf
+	    end
+	else
+	    Listing []
     end
-	handle IO.Io _ => Listing []
+    handle IO.Io {name, function, ...} =>
+	   Error ("IO failure: " ^ name ^ ": " ^ function)
 
 fun mailboxExists {domain, user} =
     let