Allow vetoing of suexec
authorAdam Chlipala <adamc@hcoop.net>
Sat, 17 Feb 2007 21:18:43 +0000 (21:18 +0000)
committerAdam Chlipala <adamc@hcoop.net>
Sat, 17 Feb 2007 21:18:43 +0000 (21:18 +0000)
lib/apache.dtl
src/plugins/apache.sml

index 1e5d54e..d80d7ef 100644 (file)
@@ -8,13 +8,19 @@ extern val web_node_to_node : web_node -> node;
 context Vhost;
 {{A WWW virtual host}}
 
 context Vhost;
 {{A WWW virtual host}}
 
+extern type suexec_flag;
+extern val suexec_flag : bool -> suexec_flag;
+{{Whether or not to use Suexec with a vhost.
+[suexec_flag] fails when passed [false] by a user without the 'www' privilege.}}
+
 extern val vhost : host -> Vhost => [Domain]
        {WebNodes : [web_node],
         SSL : bool,
         User : your_user,
         Group : your_group,
         DocumentRoot : your_path,
 extern val vhost : host -> Vhost => [Domain]
        {WebNodes : [web_node],
         SSL : bool,
         User : your_user,
         Group : your_group,
         DocumentRoot : your_path,
-        ServerAdmin : email};
+        ServerAdmin : email,
+        SuExec : suexec_flag};
 {{Add a new named Apache virtual host, specifying which nodes' Apache servers
   should answer requests for this host, whether it should use SSL, what UNIX
   user and group dynamic content generators should be run as, the filesystem
 {{Add a new named Apache virtual host, specifying which nodes' Apache servers
   should answer requests for this host, whether it should use SSL, what UNIX
   user and group dynamic content generators should be run as, the filesystem
index 65ba7fb..3d7c199 100644 (file)
@@ -58,6 +58,10 @@ val _ = Env.type_one "rewrite_arg"
        Env.string
        (CharVector.all Char.isAlphaNum)
 
        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
 fun validLocation s =
     size s > 0 andalso size s < 1000 andalso CharVector.all
                                                 (fn ch => Char.isAlphaNum ch
@@ -96,6 +100,10 @@ val _ = Defaults.registerDefault ("ServerAdmin",
                                  (TBase "email", dl),
                                  (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
 
                                  (TBase "email", dl),
                                  (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
 
+val _ = Defaults.registerDefault ("SuExec",
+                                 (TBase "suexec_flag", dl),
+                                 (fn () => (EApp ((EVar "suexec_flag", dl),
+                                                  (EVar "true", dl)), dl)))
 
 val redirect_code = fn (EVar "temp", _) => SOME "temp"
                     | (EVar "permanent", _) => SOME "permanent"
 
 val redirect_code = fn (EVar "temp", _) => SOME "temp"
                     | (EVar "permanent", _) => SOME "permanent"
@@ -194,9 +202,12 @@ fun findVhostUser fname =
            case TextIO.inputLine inf of
                NONE => NONE
              | SOME line =>
            case TextIO.inputLine inf of
                NONE => NONE
              | SOME line =>
-               case String.tokens Char.isSpace line of
-                   ["SuexecUserGroup", user, _] => SOME user
-                 | _ => loop ()
+               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
     in
        loop ()
        before TextIO.closeIn inf
@@ -310,6 +321,9 @@ fun registerAliaser f =
        aliaser := (fn x => (old x; f x))
     end
 
        aliaser := (fn x => (old x; f x))
     end
 
+fun suexec_flag (EApp ((EVar "suexec_flag", _), e), _) = Env.bool e
+  | suexec_flag _ = NONE
+
 val () = Env.containerV_one "vhost"
         ("host", Env.string)
         (fn (env, host) =>
 val () = Env.containerV_one "vhost"
         ("host", Env.string)
         (fn (env, host) =>
@@ -321,6 +335,7 @@ val () = Env.containerV_one "vhost"
                 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 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 suexec_flag (env, "SuExec")
 
                 val fullHost = host ^ "." ^ Domain.currentDomain ()
                 val vhostId = fullHost ^ (if ssl then ".ssl" else "")
 
                 val fullHost = host ^ "." ^ Domain.currentDomain ()
                 val vhostId = fullHost ^ (if ssl then ".ssl" else "")
@@ -336,7 +351,9 @@ val () = Env.containerV_one "vhost"
                                           val file = Domain.domainFile {node = node,
                                                                         name = confFile}
                                       in
                                           val file = Domain.domainFile {node = node,
                                                                         name = confFile}
                                       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
                                           TextIO.output (file, Domain.nodeIp node);
                                           TextIO.output (file, ":");
                                           TextIO.output (file, if ssl then
@@ -367,10 +384,13 @@ val () = Env.containerV_one "vhost"
                                   nodes;
                 write "\tServerName ";
                 write fullHost;
                                   nodes;
                 write "\tServerName ";
                 write fullHost;
-                write "\n\tSuexecUserGroup ";
-                write user;
-                write " ";
-                write group;
+                if suexec then
+                    (write "\n\tSuexecUserGroup ";
+                     write user;
+                     write " ";
+                     write group)
+                else
+                    ();
                 write "\n\tDocumentRoot ";
                 write docroot;
                 write "\n\tServerAdmin ";
                 write "\n\tDocumentRoot ";
                 write docroot;
                 write "\n\tServerAdmin ";