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,2018 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 datatype fwip = FwIPv4
  38               | FwIPv6
  39
  40 structure StringMap = DataStructures.StringMap
  41
  42 fun parseRules () =
  43     let
  44         val inf = TextIO.openIn Config.Firewall.firewallRules
  45
  46         fun parsePorts ports =
  47             List.mapPartial Int.fromString (String.fields (fn ch => ch = #",") ports)
  48             (* Just drop bad ports for now *)
  49
  50         fun parseNodes nodes = String.fields (fn ch => ch = #",") nodes
  51
  52         fun loop parsedRules =
  53             case TextIO.inputLine inf of
  54                 NONE => parsedRules
  55               | SOME line =>
  56                 case String.tokens Char.isSpace line of
  57                     nodes :: uname :: rest =>
  58                     let
  59                         val nodes = parseNodes nodes
  60                     in
  61                         case rest of
  62                             "Client" :: ports :: hosts => loop (map (fn node => (User uname, FirewallNode node, Client (parsePorts ports, hosts))) nodes) @ parsedRules
  63                           | "Server" :: ports :: hosts => loop (map (fn node => (User uname, FirewallNode node, Server (parsePorts ports, hosts))) nodes) @ parsedRules
  64                           | ["ProxiedServer", ports]   => loop (map (fn node => (User uname, FirewallNode node, ProxiedServer (parsePorts ports))) nodes) @ parsedRules
  65                           | ["LocalServer", ports]     => loop (map (fn node => (User uname, FirewallNode node, LocalServer (parsePorts ports))) nodes)   @ parsedRules
  66                           | _ => (print "Invalid config line\n"; loop parsedRules)
  67                     end
  68                   | _ => loop parsedRules
  69     in
  70         loop []
  71     end
  72
  73 fun formatQueryRule (Client (ports, hosts)) =
  74     "Client " ^ String.concatWith "," (map Int.toString ports) ^ " " ^ String.concatWith " " hosts
  75   | formatQueryRule  (Server (ports, hosts)) =
  76     "Server " ^ String.concatWith "," (map Int.toString ports) ^ " " ^ String.concatWith " " hosts
  77   | formatQueryRule (ProxiedServer ports) =
  78     "ProxiedServer " ^ String.concatWith "," (map Int.toString ports)
  79   | formatQueryRule (LocalServer ports) =
  80     "LocalServer " ^ String.concatWith "," (map Int.toString ports)
  81
  82 fun query (node, uname) =
  83     (* completely broken *)
  84     let
  85         val rules = parseRules ()
  86     in
  87         map (fn (_, _, r) => formatQueryRule r)
  88             (List.filter (fn (User u, FirewallNode n, _) => u = uname andalso n = node) rules)
  89     end
  90
  91 fun dnsExists dnsRR dnsRecord =
  92     let
  93         val dnsRR_string = case dnsRR of
  94                                FwIPv6 => "AAAA"
  95                              | FwIPv4 => "A"
  96     in
  97         (* timeout chosen arbitrarilty, shorter is better if it's reliable *)
  98         (* dig outputs true even if the lookup fails, but no output in short mode should work *)
  99         case Slave.runOutput (Config.Firewall.dig, ["+short", "+timeout=3", "-t", dnsRR_string, dnsRecord]) of
 100             (_, SOME s) => (case Domain.validDomain (substring (s, 0, size s - 2)) of (* delete trailing . from cname *)
 101                                 true => dnsExists dnsRR s (* dig will return CNAME, must recurse *)
 102                               | false => true) (* maybe also double check ip? use size s - 1 if so! *)
 103
 104           | (_, NONE) => false
 105     end
 106
 107 fun filterHosts (hosts, ipv6) =
 108     List.filter (fn host => if (Domain.validIpv6 host orelse Domain.validIp host)
 109                             then
 110                                 true
 111                             else
 112                                 dnsExists ipv6 host)
 113                 hosts
 114
 115
 116 fun formatPorts ports = "(" ^ String.concatWith " " (map Int.toString ports) ^ ")"
 117 fun formatHosts (hosts, ipv6) = "(" ^ String.concatWith " " (filterHosts (hosts, ipv6)) ^ ")"
 118
 119 fun formatOutputRule (Client (ports, hosts), ipv6) = "dport " ^ formatPorts ports ^ (case hosts of
 120                                                                                  [] => ""
 121                                                                                | _ => " daddr " ^ formatHosts (hosts, ipv6)) ^ " ACCEPT;"
 122   | formatOutputRule _ = ""
 123
 124 fun formatInputRule (Server (ports, hosts), ipv6) = "dport " ^ formatPorts ports ^ (case hosts of
 125                                                                                   [] => ""
 126                                                                                 | _ => " saddr " ^ formatHosts (hosts, ipv6)) ^ " ACCEPT;"
 127   | formatInputRule _ = ""
 128
 129 type ferm_lines = { input_rules : (string list) DataStructures.StringMap.map,
 130                     output_rules : (string list) DataStructures.StringMap.map }
 131
 132 fun generateNodeFermRules rules  =
 133     let
 134         fun filter_node_rules rules =
 135             List.filter (fn (uname, FirewallNode node, rule) => node = Slave.hostname () orelse case rule of
 136                                                                                                     ProxiedServer _ => List.exists (fn (h,_) => h = Slave.hostname ()) Config.Apache.webNodes_all
 137                                                                                      | _ => false)
 138                         rules
 139
 140         val inputLines = ref StringMap.empty
 141         val outputLines = ref StringMap.empty
 142         val inputLines_v6 = ref StringMap.empty
 143         val outputLines_v6 = ref StringMap.empty
 144
 145         fun confLine r (User uname, line) =
 146             let
 147                 val line = "\t" ^ line ^ "\n"
 148                 val lines = case StringMap.find (!r, uname) of
 149                                 NONE => []
 150                               | SOME lines => lines
 151             in
 152                 r := StringMap.insert (!r, uname, line :: lines)
 153             end
 154
 155         fun confLine_in (uname, rule) = confLine inputLines (uname, formatInputRule (rule, FwIPv4))
 156         fun confLine_out (uname, rule) = confLine outputLines (uname, formatOutputRule (rule, FwIPv4))
 157         fun confLine_in_v6 (uname, rule) = confLine inputLines_v6 (uname, formatInputRule (rule, FwIPv6))
 158         fun confLine_out_v6 (uname, rule) = confLine outputLines_v6 (uname, formatOutputRule (rule, FwIPv6))
 159
 160         fun insertConfLine (uname, ruleNode, rule) =
 161             case rule of
 162                 Client (ports, hosts) => (confLine_out (uname, rule); confLine_out_v6 (uname, rule))
 163               | Server (ports, hosts) => (confLine_in (uname, rule); confLine_in_v6 (uname, rule))
 164               | LocalServer ports => (insertConfLine (uname, ruleNode, Client (ports, ["127.0.0.1/8", ":::1"]));
 165                                       insertConfLine (uname, ruleNode, Server (ports, ["127.0.0.1/8", ":::1"])))
 166               | ProxiedServer ports => if (fn FirewallNode r => r) ruleNode = Slave.hostname () then
 167                                            (insertConfLine (uname, ruleNode, Server (ports, ["$WEBNODES"]));
 168                                             insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
 169                                        else (* we are a web server *)
 170                                            (insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode]));
 171                                             insertConfLine (User "www-data", ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
 172
 173         val _ = map insertConfLine (filter_node_rules rules)
 174     in
 175         { input_rules = !inputLines,
 176           output_rules = !outputLines,
 177           input6_rules = !inputLines_v6,
 178           output6_rules = !outputLines_v6 }
 179
 180
 181     end
 182
 183 fun generateFirewallConfig rules =
 184     (* rule generation must happen on the node (mandating the even
 185        service users be pts users would make it possible to do on the
 186        server, but that's not happening any time soon) *)
 187     let
 188         val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
 189         val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
 190         val user_chains_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/user_chains.conf")
 191
 192         val users_tcp6_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_out.conf")
 193         val users_tcp6_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_in.conf")
 194         val user_chains6_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/user_chains6.conf")
 195
 196         val nodeFermRules = generateNodeFermRules rules
 197
 198         fun write_tcp_in_conf_preamble outf =
 199             (* no ipv6 support yet, but use @ipfilter() in ferm to prepare *)
 200             TextIO.output (outf, String.concat ["@def $WEBNODES = @ipfilter((",
 201                                                 (String.concatWith " " (List.map (fn (_, ip) => ip)
 202                                                                                  (List.filter (fn (node, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
 203                                                                                               Config.nodeIps))),
 204                                                 "));\n\n"])
 205
 206         fun writeUserInRules tcp_inf (uname, lines) =
 207             (* We can't match the user when listening; SELinux or
 208                similar would let us manage this with better
 209                granularity.*)
 210             let
 211                 val _ = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
 212             in
 213                 TextIO.output (tcp_inf, "proto tcp {\n");
 214                 TextIO.output (tcp_inf, concat lines);
 215                 TextIO.output (tcp_inf, "\n}\n\n")
 216             end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n" (* no sense in opening ports for bad users *)
 217
 218         fun writeUserOutRules tcp_outf chains_outf (uname, lines) =
 219             let
 220                 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
 221             in
 222                 TextIO.output (tcp_outf, "mod owner uid-owner " ^ (Int.toString uid)
 223                                                    ^ " { jump user_" ^ uname ^ "_tcp_out"
 224                                                    ^ "; DROP; }\n");
 225
 226                 TextIO.output (chains_outf, "chain user_" ^ uname ^ "_tcp_out"
 227                                                  ^ " proto tcp {\n");
 228                 TextIO.output (chains_outf, concat lines);
 229                 TextIO.output (chains_outf, "\n}\n\n")
 230             end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n"
 231
 232     in
 233         write_tcp_in_conf_preamble (users_tcp_in_conf);
 234         StringMap.appi (writeUserOutRules users_tcp_out_conf user_chains_conf) (#output_rules nodeFermRules);
 235         StringMap.appi (writeUserInRules users_tcp_in_conf) (#input_rules nodeFermRules);
 236
 237         write_tcp_in_conf_preamble (users_tcp6_in_conf);
 238         StringMap.appi (writeUserOutRules users_tcp6_out_conf user_chains6_conf) (#output6_rules nodeFermRules);
 239         StringMap.appi (writeUserInRules users_tcp6_in_conf) (#input6_rules nodeFermRules);
 240
 241         TextIO.closeOut user_chains_conf;
 242         TextIO.closeOut users_tcp_out_conf;
 243         TextIO.closeOut users_tcp_in_conf;
 244
 245         TextIO.closeOut user_chains6_conf;
 246         TextIO.closeOut users_tcp6_out_conf;
 247         TextIO.closeOut users_tcp6_in_conf;
 248
 249         true
 250     end
 251
 252 fun publishConfig _ =
 253     Slave.shell [Config.Firewall.reload]
 254 end