src/plugins/firewall.sml

(* 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 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 =
	    (* 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 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 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 {\n");
		TextIO.output (tcp_outf, concat lines);
		TextIO.output (tcp_outf, "\nDROP;\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) (#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
Commit	Line	Data
	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
	191	val users_tcp6_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_out.conf")
	192	val users_tcp6_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_in.conf")
	193
	194	val nodeFermRules = generateNodeFermRules rules
	195
	196	fun write_tcp_in_conf_preamble outf =
	197	(* no ipv6 support yet, but use @ipfilter() in ferm to prepare *)
	198	TextIO.output (outf, String.concat ["@def $WEBNODES = @ipfilter((",
	199	(String.concatWith " " (List.map (fn (_, ip) => ip)
	200	(List.filter (fn (node, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
	201	Config.nodeIps))),
	202	"));\n\n"])
	203
	204	fun writeUserInRules tcp_inf (uname, lines) =
	205	(* We can't match the user when listening; SELinux or
	206	similar would let us manage this with better
	207	granularity.*)
	208	let
	209	val _ = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
	210	in
	211	TextIO.output (tcp_inf, "proto tcp mod comment comment \"user:" ^ uname ^ "\" {\n");
	212	TextIO.output (tcp_inf, concat lines);
	213	TextIO.output (tcp_inf, "\n}\n\n")
	214	end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n" (* no sense in opening ports for bad users *)
	215
	216	fun writeUserOutRules tcp_outf (uname, lines) =
	217	let
	218	val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
	219	in
	220	TextIO.output (tcp_outf, "mod owner uid-owner " ^ (Int.toString uid) ^ " mod comment comment \"user:" ^ uname ^ "\" proto tcp {\n");
	221	TextIO.output (tcp_outf, concat lines);
	222	TextIO.output (tcp_outf, "\nDROP;\n}\n\n")
	223	end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n"
	224
	225	in
	226	write_tcp_in_conf_preamble (users_tcp_in_conf);
	227	StringMap.appi (writeUserOutRules users_tcp_out_conf) (#output_rules nodeFermRules);
	228	StringMap.appi (writeUserInRules users_tcp_in_conf) (#input_rules nodeFermRules);
	229
	230	write_tcp_in_conf_preamble (users_tcp6_in_conf);
	231	StringMap.appi (writeUserOutRules users_tcp6_out_conf) (#output6_rules nodeFermRules);
	232	StringMap.appi (writeUserInRules users_tcp6_in_conf) (#input6_rules nodeFermRules);
	233
	234	TextIO.closeOut users_tcp_out_conf;
	235	TextIO.closeOut users_tcp_in_conf;
	236
	237	TextIO.closeOut users_tcp6_out_conf;
	238	TextIO.closeOut users_tcp6_in_conf;
	239
	240	true
	241	end
	242
	243
	244	fun publishConfig _ =
	245	Slave.shell [Config.Firewall.reload]
	246	end