Start of DBMS support
authorAdam Chlipala <adamc@hcoop.net>
Thu, 21 Dec 2006 23:39:14 +0000 (23:39 +0000)
committerAdam Chlipala <adamc@hcoop.net>
Thu, 21 Dec 2006 23:39:14 +0000 (23:39 +0000)
19 files changed:
Makefile
bin/.cvsignore
configDefault/postgres.cfg [new file with mode: 0644]
configDefault/postgres.cfs [new file with mode: 0644]
configDefault/postgres.csg [new file with mode: 0644]
src/.cvsignore
src/dbms.sig [new file with mode: 0644]
src/dbms.sml [new file with mode: 0644]
src/main-admin.sml
src/main-client.sml
src/main-dbtool.sml [new file with mode: 0644]
src/main.sig
src/main.sml
src/msg.sml
src/msgTypes.sml
src/plugins/domtool-postgres [new file with mode: 0755]
src/plugins/postgres.sig [new file with mode: 0644]
src/plugins/postgres.sml [new file with mode: 0644]
src/sources

index d4c8990..1f780a4 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -6,7 +6,7 @@ COMMON_DEPS := configDefault/config.sig configDefault/configDefault.sml \
 .PHONY: all mlton smlnj install
 
 mlton: bin/domtool-server bin/domtool-client bin/domtool-slave \
-       bin/domtool-admin bin/domtool-doc
+       bin/domtool-admin bin/domtool-doc bin/dbtool
 
 smlnj: $(COMMON_DEPS) openssl/smlnj/FFI/libssl.h.cm src/domtool.cm
 
@@ -34,33 +34,37 @@ openssl/openssl_sml.so: openssl/openssl_sml.o
                -o openssl/openssl_sml.so \
                openssl/openssl_sml.o -lssl
 
-src/domtool.cm: Makefile src/prefix.cm src/sources
+src/domtool.cm: src/prefix.cm src/sources
        cat src/prefix.cm src/sources >src/domtool.cm
 
 MAKE_MLB_BASE := cat src/prefix.mlb src/sources src/suffix.mlb \
        | sed 's/^\(.*\).grm$$/\1.grm.sig\n\1.grm.sml/' \
        | sed 's/^\(.*\).lex$$/\1.lex.sml/'
 
-src/domtool-server.mlb: Makefile src/prefix.mlb src/sources src/suffix.mlb
+src/domtool-server.mlb: src/prefix.mlb src/sources src/suffix.mlb
        $(MAKE_MLB_BASE) >src/domtool-server.mlb
        echo "main-server.sml" >>src/domtool-server.mlb
 
-src/domtool-client.mlb: Makefile src/prefix.mlb src/sources src/suffix.mlb
+src/domtool-client.mlb: src/prefix.mlb src/sources src/suffix.mlb
        $(MAKE_MLB_BASE) >src/domtool-client.mlb
        echo "main-client.sml" >>src/domtool-client.mlb
 
-src/domtool-slave.mlb: Makefile src/prefix.mlb src/sources src/suffix.mlb
+src/domtool-slave.mlb: src/prefix.mlb src/sources src/suffix.mlb
        $(MAKE_MLB_BASE) >src/domtool-slave.mlb
        echo "main-slave.sml" >>src/domtool-slave.mlb
 
-src/domtool-admin.mlb: Makefile src/prefix.mlb src/sources src/suffix.mlb
+src/domtool-admin.mlb: src/prefix.mlb src/sources src/suffix.mlb
        $(MAKE_MLB_BASE) >src/domtool-admin.mlb
        echo "main-admin.sml" >>src/domtool-admin.mlb
 
-src/domtool-doc.mlb: Makefile src/prefix.mlb src/sources src/suffix.mlb
+src/domtool-doc.mlb: src/prefix.mlb src/sources src/suffix.mlb
        $(MAKE_MLB_BASE) >src/domtool-doc.mlb
        echo "main-doc.sml" >>src/domtool-doc.mlb
 
