{{Set the hostname of the web site for administration of mailing lists for this
domain.}}
-extern type mailman_web_node;
+extern type mailman_node;
{{Like <tt>web_node</tt>, but with the possibility of using some additional
nodes set by the admins.}}
-extern val mailman_web_node : mailman_web_node;
+extern val mailman_node : mailman_node;
{{The default location for Mailman web interfaces}}
-extern val mailman_web_node_to_node : mailman_web_node -> node;
+extern val mailman_node_to_node : mailman_node -> node;
+
+extern type mailman_place;
+extern val mailman_place_default : mailman_node -> mailman_place;
+extern val mailman_place : mailman_node -> your_ip -> mailman_place;
+extern val mailman_place_to_web_node : mailman_place -> web_node;
+extern val mailman_place_to_node : mailman_place -> node;
+extern val mailman_place_to_ip : mailman_place -> ip;
+{{Analogous to <tt>web_place</tt>, but based on <tt>mailman_node</tt>s}}
extern val mailmanVhost : host -> [Domain]
- {MailmanWebNodes : [mailman_web_node],
+ {MailmanPlaces : [mailman_place],
SSL : ssl,
User : your_user};
{{Create an Apache virtual host to serve as the web interface for some Mailman
let
domainHost host;
in
- dnsIP host (ip_of_node (mailman_web_node_to_node mailman_web_node));
+ dnsIP host (ip_of_node (mailman_node_to_node mailman_node));
mwh <- Hostname;
mailmanWebHost mwh;
mailmanVhost host where
- MailmanWebNodes = [mailman_web_node];
+ MailmanPlaces = [mailman_place_default mailman_node];
SSL = no_ssl
end
end
fn [e] => SOME e
| _ => NONE)
-fun webPlace (EApp ((EString "web_place_default", _), (EString node, _)), _) =
+fun webPlace (EApp ((EVar "web_place_default", _), (EString node, _)), _) =
SOME (node, Domain.nodeIp node)
- | webPlace (EApp ((EApp ((EString "web_place", _), (EString node, _)), _), (EString ip, _)), _) =
+ | webPlace (EApp ((EApp ((EVar "web_place", _), (EString node, _)), _), (EString ip, _)), _) =
SOME (node, ip)
| webPlace _ = NONE
-fun webPlaceDefault node = (EApp ((EString "web_place_default", dl), (EString node, dl)), dl)
+fun webPlaceDefault node = (EApp ((EVar "web_place_default", dl), (EString node, dl)), dl)
val _ = Env.registerFunction ("web_place_to_web_node",
fn [e] => Option.map (fn (node, _) => (EString node, dl)) (webPlace e)
open Ast
-val () = Env.type_one "mailman_web_node"
+val () = Env.type_one "mailman_node"
Env.string
(fn node => Apache.webNode node orelse node = Config.Mailman.node)
val dl = ErrorMsg.dummyLoc
-val () = Env.registerFunction ("mailman_web_node",
+val () = Env.registerFunction ("mailman_node",
fn [] => SOME (EString Config.Mailman.node, dl)
| _ => NONE)
-val () = Env.registerFunction ("mailman_web_node_to_node",
+val () = Env.registerFunction ("mailman_node_to_node",
fn [e] => SOME e
| _ => NONE)
+fun mailmanPlace (EApp ((EVar "mailman_place_default", _), (EString node, _)), _) =
+ SOME (node, Domain.nodeIp node)
+ | mailmanPlace (EApp ((EApp ((EVar "mailman_place", _), (EString node, _)), _), (EString ip, _)), _) =
+ SOME (node, ip)
+ | mailmanPlace _ = NONE
+
+fun mailmanPlaceDefault node = (EApp ((EVar "mailman_place_default", dl), (EString node, dl)), dl)
+
+val _ = Env.registerFunction ("mailman_place_to_web_node",
+ fn [e] => Option.map (fn (node, _) => (EString node, dl)) (mailmanPlace e)
+ | _ => NONE)
+
+val _ = Env.registerFunction ("mailman_place_to_node",
+ fn [e] => Option.map (fn (node, _) => (EString node, dl)) (mailmanPlace e)
+ | _ => NONE)
+
+val _ = Env.registerFunction ("mailman_place_to_ip",
+ fn [e] => Option.map (fn (_, ip) => (EString ip, dl)) (mailmanPlace e)
+ | _ => NONE)
+
val () = Defaults.registerDefault
- ("MailmanWebNodes",
- (TList (TBase "mailman_web_node", dl), dl),
- (fn () => (EList [(EString Config.Mailman.node, dl)], dl)))
+ ("MailmanPlaces",
+ (TList (TBase "mailman_place", dl), dl),
+ (fn () => (EList [mailmanPlaceDefault Config.Mailman.node], dl)))
val files = ref ([] : TextIO.outstream list)
val write = ref (fn _ : string => ())
("host", Env.string)
(fn (env, host) =>
let
- val nodes = Env.env (Env.list Env.string) (env, "MailmanWebNodes")
+ val places = Env.env (Env.list mailmanPlace) (env, "MailmanPlaces")
val ssl = Env.env Apache.ssl (env, "SSL")
val user = Env.env Env.string (env, "User")
val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
in
- app (fn node =>
+ app (fn (node, ip) =>
let
val file = Domain.domainFile {node = node,
name = confFile}
print user;
print "\n";
print "<VirtualHost ";
- print (Domain.nodeIp node);
+ print ip;
print ":";
print (case ssl of
SOME _ => "443"
print " Allow from all\n";
print " </Directory>\n";
- Apache.doPre {user = user, nodes = nodes, id = vhostId, hostname = fullHost};
+ Apache.doPre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost};
print "</VirtualHost>\n";
TextIO.closeOut file;
Apache.doPost ()
- end) nodes
+ end) places
end)
val mailmanChanged = ref false