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