X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/072f12c82089f091932e1e14421986214c93007d..35659203a708078cdec25ff74adbe1e9168934d6:/src/main.sml

diff --git a/src/main.sml b/src/main.sml
index f3bedc2..db657da 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -534,6 +534,21 @@ fun requestDbTable p =
 	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 () => ())
@@ -1254,6 +1269,23 @@ fun service () =
 					      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