Remove silly special-case servercert stuff

[hcoop/domtool2.git] / src / main.sml

diff --git a/src/main.sml b/src/main.sml
index db1b52b..62af91b 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -175,7 +175,7 @@ fun reduce G fname =
        val (G, body) = check G fname
     in
        if !ErrorMsg.anyErrors then
-           NONE
+           (G, NONE)
        else
            case body of
                SOME body =>
@@ -186,16 +186,16 @@ fun reduce G fname =
                                         [PD.string "Result:",
                                          PD.space 1,
                                          p_exp body']))*)
-                   SOME (G, body')
+                   (G, SOME body')
                end
-             | _ => NONE
+             | _ => (G, NONE)
     end
 
 (*(Defaults.eInit ())*)
 
 fun eval G evs fname =
     case reduce G fname of
-       SOME (G, body') =>
+       (G, SOME body') =>
        if !ErrorMsg.anyErrors then
            raise ErrorMsg.Error
        else
@@ -204,7 +204,7 @@ fun eval G evs fname =
            in
                (G, evs')
            end
-      | NONE => (G, evs)
+      | (G, NONE) => (G, evs)
 
 val dispatcher =
     Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort
@@ -1128,10 +1128,12 @@ fun describeQuery q =
 
 fun service () =
     let
+       val host = Slave.hostname ()
+
        val () = Acl.read Config.aclFile
-       
-       val context = context (Config.serverCert,
-                              Config.serverKey,
+
+       val context = context (Config.certDir ^ "/" ^ host ^ ".pem",
+                              Config.keyDir ^ "/" ^ host ^ "/key.pem",
                               Config.trustStore)
        val _ = Domain.set_context context
 
@@ -1283,11 +1285,12 @@ fun service () =
                               | MsgRmdom doms =>
                                 doIt (fn () =>
                                          if Acl.query {user = user, class = "priv", value = "all"}
-                                            orelse List.all (fn dom => Acl.query {user = user, class = "domain", value = dom}) doms then
+                                            orelse List.all (fn dom => Domain.validDomain dom
+                                                                       andalso Acl.queryDomain {user = user, domain = dom}) doms then
                                              (Domain.rmdom doms;
-                                              app (fn dom =>
+                                              (*app (fn dom =>
                                                       Acl.revokeFromAll {class = "domain", value = dom}) doms;
-                                              Acl.write Config.aclFile;
+                                              Acl.write Config.aclFile;*)
                                               ("Removed domains" ^ foldl (fn (d, s) => s ^ " " ^ d) "" doms ^ ".",
                                                NONE))
                                          else
@@ -1365,18 +1368,22 @@ fun service () =
                                                   SOME ("Error adding user: " ^ msg)))
                                      (fn () => ())
 
-                              | MsgCreateDb {dbtype, dbname} =>
+                              | MsgCreateDb {dbtype, dbname, encoding} =>
                                 doIt (fn () =>
                                          if Dbms.validDbname dbname then
                                              case Dbms.lookup dbtype of
                                                  NONE => ("Database creation request with unknown datatype type " ^ dbtype,
                                                           SOME ("Unknown database type " ^ dbtype))
                                                | SOME handler =>
-                                                 case #createdb handler {user = user, dbname = dbname} of
-                                                     NONE => ("Created database " ^ user ^ "_" ^ dbname ^ ".",
-                                                              NONE)
-                                                   | SOME msg => ("Error creating database " ^ user ^ "_" ^ dbname ^ ": " ^ msg,
-                                                                  SOME ("Error creating database: " ^ msg))
+                                                 if not (Dbms.validEncoding encoding) then
+                                                     ("Invalid encoding " ^ valOf encoding ^ " requested for database creation.",
+                                                      SOME "Invalid encoding")
+                                                 else
+                                                     case #createdb handler {user = user, dbname = dbname, encoding = encoding} of
+                                                         NONE => ("Created database " ^ user ^ "_" ^ dbname ^ ".",
+                                                                  NONE)
+                                                       | SOME msg => ("Error creating database " ^ user ^ "_" ^ dbname ^ ": " ^ msg,
+                                                                      SOME ("Error creating database: " ^ msg))
                                          else
                                              ("Invalid database name " ^ user ^ "_" ^ dbname,
                                               SOME ("Invalid database name " ^ dbname)))