+src/dbtool.mlb: src/prefix.mlb src/sources src/suffix.mlb
+       $(MAKE_MLB_BASE) >src/dbtool.mlb
+       echo "main-dbtool.sml" >>src/dbtool.mlb
+
 openssl/smlnj/FFI/libssl.h.cm: openssl/openssl_sml.h
        cd openssl/smlnj ; ml-nlffigen -d FFI -lh LibsslH.libh -include ../libssl-h.sml \
        -cm libssl.h.cm -D__builtin_va_list="void*" \
@@ -98,6 +102,9 @@ bin/domtool-admin: $(COMMON_MLTON_DEPS) src/domtool-admin.mlb
 bin/domtool-doc: $(COMMON_MLTON_DEPS) src/domtool-doc.mlb
        mlton -output bin/domtool-doc -link-opt -ldl src/domtool-doc.mlb
 
+bin/dbtool: $(COMMON_MLTON_DEPS) src/dbtool.mlb
+       mlton -output bin/dbtool -link-opt -ldl src/dbtool.mlb
+
 install:
        cp scripts/domtool-publish /usr/local/sbin/
        cp scripts/domtool-reset-global /usr/local/sbin/
@@ -112,6 +119,8 @@ install:
        -cp bin/domtool-client /usr/local/bin/domtool
        -cp bin/domtool-admin /usr/local/bin/
        -cp bin/domtool-doc /usr/local/bin/
+       -cp bin/dbtool /usr/local/bin/
+       cp src/plugins/domtool-postgres /usr/local/sbin/
 
 .PHONY: grab_lib
 
index 16e624b..dc4068c 100644 (file)
@@ -3,3 +3,4 @@ domtool-client
 domtool-slave
 domtool-admin
 domtool-doc
+dbtool
diff --git a/configDefault/postgres.cfg b/configDefault/postgres.cfg
new file mode 100644 (file)
index 0000000..dd00d3d
--- /dev/null
@@ -0,0 +1,5 @@
+structure Postgres :> POSTGRES_CONFIG = struct
+
+val adduser = "/usr/bin/sudo /usr/local/sbin/domtool-postgres adduser "
+
+end
diff --git a/configDefault/postgres.cfs b/configDefault/postgres.cfs
new file mode 100644 (file)
index 0000000..d98e0c8
--- /dev/null
@@ -0,0 +1 @@
+structure Postgres : POSTGRES_CONFIG
diff --git a/configDefault/postgres.csg b/configDefault/postgres.csg
new file mode 100644 (file)
index 0000000..b4e6c09
--- /dev/null
@@ -0,0 +1,5 @@
+signature POSTGRES_CONFIG = sig
+
+val adduser : string
+
+end
index 5356e7a..18ad0fc 100644 (file)
@@ -7,3 +7,4 @@ domtool-client.mlb
 domtool-slave.mlb
 domtool-admin.mlb
 domtool-doc.mlb
+dbtool.mlb
diff --git a/src/dbms.sig b/src/dbms.sig
new file mode 100644 (file)
index 0000000..10bc467
--- /dev/null
@@ -0,0 +1,28 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+(* DBMS management code *)
+
+signature DBMS = sig
+
+    type handler = {adduser : string -> string option}
+
+    val register : string * handler -> unit
+    val lookup : string -> handler option
+
+end
diff --git a/src/dbms.sml b/src/dbms.sml
new file mode 100644 (file)
index 0000000..6f7bb9d
--- /dev/null
@@ -0,0 +1,34 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+(* DBMS management code *)
+
+structure Dbms :> DBMS = struct
+
+open DataStructures
+
+type handler = {adduser : string -> string option}
+              
+val dbmses : handler StringMap.map ref = ref StringMap.empty
+                 
+fun register (name, handler) =
+    dbmses := StringMap.insert (!dbmses, name, handler)
+
+fun lookup name = StringMap.find (!dbmses, name)
+
+end
index c36da01..e3dc67b 100644 (file)
@@ -16,7 +16,7 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *)
 
-(* Driver for server *)
+(* Driver for admin requests *)
 
 fun requestPerms user =
     case Main.requestListPerms user of
index e017fc0..57500c5 100644 (file)
@@ -16,7 +16,7 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *)
 
-(* Driver for server *)
+(* Driver for configuration requests *)
 
 fun domtoolRoot () =
     let
