+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *)
+
+(* Apache HTTPD handling *)
+
+structure Apache :> APACHE = struct
+
+open Ast
+
+val dl = ErrorMsg.dummyLoc
+
+val _ = Main.registerDefault ("WebNodes",
+ (TList (TBase "node", dl), dl),
+ (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes), dl)))
+
+val _ = Main.registerDefault ("SSL",
+ (TBase "bool", dl),
+ (fn () => (EVar "false", dl)))
+
+val _ = Main.registerDefault ("User",
+ (TBase "your_user", dl),
+ (fn () => (EString (Domain.getUser ()), dl)))
+
+val _ = Main.registerDefault ("Group",
+ (TBase "your_group", dl),
+ (fn () => (EString (Domain.getUser ()), dl)))
+
+val _ = Main.registerDefault ("DocumentRoot",
+ (TBase "your_path", dl),
+ (fn () => (EString ("/home/" ^ Domain.getUser () ^ "/public_html"), dl)))
+
+val _ = Main.registerDefault ("ServerAdmin",
+ (TBase "email", dl),
+ (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
+
+val vhostsChanged = ref false
+
+val () = Slave.registerPreHandler
+ (fn () => vhostsChanged := false)
+
+val () = Slave.registerFileHandler (fn fs =>
+ let
+ val spl = OS.Path.splitDirFile (#file fs)
+ in
+ if String.isSuffix ".vhost" (#file spl)
+ orelse String.isSuffix ".vhost_ssl" (#file spl) then
+ (vhostsChanged := true;
+ case #action fs of
+ Slave.Delete =>
+ ignore (OS.Process.system (Config.rm
+ ^ " -rf "
+ ^ Config.Apache.confDir
+ ^ "/"
+ ^ #file spl))
+ | _ =>
+ ignore (OS.Process.system (Config.cp
+ ^ " "
+ ^ #file fs
+ ^ " "
+ ^ Config.Apache.confDir
+ ^ "/"
+ ^ #file spl)))
+ else
+ ()
+ end)
+
+val () = Slave.registerPostHandler
+ (fn () =>
+ (if !vhostsChanged then
+ Slave.shellF ([Config.Apache.reload],
+ fn cl => "Error reloading Apache with " ^ cl)
+ else
+ ()))
+
+val vhostFiles : TextIO.outstream list ref = ref []
+fun write s = app (fn file => TextIO.output (file, s)) (!vhostFiles)
+
+val () = Env.containerV_one "vhost"
+ ("host", Env.string)
+ (fn (env, host) =>
+ let
+ val nodes = Env.env (Env.list Env.string) (env, "WebNodes")
+
+ val ssl = Env.env Env.bool (env, "SSL")
+ val user = Env.env Env.string (env, "User")
+ val group = Env.env Env.string (env, "Group")
+ val docroot = Env.env Env.string (env, "DocumentRoot")
+ val sadmin = Env.env Env.string (env, "ServerAdmin")
+
+ val fullHost = host ^ "." ^ Domain.currentDomain ()
+ val confFile = fullHost ^ (if ssl then ".vhost_ssl" else ".vhost")
+ in
+ vhostFiles := map (fn node =>
+ let
+ val file = Domain.domainFile {node = node,
+ name = confFile}
+ in
+ TextIO.output (file, "<VirtualHost ");
+ TextIO.output (file, Domain.nodeIp node);
+ TextIO.output (file, ":");
+ TextIO.output (file, if ssl then
+ "443"
+ else
+ "80");
+ TextIO.output (file, ">\n");
+ file
+ end)
+ nodes;
+ write "\tSuexecUserGroup ";
+ write user;
+ write " ";
+ write group;
+ write "\n\tDocumentRoot ";
+ write docroot;
+ write "\n\tServerAdmin ";
+ write sadmin;
+ write "\n"
+ end,
+ fn () => (write "</VirtualHost>\n";
+ app TextIO.closeOut (!vhostFiles)))
+
+end
HCoop / hcoop / domtool2.git / commitdiff