1 (* HCoop
Domtool (http
://hcoop
.sourceforge
.net
/)
2 * Copyright (c
) 2006-2007, Adam Chlipala
3 * Copyright (c
) 2011 Clinton Ebadi
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
.
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
.
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
.
20 (* Firewall management
*)
22 (* Contains portions from Fwtool
Copyright (C
) 2005 Adam Chlipala
, GPL v2 or later
*)
24 structure Firewall
:> FIREWALL
= struct
26 type firewall_rules
= { server_rules
: ((string * string) list DataStructures
.StringMap
.map
),
27 client_rules
: ((string * string) list DataStructures
.StringMap
.map
)}
29 structure StringMap
= DataStructures
.StringMap
33 val inf
= TextIO.openIn Config
.Firewall
.firewallRules
34 val out_lines
= ref StringMap
.empty
35 val in_lines
= ref StringMap
.empty
37 fun confLine
r (node
, uname
, line
) =
39 val line
= (node
, String.concat
["\t", line
, "\n"])
40 val lines
= case StringMap
.find (!r
, uname
) of
44 r
:= StringMap
.insert (!r
, uname
, line
:: lines
)
47 val confLine_in
= confLine in_lines
48 val confLine_out
= confLine out_lines
50 fun parsePorts ports
=
51 case String.fields (fn ch
=> ch
= #
",") ports
of
53 | pps
=> String.concat
["(", String.concatWith
" " pps
, ")"]
55 fun parseHosts addr hosts
=
58 |
[host
] => String.concat
[" ", addr
, " ", host
]
59 | _
=> String.concat
[" ", addr
, " (", String.concatWith
" " hosts
, ")"]
62 case TextIO.inputLine inf
of
65 case String.tokens
Char.isSpace line
of
66 node
:: uname
:: rest
=>
68 "Client" :: ports
:: hosts
=>
69 confLine_out (node
, uname
, String.concat
["dport ", parsePorts ports
, parseHosts
"daddr" hosts
, " ACCEPT;"])
70 |
"Server" :: ports
:: hosts
=>
71 confLine_in (node
, uname
, String.concat
["dport ", parsePorts ports
, parseHosts
"daddr" hosts
, " ACCEPT;"])
72 |
["LocalServer", ports
] =>
73 confLine_in (node
, uname
, String.concat
["saddr $WE dport ", parsePorts ports
, " ACCEPT;"])
74 | _
=> print
"Invalid config line\n";
79 {server_rules
= !in_lines
, client_rules
= !out_lines
}
84 val rules
= parseRules ()
86 List.map (fn (n
,r
) => r ^
" #host: " ^ n
) (getOpt (StringMap
.find (#server_rules rules
, uname
), []) @
getOpt (StringMap
.find (#client_rules rules
, uname
), []))
90 fun generateFirewallConfig
{server_rules
, client_rules
} =
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
) *)
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")
97 val users_conf
= TextIO.openOut (Config
.Firewall
.firewallDir ^
"/user_chains.conf")
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
)
105 fun write_user_tcp_conf (rules
, outf
, suffix
) =
106 StringMap
.appi (fn (uname
, rules
) =>
108 val uid
= SysWord
.toInt (Posix
.ProcEnv
.uidToWord (Posix
.SysDB
.Passwd
.uid (Posix
.SysDB
.getpwnam uname
)))
109 val lines
= filter_node_rules rules
111 TextIO.output (outf
, String.concat
112 ["mod owner uid-owner ",
118 (* Is there any point to splitting the rules like this?
*)
119 TextIO.output (users_conf
,
120 String.concat ("chain user_"
126 end handle OS
.SysErr _
=> print
"Invalid user in firewall config, skipping.\n")
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");
132 TextIO.closeOut users_conf
;
133 TextIO.closeOut users_tcp_out_conf
;
134 TextIO.closeOut users_tcp_in_conf
;
139 fun publishConfig _
=
140 Slave
.shell
[Config
.Firewall
.reload
]