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

diff --git a/src/main.sml b/src/main.sml
index 91ae29e..f2a45c7 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -386,6 +386,21 @@ fun requestRmuser user =
 	OpenSSL.close bio
     end
 
+fun requestDbUser dbtype =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgCreateDbUser dbtype);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print "Your user 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 ()
@@ -683,7 +698,37 @@ fun service () =
 				      ignore (OpenSSL.readChar bio);
 				      OpenSSL.close bio)
 				     handle OpenSSL.OpenSSL _ => ();
-				     loop ())				
+				     loop ())
+
+			      | MsgCreateDbUser dbtype =>
+				(case Dbms.lookup dbtype of
+				     NONE => ((Msg.send (bio, MsgError ("Unknown database type " ^ dbtype));
+					       print ("Database user creation request with unknown datatype type " ^ dbtype);
+					       ignore (OpenSSL.readChar bio))
+					      handle OpenSSL.OpenSSL _ => ();
+					      OpenSSL.close bio
+					      handle OpenSSL.OpenSSL _ => ();
+					      loop ())
+				   | SOME handler =>
+				     case #adduser handler user of
+					 NONE => ((Msg.send (bio, MsgOk);
+						   print ("Added " ^ dbtype ^ " user " ^ user ^ ".\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 adding user: " ^ msg));
+						       print ("Error adding a " ^ dbtype ^ " user " ^ user ^ ": " ^ msg ^ "\n");
+						       ignore (OpenSSL.readChar bio);
+						       OpenSSL.close bio)
+						      handle OpenSSL.OpenSSL _ => ();
+						      loop ()))
 
 			      | _ =>
 				(Msg.send (bio, MsgError "Unexpected command")
@@ -766,7 +811,7 @@ fun slave () =
 	OpenSSL.shutdown sock
     end
 
-fun autodocBasis outdir =
+fun listBasis () =
     let
 	val dir = Posix.FileSys.opendir Config.libRoot
 
@@ -781,10 +826,11 @@ fun autodocBasis outdir =
 			  :: files)
 		else
 		    loop files
-
-	val files = loop []
     in
-	Autodoc.autodoc {outdir = outdir, infiles = files}
+	loop []
     end
 
+fun autodocBasis outdir =
+    Autodoc.autodoc {outdir = outdir, infiles = listBasis ()}
+
 end