src/plugins/firewall.sml

(* HCoop Domtool (http://hcoop.sourceforge.net/)
 * Copyright (c) 2006-2007, Adam Chlipala
 * Copyright (c) 2011,2012,2013 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

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 loop parsedRules =
	    case TextIO.inputLine inf of
		NONE => parsedRules
	      | SOME line =>
		case String.tokens Char.isSpace line of
		    node :: uname :: rest =>
		    (case rest of
			"Client" :: ports :: hosts => loop ((User uname, FirewallNode node, Client (parsePorts ports, hosts)) :: parsedRules)
		      | "Server" :: ports :: hosts => loop ((User uname, FirewallNode node, Server (parsePorts ports, hosts)) :: parsedRules)
		      | ["ProxiedServer", ports] => loop ((User uname, FirewallNode node, ProxiedServer (parsePorts ports)) :: parsedRules)
		      | ["LocalServer", ports] => loop ((User uname, FirewallNode node, LocalServer (parsePorts ports)) :: parsedRules)
		      | _ => (print "Invalid config line\n"; loop parsedRules))
		  | _ => loop parsedRules
    in
	loop []
    end

fun query uname =
    (* completely broken *)
    let
	val rules = parseRules ()
    in
	(* map (fn (_, FirewallNode n, r) => (n, r)) (List.filter (fn (User u, _, _) => u = uname) rules) *)
	["broken"]
    end

fun formatPorts ports = "(" ^ String.concatWith " " (map Int.toString ports) ^ ")"
fun formatHosts hosts = "(" ^ String.concatWith " " hosts ^ ")"

fun formatOutputRule (Client (ports, hosts)) = "dport " ^ formatPorts ports ^ (case hosts of
										 [] => ""
									       | _ => " daddr " ^ formatHosts hosts) ^ " ACCEPT;"

fun formatInputRule (Server (ports, hosts)) = "dport " ^ formatPorts ports ^ (case hosts of
										  [] => ""
										| _ => " saddr " ^ formatHosts hosts) ^ " ACCEPT;"

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

	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)
	fun confLine_out (uname, rule) = confLine outputLines (uname, formatOutputRule rule)

	fun insertConfLine (uname, ruleNode, rule) =
	    case rule of
		Client (ports, hosts) => confLine_out (uname, rule)
	      | Server (ports, hosts) => confLine_in (uname, rule)
	      | LocalServer ports => (insertConfLine (uname, ruleNode, Client (ports, ["127.0.0.1/8"]));
				      insertConfLine (uname, ruleNode, Server (ports, ["127.0.0.1/8"])))
	      | 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 }


    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 nodeFermRules = generateNodeFermRules rules

	fun write_tcp_in_conf_preamble outf =
	    TextIO.output (outf, String.concat ["@def $WEBNODES = (",
						(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 (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 (users_tcp_in_conf, "proto tcp {\n");
		TextIO.output (users_tcp_in_conf, concat lines);
		TextIO.output (users_tcp_in_conf, "\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 (uname, lines) =
	    let
		val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
	    in
		TextIO.output (users_tcp_out_conf, "mod owner uid-owner " ^ (Int.toString uid)
						   ^ " { jump user_" ^ uname ^ "_tcp_out"
						   ^ "; DROP; }\n");

		TextIO.output (user_chains_conf, "chain user_" ^ uname ^ "_tcp_out"
						 ^ " proto tcp {\n");
		TextIO.output (user_chains_conf, concat lines);
		TextIO.output (user_chains_conf, "\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) (#output_rules nodeFermRules);
	StringMap.appi (writeUserInRules) (#input_rules nodeFermRules);

	TextIO.closeOut user_chains_conf;
	TextIO.closeOut users_tcp_out_conf;
	TextIO.closeOut users_tcp_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 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	structure StringMap = DataStructures.StringMap
	38
	39	fun parseRules () =
	40	let
	41	val inf = TextIO.openIn Config.Firewall.firewallRules
	42
	43	fun parsePorts ports =
	44	List.mapPartial Int.fromString (String.fields (fn ch => ch = #",") ports)
	45	(* Just drop bad ports for now *)
	46
	47	fun loop parsedRules =
	48	case TextIO.inputLine inf of
	49	NONE => parsedRules
	50	\| SOME line =>
	51	case String.tokens Char.isSpace line of
	52	node :: uname :: rest =>
	53	(case rest of
	54	"Client" :: ports :: hosts => loop ((User uname, FirewallNode node, Client (parsePorts ports, hosts)) :: parsedRules)
	55	\| "Server" :: ports :: hosts => loop ((User uname, FirewallNode node, Server (parsePorts ports, hosts)) :: parsedRules)
	56	\| ["ProxiedServer", ports] => loop ((User uname, FirewallNode node, ProxiedServer (parsePorts ports)) :: parsedRules)
	57	\| ["LocalServer", ports] => loop ((User uname, FirewallNode node, LocalServer (parsePorts ports)) :: parsedRules)
	58	\| _ => (print "Invalid config line\n"; loop parsedRules))
	59	\| _ => loop parsedRules
	60	in
	61	loop []
	62	end
	63
	64	fun query uname =
	65	(* completely broken *)
	66	let
	67	val rules = parseRules ()
	68	in
	69	(* map (fn (_, FirewallNode n, r) => (n, r)) (List.filter (fn (User u, _, _) => u = uname) rules) *)
	70	["broken"]
	71	end
	72
	73	fun formatPorts ports = "(" ^ String.concatWith " " (map Int.toString ports) ^ ")"
	74	fun formatHosts hosts = "(" ^ String.concatWith " " hosts ^ ")"
	75
	76	fun formatOutputRule (Client (ports, hosts)) = "dport " ^ formatPorts ports ^ (case hosts of
	77	[] => ""
	78	\| _ => " daddr " ^ formatHosts hosts) ^ " ACCEPT;"
	79
	80	fun formatInputRule (Server (ports, hosts)) = "dport " ^ formatPorts ports ^ (case hosts of
	81	[] => ""
	82	\| _ => " saddr " ^ formatHosts hosts) ^ " ACCEPT;"
	83
	84	type ferm_lines = { input_rules : (string list) DataStructures.StringMap.map,
	85	output_rules : (string list) DataStructures.StringMap.map }
	86
	87	fun generateNodeFermRules rules =
	88	let
	89	fun filter_node_rules rules =
	90	List.filter (fn (uname, FirewallNode node, rule) => node = Slave.hostname () orelse case rule of
	91	ProxiedServer _ => List.exists (fn (h,_) => h = Slave.hostname ()) Config.Apache.webNodes_all
	92	\| _ => false)
	93	rules
	94
	95	val inputLines = ref StringMap.empty
	96	val outputLines = ref StringMap.empty
	97
	98	fun confLine r (User uname, line) =
	99	let
	100	val line = "\t" ^ line ^ "\n"
	101	val lines = case StringMap.find (!r, uname) of
	102	NONE => []
	103	\| SOME lines => lines
	104	in
	105	r := StringMap.insert (!r, uname, line :: lines)
	106	end
	107
	108	fun confLine_in (uname, rule) = confLine inputLines (uname, formatInputRule rule)
	109	fun confLine_out (uname, rule) = confLine outputLines (uname, formatOutputRule rule)
	110
	111	fun insertConfLine (uname, ruleNode, rule) =
	112	case rule of
	113	Client (ports, hosts) => confLine_out (uname, rule)
	114	\| Server (ports, hosts) => confLine_in (uname, rule)
	115	\| LocalServer ports => (insertConfLine (uname, ruleNode, Client (ports, ["127.0.0.1/8"]));
	116	insertConfLine (uname, ruleNode, Server (ports, ["127.0.0.1/8"])))
	117	\| ProxiedServer ports => if (fn FirewallNode r => r) ruleNode = Slave.hostname () then
	118	(insertConfLine (uname, ruleNode, Server (ports, ["$WEBNODES"]));
	119	insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
	120	else (* we are a web server *)
	121	(insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode]));
	122	insertConfLine (User "www-data", ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
	123
	124	val _ = map insertConfLine (filter_node_rules rules)
	125	in
	126	{ input_rules = !inputLines,
	127	output_rules = !outputLines }
	128
	129
	130	end
	131
	132	fun generateFirewallConfig rules =
	133	(* rule generation must happen on the node (mandating the even
	134	service users be pts users would make it possible to do on the
	135	server, but that's not happening any time soon) *)
	136	let
	137	val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
	138	val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
	139	val user_chains_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/user_chains.conf")
	140
	141	val nodeFermRules = generateNodeFermRules rules
	142
	143	fun write_tcp_in_conf_preamble outf =
	144	TextIO.output (outf, String.concat ["@def $WEBNODES = (",
	145	(String.concatWith " " (List.map (fn (_, ip) => ip)
	146	(List.filter (fn (node, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
	147	Config.nodeIps))),
	148	");\n\n"])
	149
	150	fun writeUserInRules (uname, lines) =
	151	(* We can't match the user when listening; SELinux or
	152	similar would let us manage this with better
	153	granularity.*)
	154	let
	155	val _ = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
	156	in
	157	TextIO.output (users_tcp_in_conf, "proto tcp {\n");
	158	TextIO.output (users_tcp_in_conf, concat lines);
	159	TextIO.output (users_tcp_in_conf, "\n}\n\n")
	160	end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n" (* no sense in opening ports for bad users *)
	161
	162	fun writeUserOutRules (uname, lines) =
	163	let
	164	val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
	165	in
	166	TextIO.output (users_tcp_out_conf, "mod owner uid-owner " ^ (Int.toString uid)
	167	^ " { jump user_" ^ uname ^ "_tcp_out"
	168	^ "; DROP; }\n");
	169
	170	TextIO.output (user_chains_conf, "chain user_" ^ uname ^ "_tcp_out"
	171	^ " proto tcp {\n");
	172	TextIO.output (user_chains_conf, concat lines);
	173	TextIO.output (user_chains_conf, "\n}\n\n")
	174	end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n"
	175
	176	in
	177	write_tcp_in_conf_preamble (users_tcp_in_conf);
	178	StringMap.appi (writeUserOutRules) (#output_rules nodeFermRules);
	179	StringMap.appi (writeUserInRules) (#input_rules nodeFermRules);
	180
	181	TextIO.closeOut user_chains_conf;
	182	TextIO.closeOut users_tcp_out_conf;
	183	TextIO.closeOut users_tcp_in_conf;
	184
	185	true
	186	end
	187
	188	fun publishConfig _ =
	189	Slave.shell [Config.Firewall.reload]
	190	end