Firewall rule look-up

diff --git a/src/main-admin.sml b/src/main-admin.sml
index ffda0d7..967f1e1 100644 (file)
--- a/src/main-admin.sml
+++ b/src/main-admin.sml
@@ -53,4 +53,5 @@ val _ =
       | ["ftp", node, uname] => OS.Process.exit (Main.requestFtp {node = node, uname = uname})
       | ["tpe", node, uname] => OS.Process.exit (Main.requestTrustedPath {node = node, uname = uname})
       | ["sockperm", node, uname] => OS.Process.exit (Main.requestSocketPerm {node = node, uname = uname})
       | ["ftp", node, uname] => OS.Process.exit (Main.requestFtp {node = node, uname = uname})
       | ["tpe", node, uname] => OS.Process.exit (Main.requestTrustedPath {node = node, uname = uname})
       | ["sockperm", node, uname] => OS.Process.exit (Main.requestSocketPerm {node = node, uname = uname})

+      | ["firewall", node, uname] => OS.Process.exit (Main.requestFirewall {node = node, uname = uname})

       | _ => print "Invalid command-line arguments\n"
       | _ => print "Invalid command-line arguments\n"

diff --git a/src/main.sig b/src/main.sig
index ce81c60..3b0c791 100644 (file)
--- a/src/main.sig
+++ b/src/main.sig
@@ -74,4 +74,5 @@ signature MAIN = sig
     val requestFtp : {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 requestFtp : {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

 end
 end

diff --git a/src/main.sml b/src/main.sml
index 96c9204..ca57210 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -751,6 +751,33 @@ fun requestSocketPerm {node, uname} =
        before OpenSSL.close bio
     end
 
        before OpenSSL.close bio
     end
 

+fun requestFirewall {node, uname} =
+    let
+       val (user, context) = requestContext (fn () => ())
+       val bio = OpenSSL.connect (context, if node = Config.masterNode then
+                                               dispatcher
+                                           else
+                                               Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+
+       val _ = Msg.send (bio, MsgQuery (QFirewall uname))
+
+       fun loop () =
+           case Msg.recv bio of
+               NONE => (print "Server closed connection unexpectedly.\n";
+                        OS.Process.failure)
+             | SOME m =>
+               case m of
+                   MsgFirewall ls => (app (fn s => (print s; print "\n")) ls;
+                                      OS.Process.success)
+                 | MsgError s => (print ("Firewall query failed: " ^ s ^ "\n");
+                                  OS.Process.failure)
+                 | _ => (print "Unexpected server reply.\n";
+                         OS.Process.failure)
+    in
+       loop ()
+       before OpenSSL.close bio
+    end
+

 fun regenerate context =
     let
        val b = basis ()
 fun regenerate context =
     let
        val b = basis ()


@@ -841,6 +868,7 @@ fun answerQuery q =
       | QFtp user => if Ftp.allowed user then MsgYes else MsgNo
       | QTrustedPath user => if TrustedPath.query user then MsgYes else MsgNo
       | QSocket user => MsgSocket (SocketPerm.query user)
       | QFtp user => if Ftp.allowed user then MsgYes else MsgNo
       | QTrustedPath user => if TrustedPath.query user then MsgYes else MsgNo
       | QSocket user => MsgSocket (SocketPerm.query user)

+      | QFirewall user => MsgFirewall (Firewall.query user)

 
 fun describeQuery q =
     case q of
 
 fun describeQuery q =
     case q of


@@ -849,6 +877,7 @@ fun describeQuery q =
       | QFtp user => "Asked about FTP permissions for user " ^ user
       | QTrustedPath user => "Asked about trusted path settings for user " ^ user
       | QSocket user => "Asked about socket permissions for user " ^ user
       | QFtp user => "Asked about FTP permissions for user " ^ user
       | QTrustedPath user => "Asked about trusted path settings for user " ^ user
       | QSocket user => "Asked about socket permissions for user " ^ user

+      | QFirewall user => "Asked about firewall rules for user " ^ user

 
 fun service () =
     let
 
 fun service () =
     let

diff --git a/src/msg.sml b/src/msg.sml
index 3c795b2..5b1125b 100644 (file)
--- a/src/msg.sml
+++ b/src/msg.sml
@@ -115,6 +115,8 @@ fun sendQuery (bio, q) =
                           OpenSSL.writeString (bio, s))
       | QSocket s => (OpenSSL.writeInt (bio, 4);
                      OpenSSL.writeString (bio, s))
                           OpenSSL.writeString (bio, s))
       | QSocket s => (OpenSSL.writeInt (bio, 4);
                      OpenSSL.writeString (bio, s))

+      | QFirewall s => (OpenSSL.writeInt (bio, 5);
+                       OpenSSL.writeString (bio, s))

 
 fun recvQuery bio =
     case OpenSSL.readInt bio of
 
 fun recvQuery bio =
     case OpenSSL.readInt bio of


@@ -125,6 +127,7 @@ fun recvQuery bio =
           | 2 => Option.map QFtp (OpenSSL.readString bio)
           | 3 => Option.map QTrustedPath (OpenSSL.readString bio)
           | 4 => Option.map QSocket (OpenSSL.readString bio)
           | 2 => Option.map QFtp (OpenSSL.readString bio)
           | 3 => Option.map QTrustedPath (OpenSSL.readString bio)
           | 4 => Option.map QSocket (OpenSSL.readString bio)

+          | 5 => Option.map QFirewall (OpenSSL.readString bio)

           | _ => NONE)
       | NONE => NONE
 
           | _ => NONE)
       | NONE => NONE
 


