| 1 | (* HCoop Domtool (http://hcoop.sourceforge.net/) |
| 2 | * Copyright (c) 2006, Adam Chlipala |
| 3 | * |
| 4 | * This program is free software; you can redistribute it and/or |
| 5 | * modify it under the terms of the GNU General Public License |
| 6 | * as published by the Free Software Foundation; either version 2 |
| 7 | * of the License, or (at your option) any later version. |
| 8 | * |
| 9 | * This program is distributed in the hope that it will be useful, |
| 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 12 | * GNU General Public License for more details. |
| 13 | * |
| 14 | * You should have received a copy of the GNU General Public License |
| 15 | * along with this program; if not, write to the Free Software |
| 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. |
| 17 | *) |
| 18 | |
| 19 | (* Apache HTTPD handling *) |
| 20 | |
| 21 | structure Apache :> APACHE = struct |
| 22 | |
| 23 | open Ast |
| 24 | |
| 25 | val dl = ErrorMsg.dummyLoc |
| 26 | |
| 27 | val _ = Main.registerDefault ("WebNodes", |
| 28 | (TList (TBase "node", dl), dl), |
| 29 | (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes), dl))) |
| 30 | |
| 31 | val _ = Main.registerDefault ("SSL", |
| 32 | (TBase "bool", dl), |
| 33 | (fn () => (EVar "false", dl))) |
| 34 | |
| 35 | val _ = Main.registerDefault ("User", |
| 36 | (TBase "your_user", dl), |
| 37 | (fn () => (EString (Domain.getUser ()), dl))) |
| 38 | |
| 39 | val _ = Main.registerDefault ("Group", |
| 40 | (TBase "your_group", dl), |
| 41 | (fn () => (EString (Domain.getUser ()), dl))) |
| 42 | |
| 43 | val _ = Main.registerDefault ("DocumentRoot", |
| 44 | (TBase "your_path", dl), |
| 45 | (fn () => (EString ("/home/" ^ Domain.getUser () ^ "/public_html"), dl))) |
| 46 | |
| 47 | val _ = Main.registerDefault ("ServerAdmin", |
| 48 | (TBase "email", dl), |
| 49 | (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl))) |
| 50 | |
| 51 | val vhostsChanged = ref false |
| 52 | |
| 53 | val () = Slave.registerPreHandler |
| 54 | (fn () => vhostsChanged := false) |
| 55 | |
| 56 | val () = Slave.registerFileHandler (fn fs => |
| 57 | let |
| 58 | val spl = OS.Path.splitDirFile (#file fs) |
| 59 | in |
| 60 | if String.isSuffix ".vhost" (#file spl) |
| 61 | orelse String.isSuffix ".vhost_ssl" (#file spl) then |
| 62 | (vhostsChanged := true; |
| 63 | case #action fs of |
| 64 | Slave.Delete => |
| 65 | ignore (OS.Process.system (Config.rm |
| 66 | ^ " -rf " |
| 67 | ^ Config.Apache.confDir |
| 68 | ^ "/" |
| 69 | ^ #file spl)) |
| 70 | | _ => |
| 71 | ignore (OS.Process.system (Config.cp |
| 72 | ^ " " |
| 73 | ^ #file fs |
| 74 | ^ " " |
| 75 | ^ Config.Apache.confDir |
| 76 | ^ "/" |
| 77 | ^ #file spl))) |
| 78 | else |
| 79 | () |
| 80 | end) |
| 81 | |
| 82 | val () = Slave.registerPostHandler |
| 83 | (fn () => |
| 84 | (if !vhostsChanged then |
| 85 | Slave.shellF ([Config.Apache.reload], |
| 86 | fn cl => "Error reloading Apache with " ^ cl) |
| 87 | else |
| 88 | ())) |
| 89 | |
| 90 | val vhostFiles : TextIO.outstream list ref = ref [] |
| 91 | fun write s = app (fn file => TextIO.output (file, s)) (!vhostFiles) |
| 92 | |
| 93 | val () = Env.containerV_one "vhost" |
| 94 | ("host", Env.string) |
| 95 | (fn (env, host) => |
| 96 | let |
| 97 | val nodes = Env.env (Env.list Env.string) (env, "WebNodes") |
| 98 | |
| 99 | val ssl = Env.env Env.bool (env, "SSL") |
| 100 | val user = Env.env Env.string (env, "User") |
| 101 | val group = Env.env Env.string (env, "Group") |
| 102 | val docroot = Env.env Env.string (env, "DocumentRoot") |
| 103 | val sadmin = Env.env Env.string (env, "ServerAdmin") |
| 104 | |
| 105 | val fullHost = host ^ "." ^ Domain.currentDomain () |
| 106 | val confFile = fullHost ^ (if ssl then ".vhost_ssl" else ".vhost") |
| 107 | in |
| 108 | vhostFiles := map (fn node => |
| 109 | let |
| 110 | val file = Domain.domainFile {node = node, |
| 111 | name = confFile} |
| 112 | in |
| 113 | TextIO.output (file, "<VirtualHost "); |
| 114 | TextIO.output (file, Domain.nodeIp node); |
| 115 | TextIO.output (file, ":"); |
| 116 | TextIO.output (file, if ssl then |
| 117 | "443" |
| 118 | else |
| 119 | "80"); |
| 120 | TextIO.output (file, ">\n"); |
| 121 | file |
| 122 | end) |
| 123 | nodes; |
| 124 | write "\tSuexecUserGroup "; |
| 125 | write user; |
| 126 | write " "; |
| 127 | write group; |
| 128 | write "\n\tDocumentRoot "; |
| 129 | write docroot; |
| 130 | write "\n\tServerAdmin "; |
| 131 | write sadmin; |
| 132 | write "\n" |
| 133 | end, |
| 134 | fn () => (write "</VirtualHost>\n"; |
| 135 | app TextIO.closeOut (!vhostFiles))) |
| 136 | |
| 137 | end |