X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/8be753d995e728847df0fad81a01a1ad10180201..edf5dcbb8691753a607241508652acd680897949:/src/main.sml

diff --git a/src/main.sml b/src/main.sml
index db1b52b..62af91b 100644
--- 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)))