Adding database dropping to dbtool

diff --git a/configDefault/apache.cfg b/configDefault/apache.cfg
index 053d17a..d7f90c3 100644 (file)
--- a/configDefault/apache.cfg
+++ b/configDefault/apache.cfg
@@ -13,7 +13,7 @@ val undown1 = "/usr/bin/sudo /usr/local/sbin/domtool-publish apache1.3-undown"
 val confDir = "/var/domtool/vhosts"
 
 val webNodes_all = [("mire", {version = APACHE_2, auth = MOD_WAKLOG})]
 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 webNodes_default = ["mire"]
 

diff --git a/configDefault/mysql.cfg b/configDefault/mysql.cfg
index 1058bee..e7083e8 100644 (file)
--- a/configDefault/mysql.cfg
+++ b/configDefault/mysql.cfg
@@ -3,5 +3,6 @@ structure MySQL :> MYSQL_CONFIG = struct
 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 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
 
 end

diff --git a/configDefault/mysql.csg b/configDefault/mysql.csg
index 39004ff..71bf9dd 100644 (file)
--- a/configDefault/mysql.csg
+++ b/configDefault/mysql.csg
@@ -3,5 +3,6 @@ signature MYSQL_CONFIG = sig
 val adduser : string
 val passwd : string
 val createdb : string
 val adduser : string
 val passwd : string
 val createdb : string

+val dropdb : string

 
 end
 
 end

diff --git a/configDefault/postgres.cfg b/configDefault/postgres.cfg
index 3205fcd..6c91204 100644 (file)
--- a/configDefault/postgres.cfg
+++ b/configDefault/postgres.cfg
@@ -2,5 +2,6 @@ structure Postgres :> POSTGRES_CONFIG = struct
 
 val adduser = "/usr/bin/sudo /usr/local/sbin/domtool-postgres adduser "
 val createdb = "/usr/bin/sudo /usr/local/sbin/domtool-postgres createdb "
 
 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
 
 end

diff --git a/configDefault/postgres.csg b/configDefault/postgres.csg
index e09637a..e493dbe 100644 (file)
--- a/configDefault/postgres.csg
+++ b/configDefault/postgres.csg
@@ -2,5 +2,6 @@ signature POSTGRES_CONFIG = sig
 
 val adduser : string
 val createdb : string
 
 val adduser : string
 val createdb : string

+val dropdb : string

 
 end
 
 end

