X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/504618b9ccf4bdbd8b3e27f799770b16c6358a71..99cc41443c07f97535eaeecc628d99075ca2cebf:/src/main.sml

diff --git a/src/main.sml b/src/main.sml
index 7473fb6..3b54316 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -550,6 +550,21 @@ fun requestDbDrop p =
 	OpenSSL.close bio
     end
 
+fun requestDbGrant p =
+    let
+	val (user, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgGrantDb p);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print ("You've been granted all allowed privileges to database " ^ user ^ "_" ^ #dbname p ^ ".\n")
+	      | MsgError s => print ("Grant failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
 fun requestListMailboxes domain =
     let
 	val (_, bio) = requestBio (fn () => ())
@@ -1287,6 +1302,23 @@ fun service () =
 					       SOME ("Invalid database name " ^ dbname)))
 				      (fn () => ())
 
+			       | MsgGrantDb {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 #grant handler {user = user, dbname = dbname} of
+						      NONE => ("Grant permissions to database " ^ user ^ "_" ^ dbname ^ ".",
+							       NONE)
+						    | SOME msg => ("Error granting permissions to database " ^ user ^ "_" ^ dbname ^ ": " ^ msg,
+								   SOME ("Error granting permissions to database: " ^ msg))
+					  else
+					      ("Invalid database name " ^ user ^ "_" ^ dbname,
+					       SOME ("Invalid database name " ^ dbname)))
+				      (fn () => ())
+
 			       | MsgListMailboxes domain =>
 				 doIt (fn () =>
 					  if not (Domain.yourDomain domain) then