val confDir = "/var/domtool/vhosts"
val webNodes_all = [("mire", {version = APACHE_2, auth = MOD_WAKLOG})]
-val webNodes_admin = [("deleuze", {version = APACHE_2, auth = NO_AUTH})]
+val webNodes_admin = [("deleuze", {version = APACHE_2, auth = MOD_WAKLOG})]
val webNodes_default = ["mire"]
val adduser = "/usr/bin/sudo /usr/local/sbin/domtool-mysql adduser "
val passwd = "/usr/bin/sudo /usr/local/sbin/domtool-mysql passwd "
val createdb = "/usr/bin/sudo /usr/local/sbin/domtool-mysql createdb "
+val dropdb = "/usr/bin/sudo /usr/local/sbin/domtool-mysql dropdb "
end
val adduser : string
val passwd : string
val createdb : string
+val dropdb : string
end
val adduser = "/usr/bin/sudo /usr/local/sbin/domtool-postgres adduser "
val createdb = "/usr/bin/sudo /usr/local/sbin/domtool-postgres createdb "
+val dropdb = "/usr/bin/sudo /usr/local/sbin/domtool-postgres dropdb "
end
val adduser : string
val createdb : string
+val dropdb : string
end
type handler = {getpass : (unit -> Client.passwd_result) option,
adduser : {user : string, passwd : string option} -> string option,
passwd : {user : string, passwd : string} -> string option,
- createdb : {user : string, dbname : string} -> string option}
+ createdb : {user : string, dbname : string} -> string option,
+ dropdb : {user : string, dbname : string} -> string option}
val register : string * handler -> unit
val lookup : string -> handler option
type handler = {getpass : (unit -> Client.passwd_result) option,
adduser : {user : string, passwd : string option} -> string option,
passwd : {user : string, passwd : string} -> string option,
- createdb : {user : string, dbname : string} -> string option}
+ createdb : {user : string, dbname : string} -> string option,
+ dropdb : {user : string, dbname : string} -> string option}
val dbmses : handler StringMap.map ref = ref StringMap.empty
Main.requestDbTable {dbtype = dbtype, dbname = dbname}
else
print ("Invalid database name " ^ dbname ^ ".\n")
+ | ["dropdb", dbname] =>
+ if Dbms.validDbname dbname then
+ Main.requestDbDrop {dbtype = dbtype, dbname = dbname}
+ else
+ print ("Invalid database name " ^ dbname ^ ".\n")
| _ => print "Invalid command-line arguments\n"
val requestDbUser : {dbtype : string, passwd : string option} -> unit
val requestDbPasswd : {dbtype : string, passwd : string} -> unit
val requestDbTable : {dbtype : string, dbname : string} -> unit
+ val requestDbDrop : {dbtype : string, dbname : string} -> unit
val requestListMailboxes : string -> Vmail.listing
val requestNewMailbox : {domain : string, user : string,
OpenSSL.close bio
end
+fun requestDbDrop p =
+ let
+ val (user, bio) = requestBio (fn () => ())
+ in
+ Msg.send (bio, MsgDropDb p);
+ case Msg.recv bio of
+ NONE => print "Server closed connection unexpectedly.\n"
+ | SOME m =>
+ case m of
+ MsgOk => print ("Your database " ^ user ^ "_" ^ #dbname p ^ " has been dropped.\n")
+ | MsgError s => print ("Drop failed: " ^ s ^ "\n")
+ | _ => print "Unexpected server reply.\n";
+ OpenSSL.close bio
+ end
+
fun requestListMailboxes domain =
let
val (_, bio) = requestBio (fn () => ())
SOME ("Invalid database name " ^ dbname)))
(fn () => ())
+ | MsgDropDb {dbtype, dbname} =>
+ doIt (fn () =>
+ if Dbms.validDbname dbname then
+ case Dbms.lookup dbtype of
+ NONE => ("Database drop request with unknown datatype type " ^ dbtype,
+ SOME ("Unknown database type " ^ dbtype))
+ | SOME handler =>
+ case #dropdb handler {user = user, dbname = dbname} of
+ NONE => ("Drop database " ^ user ^ "_" ^ dbname ^ ".",
+ NONE)
+ | SOME msg => ("Error dropping database " ^ user ^ "_" ^ dbname ^ ": " ^ msg,
+ SOME ("Error dropping database: " ^ msg))
+ else
+ ("Invalid database name " ^ user ^ "_" ^ dbname,
+ SOME ("Invalid database name " ^ dbname)))
+ (fn () => ())
+
| MsgListMailboxes domain =>
doIt (fn () =>
if not (Domain.yourDomain domain) then
| MsgFirewall ls => (OpenSSL.writeInt (bio, 34);
sendList OpenSSL.writeString (bio, ls))
| MsgRegenerateTc => OpenSSL.writeInt (bio, 35)
+ | MsgDropDb {dbtype, dbname} => (OpenSSL.writeInt (bio, 36);
+ OpenSSL.writeString (bio, dbtype);
+ OpenSSL.writeString (bio, dbname))
fun checkIt v =
case v of
| 33 => Option.map MsgSocket (recvSockPerm bio)
| 34 => Option.map MsgFirewall (recvList OpenSSL.readString bio)
| 35 => SOME MsgRegenerateTc
+ | 36 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of
+ (SOME dbtype, SOME dbname) =>
+ SOME (MsgDropDb {dbtype = dbtype, dbname = dbname})
+ | _ => NONE)
| _ => NONE)
end
| MsgCreateDbUser of {dbtype : string, passwd : string option}
(* Request creation of a user for the named DBMS type *)
| MsgCreateDbTable of {dbtype : string, dbname : string}
- (* Request creation of a DBMS table *)
+ (* Request creation of a DBMS database *)
+ | MsgDropDb of {dbtype : string, dbname : string}
+ (* Request dropping of a DBMS database *)
| MsgNewMailbox of {domain : string, user : string,
passwd : string, mailbox : string}
(* Request creation of a new vmail mapping *)
else
SOME "Error executing CREATE DATABASE script"
+fun dropdb {user, dbname} =
+ if Slave.shell [Config.MySQL.dropdb, user, " ", dbname] then
+ NONE
+ else
+ SOME "Error executing DROP DATABASE script"
+
val _ = Dbms.register ("mysql", {getpass = SOME Client.getpass,
adduser = adduser,
passwd = passwd,
- createdb = createdb})
+ createdb = createdb,
+ dropdb = dropdb})
end
else
SOME "Error executing CREATE DATABASE script"
+fun dropdb {user, dbname} =
+ if Slave.shell [Config.Postgres.dropdb, user, " ", dbname] then
+ NONE
+ else
+ SOME "Error executing DROP DATABASE script"
+
val _ = Dbms.register ("postgres", {getpass = NONE,
adduser = adduser,
passwd = passwd,
- createdb = createdb})
+ createdb = createdb,
+ dropdb = dropdb})
end