1 (* HCoop
Domtool (http
://hcoop
.sourceforge
.net
/)
2 * Copyright (c
) 2006-2007, Adam Chlipala
3 * Copyright (c
) 2011,2012,2013,2014,2018 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 datatype user
= User
of string
28 datatype fwnode
= FirewallNode
of string
30 datatype fwrule
= Client
of int list
* string list
31 | Server
of int list
* string list
32 | ProxiedServer
of int list
33 | LocalServer
of int list
35 type firewall_rules
= (user
* fwnode
* fwrule
) list
37 datatype fwip
= FwIPv4
40 structure StringMap
= DataStructures
.StringMap
44 val inf
= TextIO.openIn Config
.Firewall
.firewallRules
46 fun parsePorts ports
=
47 List.mapPartial
Int.fromString (String.fields (fn ch
=> ch
= #
",") ports
)
48 (* Just drop bad ports for now
*)
50 fun parseNodes nodes
= String.fields (fn ch
=> ch
= #
",") nodes
52 fun loop parsedRules
=
53 case TextIO.inputLine inf
of
56 case String.tokens
Char.isSpace line
of
57 nodes
:: uname
:: rest
=>
59 val nodes
= parseNodes nodes
62 "Client" :: ports
:: hosts
=> loop (map (fn node
=> (User uname
, FirewallNode node
, Client (parsePorts ports
, hosts
))) nodes
) @ parsedRules
63 |
"Server" :: ports
:: hosts
=> loop (map (fn node
=> (User uname
, FirewallNode node
, Server (parsePorts ports
, hosts
))) nodes
) @ parsedRules
64 |
["ProxiedServer", ports
] => loop (map (fn node
=> (User uname
, FirewallNode node
, ProxiedServer (parsePorts ports
))) nodes
) @ parsedRules
65 |
["LocalServer", ports
] => loop (map (fn node
=> (User uname
, FirewallNode node
, LocalServer (parsePorts ports
))) nodes
) @ parsedRules
66 | _
=> (print
"Invalid config line\n"; loop parsedRules
)
68 | _
=> loop parsedRules
73 fun formatQueryRule (Client (ports
, hosts
)) =
74 "Client " ^
String.concatWith
"," (map
Int.toString ports
) ^
" " ^
String.concatWith
" " hosts
75 |
formatQueryRule (Server (ports
, hosts
)) =
76 "Server " ^
String.concatWith
"," (map
Int.toString ports
) ^
" " ^
String.concatWith
" " hosts
77 |
formatQueryRule (ProxiedServer ports
) =
78 "ProxiedServer " ^
String.concatWith
"," (map
Int.toString ports
)
79 |
formatQueryRule (LocalServer ports
) =
80 "LocalServer " ^
String.concatWith
"," (map
Int.toString ports
)
82 fun query (node
, uname
) =
83 (* completely broken
*)
85 val rules
= parseRules ()
87 map (fn (_
, _
, r
) => formatQueryRule r
)
88 (List.filter (fn (User u
, FirewallNode n
, _
) => u
= uname
andalso n
= node
) rules
)
91 fun validIp (ip
, ipv6
) = (case ipv6
of FwIPv6
=> Domain
.validIpv6 ip
92 | FwIPv4
=> Domain
.validIp ip
)
94 fun dnsExists dnsRR dnsRecord
=
96 val dnsRR_string
= case dnsRR
of
100 (* timeout chosen arbitrarilty
, shorter is better
if it
's reliable
*)
101 (* dig outputs
true even
if the lookup fails
, but no output
in short mode should work
*)
102 case Slave
.runOutput (Config
.Firewall
.dig
, ["+short", "+timeout=3", "-t", dnsRR_string
, dnsRecord
]) of
103 (_
, SOME s
) => (validIp (List.last (String.tokens
Char.isSpace s
), dnsRR
))
107 fun fermVariable x
= String.isPrefix
"$" x
108 fun filterHosts (hosts
, ipv6
) =
109 List.filter (fn host
=> (fermVariable host
110 orelse validIp (host
, ipv6
)
111 orelse dnsExists ipv6 host
))
115 fun formatPorts ports
= "(" ^
String.concatWith
" " (map
Int.toString ports
) ^
")"
116 fun formatHosts (hosts
, ipv6
) = "(" ^
String.concatWith
" " (filterHosts (hosts
, ipv6
)) ^
")"
118 fun formatOutputRule (Client (ports
, hosts
), ipv6
) = "dport " ^ formatPorts ports ^
(case hosts
of
120 | _
=> " daddr " ^
formatHosts (hosts
, ipv6
)) ^
" ACCEPT;"
121 | formatOutputRule _
= ""
123 fun formatInputRule (Server (ports
, hosts
), ipv6
) = "dport " ^ formatPorts ports ^
(case hosts
of
125 | _
=> " saddr " ^
formatHosts (hosts
, ipv6
)) ^
" ACCEPT;"
126 | formatInputRule _
= ""
128 type ferm_lines
= { input_rules
: (string list
) DataStructures
.StringMap
.map
,
129 output_rules
: (string list
) DataStructures
.StringMap
.map
}
131 fun generateNodeFermRules rules
=
133 fun filter_node_rules rules
=
134 List.filter (fn (uname
, FirewallNode node
, rule
) => node
= Slave
.hostname () orelse case rule
of
135 ProxiedServer _
=> List.exists (fn (h
,_
) => h
= Slave
.hostname ()) Config
.Apache
.webNodes_all
139 val inputLines
= ref StringMap
.empty
140 val outputLines
= ref StringMap
.empty
141 val inputLines_v6
= ref StringMap
.empty
142 val outputLines_v6
= ref StringMap
.empty
144 fun confLine
r (User uname
, line
) =
146 val line
= "\t" ^ line ^
"\n"
147 val lines
= case StringMap
.find (!r
, uname
) of
149 | SOME lines
=> lines
151 r
:= StringMap
.insert (!r
, uname
, line
:: lines
)
154 fun confLine_in (uname
, rule
) = confLine
inputLines (uname
, formatInputRule (rule
, FwIPv4
))
155 fun confLine_out (uname
, rule
) = confLine
outputLines (uname
, formatOutputRule (rule
, FwIPv4
))
156 fun confLine_in_v6 (uname
, rule
) = confLine
inputLines_v6 (uname
, formatInputRule (rule
, FwIPv6
))
157 fun confLine_out_v6 (uname
, rule
) = confLine
outputLines_v6 (uname
, formatOutputRule (rule
, FwIPv6
))
159 fun insertConfLine (uname
, ruleNode
, rule
) =
161 val fwnode_domain
= fn FirewallNode node
=> node ^
"." ^ Config
.defaultDomain
164 Client (ports
, hosts
) => (confLine_out (uname
, rule
); confLine_out_v6 (uname
, rule
))
165 |
Server (ports
, hosts
) => (confLine_in (uname
, rule
); confLine_in_v6 (uname
, rule
))
166 | LocalServer ports
=> (insertConfLine (uname
, ruleNode
, Client (ports
, ["127.0.0.1/8"]));
167 insertConfLine (uname
, ruleNode
, Server (ports
, ["127.0.0.1/8"]));
168 insertConfLine (uname
, ruleNode
, Client (ports
, ["::1"]));
169 insertConfLine (uname
, ruleNode
, Server (ports
, ["::1"])))
170 | ProxiedServer ports
=> if (fn FirewallNode r
=> r
) ruleNode
= Slave
.hostname () then
171 (insertConfLine (uname
, ruleNode
, Server (ports
, ["$WEBNODES"]));
172 insertConfLine (uname
, ruleNode
, Client (ports
, [fwnode_domain ruleNode
])))
173 else (* we are a web server
*)
174 (insertConfLine (uname
, ruleNode
, Client (ports
, [fwnode_domain ruleNode
]));
175 insertConfLine (User
"www-data", ruleNode
, Client (ports
, [fwnode_domain ruleNode
])))
178 val _
= map
insertConfLine (filter_node_rules rules
)
180 { input_rules
= !inputLines
,
181 output_rules
= !outputLines
,
182 input6_rules
= !inputLines_v6
,
183 output6_rules
= !outputLines_v6
}
188 fun generateFirewallConfig rules
=
189 (* rule generation must happen on the
node (mandating the even
190 service users be pts users would make it possible to
do on the
191 server
, but that
's not happening any time soon
) *)
193 val users_tcp_out_conf
= TextIO.openOut (Config
.Firewall
.firewallDir ^
"/users_tcp_out.conf")
194 val users_tcp_in_conf
= TextIO.openOut (Config
.Firewall
.firewallDir ^
"/users_tcp_in.conf")
196 val users_tcp6_out_conf
= TextIO.openOut (Config
.Firewall
.firewallDir ^
"/users_tcp6_out.conf")
197 val users_tcp6_in_conf
= TextIO.openOut (Config
.Firewall
.firewallDir ^
"/users_tcp6_in.conf")
199 val nodeFermRules
= generateNodeFermRules rules
201 fun write_tcp_in_conf_preamble outf
=
202 TextIO.output (outf
, String.concat
["@def $WEBNODES = @ipfilter((",
203 (String.concatWith
" " (List.map (fn (_
, ip
, ipv6
) => ip ^
" " ^
"[" ^ ipv6 ^
"]")
204 (List.filter (fn (node
, _
, _
) => List.exists (fn (n
) => n
= node
) (List.map (fn (node
, _
) => node
) (Config
.Apache
.webNodes_all @ Config
.Apache
.webNodes_admin
)))
208 fun writeUserInRules
tcp_inf (uname
, lines
) =
209 (* We can
't match the user when listening
; SELinux or
210 similar would
let us manage this
with better
213 val _
= SysWord
.toInt (Posix
.ProcEnv
.uidToWord (Posix
.SysDB
.Passwd
.uid (Posix
.SysDB
.getpwnam uname
)))
215 TextIO.output (tcp_inf
, "proto (tcp udp) mod comment comment \"user:" ^ uname ^
"\" {\n");
216 TextIO.output (tcp_inf
, concat lines
);
217 TextIO.output (tcp_inf
, "\n}\n\n")
218 end handle OS
.SysErr _
=> print ("Invalid user " ^ uname ^
" in firewall config, skipping.\n") (* no sense
in opening ports for bad users
*)
220 fun writeUserOutRules
tcp_outf (uname
, lines
) =
222 val uid
= SysWord
.toInt (Posix
.ProcEnv
.uidToWord (Posix
.SysDB
.Passwd
.uid (Posix
.SysDB
.getpwnam uname
)))
224 TextIO.output (tcp_outf
, "mod owner uid-owner " ^
(Int.toString uid
) ^
" mod comment comment \"user:" ^ uname ^
"\" proto (tcp udp) {\n");
225 TextIO.output (tcp_outf
, concat lines
);
226 TextIO.output (tcp_outf
, "\nDROP;\n}\n\n")
227 end handle OS
.SysErr _
=> print ("Invalid user " ^ uname ^
" in firewall config, skipping.\n")
230 write_tcp_in_conf_preamble (users_tcp_in_conf
);
231 StringMap
.appi (writeUserOutRules users_tcp_out_conf
) (#output_rules nodeFermRules
);
232 StringMap
.appi (writeUserInRules users_tcp_in_conf
) (#input_rules nodeFermRules
);
234 write_tcp_in_conf_preamble (users_tcp6_in_conf
);
235 StringMap
.appi (writeUserOutRules users_tcp6_out_conf
) (#output6_rules nodeFermRules
);
236 StringMap
.appi (writeUserInRules users_tcp6_in_conf
) (#input6_rules nodeFermRules
);
238 TextIO.closeOut users_tcp_out_conf
;
239 TextIO.closeOut users_tcp_in_conf
;
241 TextIO.closeOut users_tcp6_out_conf
;
242 TextIO.closeOut users_tcp6_in_conf
;
248 fun publishConfig _
=
249 Slave
.shell
[Config
.Firewall
.reload
]