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 validIp (ip, ipv6) = (case ipv6 of FwIPv6 => Domain.validIpv6 ip
  92                                      | FwIPv4 =>  Domain.validIp ip)
  93
  94 fun dnsExists dnsRR dnsRecord =
  95     let
  96         val dnsRR_string = case dnsRR of
  97                                FwIPv6 => "AAAA"
  98                              | FwIPv4 => "A"
  99     in
 100         (* timeout chosen arbitrarilty, shorter is better if it's reliable *)
 101         (* dig outputs true even if the lookup fails, but no output in short mode should work *)
 102         case Slave.runOutput (Config.Firewall.dig, ["+short", "+timeout=3", "-t", dnsRR_string, dnsRecord]) of
 103             (_, SOME s) => (validIp (List.last (String.tokens Char.isSpace s), dnsRR))
 104           | (x, 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 validIp (host, ipv6)
 111                              orelse dnsExists ipv6 host))
 112                 hosts
 113
 114
 115 fun formatPorts ports = "(" ^ String.concatWith " " (map Int.toString ports) ^ ")"
 116 fun formatHosts (hosts, ipv6) = "(" ^ String.concatWith " " (filterHosts (hosts, ipv6)) ^ ")"
 117
 118 fun formatOutputRule (Client (ports, hosts), ipv6) = "dport " ^ formatPorts ports ^ (case hosts of
 119                                                                                  [] => ""
 120                                                                                | _ => " daddr " ^ formatHosts (hosts, ipv6)) ^ " ACCEPT;"
 121   | formatOutputRule _ = ""
 122
 123 fun formatInputRule (Server (ports, hosts), ipv6) = "dport " ^ formatPorts ports ^ (case hosts of
 124                                                                                   [] => ""
 125                                                                                 | _ => " saddr " ^ formatHosts (hosts, ipv6)) ^ " ACCEPT;"
 126   | formatInputRule _ = ""
 127
 128 type ferm_lines = { input_rules : (string list) DataStructures.StringMap.map,
 129                     output_rules : (string list) DataStructures.StringMap.map }
 130
 131 fun generateNodeFermRules rules  =
 132     let
 133         fun filter_node_rules rules =
 134             List.filter (fn (uname, FirewallNode node, rule) => node = Slave.hostname () orelse case rule of
 135                                                                                                     ProxiedServer _ => List.exists (fn (h,_) => h = Slave.hostname ()) Config.Apache.webNodes_all
 136                                                                                      | _ => false)
 137                         rules
 138
 139         val inputLines = ref StringMap.empty
 140         val outputLines = ref StringMap.empty
 141         val inputLines_v6 = ref StringMap.empty
 142         val outputLines_v6 = ref StringMap.empty
 143
 144         fun confLine r (User uname, line) =
 145             let
 146                 val line = "\t" ^ line ^ "\n"
 147                 val lines = case StringMap.find (!r, uname) of
 148                                 NONE => []
 149                               | SOME lines => lines
 150             in
 151                 r := StringMap.insert (!r, uname, line :: lines)
 152             end
 153
 154         fun confLine_in (uname, rule) = confLine inputLines (uname, formatInputRule (rule, FwIPv4))
 155         fun confLine_out (uname, rule) = confLine outputLines (uname, formatOutputRule (rule, FwIPv4))
 156         fun confLine_in_v6 (uname, rule) = confLine inputLines_v6 (uname, formatInputRule (rule, FwIPv6))
 157         fun confLine_out_v6 (uname, rule) = confLine outputLines_v6 (uname, formatOutputRule (rule, FwIPv6))
 158
 159         fun insertConfLine (uname, ruleNode, rule) =
 160             let
 161                 val fwnode_domain = fn FirewallNode node => node ^ "." ^ Config.defaultDomain
 162             in
 163                 case rule of
 164                     Client (ports, hosts) => (confLine_out (uname, rule); confLine_out_v6 (uname, rule))
 165                   | Server (ports, hosts) => (confLine_in (uname, rule); confLine_in_v6 (uname, rule))
 166                   | LocalServer ports => (insertConfLine (uname, ruleNode, Client (ports, ["127.0.0.1/8"]));
 167                                           insertConfLine (uname, ruleNode, Server (ports, ["127.0.0.1/8"]));
 168                                           insertConfLine (uname, ruleNode, Client (ports, ["::1"]));
 169                                           insertConfLine (uname, ruleNode, Server (ports, ["::1"])))
 170                   | ProxiedServer ports => if (fn FirewallNode r => r) ruleNode = Slave.hostname () then
 171                                                (insertConfLine (uname, ruleNode, Server (ports, ["$WEBNODES"]));
 172                                                 insertConfLine (uname, ruleNode, Client (ports, [fwnode_domain ruleNode])))
 173                                            else (* we are a web server *)
 174                                                (insertConfLine (uname, ruleNode, Client (ports, [fwnode_domain ruleNode]));
 175                                                 insertConfLine (User "www-data", ruleNode, Client (ports, [fwnode_domain ruleNode])))
 176             end
 177
 178         val _ = map insertConfLine (filter_node_rules rules)
 179     in
 180         { input_rules = !inputLines,
 181           output_rules = !outputLines,
 182           input6_rules = !inputLines_v6,
 183           output6_rules = !outputLines_v6 }
 184
 185
 186     end
 187
 188 fun generateFirewallConfig rules =
 189     (* rule generation must happen on the node (mandating the even
 190        service users be pts users would make it possible to do on the
 191        server, but that's not happening any time soon) *)
 192     let
 193         val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
 194         val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
 195
 196         val users_tcp6_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_out.conf")
 197         val users_tcp6_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_in.conf")
 198
 199         val nodeFermRules = generateNodeFermRules rules
 200
 201         fun write_tcp_in_conf_preamble outf =
 202             TextIO.output (outf, String.concat ["@def $WEBNODES = @ipfilter((",
 203                                                 (String.concatWith " " (List.map (fn (_, ip, ipv6) => ip ^ " " ^ "[" ^ ipv6 ^ "]")
 204                                                                                  (List.filter (fn (node, _, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
 205                                                                                               Config.nodeIps))),
 206                                                 "));\n\n"])
 207
 208         fun writeUserInRules tcp_inf (uname, lines) =
 209             (* We can't match the user when listening; SELinux or
 210                similar would let us manage this with better
 211                granularity.*)
 212             let
 213                 val _ = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
 214             in
 215                 TextIO.output (tcp_inf, "proto tcp mod comment comment \"user:" ^ uname ^ "\" {\n");
 216                 TextIO.output (tcp_inf, concat lines);
 217                 TextIO.output (tcp_inf, "\n}\n\n")
 218             end handle OS.SysErr _ => print ("Invalid user " ^ uname ^ " in firewall config, skipping.\n") (* no sense in opening ports for bad users *)
 219
 220         fun writeUserOutRules tcp_outf (uname, lines) =
 221             let
 222                 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
 223             in
 224                 TextIO.output (tcp_outf, "mod owner uid-owner " ^ (Int.toString uid) ^ " mod comment comment \"user:" ^ uname ^ "\" proto tcp {\n");
 225                 TextIO.output (tcp_outf, concat lines);
 226                 TextIO.output (tcp_outf, "\nDROP;\n}\n\n")
 227             end handle OS.SysErr _ => print ("Invalid user " ^ uname ^ " in firewall config, skipping.\n")
 228
 229     in
 230         write_tcp_in_conf_preamble (users_tcp_in_conf);
 231         StringMap.appi (writeUserOutRules users_tcp_out_conf) (#output_rules nodeFermRules);
 232         StringMap.appi (writeUserInRules users_tcp_in_conf) (#input_rules nodeFermRules);
 233
 234         write_tcp_in_conf_preamble (users_tcp6_in_conf);
 235         StringMap.appi (writeUserOutRules users_tcp6_out_conf) (#output6_rules nodeFermRules);
 236         StringMap.appi (writeUserInRules users_tcp6_in_conf) (#input6_rules nodeFermRules);
 237
 238         TextIO.closeOut users_tcp_out_conf;
 239         TextIO.closeOut users_tcp_in_conf;
 240
 241         TextIO.closeOut users_tcp6_out_conf;
 242         TextIO.closeOut users_tcp6_in_conf;
 243
 244         true
 245     end
 246
 247
 248 fun publishConfig _ =
 249     Slave.shell [Config.Firewall.reload]
 250 end