From: Clinton Ebadi <clinton@unknownlamer.org>
Date: Sat, 7 Jan 2012 19:42:49 +0000 (-0500)
Subject: `fwtool' main
X-Git-Tag: release_20120902~4
X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/commitdiff_plain/a8e88df70a675cce965380df971c9e3c4d283a5e?hp=73b9542320e82ad398689b66bc1938c78cc53be0

`fwtool' main
* Basic driver
---

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 =