(* 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 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) => (case Domain.validDomain (substring (s, 0, size s - 2)) of (* delete trailing . from cname *) true => dnsExists dnsRR s (* dig will return CNAME, must recurse *) | false => true) (* maybe also double check ip? use size s - 1 if so! *) | (_, NONE) => false end fun filterHosts (hosts, ipv6) = List.filter (fn host => if (Domain.validIpv6 host orelse Domain.validIp host) then true else 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) = 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", ":::1"])); insertConfLine (uname, ruleNode, Server (ports, ["127.0.0.1/8", ":::1"]))) | ProxiedServer ports => if (fn FirewallNode r => r) ruleNode = Slave.hostname () then (insertConfLine (uname, ruleNode, Server (ports, ["$WEBNODES"])); insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode]))) else (* we are a web server *) (insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])); insertConfLine (User "www-data", ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode]))) 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 user_chains_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/user_chains.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 user_chains6_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/user_chains6.conf") val nodeFermRules = generateNodeFermRules rules fun write_tcp_in_conf_preamble outf = (* no ipv6 support yet, but use @ipfilter() in ferm to prepare *) TextIO.output (outf, String.concat ["@def $WEBNODES = @ipfilter((", (String.concatWith " " (List.map (fn (_, ip) => ip) (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 {\n"); TextIO.output (tcp_inf, concat lines); TextIO.output (tcp_inf, "\n}\n\n") end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n" (* no sense in opening ports for bad users *) fun writeUserOutRules tcp_outf chains_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) ^ " { jump user_" ^ uname ^ "_tcp_out" ^ "; DROP; }\n"); TextIO.output (chains_outf, "chain user_" ^ uname ^ "_tcp_out" ^ " proto tcp {\n"); TextIO.output (chains_outf, concat lines); TextIO.output (chains_outf, "\n}\n\n") end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n" in write_tcp_in_conf_preamble (users_tcp_in_conf); StringMap.appi (writeUserOutRules users_tcp_out_conf user_chains_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 user_chains6_conf) (#output6_rules nodeFermRules); StringMap.appi (writeUserInRules users_tcp6_in_conf) (#input6_rules nodeFermRules); TextIO.closeOut user_chains_conf; TextIO.closeOut users_tcp_out_conf; TextIO.closeOut users_tcp_in_conf; TextIO.closeOut user_chains6_conf; TextIO.closeOut users_tcp6_out_conf; TextIO.closeOut users_tcp6_in_conf; true end fun publishConfig _ = Slave.shell [Config.Firewall.reload] end