src/apache/apache.sml

   1 (*
   2 Domtool (http://hcoop.sf.net/)
   3 Copyright (C) 2004  Adam Chlipala
   4
   5 This program is free software; you can redistribute it and/or
   6 modify it under the terms of the GNU General Public License
   7 as published by the Free Software Foundation; either version 2
   8 of the License, or (at your option) any later version.
   9
  10 This program is distributed in the hope that it will be useful,
  11 but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 GNU General Public License for more details.
  14
  15 You should have received a copy of the GNU General Public License
  16 along with this program; if not, write to the Free Software
  17 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  18 *)
  19
  20 (* Apache vhost management module, with Webalizer support *)
  21
  22 structure Apache :> APACHE =
  23 struct
  24     open Config ApacheConfig Util
  25
  26     val vhosts = ref (NONE : TextIO.outstream option)
  27     val loggroups = ref (NONE : TextIO.outstream option)
  28
  29     fun init () = (vhosts := SOME (TextIO.openOut (scratchDir ^ "/vhosts.conf"));
  30                    loggroups := SOME (TextIO.openOut (scratchDir ^ "/loggroups")))
  31     fun finish () = (TextIO.closeOut (valOf (!vhosts));
  32                      vhosts := NONE;
  33                      TextIO.closeOut (valOf (!loggroups));
  34                      loggroups := NONE)
  35
  36     val noargs = ["redirect", "R", "forbidden", "F", "gone", "G", "last", "L", "chain", "C", "nosubeq", "NS", "nocase", "NC", "qsappend", "QSA", "noescape", "NE", "passthrough", "PT"]
  37
  38     fun checkRewriteCondArgs (path, args) =
  39         if size args < 2 orelse String.sub (args, 0) <> #"[" orelse String.sub (args, size args - 1) <> #"]" then
  40             (Domtool.error (path, "Not in brackets: " ^ args);
  41              false)
  42         else let
  43             val args = String.substring (args, 1, size args - 2)
  44             val fields = String.fields (fn ch => ch = #",") args
  45
  46             fun checkOne f =
  47                 case f of
  48                     "nocase" => true
  49                   | "NC" => true
  50                   | "ornext" => true
  51                   | "OR" => true
  52                   | _ => false
  53         in
  54             List.all checkOne fields
  55         end
  56
  57
  58     fun checkRewriteArgs (path, args) =
  59         if size args < 2 orelse String.sub (args, 0) <> #"[" orelse String.sub (args, size args - 1) <> #"]" then
  60             (Domtool.error (path, "Not in brackets: " ^ args);
  61              false)
  62         else let
  63             val args = String.substring (args, 1, size args - 2)
  64             val fields = String.fields (fn ch => ch = #",") args
  65
  66             fun checkField f =
  67                 case String.fields (fn ch => ch = #"=") f of
  68                     [flag] => List.exists (fn x => x = flag) noargs orelse (Domtool.error (path, "Unknown argument-free flag " ^ flag);
  69                                                                             false)
  70                   | ["type", _] => true
  71                   | ["T", _] => true
  72                   | ["skip", num] => isNat num orelse (Domtool.error (path, "Bad skip number " ^ num); false)
  73                   | ["S", num] => isNat num orelse (Domtool.error (path, "Bad skip number " ^ num); false)
  74                   | ["env", varval] =>
  75                     (case String.fields (fn ch => ch = #":") varval of
  76                          [_, _] => true
  77                        | _ => (Domtool.error (path, "Bad env setting " ^ varval);
  78                                false))
  79                   | ["E", varval] =>
  80                     (case String.fields (fn ch => ch = #":") varval of
  81                          [_, _] => true
  82                        | _ => (Domtool.error (path, "Bad env setting " ^ varval);
  83                                false))
  84                   | _ => (Domtool.error (path, "Unknown or disallowed mod_rewrite flag " ^ f);
  85                           false)
  86         in
  87             List.all checkField fields
  88         end
  89
  90     fun handler {path, domain, parent, vars, paths, users, groups, mxs} =
  91         let
  92             val _ = Domtool.dprint ("Reading host " ^ path ^ " for " ^ domain ^ "....")
  93
  94             val vhosts = valOf (!vhosts)
  95             val loggroups = valOf (!loggroups)
  96
  97             val domfile = dataDir ^ "/" ^ String.concatWith "/" (rev (String.tokens (fn ch => ch = #".") domain))
  98             val stat = Posix.FileSys.stat domfile
  99             val group' = Posix.SysDB.Group.name (Posix.SysDB.getgrgid (Posix.FileSys.ST.gid stat))
 100
 101             val _ = TextIO.output (loggroups, domain ^ "\t" ^ group' ^ "\n")
 102
 103             val hf = TextIO.openIn path
 104             val rewrite = ref false
 105
 106             val conf = TextIO.openOut (wblConfDir ^ "/" ^ domain ^ ".conf")
 107             val _ = TextIO.output (conf, "LogFile\t" ^ logDir ^ domain ^ "-access.log\n" ^
 108                                          "OutputDir\t" ^ wblDocDir ^ "/" ^ domain ^ "\n" ^
 109                                          "HostName\t" ^ domain ^ "\n" ^
 110                                          "HideSite\t" ^ domain ^ "\n" ^
 111                                          "HideReferrer\t" ^ domain ^ "\n")
 112
 113             val dir = wblDocDir ^ "/" ^ domain
 114             val _ =
 115                 if Posix.FileSys.access (dir, []) then
 116                     ()
 117                 else
 118                     Posix.FileSys.mkdir (dir, Posix.FileSys.S.flags [Posix.FileSys.S.ixoth, Posix.FileSys.S.irwxu,
 119                                                                      Posix.FileSys.S.irgrp, Posix.FileSys.S.iwgrp])
 120
 121             val htac = TextIO.openOut (dir ^ "/.htaccess")
 122             val user = ref defaultUser
 123             val group = ref defaultGroup
 124             val scripts = ref false
 125
 126             val blocked = ref []
 127
 128             local
 129                 val fixup = ref false
 130             in
 131             fun checkFixup () =
 132                 if !fixup then
 133                     ()
 134                 else
 135                     (fixup := true;
 136                      TextIO.output (vhosts, "\tPerlFixupHandler Apache::PerlVINC\n");
 137                      TextIO.output (vhosts, "\tPerlCleanupHandler Apache::PerlVINC\n"))
 138             end
 139
 140             fun checkRewrite () =
 141                 if not (!rewrite) then
 142                     (rewrite := true;
 143                      TextIO.output (vhosts, "\tRewriteEngine on\n"))
 144                 else
 145                     ()
 146
 147             fun loop (line, ()) =
 148                 (case String.tokens Char.isSpace line of
 149                      [] => ()
 150                    | ["User", user'] =>
 151                      if StringSet.member (users, user') then
 152                          user := user'
 153                      else
 154                          Domtool.error (path, "not authorized to run as " ^ user')
 155                    | ["Group", group'] =>
 156                      if StringSet.member (groups, group') then
 157                          group := group'
 158                      else
 159                          Domtool.error (path, "not authorized to run as group " ^ group')
 160                    | ["ServerAdmin", email] => TextIO.output (vhosts, "\tServerAdmin " ^ email ^ "\n")
 161                    (*| ["UserDir"] => TextIO.output (vhosts, "\tUserDir public_html\n\t<Directory /home/*/public_html/cgi-bin>\n\t\tAllowOverride None\n\t\tOptions ExecCGI\n\t\tAllow from all\n\t\tSetHandler cgi-script\n\t</Directory>\n\tScriptAliasMatch ^/~(.* )/cgi-bin/(.* ) /home/$1/public_html/cgi-bin/$2\n")*)
 162                    | ["DocumentRoot", p] =>
 163                      if checkPath (paths, p) then
 164                          TextIO.output (vhosts, "\tDocumentRoot " ^ p ^ "\n")
 165                      else
 166                          print (path ^ ": not authorized to use " ^ p ^ "\n")
 167                    | "RewriteRule" :: src :: dst :: rest =>
 168                      let
 169                          val flags =
 170                              case rest of
 171                                  [] => SOME ""
 172                                | [flags] => if checkRewriteArgs (path, flags) then SOME flags else NONE
 173                                | _ => (Domtool.error (path, "Invalid mod_rewrite flags in " ^ chop line); NONE)
 174                      in
 175                          case flags of
 176                              SOME flags =>
 177                              (checkRewrite ();
 178                              TextIO.output (vhosts, "\tRewriteRule\t" ^ src ^ " " ^ dst ^ " " ^ flags ^ "\n"))
 179                            | _ => ()
 180                      end
 181                    | "RewriteCond" :: thing :: pat :: rest =>
 182                      let
 183                          val flags =
 184                              case rest of
 185                                  [] => SOME ""
 186                                | [flags] => if checkRewriteCondArgs (path, flags) then SOME flags else NONE
 187                                | _ => (Domtool.error (path, "Invalid mod_rewrite flags in " ^ chop line); NONE)
 188                      in
 189                          case flags of
 190                              SOME flags =>
 191                              (checkRewrite ();
 192                              TextIO.output (vhosts, "\tRewriteCond\t" ^ thing ^ " " ^ pat ^ " " ^ flags ^ "\n"))
 193                            | _ => ()
 194                      end
 195                    | ["LocalProxy", src, dst, port] =>
 196                      (case Int.fromString port of
 197                           NONE => Domtool.error (path, "Invalid port number " ^ port)
 198                         | SOME n =>
 199                           if n = 80 then
 200                               Domtool.error (path, "No proxying back to Apache itself allowed")
 201                           else if n <= 0 then
 202                               Domtool.error (path, "Port number must be positive: " ^ port)
 203                           else
 204                               (checkRewrite ();
 205                                TextIO.output (vhosts, "\tRewriteRule\t" ^ src ^ " http://localhost:" ^ port ^ "/" ^ dst ^ " [P]\n")))
 206                    | ["Mailman"] =>
 207                      (checkRewrite ();
 208                       TextIO.output (vhosts, "\tRewriteRule\t^/cgi-bin/mailman/(.*)$ http://hcoop.net/cgi-bin/mailman/$1 [P]\n");
 209                       TextIO.output (vhosts, "\tRewriteRule\t^/pipermail/(.*)$ http://hcoop.net/pipermail/$1 [P]\n"))
 210                    | ["Alias", from, to] =>
 211                      if checkPath (paths, to) then
 212                          TextIO.output (vhosts, "\tAlias " ^ from ^ " " ^ to ^ "\n")
 213                      else
 214                          Domtool.error (path, "not authorized to use " ^ to)
 215                    | "ErrorDocument" :: code :: rest =>
 216                      TextIO.output (vhosts, foldl (fn (a, s) => s ^ " " ^ a) ("\tErrorDocument " ^ code) rest ^ "\n")
 217                    | ["Script", from, to] =>
 218                      (if !scripts then
 219                           ()
 220                       else
 221                           (scripts := true;
 222                            TextIO.output (vhosts, "\tUserDir disabled\n");
 223                            TextIO.output (vhosts, "\tUserDir enabled " ^ !user ^ "\n");
 224                            TextIO.output (vhosts, "\t<Directory /home/" ^ !user ^ "/public_html/cgi-bin/>\n\t\tOptions ExecCGI\n\t\tSetHandler cgi-script\n\t</Directory>\n"));
 225                       checkRewrite ();
 226                       TextIO.output (vhosts, "\tRewriteRule\t^/" ^ from ^ "(.*)$ http://" ^ domain ^ "/~" ^ !user ^ "/cgi-bin/" ^ to ^ "$1 [P]\n"))
 227                    | ["MoinMoin", from, to] =>
 228                      (if !scripts then
 229                           ()
 230                       else
 231                           (scripts := true;
 232                            TextIO.output (vhosts, "\tUserDir disabled\n");
 233                            TextIO.output (vhosts, "\tUserDir enabled " ^ !user ^ "\n");
 234                            TextIO.output (vhosts, "\t<Directory /home/" ^ !user ^ "/public_html/cgi-bin/>\n\t\tOptions ExecCGI\n\t\tSetHandler cgi-script\n\t</Directory>\n"));
 235                       checkRewrite ();
 236                       TextIO.output (vhosts, "\tRewriteRule\t^/" ^ from ^ "(.*)$ http://" ^ domain ^ "/~" ^ !user ^ "/cgi-bin/" ^ to ^ "$1 [P]\n");
 237                       TextIO.output (vhosts, "\tAlias /moin /usr/share/moin/htdocs\n"))
 238
 239                    (*| ["ScriptAlias", from, to] =>
 240                      if checkPath (paths, to) then
 241                          TextIO.output (vhosts, "\tScriptAlias " ^ from ^ " \"" ^ to ^ "\"\n")
 242                      else
 243                          Domtool.error (path, "not authorized to use " ^ to)*)
 244                    | ["SSI"] =>
 245                      TextIO.output (vhosts, "\t<Location />\n\t\tOptions +Includes +IncludesNOEXEC\n\t</Location>\n")
 246                    | ["ServerAlias", dom] =>
 247                      if validDomain dom then
 248                          let
 249                              val file = foldr (fn (c, s) => s ^ "/" ^ c) dataDir (String.fields (fn ch => ch = #".") dom) ^ ".aliased"
 250                          in
 251                              if Posix.FileSys.access (file, []) then
 252                                  (TextIO.output (vhosts, "\tServerAlias " ^ dom ^ "\n");
 253                                   TextIO.output (conf, "HideSite\t" ^ dom ^ "\n" ^
 254                                                        "HideReferrer\t" ^ dom ^ "\n"))
 255                              else
 256                                  Domtool.error (path, "not authorized to ServerAlias " ^ dom)
 257                          end
 258                      else
 259                          Domtool.error (path, "bad host: " ^ dom)
 260                    | "WebalizerUsers" :: users =>
 261                      TextIO.output (htac, "AuthType Basic\n" ^
 262                                           "AuthName \"Abulafia web account\"\n" ^
 263                                           "AuthUserFile " ^ passwdFile ^ "\n" ^
 264                                           foldl (fn (u, s) => s ^ " " ^ u) "Require user" users ^ "\n")
 265                    | ["AbuPrivate"] => TextIO.output (vhosts,
 266                                                       "\t<Location />\n" ^
 267                                                       "\t\tAuthName \"Abulafia web account\"\n" ^
 268                                                       "\t\tAuthType basic\n" ^
 269                                                       "\t\tAuthUserFile " ^ passwdFile ^ "\n" ^
 270                                                       "\t\tRequire valid-user\n" ^
 271                                                       "\t\tOrder Deny,Allow\n" ^
 272                                                       "\t\tDeny from all\n" ^
 273                                                       "\t\tAllow from 127.0.0.1\n" ^
 274                                                       (*"\t\tAllow from 63.246.10.45\n" ^*)
 275                                                       "\t\tSatisfy any\n" ^
 276                                                       "\t</Location>\n")
 277                    | ["Block", pat] => blocked := pat :: (!blocked)
 278                    | ["Default"] => (TextIO.output (vhosts, "\tServerAlias " ^ parent ^ "\n");
 279                                      TextIO.output (conf, "HideSite\t" ^ parent ^ "\n" ^
 280                                                           "HideReferrer\t" ^ parent ^ "\n"))
 281                    (*| ["CGI", p] =>
 282                      if checkPath (paths, p) then
 283                          TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n" ^
 284                                                 "\t\tOptions ExecCGI\n" ^
 285                                                 "\t\tSetHandler cgi-script\n" ^
 286                                                 "\t</Directory>\n")
 287                      else
 288                          Domtool.error (path, "not authorized to use " ^ p)*)
 289                    | ["Mod", lang, p, file] =>
 290                      (case List.find (fn (lang', _) => lang = lang') langHandlers of
 291                           NONE => Domtool.error (p, "unknown Mod language " ^ lang)
 292                         | SOME (_, f) =>
 293                           (TextIO.output (vhosts, "\t<Location " ^ p ^ ">\n");
 294                            TextIO.output (vhosts, f file);
 295                            TextIO.output (vhosts, "\t</Location>\n")))
 296                    | ["HTML", p] =>
 297                      if checkPath (paths, p) then
 298                          TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n" ^
 299                                                 "\t\tForceType text/html\n" ^
 300                                                 "\t</Directory>\n")
 301                      else
 302                          Domtool.error (path, "not authorized to use " ^ p)
 303                    | ["PerlSetVar", n, v] =>
 304                      TextIO.output (vhosts, "\tPerlSetVar " ^ n ^ " " ^ v ^ "\n")
 305                    | ["AddDefaultCharset", cs] =>
 306                      TextIO.output (vhosts, "\tAddDefaultCharSet " ^ cs ^ "\n")
 307                    | ["PerlINC", p] =>
 308                      if checkPath (paths, p) then
 309                          (checkFixup ();
 310                           TextIO.output (vhosts, "\tPerlINC " ^ p ^ "\n"))
 311                      else
 312                          Domtool.error (path, "not authorized to use " ^ p)
 313                    | ["PerlVersion", p] =>
 314                      (checkFixup ();
 315                       TextIO.output (vhosts, "\tPerlVersion " ^ p ^ "\n"))
 316                    | cmd::_ => Domtool.error (path, "unknown option: " ^ cmd))
 317         in
 318             TextIO.output (vhosts, "<VirtualHost *>\n" ^
 319                                    "\tServerName " ^ domain ^ "\n" ^
 320                                    "\tErrorLog " ^ logDir ^ domain ^ "-error.log\n" ^
 321                                    "\tCustomLog " ^ logDir ^ domain ^ "-access.log combined\n" ^
 322                                    "\tIndexOptions FancyIndexing FoldersFirst\n");
 323             ioOptLoop (fn () => Domtool.inputLine hf) loop ();
 324
 325             (case !blocked of
 326                  [] => ()
 327                | _ =>
 328                  (TextIO.output (vhosts,
 329                                  "\t<Location />\n" ^
 330                                  "\t\tOrder Allow,Deny\n" ^
 331                                  "\t\tAllow from all\n");
 332                   app (fn pat =>  TextIO.output (vhosts, "\t\tDeny from " ^ pat ^ "\n")) (!blocked);
 333                   TextIO.output (vhosts, "\t</Location>\n")));
 334
 335             if apache2 then
 336                 (TextIO.output (vhosts, "\tSuexecUserGroup ");
 337                  TextIO.output (vhosts, !user);
 338                  TextIO.output (vhosts, " ");
 339                  TextIO.output (vhosts, !group);
 340                  if !scripts then
 341                      ()
 342                  else
 343                      TextIO.output (vhosts, "\tUserDir disabled\n"))
 344             else
 345                 (TextIO.output (vhosts, "\tUser ");
 346                  TextIO.output (vhosts, !user);
 347                  TextIO.output (vhosts, "\n\tGroup ");
 348                  TextIO.output (vhosts, !group));
 349
 350             TextIO.output (vhosts, "\n</VirtualHost>\n\n");
 351             TextIO.closeIn hf;
 352             TextIO.closeOut conf;
 353             TextIO.closeOut htac
 354         end handle ex => Domtool.handleException (path, ex)
 355
 356     fun publish () =
 357         if OS.Process.isSuccess (OS.Process.system
 358                (diff ^ " " ^ scratchDir ^ "/vhosts.conf " ^ dataFile)) then
 359             OS.Process.success
 360         else if not (OS.Process.isSuccess (OS.Process.system
 361                (cp ^ " " ^ scratchDir ^ "/vhosts.conf " ^ dataFile))) then
 362             (print "Error copying vhosts.conf\n";
 363              OS.Process.failure)
 364         else if not (OS.Process.isSuccess (OS.Process.system pubCommand)) then
 365             (print "Error publishing vhosts.conf\n";
 366              OS.Process.failure)
 367         else if OS.Process.isSuccess (OS.Process.system logpermsCommand) then
 368             OS.Process.success
 369         else
 370             (print "Error updating log permissions\n";
 371              OS.Process.failure)
 372
 373     fun mkdom _ = OS.Process.success
 374
 375     val _ = Domtool.setVhostHandler {init = init,
 376                                      file = handler,
 377                                      finish = finish,
 378                                      publish = publish,
 379                                      mkdom = mkdom}
 380 end
 381