MySQL password changing

[hcoop/domtool2.git] / src / main.sml

diff --git a/src/main.sml b/src/main.sml
index f9b2c9f..7403743 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -401,6 +401,21 @@ fun requestDbUser dbtype =
        OpenSSL.close bio
     end
 
+fun requestDbPasswd rc =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgDbPasswd rc);
+       case Msg.recv bio of
+           NONE => print "Server closed connection unexpectedly.\n"
+         | SOME m =>
+           case m of
+               MsgOk => print "Your password has been changed.\n"
+             | MsgError s => print ("Password set failed: " ^ s ^ "\n")
+             | _ => print "Unexpected server reply.\n";
+       OpenSSL.close bio
+    end
+
 fun requestDbTable p =
     let
        val (user, bio) = requestBio (fn () => ())
@@ -805,6 +820,20 @@ fun service () =
                                                  SOME ("Error adding user: " ^ msg)))
                                     (fn () => ())
 
+                             | MsgDbPasswd {dbtype, passwd} =>
+                               doIt (fn () =>
+                                        case Dbms.lookup dbtype of
+                                            NONE => ("Database passwd request with unknown datatype type " ^ dbtype,
+                                                     SOME ("Unknown database type " ^ dbtype))
+                                          | SOME handler =>
+                                            case #passwd handler {user = user, passwd = passwd} of
+                                                NONE => ("Changed " ^ dbtype ^ " password of user " ^ user ^ ".",
+                                                         NONE)
+                                              | SOME msg =>
+                                                ("Error setting " ^ dbtype ^ " password of user " ^ user ^ ": " ^ msg,
+                                                 SOME ("Error adding user: " ^ msg)))
+                                    (fn () => ())
+
                              | MsgCreateDbTable {dbtype, dbname} =>
                                doIt (fn () =>
                                         if Dbms.validDbname dbname then