Firewall Regen Support
[hcoop/domtool2.git] / src / plugins / firewall.sml
1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006-2007, Adam Chlipala
3 * Copyright (c) 2011 Clinton Ebadi
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
20 (* Firewall management *)
21
22 (* Contains portions from Fwtool Copyright (C) 2005 Adam Chlipala, GPL v2 or later *)
23
24 structure Firewall :> FIREWALL = struct
25
26 type firewall_rules = { server_rules : (string list DataStructures.StringMap.map),
27 client_rules : (string list DataStructures.StringMap.map)}
28
29 structure StringMap = DataStructures.StringMap
30
31 fun parseRules _ =
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
37 fun confLine r (uname, line) =
38 let
39 val line = String.concat ["\t", line, "\n"]
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
66 uname :: rest =>
67 (case rest of
68 "Client" :: ports :: hosts =>
69 confLine_out (uname, String.concat ["dport ", parsePorts ports, parseHosts "daddr" hosts, " ACCEPT;"])
70 | "Server" :: ports :: hosts =>
71 confLine_in (uname, String.concat ["dport ", parsePorts ports, parseHosts "daddr" hosts, " ACCEPT;"])
72 | ["LocalServer", ports] =>
73 confLine_in (uname, String.concat ["saddr $WE dport ", parsePorts ports, " ACCEPT;"])
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
82 fun query uname =
83 let
84 val rules = parseRules ()
85 in
86 getOpt (StringMap.find (#server_rules rules, uname), []) @ getOpt (StringMap.find (#client_rules rules, uname), [])
87 end
88
89
90 fun generateFirewallConfig {server_rules, client_rules} =
91 (* rule generation must happen on the node (not really, but I'd rather
92 avoid codifying that uids must be consistent between hosts) *)
93 let
94 val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
95 val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
96 val users_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users.conf")
97
98 fun write_user_tcp_conf (rules, outf, suffix) =
99 StringMap.appi (fn (uname, lines) =>
100 let
101 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
102 in
103 TextIO.output (outf, String.concat
104 ["mod owner uid-owner ",
105 Int.toString uid,
106 " { goto user_",
107 uname,
108 suffix,
109 "; goto lreject; }\n"]);
110 (* Is there any point to splitting the rules like this? *)
111 TextIO.output (users_conf,
112 String.concat ("chain user_"
113 :: uname
114 :: suffix
115 :: " proto tcp {\n"
116 :: lines
117 @ ["}\n\n"]))
118 end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n")
119 rules
120 in
121 write_user_tcp_conf (server_rules, users_tcp_in_conf, "_tcp_in");
122 write_user_tcp_conf (client_rules, users_tcp_out_conf, "_tcp_out");
123
124 TextIO.closeOut users_conf;
125 TextIO.closeOut users_tcp_out_conf;
126 TextIO.closeOut users_tcp_in_conf;
127
128 true
129 end
130
131 fun publishConfig _ =
132 Slave.shell [Config.Firewall.reload]
133 end