.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
-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*" \
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/
-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
domtool-slave
domtool-admin
domtool-doc
+dbtool
--- /dev/null
+structure Postgres :> POSTGRES_CONFIG = struct
+
+val adduser = "/usr/bin/sudo /usr/local/sbin/domtool-postgres adduser "
+
+end
--- /dev/null
+structure Postgres : POSTGRES_CONFIG
--- /dev/null
+signature POSTGRES_CONFIG = sig
+
+val adduser : string
+
+end
domtool-slave.mlb
domtool-admin.mlb
domtool-doc.mlb
+dbtool.mlb
--- /dev/null
+(* 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
--- /dev/null
+(* 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
* 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
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*)
-(* Driver for server *)
+(* Driver for configuration requests *)
fun domtoolRoot () =
let
--- /dev/null
+(* 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"
val listBasis : unit -> string list
val autodocBasis : string -> unit
+ val requestDbUser : string -> unit
+
end
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 ()
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")
| 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
| 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
| 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
--- /dev/null
+#!/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
--- /dev/null
+(* 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
--- /dev/null
+(* 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
openssl.sig
openssl.sml
+dbms.sig
+dbms.sml
+
msgTypes.sml
msg.sig
msg.sml
plugins/hcoop.sig
plugins/hcoop.sml
+plugins/postgres.sig
+plugins/postgres.sml
+
order.sig
order.sml