(* HCoop Domtool (http://hcoop.sourceforge.net/) * Copyright (c) 2006-2007, Adam Chlipala * Copyright (c) 2011,2012,2013,2014,2018 Clinton Ebadi * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) (* Firewall management *) (* Contains portions from Fwtool Copyright (C) 2005 Adam Chlipala, GPL v2 or later *) structure Firewall :> FIREWALL = struct datatype user = User of string datatype fwnode = FirewallNode of string datatype fwrule = Client of int list * string list | Server of int list * string list | ProxiedServer of int list | LocalServer of int list type firewall_rules = (user * fwnode * fwrule) list datatype fwip = FwIPv4 | FwIPv6 structure StringMap = DataStructures.StringMap fun parseRules () = let val inf = TextIO.openIn Config.Firewall.firewallRules fun parsePorts ports = List.mapPartial Int.fromString (String.fields (fn ch => ch = #",") ports) (* Just drop bad ports for now *) fun parseNodes nodes = String.fields (fn ch => ch = #",") nodes fun loop parsedRules = case TextIO.inputLine inf of NONE => parsedRules | SOME line => case String.tokens Char.isSpace line of nodes :: uname :: rest => let val nodes = parseNodes nodes in case rest of "Client" :: ports :: hosts => loop (map (fn node => (User uname, FirewallNode node, Client (parsePorts ports, hosts))) nodes) @ parsedRules | "Server" :: ports :: hosts => loop (map (fn node => (User uname, FirewallNode node, Server (parsePorts ports, hosts))) nodes) @ parsedRules | ["ProxiedServer", ports] => loop (map (fn node => (User uname, FirewallNode node, ProxiedServer (parsePorts ports))) nodes) @ parsedRules | ["LocalServer", ports] => loop (map (fn node => (User uname, FirewallNode node, LocalServer (parsePorts ports))) nodes) @ parsedRules | _ => (print "Invalid config line\n"; loop parsedRules) end | _ => loop parsedRules in loop [] end fun formatQueryRule (Client (ports, hosts)) = "Client " ^ String.concatWith "," (map Int.toString ports) ^ " " ^ String.concatWith " " hosts | formatQueryRule (Server (ports, hosts)) = "Server " ^ String.concatWith "," (map Int.toString ports) ^ " " ^ String.concatWith " " hosts | formatQueryRule (ProxiedServer ports) = "ProxiedServer " ^ String.concatWith "," (map Int.toString ports) | formatQueryRule (LocalServer ports) = "LocalServer " ^ String.concatWith "," (map Int.toString ports) fun query (node, uname) = (* completely broken *) let val rules = parseRules () in map (fn (_, _, r) => formatQueryRule r) (List.filter (fn (User u, FirewallNode n, _) => u = uname andalso n = node) rules) end fun validIp (ip, ipv6) = (case ipv6 of FwIPv6 => Domain.validIpv6 ip | FwIPv4 => Domain.validIp ip) fun dnsExists dnsRR dnsRecord = let val dnsRR_string = case dnsRR of FwIPv6 => "AAAA" | FwIPv4 => "A" in (* timeout chosen arbitrarilty, shorter is better if it's reliable *) (* dig outputs true even if the lookup fails, but no output in short mode should work *) case Slave.runOutput (Config.Firewall.dig, ["+short", "+timeout=3", "-t", dnsRR_string, dnsRecord]) of (_, SOME s) => (validIp (List.last (String.tokens Char.isSpace s), dnsRR)) | (x, NONE) => false end fun fermVariable x = String.isPrefix "$" x fun filterHosts (hosts, ipv6) = List.filter (fn host => (fermVariable host orelse validIp (host, ipv6) orelse dnsExists ipv6 host)) hosts fun formatPorts ports = "(" ^ String.concatWith " " (map Int.toString ports) ^ ")" fun formatHosts (hosts, ipv6) = "(" ^ String.concatWith " " (filterHosts (hosts, ipv6)) ^ ")" fun formatOutputRule (Client (ports, hosts), ipv6) = "dport " ^ formatPorts ports ^ (case hosts of [] => "" | _ => " daddr " ^ formatHosts (hosts, ipv6)) ^ " ACCEPT;" | formatOutputRule _ = "" fun formatInputRule (Server (ports, hosts), ipv6) = "dport " ^ formatPorts ports ^ (case hosts of [] => "" | _ => " saddr " ^ formatHosts (hosts, ipv6)) ^ " ACCEPT;" | formatInputRule _ = "" type ferm_lines = { input_rules : (string list) DataStructures.StringMap.map, output_rules : (string list) DataStructures.StringMap.map } fun generateNodeFermRules rules = let fun filter_node_rules rules = List.filter (fn (uname, FirewallNode node, rule) => node = Slave.hostname () orelse case rule of ProxiedServer _ => List.exists (fn (h,_) => h = Slave.hostname ()) Config.Apache.webNodes_all | _ => false) rules val inputLines = ref StringMap.empty val outputLines = ref StringMap.empty val inputLines_v6 = ref StringMap.empty val outputLines_v6 = ref StringMap.empty fun confLine r (User uname, line) = let val line = "\t" ^ line ^ "\n" val lines = case StringMap.find (!r, uname) of NONE => [] | SOME lines => lines in r := StringMap.insert (!r, uname, line :: lines) end fun confLine_in (uname, rule) = confLine inputLines (uname, formatInputRule (rule, FwIPv4)) fun confLine_out (uname, rule) = confLine outputLines (uname, formatOutputRule (rule, FwIPv4)) fun confLine_in_v6 (uname, rule) = confLine inputLines_v6 (uname, formatInputRule (rule, FwIPv6)) fun confLine_out_v6 (uname, rule) = confLine outputLines_v6 (uname, formatOutputRule (rule, FwIPv6)) fun insertConfLine (uname, ruleNode, rule) = let val fwnode_domain = fn FirewallNode node => node ^ "." ^ Config.defaultDomain in case rule of Client (ports, hosts) => (confLine_out (uname, rule); confLine_out_v6 (uname, rule)) | Server (ports, hosts) => (confLine_in (uname, rule); confLine_in_v6 (uname, rule)) | LocalServer ports => (insertConfLine (uname, ruleNode, Client (ports, ["127.0.0.1/8"])); insertConfLine (uname, ruleNode, Server (ports, ["127.0.0.1/8"])); insertConfLine (uname, ruleNode, Client (ports, ["::1"])); insertConfLine (uname, ruleNode, Server (ports, ["::1"]))) | ProxiedServer ports => if (fn FirewallNode r => r) ruleNode = Slave.hostname () then (insertConfLine (uname, ruleNode, Server (ports, ["$WEBNODES"])); insertConfLine (uname, ruleNode, Client (ports, [fwnode_domain ruleNode]))) else (* we are a web server *) (insertConfLine (uname, ruleNode, Client (ports, [fwnode_domain ruleNode])); insertConfLine (User "www-data", ruleNode, Client (ports, [fwnode_domain ruleNode]))) end val _ = map insertConfLine (filter_node_rules rules) in { input_rules = !inputLines, output_rules = !outputLines, input6_rules = !inputLines_v6, output6_rules = !outputLines_v6 } end fun generateFirewallConfig rules = (* rule generation must happen on the node (mandating the even service users be pts users would make it possible to do on the server, but that's not happening any time soon) *) let val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf") val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf") val users_tcp6_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_out.conf") val users_tcp6_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_in.conf") val nodeFermRules = generateNodeFermRules rules fun write_tcp_in_conf_preamble outf = TextIO.output (outf, String.concat ["@def $WEBNODES = @ipfilter((", (String.concatWith " " (List.map (fn (_, ip, ipv6) => ip ^ " " ^ "[" ^ ipv6 ^ "]") (List.filter (fn (node, _, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin))) Config.nodeIps))), "));\n\n"]) fun writeUserInRules tcp_inf (uname, lines) = (* We can't match the user when listening; SELinux or similar would let us manage this with better granularity.*) let val _ = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname))) in TextIO.output (tcp_inf, "proto (tcp udp) mod comment comment \"user:" ^ uname ^ "\" {\n"); TextIO.output (tcp_inf, concat lines); TextIO.output (tcp_inf, "\n}\n\n") end handle OS.SysErr _ => print ("Invalid user " ^ uname ^ " in firewall config, skipping.\n") (* no sense in opening ports for bad users *) fun writeUserOutRules tcp_outf (uname, lines) = let val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname))) in TextIO.output (tcp_outf, "mod owner uid-owner " ^ (Int.toString uid) ^ " mod comment comment \"user:" ^ uname ^ "\" proto (tcp udp) {\n"); TextIO.output (tcp_outf, concat lines); TextIO.output (tcp_outf, "\nDROP;\n}\n\n") end handle OS.SysErr _ => print ("Invalid user " ^ uname ^ " in firewall config, skipping.\n") in write_tcp_in_conf_preamble (users_tcp_in_conf); StringMap.appi (writeUserOutRules users_tcp_out_conf) (#output_rules nodeFermRules); StringMap.appi (writeUserInRules users_tcp_in_conf) (#input_rules nodeFermRules); write_tcp_in_conf_preamble (users_tcp6_in_conf); StringMap.appi (writeUserOutRules users_tcp6_out_conf) (#output6_rules nodeFermRules); StringMap.appi (writeUserInRules users_tcp6_in_conf) (#input6_rules nodeFermRules); TextIO.closeOut users_tcp_out_conf; TextIO.closeOut users_tcp_in_conf; TextIO.closeOut users_tcp6_out_conf; TextIO.closeOut users_tcp6_in_conf; true end fun publishConfig _ = Slave.shell [Config.Firewall.reload] end