Proper calculation of different log files for different hosts
[hcoop/domtool2.git] / src / plugins / apache.sml
index d706de9..1bb622b 100644 (file)
@@ -22,6 +22,17 @@ structure Apache :> APACHE = struct
 
 open Ast
 
+val _ = Env.type_one "web_node"
+       Env.string
+       (fn node =>
+           List.exists (fn (x, _) => x = node) Config.Apache.webNodes_all
+           orelse (Domain.hasPriv "www"
+                   andalso List.exists (fn (x, _) => x = node) Config.Apache.webNodes_admin))
+
+val _ = Env.registerFunction ("web_node_to_node",
+                             fn [e] => SOME e
+                              | _ => NONE)
+
 val _ = Env.type_one "proxy_port"
        Env.int
        (fn n => n > 1024)
@@ -47,6 +58,10 @@ val _ = Env.type_one "rewrite_arg"
        Env.string
        (CharVector.all Char.isAlphaNum)
 
+val _ = Env.type_one "suexec_flag"
+       Env.bool
+       (fn b => b orelse Domain.hasPriv "www")
+
 fun validLocation s =
     size s > 0 andalso size s < 1000 andalso CharVector.all
                                                 (fn ch => Char.isAlphaNum ch
@@ -59,32 +74,48 @@ val _ = Env.type_one "location"
        Env.string
        validLocation
 
+fun validCert s = Acl.query {user = Domain.getUser (),
+                            class = "cert",
+                            value = s}
+
+val _ = Env.type_one "ssl_cert_path"
+       Env.string
+       validCert
+
+fun ssl e = case e of
+               (EVar "no_ssl", _) => SOME NONE
+             | (EApp ((EVar "use_cert", _), s), _) => Option.map SOME (Env.string s)
+             | _ => NONE
+
 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 _ = Defaults.registerDefault ("WebNodes",
+                                 (TList (TBase "web_node", dl), dl),
+                                 (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl)))
 
-val _ = Main.registerDefault ("SSL",
-                             (TBase "bool", dl),
-                             (fn () => (EVar "false", dl)))
+val _ = Defaults.registerDefault ("SSL",
+                                 (TBase "ssl", dl),
+                                 (fn () => (EVar "no_ssl", dl)))
 
-val _ = Main.registerDefault ("User",
-                             (TBase "your_user", dl),
-                             (fn () => (EString (Domain.getUser ()), dl)))
+val _ = Defaults.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 _ = Defaults.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 _ = Defaults.registerDefault ("DocumentRoot",
+                                 (TBase "your_path", dl),
+                                 (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl)))
 
