From 5578301956a94262fa7b3ffdb33d8cd644a9311c Mon Sep 17 00:00:00 2001 From: Davor Ocelic Date: Tue, 16 Feb 2010 17:39:13 +0000 Subject: [PATCH 01/16] Fix pcre_sml.so paths --- pcre/mlton/libpcre-h.sml | 2 +- pcre/smlnj/libpcre-h.sml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/pcre/mlton/libpcre-h.sml b/pcre/mlton/libpcre-h.sml index 3412cf6..0408eab 100644 --- a/pcre/mlton/libpcre-h.sml +++ b/pcre/mlton/libpcre-h.sml @@ -1,7 +1,7 @@ structure LibpcreH = struct local val global = "/usr/local/lib/pcre_sml.so" - val locl = "openssl/pcre_sml.so" + val locl = "pcre/pcre_sml.so" val lh = DynLinkage.open_lib { name = if Posix.FileSys.access (global, []) then global else locl, global = true, lazy = true } diff --git a/pcre/smlnj/libpcre-h.sml b/pcre/smlnj/libpcre-h.sml index 3412cf6..0408eab 100644 --- a/pcre/smlnj/libpcre-h.sml +++ b/pcre/smlnj/libpcre-h.sml @@ -1,7 +1,7 @@ structure LibpcreH = struct local val global = "/usr/local/lib/pcre_sml.so" - val locl = "openssl/pcre_sml.so" + val locl = "pcre/pcre_sml.so" val lh = DynLinkage.open_lib { name = if Posix.FileSys.access (global, []) then global else locl, global = true, lazy = true } -- 2.20.1 From fd59cbe6ef388ea0b4b6380e5887a4d5e6d6b93e Mon Sep 17 00:00:00 2001 From: clinton_admin Date: Mon, 4 Oct 2010 00:21:30 -0400 Subject: [PATCH 02/16] =?utf8?q?Temporary=20workaround=20to=20`domtool-pos?= =?utf8?q?tgres'=20script=20*=20Explicitly=20connect=20to=20`postgres'=20h?= =?utf8?q?ost=20until=20fritz=20has=20a=20slave=20=20=20installed=20and=20?= =?utf8?q?databases=20can=20be=20managed=20by=20slaves=C3?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- src/plugins/domtool-postgres | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/plugins/domtool-postgres b/src/plugins/domtool-postgres index 35fbc90..d05999f 100755 --- a/src/plugins/domtool-postgres +++ b/src/plugins/domtool-postgres @@ -4,8 +4,8 @@ case $1 in adduser) USERNAME=$2 - sudo -u postgres psql -c "CREATE USER $USERNAME" template1 - sudo -u postgres psql -c "ALTER TABLESPACE user_$USERNAME OWNER TO $USERNAME" + sudo -u postgres psql -h postgres -c "CREATE USER $USERNAME" template1 + sudo -u postgres psql -h postgres -c "ALTER TABLESPACE user_$USERNAME OWNER TO $USERNAME" ;; createdb) @@ -18,7 +18,7 @@ case $1 in ENCODING="-E $ENCODING" fi - sudo -u postgres createdb -O $USERNAME -D user_$USERNAME $ENCODING $DBNAME + sudo -u postgres createdb -h postgres -O $USERNAME -D user_$USERNAME $ENCODING $DBNAME ;; dropdb) @@ -26,7 +26,7 @@ case $1 in DBNAME_BASE=$3 DBNAME="${USERNAME}_${DBNAME_BASE}" - sudo -u postgres dropdb $DBNAME + sudo -u postgres dropdb -h postgres $DBNAME ;; *) -- 2.20.1 From 34cf59af2b3660e876a501fa3908f8fe5eebc22e Mon Sep 17 00:00:00 2001 From: Clinton Ebadi Date: Tue, 2 Nov 2010 19:09:46 -0400 Subject: [PATCH 03/16] Remove outpost from domtool control * The domtool config for hcoop.net needs to be updated --- configDefault/domtool.cfg | 8 ++++---- lib/hcoop.dtl | 1 - 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/configDefault/domtool.cfg b/configDefault/domtool.cfg index 61ac39f..8e890b1 100644 --- a/configDefault/domtool.cfg +++ b/configDefault/domtool.cfg @@ -19,17 +19,17 @@ val defaultRetry = 1800 val defaultExpiry = 1209600 val defaultMinimum = 3600 -val nodeIps = [("deleuze", "69.90.123.67"), ("mire", "69.90.123.68"), ("outpost", "89.16.166.179"), ("hopper", "69.90.123.74")] +val nodeIps = [("deleuze", "69.90.123.67"), ("mire", "69.90.123.68"), ("hopper", "69.90.123.74")] val defaultNode = "deleuze" val masterNode = "deleuze" -val slaveNodes = ["mire", "outpost", "hopper"] +val slaveNodes = ["mire", "hopper"] -val dnsNodes_all = ["deleuze", "mire", "outpost"] +val dnsNodes_all = ["deleuze", "mire"] val dnsNodes_admin = [] val mailNodes_all = ["deleuze", "hopper"] -val mailNodes_admin = ["mire", "outpost"] +val mailNodes_admin = ["mire"] val aclFile = "/afs/hcoop.net/common/etc/domtool/acl" diff --git a/lib/hcoop.dtl b/lib/hcoop.dtl index 55c1e2c..8fdf79c 100644 --- a/lib/hcoop.dtl +++ b/lib/hcoop.dtl @@ -18,7 +18,6 @@ val fritz_ip : (ip) = "69.90.123.75"; val deleuze_ip : (ip) = "69.90.123.67"; val mire_ip : (ip) = "69.90.123.68"; val krunk_ip : (ip) = "69.90.123.70"; -val outpost_ip : (ip) = "89.16.166.179"; val fyodor_ip : (ip) = "64.20.38.170"; val simpleWeb = \host -> \docroot -> web host where -- 2.20.1 From c362e4cc29d981936644c90c71e9d2127b5ea6d3 Mon Sep 17 00:00:00 2001 From: Clinton Ebadi Date: Thu, 25 Nov 2010 01:03:40 -0500 Subject: [PATCH 04/16] Attempt to move Dbms handling into slave * It typechecks and compiles... and looks like it ought to work * `requestDbFoo' functions make an ad-hoc connection to a slave. There is much room for cleanup here. * /Factored/ doIt function from `service' so that the Dbms message handling could be cut and pasted into the slave function * Added Dbms.dbmsNode configuration option * Note that dbms operations *always* occur on a slave now--if the machine is also the dispatcher node it will now need to run a slave instance as well --- configDefault/dbms.cfg | 5 + configDefault/dbms.cfs | 1 + configDefault/dbms.csg | 5 + src/main.sml | 286 ++++++++++++++++++++++------------------- 4 files changed, 164 insertions(+), 133 deletions(-) create mode 100644 configDefault/dbms.cfg create mode 100644 configDefault/dbms.cfs create mode 100644 configDefault/dbms.csg diff --git a/configDefault/dbms.cfg b/configDefault/dbms.cfg new file mode 100644 index 0000000..2a7e6e2 --- /dev/null +++ b/configDefault/dbms.cfg @@ -0,0 +1,5 @@ +structure Dbms :> DBMS_CONFIG = struct + +val dbmsNode = "fritz" + +end diff --git a/configDefault/dbms.cfs b/configDefault/dbms.cfs new file mode 100644 index 0000000..4f29c01 --- /dev/null +++ b/configDefault/dbms.cfs @@ -0,0 +1 @@ +structure Dbms : DBMS_CONFIG diff --git a/configDefault/dbms.csg b/configDefault/dbms.csg new file mode 100644 index 0000000..a9f05e2 --- /dev/null +++ b/configDefault/dbms.csg @@ -0,0 +1,5 @@ +signature DBMS_CONFIG = sig + + val dbmsNode : string + +end diff --git a/src/main.sml b/src/main.sml index d46deac..cf53af0 100644 --- a/src/main.sml +++ b/src/main.sml @@ -535,7 +535,9 @@ fun requestRmuser user = fun requestDbUser dbtype = let - val (_, bio) = requestBio (fn () => ()) + val (_, context) = requestContext (fn () => ()) + val bio = OpenSSL.connect true (context, + Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort) in Msg.send (bio, MsgCreateDbUser dbtype); case Msg.recv bio of @@ -550,7 +552,9 @@ fun requestDbUser dbtype = fun requestDbPasswd rc = let - val (_, bio) = requestBio (fn () => ()) + val (_, context) = requestContext (fn () => ()) + val bio = OpenSSL.connect true (context, + Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort) in Msg.send (bio, MsgDbPasswd rc); case Msg.recv bio of @@ -565,7 +569,9 @@ fun requestDbPasswd rc = fun requestDbTable p = let - val (user, bio) = requestBio (fn () => ()) + val (user, context) = requestContext (fn () => ()) + val bio = OpenSSL.connect true (context, + Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort) in Msg.send (bio, MsgCreateDb p); case Msg.recv bio of @@ -580,7 +586,9 @@ fun requestDbTable p = fun requestDbDrop p = let - val (user, bio) = requestBio (fn () => ()) + val (user, context) = requestContext (fn () => ()) + val bio = OpenSSL.connect true (context, + Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort) in Msg.send (bio, MsgDropDb p); case Msg.recv bio of @@ -595,7 +603,9 @@ fun requestDbDrop p = fun requestDbGrant p = let - val (user, bio) = requestBio (fn () => ()) + val (user, context) = requestContext (fn () => ()) + val bio = OpenSSL.connect true (context, + Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort) in Msg.send (bio, MsgGrantDb p); case Msg.recv bio of @@ -1162,6 +1172,43 @@ fun describeQuery q = | QSocket user => "Asked about socket permissions for user " ^ user | QFirewall user => "Asked about firewall rules for user " ^ user +fun doIt' loop bio f cleanup = + ((case f () of + (msgLocal, SOME msgRemote) => + (print msgLocal; + print "\n"; + Msg.send (bio, MsgError msgRemote)) + | (msgLocal, NONE) => + (print msgLocal; + print "\n"; + Msg.send (bio, MsgOk))) + handle e as (OpenSSL.OpenSSL s) => + (print ("OpenSSL error: " ^ s ^ "\n"); + app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e); + Msg.send (bio, MsgError ("OpenSSL error: " ^ s)) + handle OpenSSL.OpenSSL _ => ()) + | OS.SysErr (s, _) => + (print "System error: "; + print s; + print "\n"; + Msg.send (bio, MsgError ("System error: " ^ s)) + handle OpenSSL.OpenSSL _ => ()) + | Fail s => + (print "Failure: "; + print s; + print "\n"; + Msg.send (bio, MsgError ("Failure: " ^ s)) + handle OpenSSL.OpenSSL _ => ()) + | ErrorMsg.Error => + (print "Compilation error\n"; + Msg.send (bio, MsgError "Error during configuration evaluation") + handle OpenSSL.OpenSSL _ => ()); + (cleanup (); + ignore (OpenSSL.readChar bio); + OpenSSL.close bio) + handle OpenSSL.OpenSSL _ => (); + loop ()) + fun service () = let val host = Slave.hostname () @@ -1183,43 +1230,7 @@ fun service () = val user = OpenSSL.peerCN bio val () = print ("\nConnection from " ^ user ^ " at " ^ now () ^ "\n") val () = Domain.setUser user - - fun doIt f cleanup = - ((case f () of - (msgLocal, SOME msgRemote) => - (print msgLocal; - print "\n"; - Msg.send (bio, MsgError msgRemote)) - | (msgLocal, NONE) => - (print msgLocal; - print "\n"; - Msg.send (bio, MsgOk))) - handle e as (OpenSSL.OpenSSL s) => - (print ("OpenSSL error: " ^ s ^ "\n"); - app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e); - Msg.send (bio, MsgError ("OpenSSL error: " ^ s)) - handle OpenSSL.OpenSSL _ => ()) - | OS.SysErr (s, _) => - (print "System error: "; - print s; - print "\n"; - Msg.send (bio, MsgError ("System error: " ^ s)) - handle OpenSSL.OpenSSL _ => ()) - | Fail s => - (print "Failure: "; - print s; - print "\n"; - Msg.send (bio, MsgError ("Failure: " ^ s)) - handle OpenSSL.OpenSSL _ => ()) - | ErrorMsg.Error => - (print "Compilation error\n"; - Msg.send (bio, MsgError "Error during configuration evaluation") - handle OpenSSL.OpenSSL _ => ()); - (cleanup (); - ignore (OpenSSL.readChar bio); - OpenSSL.close bio) - handle OpenSSL.OpenSSL _ => (); - loop ()) + val doIt = doIt' loop bio fun doConfig codes = let @@ -1380,89 +1391,6 @@ fun service () = SOME "Not authorized to remove users")) (fn () => ()) - | MsgCreateDbUser {dbtype, passwd} => - doIt (fn () => - case Dbms.lookup dbtype of - NONE => ("Database user creation request with unknown datatype type " ^ dbtype, - SOME ("Unknown database type " ^ dbtype)) - | SOME handler => - case #adduser handler {user = user, passwd = passwd} of - NONE => ("Added " ^ dbtype ^ " user " ^ user ^ ".", - NONE) - | SOME msg => - ("Error adding a " ^ dbtype ^ " user " ^ user ^ ": " ^ msg, - 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 () => ()) - - | MsgCreateDb {dbtype, dbname, encoding} => - doIt (fn () => - if Dbms.validDbname dbname then - case Dbms.lookup dbtype of - NONE => ("Database creation request with unknown datatype type " ^ dbtype, - SOME ("Unknown database type " ^ dbtype)) - | SOME handler => - if not (Dbms.validEncoding encoding) then - ("Invalid encoding " ^ valOf encoding ^ " requested for database creation.", - SOME "Invalid encoding") - else - case #createdb handler {user = user, dbname = dbname, encoding = encoding} of - NONE => ("Created database " ^ user ^ "_" ^ dbname ^ ".", - NONE) - | SOME msg => ("Error creating database " ^ user ^ "_" ^ dbname ^ ": " ^ msg, - SOME ("Error creating database: " ^ msg)) - else - ("Invalid database name " ^ user ^ "_" ^ dbname, - SOME ("Invalid database name " ^ dbname))) - (fn () => ()) - - | MsgDropDb {dbtype, dbname} => - doIt (fn () => - if Dbms.validDbname dbname then - case Dbms.lookup dbtype of - NONE => ("Database drop request with unknown datatype type " ^ dbtype, - SOME ("Unknown database type " ^ dbtype)) - | SOME handler => - case #dropdb handler {user = user, dbname = dbname} of - NONE => ("Drop database " ^ user ^ "_" ^ dbname ^ ".", - NONE) - | SOME msg => ("Error dropping database " ^ user ^ "_" ^ dbname ^ ": " ^ msg, - SOME ("Error dropping database: " ^ msg)) - else - ("Invalid database name " ^ user ^ "_" ^ dbname, - SOME ("Invalid database name " ^ dbname))) - (fn () => ()) - - | MsgGrantDb {dbtype, dbname} => - doIt (fn () => - if Dbms.validDbname dbname then - case Dbms.lookup dbtype of - NONE => ("Database drop request with unknown datatype type " ^ dbtype, - SOME ("Unknown database type " ^ dbtype)) - | SOME handler => - case #grant handler {user = user, dbname = dbname} of - NONE => ("Grant permissions to database " ^ user ^ "_" ^ dbname ^ ".", - NONE) - | SOME msg => ("Error granting permissions to database " ^ user ^ "_" ^ dbname ^ ": " ^ msg, - SOME ("Error granting permissions to database: " ^ msg)) - else - ("Invalid database name " ^ user ^ "_" ^ dbname, - SOME ("Invalid database name " ^ dbname))) - (fn () => ()) - | MsgListMailboxes domain => doIt (fn () => if not (Domain.yourDomain domain) then @@ -1720,14 +1648,106 @@ fun slave () = | _ => (OpenSSL.close bio; loop ()) else - case Msg.recv bio of - SOME (MsgQuery q) => (print (describeQuery q ^ "\n"); - Msg.send (bio, answerQuery q); - ignore (OpenSSL.readChar bio); - OpenSSL.close bio; - loop ()) - | _ => (OpenSSL.close bio; - loop ()) + let + val doIt = doIt' loop bio + val user = peer + in + case Msg.recv bio of + NONE => (OpenSSL.close bio + handle OpenSSL.OpenSSL _ => (); + loop ()) + | SOME m => + case m of + (MsgQuery q) => (print (describeQuery q ^ "\n"); + Msg.send (bio, answerQuery q); + ignore (OpenSSL.readChar bio); + OpenSSL.close bio; + loop ()) + | MsgCreateDbUser {dbtype, passwd} => + doIt (fn () => + case Dbms.lookup dbtype of + NONE => ("Database user creation request with unknown datatype type " ^ dbtype, + SOME ("Unknown database type " ^ dbtype)) + | SOME handler => + case #adduser handler {user = user, passwd = passwd} of + NONE => ("Added " ^ dbtype ^ " user " ^ user ^ ".", + NONE) + | SOME msg => + ("Error adding a " ^ dbtype ^ " user " ^ user ^ ": " ^ msg, + 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 () => ()) + + | MsgCreateDb {dbtype, dbname, encoding} => + doIt (fn () => + if Dbms.validDbname dbname then + case Dbms.lookup dbtype of + NONE => ("Database creation request with unknown datatype type " ^ dbtype, + SOME ("Unknown database type " ^ dbtype)) + | SOME handler => + if not (Dbms.validEncoding encoding) then + ("Invalid encoding " ^ valOf encoding ^ " requested for database creation.", + SOME "Invalid encoding") + else + case #createdb handler {user = user, dbname = dbname, encoding = encoding} of + NONE => ("Created database " ^ user ^ "_" ^ dbname ^ ".", + NONE) + | SOME msg => ("Error creating database " ^ user ^ "_" ^ dbname ^ ": " ^ msg, + SOME ("Error creating database: " ^ msg)) + else + ("Invalid database name " ^ user ^ "_" ^ dbname, + SOME ("Invalid database name " ^ dbname))) + (fn () => ()) + + | MsgDropDb {dbtype, dbname} => + doIt (fn () => + if Dbms.validDbname dbname then + case Dbms.lookup dbtype of + NONE => ("Database drop request with unknown datatype type " ^ dbtype, + SOME ("Unknown database type " ^ dbtype)) + | SOME handler => + case #dropdb handler {user = user, dbname = dbname} of + NONE => ("Drop database " ^ user ^ "_" ^ dbname ^ ".", + NONE) + | SOME msg => ("Error dropping database " ^ user ^ "_" ^ dbname ^ ": " ^ msg, + SOME ("Error dropping database: " ^ msg)) + else + ("Invalid database name " ^ user ^ "_" ^ dbname, + SOME ("Invalid database name " ^ dbname))) + (fn () => ()) + + | MsgGrantDb {dbtype, dbname} => + doIt (fn () => + if Dbms.validDbname dbname then + case Dbms.lookup dbtype of + NONE => ("Database drop request with unknown datatype type " ^ dbtype, + SOME ("Unknown database type " ^ dbtype)) + | SOME handler => + case #grant handler {user = user, dbname = dbname} of + NONE => ("Grant permissions to database " ^ user ^ "_" ^ dbname ^ ".", + NONE) + | SOME msg => ("Error granting permissions to database " ^ user ^ "_" ^ dbname ^ ": " ^ msg, + SOME ("Error granting permissions to database: " ^ msg)) + else + ("Invalid database name " ^ user ^ "_" ^ dbname, + SOME ("Invalid database name " ^ dbname))) + (fn () => ()) + | _ => (OpenSSL.close bio; + loop ()) + end end handle OpenSSL.OpenSSL s => (print ("OpenSSL error: " ^ s ^ "\n"); OpenSSL.close bio -- 2.20.1 From 0a97b78a4e7ad25e640ac126f8093bffaf85b231 Mon Sep 17 00:00:00 2001 From: Clinton Ebadi Date: Thu, 25 Nov 2010 01:10:17 -0500 Subject: [PATCH 05/16] Update domtool-mysql script for local filesystem tablespaces * /afs/hcoop.net/common/databases -> /srv/databases * ACL -> give group mysql rw permissions on all files --- src/plugins/domtool-mysql | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/plugins/domtool-mysql b/src/plugins/domtool-mysql index 49363b1..b3690ff 100755 --- a/src/plugins/domtool-mysql +++ b/src/plugins/domtool-mysql @@ -21,10 +21,7 @@ case $1 in USERNAME=$2 DBNAME_BASE=$3 DBNAME="${USERNAME}_${DBNAME_BASE}" - DIR=/afs/hcoop.net/common/databases/${USERNAME:0:1}/${USERNAME:0:2}/$USERNAME/mysql - - kinit -k -t /etc/keytabs/root.admin.keytab root/admin - aklog + DIR=/srv/databases/${USERNAME:0:1}/${USERNAME:0:2}/$USERNAME/mysql if [ ! -d $DIR ]; then echo WARNING: $DIR must already exist! @@ -34,7 +31,7 @@ case $1 in chown mysql:mysql $DIR/$DBNAME chmod 770 $DIR/$DBNAME ln -sf $DIR/$DBNAME /var/lib/mysql/$DBNAME - fs setacl -dir $DIR/$DBNAME/ -acl system:mysql all + chmod g+rw -R $DIR/$DBNAME/ sudo -H mysql -e "GRANT CREATE,CREATE TEMPORARY TABLES,SELECT,INSERT,UPDATE,DELETE,INDEX,ALTER,CREATE VIEW,SHOW VIEW,LOCK TABLES,GRANT OPTION ON TABLE * TO '$USERNAME'@$WHERE;" $DBNAME sudo -H mysql -e "FLUSH PRIVILEGES;" -- 2.20.1 From 559049583024fef3e2ee384a5b9e98f0a1dc0168 Mon Sep 17 00:00:00 2001 From: clinton_admin Date: Tue, 30 Nov 2010 22:12:42 -0500 Subject: [PATCH 06/16] Readd outpost_ip to hcoop base library --- lib/hcoop.dtl | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/hcoop.dtl b/lib/hcoop.dtl index 8fdf79c..49d6aea 100644 --- a/lib/hcoop.dtl +++ b/lib/hcoop.dtl @@ -17,6 +17,7 @@ val mailmanHcoop = mailmanWebHost "lists.hcoop.net"; val fritz_ip : (ip) = "69.90.123.75"; val deleuze_ip : (ip) = "69.90.123.67"; val mire_ip : (ip) = "69.90.123.68"; +val outpost_ip : (ip) = "74.115.254.28"; val krunk_ip : (ip) = "69.90.123.70"; val fyodor_ip : (ip) = "64.20.38.170"; -- 2.20.1 From e58be1e67833b160d6a3e2425b89bed0aaedc53a Mon Sep 17 00:00:00 2001 From: clinton_admin Date: Wed, 1 Dec 2010 01:02:53 -0500 Subject: [PATCH 07/16] Add fritz as a slave node * Not used for anything yet, ensuring that the slave is setup correctly --- configDefault/domtool.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configDefault/domtool.cfg b/configDefault/domtool.cfg index 8e890b1..e5a5791 100644 --- a/configDefault/domtool.cfg +++ b/configDefault/domtool.cfg @@ -19,7 +19,7 @@ val defaultRetry = 1800 val defaultExpiry = 1209600 val defaultMinimum = 3600 -val nodeIps = [("deleuze", "69.90.123.67"), ("mire", "69.90.123.68"), ("hopper", "69.90.123.74")] +val nodeIps = [("deleuze", "69.90.123.67"), ("mire", "69.90.123.68"), ("hopper", "69.90.123.74"), ("fritz", "69.90.123.75")] val defaultNode = "deleuze" val masterNode = "deleuze" -- 2.20.1 From caba7e2782fd6c39873fcb05059ad0bdb037a2aa Mon Sep 17 00:00:00 2001 From: Clinton Ebadi Date: Wed, 1 Dec 2010 01:49:36 -0500 Subject: [PATCH 08/16] Move Mysql-fixperms into slave * Occurs on dbmsNode as with other database operations --- src/main.sml | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/src/main.sml b/src/main.sml index cf53af0..2800cbd 100644 --- a/src/main.sml +++ b/src/main.sml @@ -735,7 +735,9 @@ fun requestSmtpLog domain = fun requestMysqlFixperms () = let - val (_, bio) = requestBio (fn () => ()) + val (_, context) = requestContext (fn () => ()) + val bio = OpenSSL.connect true (context, + Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort) in Msg.send (bio, MsgMysqlFixperms); case Msg.recv bio of @@ -1505,18 +1507,6 @@ fun service () = (describeQuery q, NONE))) (fn () => ()) - - | MsgMysqlFixperms => - (print "Starting mysql-fixperms\n"; - doIt (fn () => if OS.Process.isSuccess - (OS.Process.system "/usr/bin/sudo -H /afs/hcoop.net/common/etc/scripts/mysql-grant-table-drop") then - ("Requested mysql-fixperms", - NONE) - else - ("Requested mysql-fixperms, but execution failed!", - SOME "Script execution failed.")) - (fn () => ())) - | MsgDescribe dom => doIt (fn () => if not (Domain.validDomain dom) then ("Requested description of invalid domain " ^ dom, @@ -1745,6 +1735,17 @@ fun slave () = ("Invalid database name " ^ user ^ "_" ^ dbname, SOME ("Invalid database name " ^ dbname))) (fn () => ()) + | MsgMysqlFixperms => + (print "Starting mysql-fixperms\n"; + doIt (fn () => if OS.Process.isSuccess + (OS.Process.system "/usr/bin/sudo -H /afs/hcoop.net/common/etc/scripts/mysql-grant-table-drop") then + ("Requested mysql-fixperms", + NONE) + else + ("Requested mysql-fixperms, but execution failed!", + SOME "Script execution failed.")) + (fn () => ())) + | _ => (OpenSSL.close bio; loop ()) end -- 2.20.1 From d2d861a963e4809da4b1f0dd34788540b1b9dcb1 Mon Sep 17 00:00:00 2001 From: root Date: Sun, 5 Dec 2010 21:38:54 +0000 Subject: [PATCH 09/16] Configure outpost as a dns slave * And remove hopper as it is not in dnsNodes_all and does not have bind installed --- configDefault/domtool.cfg | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/configDefault/domtool.cfg b/configDefault/domtool.cfg index e5a5791..ef7c620 100644 --- a/configDefault/domtool.cfg +++ b/configDefault/domtool.cfg @@ -19,13 +19,13 @@ val defaultRetry = 1800 val defaultExpiry = 1209600 val defaultMinimum = 3600 -val nodeIps = [("deleuze", "69.90.123.67"), ("mire", "69.90.123.68"), ("hopper", "69.90.123.74"), ("fritz", "69.90.123.75")] +val nodeIps = [("deleuze", "69.90.123.67"), ("mire", "69.90.123.68"), ("hopper", "69.90.123.74"), ("fritz", "69.90.123.75"), ("outpost", "74.115.254.28")] val defaultNode = "deleuze" val masterNode = "deleuze" -val slaveNodes = ["mire", "hopper"] +val slaveNodes = ["mire", "outpost"] -val dnsNodes_all = ["deleuze", "mire"] +val dnsNodes_all = ["deleuze", "mire", "outpost"] val dnsNodes_admin = [] val mailNodes_all = ["deleuze", "hopper"] -- 2.20.1 From 03f5c1498319745508dd68b6243be9fe1d697a5b Mon Sep 17 00:00:00 2001 From: Clinton Ebadi Date: Mon, 31 Jan 2011 13:52:00 -0500 Subject: [PATCH 10/16] Enable fritz as an admin web node --- configDefault/apache.cfg | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/configDefault/apache.cfg b/configDefault/apache.cfg index 6a5dd65..85268d7 100644 --- a/configDefault/apache.cfg +++ b/configDefault/apache.cfg @@ -15,7 +15,8 @@ val fixperms1 = "/usr/bin/sudo /usr/local/sbin/domtool-publish apache1.3-fixperm val confDir = "/var/domtool/vhosts" val webNodes_all = [("mire", {version = APACHE_2, auth = MOD_WAKLOG})] -val webNodes_admin = [("deleuze", {version = APACHE_2, auth = MOD_WAKLOG})] +val webNodes_admin = [("deleuze", {version = APACHE_2, auth = MOD_WAKLOG}), + ("fritz", {version = APACHE_2, auth = MOD_WAKLOG})] val webNodes_default = ["mire"] -- 2.20.1 From 883dd79c5d791f7b3d961917f8f2c3b58a1195ea Mon Sep 17 00:00:00 2001 From: clinton_admin Date: Mon, 31 Jan 2011 14:00:03 -0500 Subject: [PATCH 11/16] Force use of actual echo instead of shell builtin * The default echo builtin used by make doesn't support -e any more! --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index c1fb6d3..2d0c6ab 100644 --- a/Makefile +++ b/Makefile @@ -9,7 +9,7 @@ COMMON_DEPS := configDefault/config.sig configDefault/configDefault.sml \ EMACS_DIR := /usr/local/share/emacs/site-lisp/domtool-mode config.sml: - echo -e 'structure Config :> CONFIG = struct\nopen ConfigDefault\nend' > $@ + /bin/echo -e 'structure Config :> CONFIG = struct\nopen ConfigDefault\nend' > $@ .PHONY: all mlton smlnj install install_sos -- 2.20.1 From 837dcf99c5f89f708b27a6accc618f071e4107b8 Mon Sep 17 00:00:00 2001 From: Clinton Ebadi Date: Tue, 8 Mar 2011 11:33:32 -0500 Subject: [PATCH 12/16] Remove hopper from domtool email configuration --- configDefault/domtool.cfg | 2 +- configDefault/exim.cfg | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/configDefault/domtool.cfg b/configDefault/domtool.cfg index ef7c620..6a64a83 100644 --- a/configDefault/domtool.cfg +++ b/configDefault/domtool.cfg @@ -28,7 +28,7 @@ val slaveNodes = ["mire", "outpost"] val dnsNodes_all = ["deleuze", "mire", "outpost"] val dnsNodes_admin = [] -val mailNodes_all = ["deleuze", "hopper"] +val mailNodes_all = ["deleuze"] val mailNodes_admin = ["mire"] val aclFile = "/afs/hcoop.net/common/etc/domtool/acl" diff --git a/configDefault/exim.cfg b/configDefault/exim.cfg index 6118466..a1ef37a 100644 --- a/configDefault/exim.cfg +++ b/configDefault/exim.cfg @@ -7,7 +7,7 @@ val relayDomains = "/var/domtool/relay_domains.cfg" val reload = "/usr/bin/sudo /usr/local/sbin/domtool-publish exim" -val aliasTo = ["deleuze", "hopper"] +val aliasTo = ["deleuze"] val mainLog = "/var/log/exim4/mainlog" -- 2.20.1 From 37478a27c5ccb3252a0c0211535aa567f67e0adb Mon Sep 17 00:00:00 2001 From: Clinton Ebadi Date: Sat, 19 Mar 2011 19:11:22 -0400 Subject: [PATCH 13/16] vmailpasswd: actually call domtool-publish --- src/mail/vmailpasswd.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mail/vmailpasswd.c b/src/mail/vmailpasswd.c index c371645..67fdf33 100644 --- a/src/mail/vmailpasswd.c +++ b/src/mail/vmailpasswd.c @@ -117,5 +117,5 @@ main(int argc, char *argv[]) { return rc; } - return system("/usr/local/bin/domtool-publish courier"); + return system("/usr/local/sbin/domtool-publish courier"); } -- 2.20.1 From ec95f39fbe75c414e53f5f922b75390a0179e916 Mon Sep 17 00:00:00 2001 From: Clinton Ebadi Date: Tue, 29 Nov 2011 02:08:16 -0500 Subject: [PATCH 14/16] Port firewall generation from Domtool1/fwtool * fwtool was a bit of a hack -- try to clean things up... * Parsing and generating the config are split (somewhat) * Only one set of rules for all nodes with a firewall --- configDefault/firewall.cfg | 8 +++ configDefault/firewall.cfs | 1 + configDefault/firewall.csg | 7 +++ src/plugins/firewall.sig | 2 + src/plugins/firewall.sml | 119 +++++++++++++++++++++++++++++++------ 5 files changed, 118 insertions(+), 19 deletions(-) create mode 100644 configDefault/firewall.cfg create mode 100644 configDefault/firewall.cfs create mode 100644 configDefault/firewall.csg diff --git a/configDefault/firewall.cfg b/configDefault/firewall.cfg new file mode 100644 index 0000000..f07ecad --- /dev/null +++ b/configDefault/firewall.cfg @@ -0,0 +1,8 @@ +(* -*- sml -*- *) +structure Firewall :> FIREWALL_CONFIG = struct + +val firewallRules = "/home/clinton/misc/hcoop/firewall/user.rules" +val firewallDir = "/home/clinton/misc/hcoop/firewall/output" +val firewallNodes = ["bog"] + +end diff --git a/configDefault/firewall.cfs b/configDefault/firewall.cfs new file mode 100644 index 0000000..b21e779 --- /dev/null +++ b/configDefault/firewall.cfs @@ -0,0 +1 @@ +structure Firewall : FIREWALL_CONFIG diff --git a/configDefault/firewall.csg b/configDefault/firewall.csg new file mode 100644 index 0000000..95bb6bd --- /dev/null +++ b/configDefault/firewall.csg @@ -0,0 +1,7 @@ +(* -*- sml -*- *) +signature FIREWALL_CONFIG = sig + + val firewallNodes : string list (* Nodes to firewall *) + val firewallDir : string (* Output directory for ferm config *) + val firewallRules : string (* Rules file *) +end diff --git a/src/plugins/firewall.sig b/src/plugins/firewall.sig index ec30375..94a838a 100644 --- a/src/plugins/firewall.sig +++ b/src/plugins/firewall.sig @@ -23,4 +23,6 @@ signature FIREWALL = sig val query : string -> string list (* List a user's local firewall rules. *) + val generateFirewallConfig : unit -> unit + end diff --git a/src/plugins/firewall.sml b/src/plugins/firewall.sml index 6a4bb30..65c9db1 100644 --- a/src/plugins/firewall.sml +++ b/src/plugins/firewall.sml @@ -1,5 +1,6 @@ (* HCoop Domtool (http://hcoop.sourceforge.net/) * Copyright (c) 2006-2007, Adam Chlipala + * Copyright (c) 2011 Clinton Ebadi * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License @@ -16,31 +17,111 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) -(* Firewall rule querying *) +(* Firewall management *) + +(* Contains portions from Fwtool Copyright (C) 2005 Adam Chlipala, GPL v2 or later *) structure Firewall :> FIREWALL = struct +structure StringMap = DataStructures.StringMap + +fun parseRules _ = + let + val inf = TextIO.openIn Config.Firewall.firewallRules + val out_lines = ref StringMap.empty + val in_lines = ref StringMap.empty + + fun confLine r (uname, line) = + let + val line = String.concat ["\t", line, "\n"] + val lines = case StringMap.find (!r, uname) of + NONE => [] + | SOME lines => lines + in + r := StringMap.insert (!r, uname, line :: lines) + end + + val confLine_in = confLine in_lines + val confLine_out = confLine out_lines + + fun parsePorts ports = + case String.fields (fn ch => ch = #",") ports of + [pp] => pp + | pps => String.concat ["(", String.concatWith " " pps, ")"] + + fun parseHosts addr hosts = + case hosts of + [] => "" + | [host] => String.concat [" ", addr, " ", host] + | _ => String.concat [" ", addr, " (", String.concatWith " " hosts, ")"] + + fun loop () = + case TextIO.inputLine inf of + NONE => () + | SOME line => + case String.tokens Char.isSpace line of + uname :: rest => + (case rest of + "Client" :: ports :: hosts => + confLine_out (uname, String.concat ["dport ", parsePorts ports, parseHosts "daddr" hosts, " ACCEPT;"]) + | "Server" :: ports :: hosts => + confLine_in (uname, String.concat ["dport ", parsePorts ports, parseHosts "daddr" hosts, " ACCEPT;"]) + | ["LocalServer", ports] => + confLine_in (uname, String.concat ["saddr $WE dport ", parsePorts ports, " ACCEPT;"]) + | _ => print "Invalid config line\n"; + loop ()) + | _ => loop () + val _ = loop () + in + {server_rules = !in_lines, client_rules = !out_lines} + end + fun query uname = let - val inf = TextIO.openIn "/etc/firewall/users.rules" - - fun loop rules = - case TextIO.inputLine inf of - NONE => List.rev rules - | SOME line => - if String.sub (line, 0) = #"#" then - loop rules - else case String.tokens Char.isSpace line of - uname'::rest => - if uname = uname' then - loop (String.concatWith " " rest :: rules) - else - loop rules - | _ => loop rules + val rules = parseRules () in - loop [] - before TextIO.closeIn inf - end handle IO.Io _ => [] + getOpt (StringMap.find (#server_rules rules, uname), []) @ getOpt (StringMap.find (#client_rules rules, uname), []) + end + +fun generateFirewallConfig _ = +(* rule generation must happen on the node (not really, but I'd rather + avoid codifying that uids must be consistent between hosts) *) + let + val {server_rules, client_rules} = parseRules () + val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf") + val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf") + val users_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users.conf") + + fun write_user_tcp_conf (rules, outf, suffix) = + StringMap.appi (fn (uname, lines) => + let + val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname))) + in + TextIO.output (outf, String.concat + ["mod owner uid-owner ", + Int.toString uid, + " { goto user_", + uname, + suffix, + "; goto lreject; }\n"]); + (* Is there any point to splitting the rules like this? *) + TextIO.output (users_conf, + String.concat ("chain user_" + :: uname + :: suffix + :: " proto tcp {\n" + :: lines + @ ["}\n\n"])) + end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n") + rules + in + write_user_tcp_conf (server_rules, users_tcp_in_conf, "_tcp_in"); + write_user_tcp_conf (client_rules, users_tcp_out_conf, "_tcp_out"); + TextIO.closeOut users_conf; + TextIO.closeOut users_tcp_out_conf; + TextIO.closeOut users_tcp_in_conf + end + end -- 2.20.1 From 73b9542320e82ad398689b66bc1938c78cc53be0 Mon Sep 17 00:00:00 2001 From: Clinton Ebadi Date: Thu, 29 Dec 2011 15:06:50 -0500 Subject: [PATCH 15/16] Firewall Regen Support * Clean up code slightly (still ugly, I'm no good with SML) * Accept `MsgFirewallRegen' to regenerate firewall on slave * Not tested much, should also generate the firewall elsewhere and copy to `/etc' --- configDefault/firewall.cfg | 2 ++ configDefault/firewall.csg | 2 ++ scripts/domtool-publish | 5 ++++- src/main.sml | 10 ++++++++++ src/msg.sml | 2 ++ src/msgTypes.sml | 2 ++ src/plugins/firewall.sig | 11 +++++++++-- src/plugins/firewall.sml | 14 ++++++++++---- 8 files changed, 41 insertions(+), 7 deletions(-) diff --git a/configDefault/firewall.cfg b/configDefault/firewall.cfg index f07ecad..b2d5179 100644 --- a/configDefault/firewall.cfg +++ b/configDefault/firewall.cfg @@ -5,4 +5,6 @@ val firewallRules = "/home/clinton/misc/hcoop/firewall/user.rules" val firewallDir = "/home/clinton/misc/hcoop/firewall/output" val firewallNodes = ["bog"] +val reload = "/usr/bin/sudo /usr/local/sbin/domtool-publish firewall" + end diff --git a/configDefault/firewall.csg b/configDefault/firewall.csg index 95bb6bd..af23b1c 100644 --- a/configDefault/firewall.csg +++ b/configDefault/firewall.csg @@ -4,4 +4,6 @@ signature FIREWALL_CONFIG = sig val firewallNodes : string list (* Nodes to firewall *) val firewallDir : string (* Output directory for ferm config *) val firewallRules : string (* Rules file *) + + val reload : string (* Command to reload configuration *) end diff --git a/scripts/domtool-publish b/scripts/domtool-publish index f11bc4c..7518281 100755 --- a/scripts/domtool-publish +++ b/scripts/domtool-publish @@ -78,7 +78,10 @@ case $1 in /bin/cp /var/domtool/waklog.conf /etc/apache2/ /etc/init.d/apache2 reload ;; + firewall) + /etc/init.d/ferm reload + ;; *) - echo "Usage: domtool-publish [apache|bind|courier|exim|mailman|smtplog STRING|users]" + echo "Usage: domtool-publish [apache|bind|courier|exim|mailman|smtplog STRING|users|firewall]" ;; esac diff --git a/src/main.sml b/src/main.sml index 2800cbd..a673fde 100644 --- a/src/main.sml +++ b/src/main.sml @@ -1745,6 +1745,16 @@ fun slave () = ("Requested mysql-fixperms, but execution failed!", SOME "Script execution failed.")) (fn () => ())) + | MsgFirewallRegen => + doIt (fn () => if Acl.query {user = user, class = "priv", value = "all"} andalso List.exists (fn x => x = host) Config.Firewall.firewallNodes then + if (Firewall.generateFirewallConfig (Firewall.parseRules ()) andalso Firewall.publishConfig ()) + then + ("Firewall rules regenerated.", NONE) + else + ("Rules regeneration failed!", SOME "Script execution failed.") + else + ("Not authorized to regenerate firewall.", SOME ("Unauthorized user " ^ user ^ "attempted to regenerated firewall"))) + (fn () => ()) | _ => (OpenSSL.close bio; loop ()) diff --git a/src/msg.sml b/src/msg.sml index a745f5c..ab79885 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -238,6 +238,7 @@ fun send (bio, m) = OpenSSL.writeString (bio, s)) | MsgReUsers => OpenSSL.writeInt (bio, 41) | MsgVmailChanged => OpenSSL.writeInt (bio, 42) + | MsgFirewallRegen => OpenSSL.writeInt (bio, 43) fun checkIt v = case v of @@ -352,6 +353,7 @@ fun recv bio = | 40 => Option.map MsgDescription (OpenSSL.readString bio) | 41 => SOME MsgReUsers | 42 => SOME MsgVmailChanged + | 43 => SOME MsgFirewallRegen | _ => NONE) end diff --git a/src/msgTypes.sml b/src/msgTypes.sml index 45646a6..a0b7593 100644 --- a/src/msgTypes.sml +++ b/src/msgTypes.sml @@ -128,5 +128,7 @@ datatype msg = (* Rerun all callbacks for cases where the set of users has changed *) | MsgVmailChanged (* Server tells slave that vmail user information has changed *) + | MsgFirewallRegen + (* Regenerate firewall on user machines *) end diff --git a/src/plugins/firewall.sig b/src/plugins/firewall.sig index 94a838a..0bb8611 100644 --- a/src/plugins/firewall.sig +++ b/src/plugins/firewall.sig @@ -1,5 +1,6 @@ (* HCoop Domtool (http://hcoop.sourceforge.net/) * Copyright (c) 2006-2007, Adam Chlipala + * Copyright (c) 2011, Clinton Ebadi * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License @@ -16,13 +17,19 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) -(* Firewall rule querying *) +(* Firewall rule querying/generation *) signature FIREWALL = sig + type firewall_rules = { server_rules : (string list DataStructures.StringMap.map), + client_rules : (string list DataStructures.StringMap.map)} + val query : string -> string list (* List a user's local firewall rules. *) - val generateFirewallConfig : unit -> unit + val parseRules : unit -> firewall_rules + val generateFirewallConfig : firewall_rules -> bool + + val publishConfig : unit -> bool end diff --git a/src/plugins/firewall.sml b/src/plugins/firewall.sml index 65c9db1..70c45b5 100644 --- a/src/plugins/firewall.sml +++ b/src/plugins/firewall.sml @@ -23,6 +23,9 @@ structure Firewall :> FIREWALL = struct +type firewall_rules = { server_rules : (string list DataStructures.StringMap.map), + client_rules : (string list DataStructures.StringMap.map)} + structure StringMap = DataStructures.StringMap fun parseRules _ = @@ -84,11 +87,10 @@ fun query uname = end -fun generateFirewallConfig _ = +fun generateFirewallConfig {server_rules, client_rules} = (* rule generation must happen on the node (not really, but I'd rather avoid codifying that uids must be consistent between hosts) *) let - val {server_rules, client_rules} = parseRules () val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf") val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf") val users_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users.conf") @@ -121,7 +123,11 @@ fun generateFirewallConfig _ = TextIO.closeOut users_conf; TextIO.closeOut users_tcp_out_conf; - TextIO.closeOut users_tcp_in_conf + TextIO.closeOut users_tcp_in_conf; + + true end - + +fun publishConfig _ = + Slave.shell [Config.Firewall.reload] end -- 2.20.1 From a8e88df70a675cce965380df971c9e3c4d283a5e Mon Sep 17 00:00:00 2001 From: Clinton Ebadi Date: Sat, 7 Jan 2012 14:42:49 -0500 Subject: [PATCH 16/16] `fwtool' main * Basic driver --- Makefile | 11 ++++++++++- src/main-fwtool.sml | 25 +++++++++++++++++++++++++ src/main.sig | 2 ++ src/main.sml | 25 +++++++++++++++++++++++++ 4 files changed, 62 insertions(+), 1 deletion(-) create mode 100644 src/main-fwtool.sml diff --git a/Makefile b/Makefile index 2d0c6ab..7f5d7d5 100644 --- a/Makefile +++ b/Makefile @@ -15,7 +15,8 @@ config.sml: mlton: bin/domtool-server bin/domtool-client bin/domtool-slave \ bin/domtool-admin bin/domtool-doc bin/dbtool bin/vmail \ - bin/smtplog bin/setsa bin/mysql-fixperms bin/webbw bin/domtool-tail + bin/smtplog bin/setsa bin/mysql-fixperms bin/webbw bin/domtool-tail \ + bin/fwtool smlnj: $(COMMON_DEPS) openssl/smlnj/FFI/libssl.h.cm pcre/smlnj/FFI/libpcre.h.cm \ src/domtool.cm @@ -99,6 +100,10 @@ src/mysql-fixperms.mlb: src/prefix.mlb src/sources src/suffix.mlb $(MAKE_MLB_BASE) >src/mysql-fixperms.mlb echo "main-mysql-fixperms.sml" >>src/mysql-fixperms.mlb +src/fwtool.mlb: src/prefix.mlb src/sources src/suffix.mlb + $(MAKE_MLB_BASE) >src/fwtool.mlb + echo "main-fwtool.sml" >>src/fwtool.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*" \ @@ -169,6 +174,9 @@ bin/smtplog: $(COMMON_MLTON_DEPS) src/smtplog.mlb bin/mysql-fixperms: $(COMMON_MLTON_DEPS) src/mysql-fixperms.mlb $(MLTON) -output bin/mysql-fixperms src/mysql-fixperms.mlb +bin/fwtool: $(COMMON_MLTON_DEPS) src/fwtool.mlb + $(MLTON) -output bin/fwtool src/fwtool.mlb + bin/webbw: $(COMMON_MLTON_DEPS) src/stats/webbw.mlb src/stats/*.sml mlton -output bin/webbw src/stats/webbw.mlb @@ -202,6 +210,7 @@ install: install_sos -cp bin/domtool-admin /usr/local/bin/ -cp bin/domtool-doc /usr/local/bin/ -cp bin/dbtool /usr/local/bin/ + -cp bin/fwtool /usr/local/bin/ -cp bin/vmail /usr/local/bin/ -cp bin/setsa /usr/local/bin/ -cp bin/smtplog /usr/local/bin/ diff --git a/src/main-fwtool.sml b/src/main-fwtool.sml new file mode 100644 index 0000000..18c2ada --- /dev/null +++ b/src/main-fwtool.sml @@ -0,0 +1,25 @@ +(* HCoop Domtool (http://hcoop.sourceforge.net/) + * Copyright (c) 2006, Adam Chlipala + * Copyright (c) 2012 Clinton Ebadi + * + * 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 fwtool *) + +val _ = + OS.Process.exit (case CommandLine.arguments () of + "regen" :: nodeName :: rest => Main.requestFirewallRegen nodeName + | _ => (print "Usage: fwtool regen NODE\n"; OS.Process.failure)) diff --git a/src/main.sig b/src/main.sig index db7ab02..0f90ba9 100644 --- a/src/main.sig +++ b/src/main.sig @@ -83,4 +83,6 @@ signature MAIN = sig val requestTrustedPath : {node : string, uname : string} -> OS.Process.status val requestSocketPerm : {node : string, uname : string} -> OS.Process.status val requestFirewall : {node : string, uname : string} -> OS.Process.status + + val requestFirewallRegen : string -> OS.Process.status end diff --git a/src/main.sml b/src/main.sml index a673fde..c95ef31 100644 --- a/src/main.sml +++ b/src/main.sml @@ -954,6 +954,31 @@ fun requestReUsers () = OpenSSL.close bio end +fun requestFirewallRegen node = + let + val (user, context) = requestContext (fn () => ()) + val bio = OpenSSL.connect true (context, Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort) + (* Only supporting on slave nodes *) + + val _ = Msg.send (bio, MsgFirewallRegen) + + fun handleResult () = + case Msg.recv bio of + NONE => (print "Server closed connection unexpectedly.\n"; + OS.Process.failure) + | SOME m => + case m of + MsgOk => (print "Firewall regenerated.\n"; + OS.Process.success) + | MsgError s => (print ("Firewall regeneration failed: " ^ s ^ "\n"); + OS.Process.failure) + | _ => (print "Unexpected server reply.\n"; + OS.Process.failure) + in + handleResult() + before OpenSSL.close bio + end + structure SS = StringSet fun domainList dname = -- 2.20.1