Mailing list fun

diff --git a/app.sml b/app.sml
index bd00049..aec4e35 100644 (file)
--- a/app.sml
+++ b/app.sml
@@ -136,8 +136,8 @@ fun readFile fname =
        before TextIO.closeIn inf
     end
 
-fun readTosBody () = readFile "/var/www/home/html/tos.body.html"
-fun readTosAgree () = readFile "/var/www/home/html/tos.agree.html"
-fun readTosMinorAgree () = readFile "/var/www/home/html/tos.agree.minor.html"
+fun readTosBody () = readFile "/home/hcoop/public_html/tos.body.html"
+fun readTosAgree () = readFile "/home/hcoop/public_html/tos.agree.html"
+fun readTosMinorAgree () = readFile "/home/hcoop/public_html/tos.agree.minor.html"
 
 end

diff --git a/list.mlt b/list.mlt
index d1f0d09..44d8e26 100644 (file)
--- a/list.mlt
+++ b/list.mlt
@@ -27,11 +27,12 @@ elseif $"cmd" = "open" then
 <tr> <td align="right" valign="top"><b>Reason</b>:</td> <td colspan="2"><% Web.html (#msg req) %></td> </tr>
 </table>
 
-<% if admin then %>
+<% if admin then
+       val (user, dom) = MailingList.listWebHost (#data req) %>
        <br>
        <a href="list?mod=<% #id req %>">[Modify]</a>
        <a href="list?del=<% #id req %>">[Delete]</a><br>
-       To set up, run: <tt>newlist <% #data req %>&nbsp;<% name %><% Init.emailSuffix %> <% Util.randomPassword () %></tt>
+       To set up, run: <tt>listnew <% user %>&nbsp;<% dom %>&nbsp;<% name %>&nbsp;<% Util.randomPassword () %></tt>
 <% end %>
 
 <%     end
@@ -115,7 +116,7 @@ elseif $"mod" <> "" then
 
 <p>Enter here the e-mail address you would like for your list.  Please keep in mind that the part of your list address before the "@" must be unique across all mailing lists we run.  We may reject applications with overly general names here, especially names of current users or UNIX usernames that are likely to be chosen by future members.  The "Reason" field is optional.</p>
 
-<p>If you want to use the Mailman web interface on your new list, and you want this to appear on a different web virtual host than hcoop.net, you should create a file <tt>.mailman</tt> in the domtool directory for this domain, before submitting a request. In that file, put the hostname of the vhost you want to use.</p>
+<p>If you want to use the Mailman web interface on your new list, and you want this to appear on a different web virtual host than hcoop.net, you should create a file <tt>.mailman</tt> in the domtool directory for this domain, before submitting a request. In that file, put the hostname of the vhost you want to use, and be sure to include a <tt>Mailman</tt> directive in that vhost's configuration.</p>
 
 <form action="list">
 <table>

diff --git a/mailinglist.sml b/mailinglist.sml
dissimilarity index 99%
index a74132b..ca8b95d 100644 (file)
--- a/mailinglist.sml
+++ b/mailinglist.sml
@@ -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

diff --git a/util.sig b/util.sig
index df2fda7..9be363b 100644 (file)
--- a/util.sig
+++ b/util.sig
@@ -22,4 +22,6 @@ sig
     val whoisUrl : string -> string
 
     val randomPassword : unit -> string
-end
\ No newline at end of file
+
+    val domainDir : string -> string
+end

diff --git a/util.sml b/util.sml
index c56a011..d5c68d5 100644 (file)
--- a/util.sml
+++ b/util.sml
@@ -62,4 +62,7 @@ fun init () = rnd := Random.rand (SysWord.toInt (Posix.Process.pidToWord (Posix.
 
 fun randomPassword () = Int.toString (Int.abs (Random.randInt (!rnd)))
 
-end
\ No newline at end of file
+fun domainDir dom =
+    String.concatWith "/" ("/etc/domains" :: String.fields (fn ch => ch = #".") dom)
+
+end