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