Per-host firewall rules
[hcoop/domtool2.git] / src / plugins / firewall.sml
CommitLineData
f9548f16
AC
1(* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006-2007, Adam Chlipala
ec95f39f 3 * Copyright (c) 2011 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
24structure Firewall :> FIREWALL = struct
25
9a8de137
CE
26type firewall_rules = { server_rules : ((string * string) list DataStructures.StringMap.map),
27 client_rules : ((string * string) list DataStructures.StringMap.map)}
73b95423 28
ec95f39f
CE
29structure StringMap = DataStructures.StringMap
30
9a8de137 31fun parseRules () =
ec95f39f
CE
32 let
33 val inf = TextIO.openIn Config.Firewall.firewallRules
34 val out_lines = ref StringMap.empty
35 val in_lines = ref StringMap.empty
36
9a8de137 37 fun confLine r (node, uname, line) =
ec95f39f 38 let
9a8de137 39 val line = (node, String.concat ["\t", line, "\n"])
ec95f39f
CE
40 val lines = case StringMap.find (!r, uname) of
41 NONE => []
42 | SOME lines => lines
43 in
44 r := StringMap.insert (!r, uname, line :: lines)
45 end
46
47 val confLine_in = confLine in_lines
48 val confLine_out = confLine out_lines
49
50 fun parsePorts ports =
51 case String.fields (fn ch => ch = #",") ports of
52 [pp] => pp
53 | pps => String.concat ["(", String.concatWith " " pps, ")"]
54
55 fun parseHosts addr hosts =
56 case hosts of
57 [] => ""
58 | [host] => String.concat [" ", addr, " ", host]
59 | _ => String.concat [" ", addr, " (", String.concatWith " " hosts, ")"]
60
61 fun loop () =
62 case TextIO.inputLine inf of
63 NONE => ()
64 | SOME line =>
65 case String.tokens Char.isSpace line of
9a8de137 66 node :: uname :: rest =>
ec95f39f
CE
67 (case rest of
68 "Client" :: ports :: hosts =>
9a8de137 69 confLine_out (node, uname, String.concat ["dport ", parsePorts ports, parseHosts "daddr" hosts, " ACCEPT;"])
ec95f39f 70 | "Server" :: ports :: hosts =>
9a8de137 71 confLine_in (node, uname, String.concat ["dport ", parsePorts ports, parseHosts "daddr" hosts, " ACCEPT;"])
ec95f39f 72 | ["LocalServer", ports] =>
9a8de137 73 confLine_in (node, uname, String.concat ["saddr $WE dport ", parsePorts ports, " ACCEPT;"])
ec95f39f
CE
74 | _ => print "Invalid config line\n";
75 loop ())
76 | _ => loop ()
77 val _ = loop ()
78 in
79 {server_rules = !in_lines, client_rules = !out_lines}
80 end
81
f9548f16
AC
82fun query uname =
83 let
ec95f39f 84 val rules = parseRules ()
f9548f16 85 in
9a8de137 86 List.map (fn (n,r) => r ^ " #host: " ^ n) (getOpt (StringMap.find (#server_rules rules, uname), []) @ getOpt (StringMap.find (#client_rules rules, uname), []))
ec95f39f
CE
87 end
88
f9548f16 89
73b95423 90fun generateFirewallConfig {server_rules, client_rules} =
9a8de137
CE
91 (* rule generation must happen on the node (mandating the even
92 service users be pts users would make it possible to do on the
93 server, but that's not happening any time soon) *)
ec95f39f 94 let
ec95f39f
CE
95 val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
96 val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
9a8de137
CE
97 val users_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/user_chains.conf")
98
99 fun filter_node_rules lines =
100 (* filter out rules for other hosts here... really not
101 ideal, but it should work for the time being *)
102 List.map (fn (node, line) => line)
103 (List.filter (fn (node, line) => node = Slave.hostname ()) lines)
ec95f39f
CE
104
105 fun write_user_tcp_conf (rules, outf, suffix) =
9a8de137 106 StringMap.appi (fn (uname, rules) =>
ec95f39f
CE
107 let
108 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
9a8de137 109 val lines = filter_node_rules rules
ec95f39f
CE
110 in
111 TextIO.output (outf, String.concat
112 ["mod owner uid-owner ",
113 Int.toString uid,
114 " { goto user_",
115 uname,
116 suffix,
9a8de137 117 "; DROP; }\n"]);
ec95f39f
CE
118 (* Is there any point to splitting the rules like this? *)
119 TextIO.output (users_conf,
120 String.concat ("chain user_"
121 :: uname
122 :: suffix
123 :: " proto tcp {\n"
124 :: lines
125 @ ["}\n\n"]))
126 end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n")
127 rules
128 in
129 write_user_tcp_conf (server_rules, users_tcp_in_conf, "_tcp_in");
130 write_user_tcp_conf (client_rules, users_tcp_out_conf, "_tcp_out");
f9548f16 131
ec95f39f
CE
132 TextIO.closeOut users_conf;
133 TextIO.closeOut users_tcp_out_conf;
73b95423
CE
134 TextIO.closeOut users_tcp_in_conf;
135
136 true
ec95f39f 137 end
73b95423
CE
138
139fun publishConfig _ =
140 Slave.shell [Config.Firewall.reload]
f9548f16 141end