src/plugins/firewall.sml

   1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
   2  * Copyright (c) 2006-2007, Adam Chlipala
   3  * Copyright (c) 2011 Clinton Ebadi
   4  *
   5  * This program is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU General Public License
   7  * as published by the Free Software Foundation; either version 2
   8  * of the License, or (at your option) any later version.
   9  *
  10  * This program is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  * GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License
  16  * along with this program; if not, write to the Free Software
  17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  18  *)
  19
  20 (* Firewall management *)
  21
  22 (* Contains portions from Fwtool Copyright (C) 2005  Adam Chlipala, GPL v2 or later *)
  23
  24 structure Firewall :> FIREWALL = struct
  25
  26 type firewall_rules = { server_rules : ((string * string) list DataStructures.StringMap.map),
  27                         client_rules : ((string * string) list DataStructures.StringMap.map)}
  28
  29 structure StringMap = DataStructures.StringMap
  30
  31 fun parseRules () =
  32     let
  33         val inf = TextIO.openIn Config.Firewall.firewallRules
  34         val out_lines = ref StringMap.empty
  35         val in_lines = ref StringMap.empty
  36
  37         fun confLine r (node, uname, line) =
  38             let
  39                 val line = (node, String.concat ["\t", line, "\n"])
  40                 val lines = case StringMap.find (!r, uname) of
  41                                 NONE => []
  42                               | SOME lines => lines
  43             in
  44                 r := StringMap.insert (!r, uname, line :: lines)
  45             end
  46
  47         val confLine_in = confLine in_lines
  48         val confLine_out = confLine out_lines
  49
  50         fun parsePorts ports =
  51             case String.fields (fn ch => ch = #",") ports of
  52                 [pp] => pp
  53               | pps => String.concat ["(", String.concatWith " " pps, ")"]
  54
  55         fun parseHosts addr hosts =
  56             case hosts of
  57                 [] => ""
  58               | [host] => String.concat [" ", addr, " ", host]
  59               | _ => String.concat [" ", addr, " (", String.concatWith " " hosts, ")"]
  60
  61         fun loop () =
  62             case TextIO.inputLine inf of
  63                 NONE => ()
  64               | SOME line =>
  65                 case String.tokens Char.isSpace line of
  66                     node :: uname :: rest =>
  67                     (case rest of
  68                         "Client" :: ports :: hosts =>
  69                         confLine_out (node, uname, String.concat ["dport ", parsePorts ports, parseHosts "daddr" hosts, " ACCEPT;"])
  70                       | "Server" :: ports :: hosts =>
  71                         confLine_in (node, uname, String.concat ["dport ", parsePorts ports, parseHosts "saddr" hosts, " ACCEPT;"])
  72                       | ["ProxiedServer", ports] =>
  73                         (* should this also allow access on lo? fixme: open output ports on apache node *)
  74                         (confLine_in (node, uname, String.concat ["saddr $WEBNODES dport ", parsePorts ports, " ACCEPT;"]);
  75                          (* Warning: duplicates code of Client case *)
  76                          List.map (fn (node, _) => confLine_out (node, uname, String.concat ["dport ", parsePorts ports, Domain.nodeIp node, " ACCEPT;"] ))
  77                                   Config.Apache.webNodes_all; ())
  78                       | ["LocalServer", ports] =>
  79                         confLine_in (node, uname, String.concat ["saddr 127.0.0.1/8 dport ", parsePorts ports, " ACCEPT;"])
  80                       | _ => print "Invalid config line\n";
  81                      loop ())
  82                   | _ => loop ()
  83         val _ = loop ()
  84     in
  85         {server_rules = !in_lines, client_rules = !out_lines}
  86     end
  87
  88 fun query uname =
  89     let
  90         val rules = parseRules ()
  91     in
  92         List.map (fn (n,r) => r ^ " #host: " ^ n) (getOpt (StringMap.find (#server_rules rules, uname), []) @ getOpt (StringMap.find (#client_rules rules, uname), []))
  93     end
  94
  95
  96 fun generateFirewallConfig {server_rules, client_rules} =
  97     (* rule generation must happen on the node (mandating the even
  98        service users be pts users would make it possible to do on the
  99        server, but that's not happening any time soon) *)
 100     let
 101         val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
 102         val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
 103         val users_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/user_chains.conf")
 104
 105         fun filter_node_rules lines =
 106             (* filter out rules for other hosts here... really not
 107             ideal, but it should work for the time being *)
 108             List.map (fn (node, line) => line)
 109                      (List.filter (fn (node, line) => node = Slave.hostname ()) lines)
 110
 111         fun write_user_tcp_conf (rules, outf, suffix) =
 112             StringMap.appi (fn (uname, rules) =>
 113                                let
 114                                    val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
 115                                    val lines = filter_node_rules rules
 116                                in
 117                                    TextIO.output (outf, String.concat
 118                                                             ["mod owner uid-owner ",
 119                                                              Int.toString uid,
 120                                                              " { jump user_",
 121                                                              uname,
 122                                                              suffix,
 123                                                              "; DROP; }\n"]);
 124                                    (* Is there any point to splitting the rules like this? *)
 125                                    TextIO.output (users_conf,
 126                                                   String.concat ("chain user_"
 127                                                                  :: uname
 128                                                                  :: suffix
 129                                                                  :: " proto tcp {\n"
 130                                                                  :: lines
 131                                                                  @ ["}\n\n"]))
 132                                end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n")
 133                            rules
 134
 135         fun write_tcp_in_conf (rules, outf, suffix) =
 136             (* Lame hack: can't use iptables to restrict port binding,
 137                punting on SELinux &c for now and just opening every
 138                port any user requests *)
 139
 140             let
 141             in
 142                 TextIO.output (outf, String.concat ["@def $WEBNODES = (",
 143                                                     (String.concatWith " " (List.map (fn (_, ip) => ip)
 144                                                                                       (List.filter (fn (node, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
 145                                                                                                    Config.nodeIps))),
 146                                                     ");\n\n"]);
 147                 StringMap.appi (fn (uname, rules) =>
 148                                    let
 149                                        val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
 150                                        val lines = filter_node_rules rules
 151                                    in
 152                                        TextIO.output (outf,
 153                                                       String.concat ("proto tcp {\n"
 154                                                                      :: lines
 155                                                                      @ ["}\n\n"]))
 156                                    end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n")
 157                                rules
 158             end
 159     in
 160         write_tcp_in_conf (server_rules, users_tcp_in_conf, "_tcp_in");
 161         write_user_tcp_conf (client_rules, users_tcp_out_conf, "_tcp_out");
 162
 163         TextIO.closeOut users_conf;
 164         TextIO.closeOut users_tcp_out_conf;
 165         TextIO.closeOut users_tcp_in_conf;
 166
 167         true
 168     end
 169
 170 fun publishConfig _ =
 171     Slave.shell [Config.Firewall.reload]
 172 end