payment: note that Stripe has instituted an additional 1% fee for non-US cards

[hcoop/portal.git] / mailinglist.sml

diff --git a/mailinglist.sml b/mailinglist.sml
dissimilarity index 99%
index a74132b..37f31df 100644 (file)
--- a/mailinglist.sml
+++ b/mailinglist.sml
@@ -1,12 +1,41 @@
-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 = user, dom = dom, vhost = "<<<No darned data in " ^ mmf ^ ">>>"}
+                      | SOME line =>
+                        case String.tokens (fn ch => Char.isSpace ch orelse ch = #":" orelse ch = #"'" orelse ch = #",") line of
+                            [vhost, _] => {user = user, dom = dom, vhost = "http://" ^ vhost}
+                          | _ => {user = user, dom = dom, vhost = "<<<Parse failure in " ^ mmf ^ ">>>"})
+                   before TextIO.closeIn inf
+               end handle _ => {user = user, dom = dom, vhost = "<<<A darn old exception reading " ^ mmf ^ ">>>"}
+           else
+               {user = user, dom = dom, vhost = "https://lists.hcoop.net"}
+       end
+      | _ => raise (Fail "Bad mailing list name")
+
+end