`fwtool' main

[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 list DataStructures.StringMap.map), 
			client_rules : (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 (uname, line) =
	    let
		val line = 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
		    uname :: rest =>
		    (case rest of
			"Client" :: ports :: hosts =>
			confLine_out (uname, String.concat ["dport ", parsePorts ports, parseHosts "daddr" hosts, " ACCEPT;"])
		      | "Server" :: ports :: hosts =>
			confLine_in (uname, String.concat ["dport ", parsePorts ports, parseHosts "daddr" hosts, " ACCEPT;"])
		      | ["LocalServer", ports] =>
			confLine_in (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
	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 (not really, but I'd rather
    avoid codifying that uids must be consistent between hosts) *) 
    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 ^ "/users.conf")

	fun write_user_tcp_conf (rules, outf, suffix) =
	    StringMap.appi (fn (uname, lines) =>
			       let
				   val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
			       in
				   TextIO.output (outf, String.concat
							    ["mod owner uid-owner ",
							     Int.toString uid,
							     " { goto user_",
							     uname,
							     suffix,
							     "; goto lreject; }\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