diff --git a/src/main-dbtool.sml b/src/main-dbtool.sml
new file mode 100644 (file)
index 0000000..98e6e03
--- /dev/null
@@ -0,0 +1,30 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+(* Driver for dbtool *)
+
+val _ =
+    case CommandLine.arguments () of
+       [] => print "Invalid command-line arguments\n"
+      | dbtype :: rest =>
+       case Dbms.lookup dbtype of
+           NONE => print ("Unknown database type " ^ dbtype ^ ".\n")
+         | _ =>
+           case rest of
+               ["adduser"] => Main.requestDbUser dbtype
+             | _ => print "Invalid command-line arguments\n"
index f8d6b94..d6c64c5 100644 (file)
@@ -48,4 +48,6 @@ signature MAIN = sig
     val listBasis : unit -> string list
     val autodocBasis : string -> unit
 
+    val requestDbUser : string -> unit
+
 end
index 7457545..f2a45c7 100644 (file)
@@ -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")
index 251626a..2b6cd20 100644 (file)
@@ -98,6 +98,8 @@ fun send (bio, m) =
       | MsgRegenerate => OpenSSL.writeInt (bio, 14)
       | MsgRmuser dom => (OpenSSL.writeInt (bio, 15);
                          OpenSSL.writeString (bio, dom))
+      | MsgCreateDbUser s => (OpenSSL.writeInt (bio, 16);
+                             OpenSSL.writeString (bio, s))
 
 fun checkIt v =
     case v of
@@ -148,6 +150,7 @@ fun recv bio =
                   | 13 => Option.map MsgRmdom (recvList OpenSSL.readString bio)
                   | 14 => SOME MsgRegenerate
                   | 15 => Option.map MsgRmuser (OpenSSL.readString bio)
+                  | 16 => Option.map MsgCreateDbUser (OpenSSL.readString bio)
                   | _ => NONE)
         
 end
index 44f4178..0c7e5fe 100644 (file)
@@ -54,5 +54,7 @@ datatype msg =
        | MsgRmuser of string
        (* Remove all ACL entries for a user, and remove all domains to which
        * that user and no one else has rights. *)
+       | MsgCreateDbUser of string
+       (* Request creation of a user for the named DBMS type *)
 
 end
diff --git a/src/plugins/domtool-postgres b/src/plugins/domtool-postgres
new file mode 100755 (executable)
index 0000000..276637f
--- /dev/null
@@ -0,0 +1,13 @@
+#!/bin/sh -e
+
+case $1 in
+       adduser)
+               echo "I would create PostgreSQL user $2."
+       ;;
+       createdb)
+               echo "I would create PostgreSQL table $2_$3 for user $2."
+       ;;
+       *)
+               echo "Usage: domtool-postgres [adduser <user> | createdb <user> <table>]"
+       ;;
+esac
diff --git a/src/plugins/postgres.sig b/src/plugins/postgres.sig
new file mode 100644 (file)
index 0000000..1f42d66
--- /dev/null
@@ -0,0 +1,23 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+(* PostgreSQL user/table management *)
+
+signature POSTGRES = sig
+
+end
diff --git a/src/plugins/postgres.sml b/src/plugins/postgres.sml
new file mode 100644 (file)
index 0000000..a267e4f
--- /dev/null
@@ -0,0 +1,31 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+(* PostgreSQL user/table management *)
+
+structure Postgres :> POSTGRES = struct
+
+fun adduser user =
+    if Slave.shell [Config.Postgres.adduser, user] then
+       NONE
+    else
+       SOME "Error executing CREATE USER script"
+
+val _ = Dbms.register ("postgres", {adduser = adduser})
+
+end
index 3b78866..f5043b5 100644 (file)
@@ -46,6 +46,9 @@ defaults.sml
 openssl.sig
 openssl.sml
 
+dbms.sig
+dbms.sml
+
 msgTypes.sml
 msg.sig
 msg.sml
@@ -74,6 +77,9 @@ plugins/mailman.sml
 plugins/hcoop.sig
 plugins/hcoop.sml
 
+plugins/postgres.sig
+plugins/postgres.sml
+
 order.sig
 order.sml