X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/d541c6185fb0f426dce0b16e85327b53635169e0..90dd48df1de3ea116fe2f2c0ec0fe36c71e17e5c:/src/main.sml

diff --git a/src/main.sml b/src/main.sml
index f2a45c7..5f2038d 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -401,6 +401,21 @@ fun requestDbUser dbtype =
 	OpenSSL.close bio
     end
 
+fun requestDbTable p =
+    let
+	val (user, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgCreateDbTable 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 created.\n")
+	      | MsgError s => print ("Creation failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
 fun regenerate context =
     let
 	val b = basis ()
@@ -730,6 +745,44 @@ fun service () =
 						      handle OpenSSL.OpenSSL _ => ();
 						      loop ()))
 
+			      | MsgCreateDbTable {dbtype, dbname} =>
+				if Dbms.validDbname dbname then
+				    (case Dbms.lookup dbtype of
+					 NONE => ((Msg.send (bio, MsgError ("Unknown database type " ^ dbtype));
+						   print ("Database creation request with unknown datatype type " ^ dbtype);
+						   ignore (OpenSSL.readChar bio))
+						  handle OpenSSL.OpenSSL _ => ();
+						  OpenSSL.close bio
+						  handle OpenSSL.OpenSSL _ => ();
+						  loop ())
+				       | SOME handler =>
+					 case #createdb handler {user = user, dbname = dbname} of
+					     NONE => ((Msg.send (bio, MsgOk);
+						       print ("Created database " ^ user ^ "_" ^ dbname ^ ".\n"))
+						      handle OpenSSL.OpenSSL s =>
+							     (print "OpenSSL error\n";
+							      Msg.send (bio,
+									MsgError
+									    ("Error during creation: "
+									     ^ s)));
+						      (ignore (OpenSSL.readChar bio);
+						       OpenSSL.close bio)
+						      handle OpenSSL.OpenSSL _ => ();
+						      loop ())
+					   | SOME msg => ((Msg.send (bio, MsgError ("Error creating database: " ^ msg));
+							   print ("Error creating database " ^ user ^ "_" ^ dbname ^ ": " ^ msg ^ "\n");
+							   ignore (OpenSSL.readChar bio);
+							   OpenSSL.close bio)
+							  handle OpenSSL.OpenSSL _ => ();
+							  loop ()))
+				else
+				    ((Msg.send (bio, MsgError ("Invalid database name " ^ dbname));
+				      print ("Invalid database name " ^ user ^ "_" ^ dbname ^ "\n");
+				      ignore (OpenSSL.readChar bio);
+				      OpenSSL.close bio)
+				     handle OpenSSL.OpenSSL _ => ();
+				     loop ())
+
 			      | _ =>
 				(Msg.send (bio, MsgError "Unexpected command")
 				 handle OpenSSL.OpenSSL _ => ();