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 fermVariable x = String.isPrefix "$" x
 108 fun filterHosts (hosts, ipv6) =
 109     List.filter (fn host => fermVariable host
 110                             orelse (case ipv6 of FwIPv6 => Domain.validIpv6 host
 111                                                | FwIPv4 =>  Domain.validIp host)
 112                             orelse 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             let
 162                 val fwnode_domain = fn FirewallNode node => node ^ "." ^ Config.defaultDomain
 163             in
 164                 case rule of
 165                     Client (ports, hosts) => (confLine_out (uname, rule); confLine_out_v6 (uname, rule))
 166                   | Server (ports, hosts) => (confLine_in (uname, rule); confLine_in_v6 (uname, rule))
 167                   | LocalServer ports => (insertConfLine (uname, ruleNode, Client (ports, ["127.0.0.1/8"]));
 168                                           insertConfLine (uname, ruleNode, Server (ports, ["127.0.0.1/8"]));
 169                                           insertConfLine (uname, ruleNode, Client (ports, [":::1"]));
 170                                           insertConfLine (uname, ruleNode, Server (ports, [":::1"])))
 171                   | ProxiedServer ports => if (fn FirewallNode r => r) ruleNode = Slave.hostname () then
 172                                                (insertConfLine (uname, ruleNode, Server (ports, ["$WEBNODES"]));
 173                                                 insertConfLine (uname, ruleNode, Client (ports, [fwnode_domain ruleNode])))
 174                                            else (* we are a web server *)
 175                                                (insertConfLine (uname, ruleNode, Client (ports, [fwnode_domain ruleNode]));
 176                                                 insertConfLine (User "www-data", ruleNode, Client (ports, [fwnode_domain ruleNode])))
 177             end
 178
 179         val _ = map insertConfLine (filter_node_rules rules)
 180     in
 181         { input_rules = !inputLines,
 182           output_rules = !outputLines,
 183           input6_rules = !inputLines_v6,
 184           output6_rules = !outputLines_v6 }
 185
 186
 187     end
 188
 189 fun generateFirewallConfig rules =
 190     (* rule generation must happen on the node (mandating the even
 191        service users be pts users would make it possible to do on the
 192        server, but that's not happening any time soon) *)
 193     let
 194         val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
 195         val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
 196
 197         val users_tcp6_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_out.conf")
 198         val users_tcp6_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_in.conf")
 199
 200         val nodeFermRules = generateNodeFermRules rules
 201
 202         fun write_tcp_in_conf_preamble outf =
 203             (* no ipv6 support yet, but use @ipfilter() in ferm to prepare *)
 204             TextIO.output (outf, String.concat ["@def $WEBNODES = @ipfilter((",
 205                                                 (String.concatWith " " (List.map (fn (_, ip) => ip)
 206                                                                                  (List.filter (fn (node, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
 207                                                                                               Config.nodeIps))),
 208                                                 "));\n\n"])
 209
 210         fun writeUserInRules tcp_inf (uname, lines) =
 211             (* We can't match the user when listening; SELinux or
 212                similar would let us manage this with better
 213                granularity.*)
 214             let
 215                 val _ = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
 216             in
 217                 TextIO.output (tcp_inf, "proto tcp mod comment comment \"user:" ^ uname ^ "\" {\n");
 218                 TextIO.output (tcp_inf, concat lines);
 219                 TextIO.output (tcp_inf, "\n}\n\n")
 220             end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n" (* no sense in opening ports for bad users *)
 221
 222         fun writeUserOutRules tcp_outf (uname, lines) =
 223             let
 224                 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
 225             in
 226                 TextIO.output (tcp_outf, "mod owner uid-owner " ^ (Int.toString uid) ^ " mod comment comment \"user:" ^ uname ^ "\" proto tcp {\n");
 227                 TextIO.output (tcp_outf, concat lines);
 228                 TextIO.output (tcp_outf, "\nDROP;\n}\n\n")
 229             end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n"
 230
 231     in
 232         write_tcp_in_conf_preamble (users_tcp_in_conf);
 233         StringMap.appi (writeUserOutRules users_tcp_out_conf) (#output_rules nodeFermRules);
 234         StringMap.appi (writeUserInRules users_tcp_in_conf) (#input_rules nodeFermRules);
 235
 236         write_tcp_in_conf_preamble (users_tcp6_in_conf);
 237         StringMap.appi (writeUserOutRules users_tcp6_out_conf) (#output6_rules nodeFermRules);
 238         StringMap.appi (writeUserInRules users_tcp6_in_conf) (#input6_rules nodeFermRules);
 239
 240         TextIO.closeOut users_tcp_out_conf;
 241         TextIO.closeOut users_tcp_in_conf;
 242
 243         TextIO.closeOut users_tcp6_out_conf;
 244         TextIO.closeOut users_tcp6_in_conf;
 245
 246         true
 247     end
 248
 249
 250 fun publishConfig _ =
 251     Slave.shell [Config.Firewall.reload]
 252 end