diff --git a/src/dbms.sig b/src/dbms.sig
index deb2127..b600d9d 100644 (file)
--- a/src/dbms.sig
+++ b/src/dbms.sig
@@ -25,7 +25,8 @@ signature DBMS = sig
     type handler = {getpass : (unit -> Client.passwd_result) option,
                    adduser : {user : string, passwd : string option} -> string option,
                    passwd : {user : string, passwd : string} -> string 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 register : string * handler -> unit
     val lookup : string -> handler option
 
     val register : string * handler -> unit
     val lookup : string -> handler option

diff --git a/src/dbms.sml b/src/dbms.sml
index fd04fd7..cc00d04 100644 (file)
--- a/src/dbms.sml
+++ b/src/dbms.sml
@@ -27,7 +27,8 @@ val validDbname = CharVector.all Char.isAlpha
 type handler = {getpass : (unit -> Client.passwd_result) option,
                adduser : {user : string, passwd : string option} -> string option,
                passwd : {user : string, passwd : string} -> string 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
                  
               
 val dbmses : handler StringMap.map ref = ref StringMap.empty
                  

diff --git a/src/main-dbtool.sml b/src/main-dbtool.sml
index a571159..f969c76 100644 (file)
--- a/src/main-dbtool.sml
+++ b/src/main-dbtool.sml
@@ -58,4 +58,9 @@ val _ =
                    Main.requestDbTable {dbtype = dbtype, dbname = dbname}
                else
                    print ("Invalid database name " ^ dbname ^ ".\n")
                    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"
              | _ => print "Invalid command-line arguments\n"

diff --git a/src/main.sig b/src/main.sig
index cddbeba..39c7810 100644 (file)
--- a/src/main.sig
+++ b/src/main.sig
@@ -58,6 +58,7 @@ signature MAIN = sig
     val requestDbUser : {dbtype : string, passwd : string option} -> unit
     val requestDbPasswd : {dbtype : string, passwd : string} -> unit
     val requestDbTable : {dbtype : string, dbname : string} -> unit
     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,
 
     val requestListMailboxes : string -> Vmail.listing
     val requestNewMailbox : {domain : string, user : string,

diff --git a/src/main.sml b/src/main.sml
index f3bedc2..db657da 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -534,6 +534,21 @@ fun requestDbTable p =
        OpenSSL.close bio
     end
 
        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 () => ())
 fun requestListMailboxes domain =
     let
        val (_, bio) = requestBio (fn () => ())


@@ -1254,6 +1269,23 @@ fun service () =
                                              SOME ("Invalid database name " ^ dbname)))
                                     (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
                              | MsgListMailboxes domain =>
                                doIt (fn () =>
                                         if not (Domain.yourDomain domain) then

diff --git a/src/msg.sml b/src/msg.sml
index 19a84b4..bbaf24a 100644 (file)
--- a/src/msg.sml
+++ b/src/msg.sml
@@ -222,6 +222,9 @@ fun send (bio, m) =
       | MsgFirewall ls => (OpenSSL.writeInt (bio, 34);
                           sendList OpenSSL.writeString (bio, ls))
       | MsgRegenerateTc => OpenSSL.writeInt (bio, 35)
       | 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
 
 fun checkIt v =
     case v of


@@ -323,6 +326,10 @@ fun recv bio =
                   | 33 => Option.map MsgSocket (recvSockPerm bio)
                   | 34 => Option.map MsgFirewall (recvList OpenSSL.readString bio)
                   | 35 => SOME MsgRegenerateTc
                   | 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
                   | _ => NONE)
         
 end

diff --git a/src/msgTypes.sml b/src/msgTypes.sml
index 00dc82a..8f15ad7 100644 (file)
--- a/src/msgTypes.sml
+++ b/src/msgTypes.sml
@@ -77,7 +77,9 @@ datatype msg =
        | MsgCreateDbUser of {dbtype : string, passwd : string option}
        (* Request creation of a user for the named DBMS type *)
        | MsgCreateDbTable of {dbtype : string, dbname : string}
        | 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 *)
        | MsgNewMailbox of {domain : string, user : string,
                           passwd : string, mailbox : string}
        (* Request creation of a new vmail mapping *)

diff --git a/src/plugins/mysql.sml b/src/plugins/mysql.sml
index dae75cc..7f55e5f 100644 (file)
--- a/src/plugins/mysql.sml
+++ b/src/plugins/mysql.sml
@@ -53,9 +53,16 @@ fun createdb {user, dbname} =
     else
        SOME "Error executing CREATE DATABASE script"
 
     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,
 val _ = Dbms.register ("mysql", {getpass = SOME Client.getpass,
                                 adduser = adduser,
                                 passwd = passwd,

-                                createdb = createdb})
+                                createdb = createdb,
+                                dropdb = dropdb})

 
 end
 
 end

diff --git a/src/plugins/postgres.sml b/src/plugins/postgres.sml
index 1689840..b92a5cf 100644 (file)
--- a/src/plugins/postgres.sml
+++ b/src/plugins/postgres.sml
@@ -34,9 +34,16 @@ fun createdb {user, dbname} =
     else
        SOME "Error executing CREATE DATABASE script"
 
     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,
 val _ = Dbms.register ("postgres", {getpass = NONE,
                                    adduser = adduser,
                                    passwd = passwd,

-                                   createdb = createdb})
+                                   createdb = createdb,
+                                   dropdb = dropdb})

 
 end
 
 end