`fwtool' main
authorClinton Ebadi <clinton@unknownlamer.org>
Sat, 7 Jan 2012 19:42:49 +0000 (14:42 -0500)
committerClinton Ebadi <clinton@unknownlamer.org>
Sat, 7 Jan 2012 19:42:49 +0000 (14:42 -0500)
* Basic driver

Makefile
src/main-fwtool.sml [new file with mode: 0644]
src/main.sig
src/main.sml

index 2d0c6ab..7f5d7d5 100644 (file)
--- 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 \
 
 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
 
 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
 
        $(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*" \
 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/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
 
 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/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/
        -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 (file)
index 0000000..18c2ada
--- /dev/null
@@ -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))
index db7ab02..0f90ba9 100644 (file)
@@ -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 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
 end
index a673fde..c95ef31 100644 (file)
@@ -954,6 +954,31 @@ fun requestReUsers () =
        OpenSSL.close bio
     end
 
        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 =
 structure SS = StringSet
 
 fun domainList dname =