fun requestSlaveBio () = requestSlaveBio' true
-fun request fname =
+fun request (fname, libOpt) =
let
- val (user, bio) = requestBio (fn () => ignore (check (basis ()) fname))
-
- val inf = TextIO.openIn fname
+ val (user, bio) = requestBio (fn () =>
+ let
+ val env = basis ()
+ val env = case libOpt of
+ NONE => env
+ | SOME lib => #1 (check env lib)
+ in
+ ignore (check env fname)
+ end)
+
+ fun readFile fname =
+ let
+ val inf = TextIO.openIn fname
- fun loop lines =
- case TextIO.inputLine inf of
- NONE => String.concat (List.rev lines)
- | SOME line => loop (line :: lines)
+ fun loop lines =
+ case TextIO.inputLine inf of
+ NONE => String.concat (rev lines)
+ | SOME line => loop (line :: lines)
+ in
+ loop []
+ before TextIO.closeIn inf
+ end
- val code = loop []
+ val code = readFile fname
+ val msg = case libOpt of
+ NONE => MsgConfig code
+ | SOME fname' => MsgMultiConfig [readFile fname', code]
in
- TextIO.closeIn inf;
- Msg.send (bio, MsgConfig code);
+ Msg.send (bio, msg);
case Msg.recv bio of
NONE => print "Server closed connection unexpectedly.\n"
| SOME m =>
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
| 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 =>
Acl.revokeFromAll {class = "domain", value = dom}) doms;
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)))
(fn () => ())
| MsgMysqlFixperms =>
- doIt (fn () => if OS.Process.isSuccess
- (OS.Process.system "/usr/bin/sudo -H /afs/hcoop.net/common/etc/scripts/mysql-grant-table-drop") then
- ("Requested mysql-fixperms",
- NONE)
+ (print "Starting mysql-fixperms\n";
+ doIt (fn () => if OS.Process.isSuccess
+ (OS.Process.system "/usr/bin/sudo -H /afs/hcoop.net/common/etc/scripts/mysql-grant-table-drop") then
+ ("Requested mysql-fixperms",
+ NONE)
else
("Requested mysql-fixperms, but execution failed!",
SOME "Script execution failed."))
- (fn () => ())
+ (fn () => ()))
| MsgDescribe dom =>
doIt (fn () => if not (Domain.validDomain dom) then