[hcoop/domtool2.git] / src / plugins / firewall.sml

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

fun formatInputRule (Server (ports, hosts)) = "dport " ^ formatPorts ports ^ (case hosts of 
										  [] => ""
										| _ => " saddr " ^ formatHosts hosts) ^ " 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

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