-val _ = Main.registerDefault ("ServerAdmin",
-                             (TBase "email", dl),
-                             (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
+val _ = Defaults.registerDefault ("ServerAdmin",
+                                 (TBase "email", dl),
+                                 (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
 
+val _ = Defaults.registerDefault ("SuExec",
+                                 (TBase "suexec_flag", dl),
+                                 (fn () => (EVar "true", dl)))
 
 val redirect_code = fn (EVar "temp", _) => SOME "temp"
                     | (EVar "permanent", _) => SOME "permanent"
@@ -131,34 +162,177 @@ val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI"
                     | (EVar "indexes", _) => SOME "Indexes"
                     | _ => NONE
 
+val autoindex_width = fn (EVar "autofit", _) => SOME "*"
+                      | (EApp ((EVar "characters", _), n), _) =>
+                        Option.map Int.toString (Env.int n)
+                      | _ => NONE
+
+val autoindex_option = fn (EApp ((EVar "descriptionWidth", _), w), _) =>
+                         Option.map (fn w => ("DescriptionWidth", SOME w))
+                         (autoindex_width w)
+                       | (EVar "fancyIndexing", _) => SOME ("FancyIndexing", NONE)
+                       | (EVar "foldersFirst", _) => SOME ("FoldersFirst", NONE)
+                       | (EVar "htmlTable", _) => SOME ("HTMLTable", NONE)
+                       | (EVar "iconsAreLinks", _) => SOME ("IconsAreLinks", NONE)
+                       | (EApp ((EVar "iconHeight", _), n), _) =>
+                         Option.map (fn w => ("IconHeight", SOME (Int.toString w)))
+                                    (Env.int n)
+                       | (EApp ((EVar "iconWidth", _), n), _) =>
+                         Option.map (fn w => ("IconWidth", SOME (Int.toString w)))
+                                    (Env.int n)
+                       | (EVar "ignoreCase", _) => SOME ("IgnoreCase", NONE)
+                       | (EVar "ignoreClient", _) => SOME ("IgnoreClient", NONE)
+                       | (EApp ((EVar "nameWidth", _), w), _) =>
+                         Option.map (fn w => ("NameWidth", SOME w))
+                                    (autoindex_width w)
+                       | (EVar "scanHtmlTitles", _) => SOME ("ScanHTMLTitles", NONE)
+                       | (EVar "suppressColumnSorting", _) => SOME ("SuppressColumnSorting", NONE)
+                       | (EVar "suppressDescription", _) => SOME ("SuppressDescription", NONE)
+                       | (EVar "suppressHtmlPreamble", _) => SOME ("SuppressHTMLPreamble", NONE)
+                       | (EVar "suppressIcon", _) => SOME ("SuppressIcon", NONE)
+                       | (EVar "suppressLastModified", _) => SOME ("SuppressLastModified", NONE)
+                       | (EVar "suppressRules", _) => SOME ("SuppressRules", NONE)
+                       | (EVar "suppressSize", _) => SOME ("SuppressSize", NONE)
+                       | (EVar "trackModified", _) => SOME ("TrackModified", NONE)
+                       | (EVar "versionSort", _) => SOME ("VersionSort", NONE)
+                       | (EVar "xhtml", _) => SOME ("XHTML", NONE)
+
+                       | _ => NONE
 
 val vhostsChanged = ref false
+val logDeleted = ref false
 
 val () = Slave.registerPreHandler
-            (fn () => vhostsChanged := false)
+            (fn () => (vhostsChanged := false;
+                       logDeleted := false))
+
+fun findVhostUser fname =
+    let
+       val inf = TextIO.openIn fname
+
+       fun loop () =
+           case TextIO.inputLine inf of
+               NONE => NONE
+             | SOME line =>
+               if String.isPrefix "# Owner: " line then
+                   case String.tokens Char.isSpace line of
+                       [_, _, user] => SOME user
+                     | _ => NONE
+               else
+                   loop ()
+    in
+       loop ()
+       before TextIO.closeIn inf
+    end handle _ => NONE
+
+val webNodes_full = Config.Apache.webNodes_all @ Config.Apache.webNodes_admin
+
+fun isVersion1 node =
+    List.exists (fn (n, {version = ConfigTypes.APACHE_1_3, ...}) => n = node
+                 | _ => false) webNodes_full
+
+fun imVersion1 () = isVersion1 (Slave.hostname ())
+
+fun isWaklog node =
+    List.exists (fn (n, {auth = ConfigTypes.MOD_WAKLOG, ...}) => n = node
+                 | _ => false) webNodes_full
+
+fun down () = if imVersion1 () then Config.Apache.down1 else Config.Apache.down
+fun undown () = if imVersion1 () then Config.Apache.undown1 else Config.Apache.undown
+fun reload () = if imVersion1 () then Config.Apache.reload1 else Config.Apache.reload
+
+fun logDir {user, node, vhostId} =
+    String.concat [Config.Apache.logDirOf (isVersion1 node) user,
+                  "/",
+                  node,
+                  "/",
+                  vhostId]
 
 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)))
+                                             orelse String.isSuffix ".vhost_ssl" (#file spl) then let
+                                                  val realVhostFile = OS.Path.joinDirFile
+                                                                          {dir = Config.Apache.confDir,
+                                                                           file = #file spl}
+
+                                                  val user = findVhostUser (#file fs)
+                                                  val oldUser = findVhostUser realVhostFile
+                                              in
+                                                  if (oldUser = NONE andalso #action fs <> Slave.Add)
+                                                     orelse (user = NONE andalso #action fs <> Slave.Delete) then
+                                                      print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "!  Taking no action.\n")
+                                                  else
+                                                      let
+                                                          val vhostId = if OS.Path.ext (#file spl) = SOME ".vhost_ssl" then
+                                                                            OS.Path.base (#file spl) ^ ".ssl"
+                                                                        else
+                                                                            OS.Path.base (#file spl)
+
+                                                          fun realLogDir user =
+                                                              logDir {user = valOf user,
+                                                                      node = Slave.hostname (),
+                                                                      vhostId = vhostId}
+                                                      in
+                                                          vhostsChanged := true;
+                                                          case #action fs of
+                                                              Slave.Delete =>
+                                                              (if !logDeleted then
+                                                                   ()
+                                                               else
+                                                                   (ignore (OS.Process.system (down ()));
+                                                                    logDeleted := true);
+                                                               ignore (OS.Process.system (Config.rm
+                                                                                          ^ " -rf "
+                                                                                          ^ realVhostFile));
+                                                               ignore (OS.Process.system (Config.rm
+                                                                                          ^ " -rf "
+                                                                                          ^ realLogDir oldUser)))
+                                                            | Slave.Add =>
+                                                              let
+                                                                  val rld = realLogDir user
+                                                              in
+                                                                  ignore (OS.Process.system (Config.cp
+                                                                                             ^ " "
+                                                                                             ^ #file fs
+                                                                                             ^ " "
+                                                                                             ^ realVhostFile));
+                                                                  if Posix.FileSys.access (rld, []) then
+                                                                      ()
+                                                                  else
+                                                                      Slave.mkDirAll rld
+                                                              end
+                                                              
+                                                            | _ =>
+                                                              (ignore (OS.Process.system (Config.cp
+                                                                                          ^ " "
+                                                                                          ^ #file fs
+                                                                                          ^ " "
+                                                                                          ^ realVhostFile));
+                                                               if user <> oldUser then
+                                                                   let
+                                                                       val old = realLogDir oldUser
+                                                                       val rld = realLogDir user
+                                                                   in
+                                                                       if !logDeleted then
+                                                                           ()
+                                                                       else
+                                                                           (ignore (OS.Process.system (down ()));
+                                                                            logDeleted := true);
+                                                                       ignore (OS.Process.system (Config.rm
+                                                                                                  ^ " -rf "
+                                                                                                  ^ realLogDir oldUser));
+                                                                       if Posix.FileSys.access (rld, []) then
+                                                                           ()
+                                                                       else
+                                                                           Slave.mkDirAll rld
+                                                                   end
+                                                               else
+                                                                   ())
+                                                      end
+                                              end
                                           else
                                               ()
                                       end)
@@ -166,95 +340,160 @@ val () = Slave.registerFileHandler (fn fs =>
 val () = Slave.registerPostHandler
         (fn () =>
             (if !vhostsChanged then
-                 Slave.shellF ([Config.Apache.reload],
+                 Slave.shellF ([if !logDeleted then undown () else 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 vhostFiles : (string * TextIO.outstream) list ref = ref []
+fun write' s = app (fn (node, file) => TextIO.output (file, s node)) (!vhostFiles)
+fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
 
 val rewriteEnabled = ref false
+val localRewriteEnabled = ref false
 val currentVhost = ref ""
 val currentVhostId = ref ""
 
+val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
+fun registerPre f =
+    let
+       val old = !pre
+    in
+       pre := (fn x => (old x; f x))
+    end
+
+val post = ref (fn () => ())
+fun registerPost f =
+    let
+       val old = !post
+    in
+       post := (fn () => (old (); f ()))
+    end
+
+val aliaser = ref (fn _ : string => ())
+fun registerAliaser f =
+    let
+       val old = !aliaser
+    in
+       aliaser := (fn x => (old x; f x))
+    end
+
 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 ssl = Env.env ssl (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 suexec = Env.env Env.bool (env, "SuExec")
 
                 val fullHost = host ^ "." ^ Domain.currentDomain ()
-                val vhostId = fullHost ^ (if ssl then ".ssl" else "")
-                val confFile = fullHost ^ (if ssl then ".vhost_ssl" else ".vhost")
+                val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
+                val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
             in
                 currentVhost := fullHost;
                 currentVhostId := vhostId;
 
                 rewriteEnabled := false;
+                localRewriteEnabled := false;
                 vhostFiles := map (fn node =>
                                       let
                                           val file = Domain.domainFile {node = node,
                                                                         name = confFile}
+
+                                          val ld = logDir {user = user, node = node, vhostId = vhostId}
                                       in
-                                          TextIO.output (file, "<VirtualHost ");
+                                          TextIO.output (file, "# Owner: ");
+                                          TextIO.output (file, user);
+                                          TextIO.output (file, "\n<VirtualHost ");
                                           TextIO.output (file, Domain.nodeIp node);
                                           TextIO.output (file, ":");
-                                          TextIO.output (file, if ssl then
-                                                                   "443"
-                                                               else
-                                                                   "80");
+                                          TextIO.output (file, case ssl of
+                                                                   SOME _ => "443"
+                                                                 | NONE => "80");
                                           TextIO.output (file, ">\n");
-                                          file
+                                          TextIO.output (file, "\tErrorLog ");
+                                          TextIO.output (file, ld);
+                                          TextIO.output (file, "/error.log\n\tCustomLog ");
+                                          TextIO.output (file, ld);
+                                          TextIO.output (file, "/access.log combined\n");
+                                          TextIO.output (file, "\tServerName ");
+                                          TextIO.output (file, fullHost);
+                                          if suexec then
+                                              if isVersion1 node then
+                                                  (TextIO.output (file, "\n\tUser ");
+                                                   TextIO.output (file, user);
+                                                   TextIO.output (file, "\n\tGroup ");
+                                                   TextIO.output (file, group))
+                                              else
+                                                  (TextIO.output (file, "\n\tSuexecUserGroup ");
+                                                   TextIO.output (file, user);
+                                                   TextIO.output (file, " ");
+                                                   TextIO.output (file, group))
+                                          else
+                                              ();
+                                          if isWaklog node then
+                                              (TextIO.output (file, "\n\tWaklogProtected on\n\tWaklogPrincipal ");
+                                               TextIO.output (file, user);
+                                               TextIO.output (file, "/cgi@HCOOP.NET /etc/keytabs/cgi/");
+                                               TextIO.output (file, user))
+                                          else
+                                              ();
+                                          (ld, file)
                                       end)
                                   nodes;
-                write "\tServerName ";
-                write fullHost;
-                write "\n\tSuexecUserGroup ";
-                write user;
-                write " ";
-                write group;
                 write "\n\tDocumentRoot ";
                 write docroot;
                 write "\n\tServerAdmin ";
                 write sadmin;
-                write "\n\tErrorLog ";
-                write Config.Apache.logDir;
-                write "/";
-                write vhostId;
-                write "/error.log\n\tCustomLog ";
-                write Config.Apache.logDir;
-                write "/";
-                write vhostId;
-                write "/access.log combined\n"
+                case ssl of
+                    SOME cert =>
+                    (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
+                     write cert)
+                  | NONE => ();
+                write "\n";
+                !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost}
             end,
-         fn () => (write "</VirtualHost>\n";
-                   app TextIO.closeOut (!vhostFiles)))
+         fn () => (!post ();
+                   write "</VirtualHost>\n";
+                   app (TextIO.closeOut o #2) (!vhostFiles)))
+
+val inLocal = ref false
 
 val () = Env.container_one "location"
         ("prefix", Env.string)
         (fn prefix =>
             (write "\t<Location ";
              write prefix;
-             write ">\n"),
-         fn () => write "\t</Location>\n")
+             write ">\n";
+             inLocal := true),
+         fn () => (write "\t</Location>\n";
+                   inLocal := false;
+                   localRewriteEnabled := false))
 
 val () = Env.container_one "directory"
         ("directory", Env.string)
         (fn directory =>
             (write "\t<Directory ";
              write directory;
-             write ">\n"),
-         fn () => write "\t</Directory>\n")
+             write ">\n";
+             inLocal := true),
+         fn () => (write "\t</Directory>\n";
+                   inLocal := false;
+                   localRewriteEnabled := false))
 
 fun checkRewrite () =
-    if !rewriteEnabled then
+    if !inLocal then
+       if !rewriteEnabled orelse !localRewriteEnabled then
+           ()
+       else
+           (write "\tRewriteEngine on\n";
+            localRewriteEnabled := true)
+    else if !rewriteEnabled then
        ()
     else
        (write "\tRewriteEngine on\n";
@@ -329,9 +568,7 @@ val () = Env.action_one "rewriteLogLevel"
         (fn level =>
             (checkRewrite ();
              write "\tRewriteLog ";
-             write Config.Apache.logDir;
-             write "/";
-             write (!currentVhostId);
+             write' (fn x => x);
              write "/rewrite.log\n\tRewriteLogLevel ";
              write (Int.toString level);
              write "\n"))
@@ -402,7 +639,8 @@ val () = Env.action_one "serverAlias"
         (fn host =>
             (write "\tServerAlias ";
              write host;
-             write "\n"))
+             write "\n";
+             !aliaser host))
 
 val authType = fn (EVar "basic", _) => SOME "basic"
                | (EVar "digest", _) => SOME "digest"
@@ -509,7 +747,7 @@ val () = Env.action_one "addDefaultCharset"
                    write ty;
                    write "\n"))
 
-val () = Env.action_one "davSvn"
+(*val () = Env.action_one "davSvn"
         ("path", Env.string)
         (fn path => (write "\tDAV svn\n\tSVNPath ";
                      write path;
@@ -519,6 +757,69 @@ val () = Env.action_one "authzSvnAccessFile"
         ("path", Env.string)
         (fn path => (write "\tAuthzSVNAccessFile ";
                      write path;
+                     write "\n"))*)
+
+val () = Env.action_two "addDescription"
+        ("description", Env.string, "patterns", Env.list Env.string)
+        (fn (desc, pats) =>
+            case pats of
+                [] => ()
+              | _ => (write "\tAddDescription \"";
+                      write (String.toString desc);
+                      write "\"";
+                      app (fn pat => (write " "; write pat)) pats;
+                      write "\n"))
+
+val () = Env.action_one "indexOptions"
+        ("options", Env.list autoindex_option)
+        (fn opts =>
+            case opts of
+                [] => ()
+              | _ => (write "\tIndexOptions";
+                      app (fn (opt, arg) =>
+                              (write " ";
+                               write opt;
+                               Option.app (fn arg =>
+                                              (write "="; write arg)) arg)) opts;
+                      write "\n"))
+
+val () = Env.action_one "set_indexOptions"
+        ("options", Env.list autoindex_option)
+        (fn opts =>
+            case opts of
+                [] => ()
+              | _ => (write "\tIndexOptions";
+                      app (fn (opt, arg) =>
+                              (write " +";
+                               write opt;
+                               Option.app (fn arg =>
+                                              (write "="; write arg)) arg)) opts;
+                      write "\n"))
+
+val () = Env.action_one "unset_indexOptions"
+        ("options", Env.list autoindex_option)
+        (fn opts =>
+            case opts of
+                [] => ()
+              | _ => (write "\tIndexOptions";
+                      app (fn (opt, _) =>
+                              (write " -";
+                               write opt)) opts;
+                      write "\n"))
+
+val () = Env.action_one "headerName"
+        ("name", Env.string)
+        (fn name => (write "\tHeaderName ";
+                     write name;
                      write "\n"))
 
+val () = Env.action_one "readmeName"
+        ("name", Env.string)
+        (fn name => (write "\tReadmeName ";
+                     write name;
+                     write "\n"))
+
+val () = Domain.registerResetLocal (fn () =>
+                                      ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
+
 end