SSL certificates

diff --git a/lib/apache.dtl b/lib/apache.dtl
index d80d7ef..93fb3a3 100644 (file)
--- a/lib/apache.dtl
+++ b/lib/apache.dtl
@@ -9,13 +9,20 @@ context Vhost;
 {{A WWW virtual host}}
 
 extern type suexec_flag;
 {{A WWW virtual host}}
 
 extern type suexec_flag;

-extern val suexec_flag : bool -> suexec_flag;

 {{Whether or not to use Suexec with a vhost.
 {{Whether or not to use Suexec with a vhost.

-[suexec_flag] fails when passed [false] by a user without the 'www' privilege.}}
+For users with the 'www' privilege, this type is identical to [bool].
+For others, it has only one value, [true].}}
+
+extern type ssl_cert_path;
+{{Filesystem path to an SSL certificate in your 'cert' list}}
+
+extern type ssl;
+extern val no_ssl : ssl;
+extern val use_cert : ssl_cert_path -> ssl;

 
 extern val vhost : host -> Vhost => [Domain]
        {WebNodes : [web_node],
 
 extern val vhost : host -> Vhost => [Domain]
        {WebNodes : [web_node],

-        SSL : bool,
+        SSL : ssl,

         User : your_user,
         Group : your_group,
         DocumentRoot : your_path,
         User : your_user,
         Group : your_group,
         DocumentRoot : your_path,

diff --git a/src/main.sml b/src/main.sml
index 29d2b37..6585144 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -665,6 +665,7 @@ fun regenerate context =
            end
                handle IO.Io _ => ()
                     | OS.SysErr (s, _) => print ("System error processing user " ^ user ^ ": " ^ s ^ "\n")
            end
                handle IO.Io _ => ()
                     | OS.SysErr (s, _) => print ("System error processing user " ^ user ^ ": " ^ s ^ "\n")

+                    | ErrorMsg.Error => print ("User " ^ user ^ " had a compilation error.\n")

     in
        app contactNode Config.nodeIps;
        Env.pre ();
     in
        app contactNode Config.nodeIps;
        Env.pre ();

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 558c998..9a08a84 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -74,6 +74,19 @@ val _ = Env.type_one "location"
        Env.string
        validLocation
 
        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 _ = Defaults.registerDefault ("WebNodes",
 val dl = ErrorMsg.dummyLoc
 
 val _ = Defaults.registerDefault ("WebNodes",


@@ -102,8 +115,7 @@ val _ = Defaults.registerDefault ("ServerAdmin",
 
 val _ = Defaults.registerDefault ("SuExec",
                                  (TBase "suexec_flag", dl),
 
 val _ = Defaults.registerDefault ("SuExec",
                                  (TBase "suexec_flag", dl),

-                                 (fn () => (EApp ((EVar "suexec_flag", dl),
-                                                  (EVar "true", dl)), dl)))
+                                 (fn () => (EVar "true", 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"


@@ -246,10 +258,15 @@ val () = Slave.registerFileHandler (fn fs =>
                                                                                        {dir = realLogDir,
                                                                                         file = Slave.hostname ()}
                                                                   val {base, ...} = OS.Path.splitBaseExt (#file spl)
                                                                                        {dir = realLogDir,
                                                                                         file = Slave.hostname ()}
                                                                   val {base, ...} = OS.Path.splitBaseExt (#file spl)

+
+                                                                  val realLogDir = OS.Path.joinDirFile
+                                                                                       {dir = realLogDir,
+                                                                                        file = base}

                                                               in
                                                               in

-                                                                  OS.Path.joinDirFile
-                                                                      {dir = realLogDir,
-                                                                       file = base}
+                                                                  if String.isSuffix ".vhost_ssl" (#file spl) then
+                                                                      realLogDir ^ ".ssl"
+                                                                  else
+                                                                      realLogDir

                                                               end
                                                       in
                                                           vhostsChanged := true;
                                                               end
                                                       in
                                                           vhostsChanged := true;


@@ -354,25 +371,22 @@ 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) =>
             let
                 val nodes = Env.env (Env.list Env.string) (env, "WebNodes")
 
 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 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 suexec_flag (env, "SuExec")
+                val suexec = Env.env Env.bool (env, "SuExec")

 
                 val fullHost = host ^ "." ^ Domain.currentDomain ()
 
                 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;
             in
                 currentVhost := fullHost;
                 currentVhostId := vhostId;


@@ -389,10 +403,9 @@ val () = Env.containerV_one "vhost"
                                           TextIO.output (file, "\n<VirtualHost ");
                                           TextIO.output (file, Domain.nodeIp node);
                                           TextIO.output (file, ":");
                                           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");
                                           TextIO.output (file, "\tErrorLog ");
                                           TextIO.output (file, Config.homeBase);
                                           TextIO.output (file, ">\n");
                                           TextIO.output (file, "\tErrorLog ");
                                           TextIO.output (file, Config.homeBase);


@@ -428,10 +441,11 @@ val () = Env.containerV_one "vhost"
                 write docroot;
                 write "\n\tServerAdmin ";
                 write sadmin;
                 write docroot;
                 write "\n\tServerAdmin ";
                 write sadmin;

-                if ssl then
-                    (write "\n\tSSLEngine on")
-                else
-                    ();
+                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,
                 write "\n";
                 !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost}
             end,