@@ -216,6 +219,8 @@ fun send (bio, m) =
                       sendQuery (bio, q))
       | MsgSocket p => (OpenSSL.writeInt (bio, 33);
                        sendSockPerm (bio, p))
                       sendQuery (bio, q))
       | MsgSocket p => (OpenSSL.writeInt (bio, 33);
                        sendSockPerm (bio, p))

+      | MsgFirewall ls => (OpenSSL.writeInt (bio, 34);
+                          sendList OpenSSL.writeString (bio, ls))

 
 fun checkIt v =
     case v of
 
 fun checkIt v =
     case v of


@@ -315,6 +320,7 @@ fun recv bio =
                   | 31 => SOME MsgNo
                   | 32 => Option.map MsgQuery (recvQuery bio)
                   | 33 => Option.map MsgSocket (recvSockPerm bio)
                   | 31 => SOME MsgNo
                   | 32 => Option.map MsgQuery (recvQuery bio)
                   | 33 => Option.map MsgSocket (recvSockPerm bio)

+                  | 34 => Option.map MsgFirewall (recvList OpenSSL.readString bio)

                   | _ => NONE)
         
 end
                   | _ => NONE)
         
 end

diff --git a/src/msgTypes.sml b/src/msgTypes.sml
index b91e198..4827c62 100644 (file)
--- a/src/msgTypes.sml
+++ b/src/msgTypes.sml
@@ -37,6 +37,8 @@ datatype query =
        (* Is this user restricted to trusted-path executables? *)
        | QSocket of string
        (* What socket permissions does this user have? *)
        (* Is this user restricted to trusted-path executables? *)
        | QSocket of string
        (* What socket permissions does this user have? *)

+       | QFirewall of string
+       (* What firewall rules does this user have? *)

 
 datatype msg =
         MsgOk
 
 datatype msg =
         MsgOk


@@ -108,5 +110,7 @@ datatype msg =
        (* Ask for host-specific information *)
        | MsgSocket of socket_permission
        (* Answer to a QSocket query *)
        (* Ask for host-specific information *)
        | MsgSocket of socket_permission
        (* Answer to a QSocket query *)

+       | MsgFirewall of string list
+       (* Answer to a QFirewall query *)

 
 end
 
 end

diff --git a/src/plugins/firewall.sig b/src/plugins/firewall.sig
new file mode 100644 (file)
index 0000000..ec30375
--- /dev/null
+++ b/src/plugins/firewall.sig
@@ -0,0 +1,26 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006-2007, 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.
+ *)
+
+(* Firewall rule querying *)
+
+signature FIREWALL = sig
+
+    val query : string -> string list
+    (* List a user's local firewall rules. *)
+
+end

diff --git a/src/plugins/firewall.sml b/src/plugins/firewall.sml
new file mode 100644 (file)
index 0000000..6a4bb30
--- /dev/null
+++ b/src/plugins/firewall.sml
@@ -0,0 +1,46 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006-2007, 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.
+ *)
+
+(* Firewall rule querying *)
+
+structure Firewall :> FIREWALL = struct
+
+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
+    in
+        loop []
+        before TextIO.closeIn inf
+    end handle IO.Io _ => []
+
+
+end

diff --git a/src/sources b/src/sources
index 20fa877..70b79da 100644 (file)
--- a/src/sources
+++ b/src/sources
@@ -101,6 +101,9 @@ plugins/trustedPath.sml
 plugins/socketPerm.sig
 plugins/socketPerm.sml
 
 plugins/socketPerm.sig
 plugins/socketPerm.sml
 

+plugins/firewall.sig
+plugins/firewall.sml
+

 mail/vmail.sig
 mail/vmail.sml
 
 mail/vmail.sig
 mail/vmail.sml