Allow commas in ticket titles
[hcoop/zz_old/portal.git] / mailinglist.sml
dissimilarity index 99%
index a74132b..ca8b95d 100644 (file)
@@ -1,12 +1,39 @@
-structure MailingList = Request(struct
-                               val table = "MailingList"
-                               val adminGroup = "lists"
-                               fun subject list = "Mailman list request: " ^ list
-                               val template = "list"
-                               val descr = "mailing list"
-
-                               fun body (mail, lst) =
-                                   (Mail.mwrite (mail, "List name: ");
-                                    Mail.mwrite (mail, lst);
-                                    Mail.mwrite (mail, "\n"))
-                               end)
+structure MailingList =
+struct
+
+structure R = Request(struct
+                     val table = "MailingList"
+                     val adminGroup = "lists"
+                     fun subject list = "Mailman list request: " ^ list
+                     val template = "list"
+                     val descr = "mailing list"
+                                 
+                     fun body (mail, lst) =
+                         (Mail.mwrite (mail, "List name: ");
+                          Mail.mwrite (mail, lst);
+                          Mail.mwrite (mail, "\n"))
+                     end)
+open R
+
+fun listWebHost name =
+    case String.tokens (fn ch => ch = #"@") name of
+       [user, dom] =>
+       let
+           val mmf = Util.domainDir dom ^ "/.mailman"
+       in
+           if Posix.FileSys.access (mmf, []) then
+               let
+                   val inf = TextIO.openIn mmf
+               in
+                   (case TextIO.inputLine inf of
+                        NONE => (user, dom)
+                      | SOME line =>
+                        (user, String.substring (line, 0, size line - 1)))
+                   before TextIO.closeIn inf
+               end handle _ => (user, dom)
+           else
+               (user, dom)
+       end
+      | _ => raise (Fail "Bad mailing list name")
+
+end