Add navajos to domtool reset global

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

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

type firewall_rules = { server_rules : ((string * string) list DataStructures.StringMap.map), 
			client_rules : ((string * string) list DataStructures.StringMap.map)}

structure StringMap = DataStructures.StringMap

fun parseRules () =
    let
	val inf = TextIO.openIn Config.Firewall.firewallRules
	val out_lines = ref StringMap.empty
	val in_lines = ref StringMap.empty

	fun confLine r (node, uname, line) =
	    let
		val line = (node, String.concat ["\t", line, "\n"])
		val lines = case StringMap.find (!r, uname) of
				NONE => []
			      | SOME lines => lines
	    in
		r := StringMap.insert (!r, uname, line :: lines)
	    end

	val confLine_in = confLine in_lines
	val confLine_out = confLine out_lines

	fun parsePorts ports =
	    case String.fields (fn ch => ch = #",") ports of
		[pp] => pp
	      | pps => String.concat ["(", String.concatWith " " pps, ")"]
		       
	fun parseHosts addr hosts =
	    case hosts of
		[] => ""
	      | [host] => String.concat [" ", addr, " ", host]
	      | _ => String.concat [" ", addr, " (", String.concatWith " " hosts, ")"]

	fun loop () =
	    case TextIO.inputLine inf of
		NONE => ()
	      | SOME line =>
		case String.tokens Char.isSpace line of
		    node :: uname :: rest =>
		    (case rest of
			"Client" :: ports :: hosts =>
			confLine_out (node, uname, String.concat ["dport ", parsePorts ports, parseHosts "daddr" hosts, " ACCEPT;"])
		      | "Server" :: ports :: hosts =>
			confLine_in (node, uname, String.concat ["dport ", parsePorts ports, parseHosts "daddr" hosts, " ACCEPT;"])
		      | ["LocalServer", ports] =>
			confLine_in (node, uname, String.concat ["saddr $WE dport ", parsePorts ports, " ACCEPT;"])
		      | _ => print "Invalid config line\n";
		     loop ())
		  | _ => loop ()
	val _ = loop ()
    in
	{server_rules = !in_lines, client_rules = !out_lines}
    end

fun query uname =
    let
	val rules = parseRules ()
    in
	List.map (fn (n,r) => r ^ " #host: " ^ n) (getOpt (StringMap.find (#server_rules rules, uname), []) @ getOpt (StringMap.find (#client_rules rules, uname), []))
    end


fun generateFirewallConfig {server_rules, client_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_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/user_chains.conf")

	fun filter_node_rules lines =
	    (* filter out rules for other hosts here... really not
	    ideal, but it should work for the time being *)
	    List.map (fn (node, line) => line)
		     (List.filter (fn (node, line) => node = Slave.hostname ()) lines)

	fun write_user_tcp_conf (rules, outf, suffix) =
	    StringMap.appi (fn (uname, rules) =>
			       let
				   val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
				   val lines = filter_node_rules rules
			       in
				   TextIO.output (outf, String.concat
							    ["mod owner uid-owner ",
							     Int.toString uid,
							     " { goto user_",
							     uname,
							     suffix,
							     "; DROP; }\n"]);
				   (* Is there any point to splitting the rules like this? *)
				   TextIO.output (users_conf,
						  String.concat ("chain user_"
								 :: uname
								 :: suffix
								 :: " proto tcp {\n"
								 :: lines
								 @ ["}\n\n"]))
			       end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n")
			   rules
    in
	write_user_tcp_conf (server_rules, users_tcp_in_conf, "_tcp_in");
	write_user_tcp_conf (client_rules, users_tcp_out_conf, "_tcp_out");

	TextIO.closeOut users_conf;
	TextIO.closeOut users_tcp_out_conf;
	TextIO.closeOut users_tcp_in_conf;

	true
    end

fun publishConfig _ = 
    Slave.shell [Config.Firewall.reload]
end