src/plugins/firewall.sml

   1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
   2  * Copyright (c) 2006-2007, Adam Chlipala
   3  * Copyright (c) 2011,2012,2013,2014 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 datatype user = User of string
  27
  28 datatype fwnode = FirewallNode of string
  29
  30 datatype fwrule = Client of int list * string list
  31                 | Server of int list * string list
  32                 | ProxiedServer of int list
  33                 | LocalServer of int list
  34
  35 type firewall_rules = (user * fwnode * fwrule) list
  36
  37 structure StringMap = DataStructures.StringMap
  38
  39 fun parseRules () =
  40     let
  41         val inf = TextIO.openIn Config.Firewall.firewallRules
  42
  43         fun parsePorts ports =
  44             List.mapPartial Int.fromString (String.fields (fn ch => ch = #",") ports)
  45             (* Just drop bad ports for now *)
  46
  47         fun loop parsedRules =
  48             case TextIO.inputLine inf of
  49                 NONE => parsedRules
  50               | SOME line =>
  51                 case String.tokens Char.isSpace line of
  52                     node :: uname :: rest =>
  53                     (case rest of
  54                         "Client" :: ports :: hosts => loop ((User uname, FirewallNode node, Client (parsePorts ports, hosts)) :: parsedRules)
  55                       | "Server" :: ports :: hosts => loop ((User uname, FirewallNode node, Server (parsePorts ports, hosts)) :: parsedRules)
  56                       | ["ProxiedServer", ports] => loop ((User uname, FirewallNode node, ProxiedServer (parsePorts ports)) :: parsedRules)
  57                       | ["LocalServer", ports] => loop ((User uname, FirewallNode node, LocalServer (parsePorts ports)) :: parsedRules)
  58                       | _ => (print "Invalid config line\n"; loop parsedRules))
  59                   | _ => loop parsedRules
  60     in
  61         loop []
  62     end
  63
  64 fun formatQueryRule (Client (ports, hosts)) =
  65     "Client " ^ String.concatWith "," (map Int.toString ports) ^ " " ^ String.concatWith " " hosts
  66   | formatQueryRule  (Server (ports, hosts)) =
  67     "Server " ^ String.concatWith "," (map Int.toString ports) ^ " " ^ String.concatWith " " hosts
  68   | formatQueryRule (ProxiedServer ports) =
  69     "ProxiedServer " ^ String.concatWith "," (map Int.toString ports)
  70   | formatQueryRule (LocalServer ports) =
  71     "LocalServer " ^ String.concatWith "," (map Int.toString ports)
  72
  73 fun query (node, uname) =
  74     (* completely broken *)
  75     let
  76         val rules = parseRules ()
  77     in
  78         map (fn (_, _, r) => formatQueryRule r)
  79             (List.filter (fn (User u, FirewallNode n, _) => u = uname andalso n = node) rules)
  80     end
  81
  82 fun formatPorts ports = "(" ^ String.concatWith " " (map Int.toString ports) ^ ")"
  83 fun formatHosts hosts = "(" ^ String.concatWith " " hosts ^ ")"
  84
  85 fun formatOutputRule (Client (ports, hosts)) = "dport " ^ formatPorts ports ^ (case hosts of
  86                                                                                  [] => ""
  87                                                                                | _ => " daddr " ^ formatHosts hosts) ^ " ACCEPT;"
  88   | formatOutputRule _ = ""
  89
  90 fun formatInputRule (Server (ports, hosts)) = "dport " ^ formatPorts ports ^ (case hosts of
  91                                                                                   [] => ""
  92                                                                                 | _ => " saddr " ^ formatHosts hosts) ^ " ACCEPT;"
  93   | formatInputRule _ = ""
  94
  95 type ferm_lines = { input_rules : (string list) DataStructures.StringMap.map,
  96                     output_rules : (string list) DataStructures.StringMap.map }
  97
  98 fun generateNodeFermRules rules  =
  99     let
 100         fun filter_node_rules rules =
 101             List.filter (fn (uname, FirewallNode node, rule) => node = Slave.hostname () orelse case rule of
 102                                                                                                     ProxiedServer _ => List.exists (fn (h,_) => h = Slave.hostname ()) Config.Apache.webNodes_all
 103                                                                                      | _ => false)
 104                         rules
 105
 106         val inputLines = ref StringMap.empty
 107         val outputLines = ref StringMap.empty
 108
 109         fun confLine r (User uname, line) =
 110             let
 111                 val line = "\t" ^ line ^ "\n"
 112                 val lines = case StringMap.find (!r, uname) of
 113                                 NONE => []
 114                               | SOME lines => lines
 115             in
 116                 r := StringMap.insert (!r, uname, line :: lines)
 117             end
 118
 119         fun confLine_in (uname, rule) = confLine inputLines (uname, formatInputRule rule)
 120         fun confLine_out (uname, rule) = confLine outputLines (uname, formatOutputRule rule)
 121
 122         fun insertConfLine (uname, ruleNode, rule) =
 123             case rule of
 124                 Client (ports, hosts) => confLine_out (uname, rule)
 125               | Server (ports, hosts) => confLine_in (uname, rule)
 126               | LocalServer ports => (insertConfLine (uname, ruleNode, Client (ports, ["127.0.0.1/8"]));
 127                                       insertConfLine (uname, ruleNode, Server (ports, ["127.0.0.1/8"])))
 128               | ProxiedServer ports => if (fn FirewallNode r => r) ruleNode = Slave.hostname () then
 129                                            (insertConfLine (uname, ruleNode, Server (ports, ["$WEBNODES"]));
 130                                             insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
 131                                        else (* we are a web server *)
 132                                            (insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode]));
 133                                             insertConfLine (User "www-data", ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
 134
 135         val _ = map insertConfLine (filter_node_rules rules)
 136     in
 137         { input_rules = !inputLines,
 138           output_rules = !outputLines }
 139
 140
 141     end
 142
 143 fun generateFirewallConfig rules =
 144     (* rule generation must happen on the node (mandating the even
 145        service users be pts users would make it possible to do on the
 146        server, but that's not happening any time soon) *)
 147     let
 148         val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
 149         val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
 150         val user_chains_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/user_chains.conf")
 151
 152         val nodeFermRules = generateNodeFermRules rules
 153
 154         fun write_tcp_in_conf_preamble outf =
 155             TextIO.output (outf, String.concat ["@def $WEBNODES = (",
 156                                                 (String.concatWith " " (List.map (fn (_, ip) => ip)
 157                                                                                  (List.filter (fn (node, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
 158                                                                                               Config.nodeIps))),
 159                                                 ");\n\n"])
 160
 161         fun writeUserInRules (uname, lines) =
 162             (* We can't match the user when listening; SELinux or
 163                similar would let us manage this with better
 164                granularity.*)
 165             let
 166                 val _ = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
 167             in
 168                 TextIO.output (users_tcp_in_conf, "proto tcp {\n");
 169                 TextIO.output (users_tcp_in_conf, concat lines);
 170                 TextIO.output (users_tcp_in_conf, "\n}\n\n")
 171             end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n" (* no sense in opening ports for bad users *)
 172
 173         fun writeUserOutRules (uname, lines) =
 174             let
 175                 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
 176             in
 177                 TextIO.output (users_tcp_out_conf, "mod owner uid-owner " ^ (Int.toString uid)
 178                                                    ^ " { jump user_" ^ uname ^ "_tcp_out"
 179                                                    ^ "; DROP; }\n");
 180
 181                 TextIO.output (user_chains_conf, "chain user_" ^ uname ^ "_tcp_out"
 182                                                  ^ " proto tcp {\n");
 183                 TextIO.output (user_chains_conf, concat lines);
 184                 TextIO.output (user_chains_conf, "\n}\n\n")
 185             end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n"
 186
 187     in
 188         write_tcp_in_conf_preamble (users_tcp_in_conf);
 189         StringMap.appi (writeUserOutRules) (#output_rules nodeFermRules);
 190         StringMap.appi (writeUserInRules) (#input_rules nodeFermRules);
 191
 192         TextIO.closeOut user_chains_conf;
 193         TextIO.closeOut users_tcp_out_conf;
 194         TextIO.closeOut users_tcp_in_conf;
 195
 196         true
 197     end
 198
 199 fun publishConfig _ =
 200     Slave.shell [Config.Firewall.reload]
 201 end