1 (* HCoop
Domtool (http
://hcoop
.sourceforge
.net
/)
2 * Copyright (c
) 2006-2007, Adam Chlipala
3 * Copyright (c
) 2011,2012,2013 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 structure StringMap
= DataStructures
.StringMap
41 val inf
= TextIO.openIn Config
.Firewall
.firewallRules
43 fun parsePorts ports
=
44 List.mapPartial
Int.fromString (String.fields (fn ch
=> ch
= #
",") ports
)
45 (* Just drop bad ports for now
*)
47 fun loop parsedRules
=
48 case TextIO.inputLine inf
of
51 case String.tokens
Char.isSpace line
of
52 node
:: uname
:: rest
=>
54 "Client" :: ports
:: hosts
=> loop ((User uname
, FirewallNode node
, Client (parsePorts ports
, hosts
)) :: parsedRules
)
55 |
"Server" :: ports
:: hosts
=> loop ((User uname
, FirewallNode node
, Server (parsePorts ports
, hosts
)) :: parsedRules
)
56 |
["ProxiedServer", ports
] => loop ((User uname
, FirewallNode node
, ProxiedServer (parsePorts ports
)) :: parsedRules
)
57 |
["LocalServer", ports
] => loop ((User uname
, FirewallNode node
, LocalServer (parsePorts ports
)) :: parsedRules
)
58 | _
=> (print
"Invalid config line\n"; loop parsedRules
))
59 | _
=> loop parsedRules
64 fun formatQueryRule (Client (ports
, hosts
)) =
65 "Client " ^
String.concatWith
"," (map
Int.toString ports
) ^
" " ^
String.concatWith
" " hosts
66 |
formatQueryRule (Server (ports
, hosts
)) =
67 "Server " ^
String.concatWith
"," (map
Int.toString ports
) ^
" " ^
String.concatWith
" " hosts
68 |
formatQueryRule (ProxiedServer ports
) =
69 "ProxiedServer " ^
String.concatWith
"," (map
Int.toString ports
)
70 |
formatQueryRule (LocalServer ports
) =
71 "LocalServer " ^
String.concatWith
"," (map
Int.toString ports
)
73 fun query (node
, uname
) =
74 (* completely broken
*)
76 val rules
= parseRules ()
78 map (fn (_
, _
, r
) => formatQueryRule r
)
79 (List.filter (fn (User u
, FirewallNode n
, _
) => u
= uname
andalso n
= node
) rules
)
82 fun formatPorts ports
= "(" ^
String.concatWith
" " (map
Int.toString ports
) ^
")"
83 fun formatHosts hosts
= "(" ^
String.concatWith
" " hosts ^
")"
85 fun formatOutputRule (Client (ports
, hosts
)) = "dport " ^ formatPorts ports ^
(case hosts
of
87 | _
=> " daddr " ^ formatHosts hosts
) ^
" ACCEPT;"
88 | formatOutputRule _
= ""
90 fun formatInputRule (Server (ports
, hosts
)) = "dport " ^ formatPorts ports ^
(case hosts
of
92 | _
=> " saddr " ^ formatHosts hosts
) ^
" ACCEPT;"
93 | formatInputRule _
= ""
95 type ferm_lines
= { input_rules
: (string list
) DataStructures
.StringMap
.map
,
96 output_rules
: (string list
) DataStructures
.StringMap
.map
}
98 fun generateNodeFermRules rules
=
100 fun filter_node_rules rules
=
101 List.filter (fn (uname
, FirewallNode node
, rule
) => node
= Slave
.hostname () orelse case rule
of
102 ProxiedServer _
=> List.exists (fn (h
,_
) => h
= Slave
.hostname ()) Config
.Apache
.webNodes_all
106 val inputLines
= ref StringMap
.empty
107 val outputLines
= ref StringMap
.empty
109 fun confLine
r (User uname
, line
) =
111 val line
= "\t" ^ line ^
"\n"
112 val lines
= case StringMap
.find (!r
, uname
) of
114 | SOME lines
=> lines
116 r
:= StringMap
.insert (!r
, uname
, line
:: lines
)
119 fun confLine_in (uname
, rule
) = confLine
inputLines (uname
, formatInputRule rule
)
120 fun confLine_out (uname
, rule
) = confLine
outputLines (uname
, formatOutputRule rule
)
122 fun insertConfLine (uname
, ruleNode
, rule
) =
124 Client (ports
, hosts
) => confLine_out (uname
, rule
)
125 |
Server (ports
, hosts
) => confLine_in (uname
, rule
)
126 | LocalServer ports
=> (insertConfLine (uname
, ruleNode
, Client (ports
, ["127.0.0.1/8"]));
127 insertConfLine (uname
, ruleNode
, Server (ports
, ["127.0.0.1/8"])))
128 | ProxiedServer ports
=> if (fn FirewallNode r
=> r
) ruleNode
= Slave
.hostname () then
129 (insertConfLine (uname
, ruleNode
, Server (ports
, ["$WEBNODES"]));
130 insertConfLine (uname
, ruleNode
, Client (ports
, [(fn FirewallNode r
=> r
) ruleNode
])))
131 else (* we are a web server
*)
132 (insertConfLine (uname
, ruleNode
, Client (ports
, [(fn FirewallNode r
=> r
) ruleNode
]));
133 insertConfLine (User
"www-data", ruleNode
, Client (ports
, [(fn FirewallNode r
=> r
) ruleNode
])))
135 val _
= map
insertConfLine (filter_node_rules rules
)
137 { input_rules
= !inputLines
,
138 output_rules
= !outputLines
}
143 fun generateFirewallConfig rules
=
144 (* rule generation must happen on the
node (mandating the even
145 service users be pts users would make it possible to
do on the
146 server
, but that
's not happening any time soon
) *)
148 val users_tcp_out_conf
= TextIO.openOut (Config
.Firewall
.firewallDir ^
"/users_tcp_out.conf")
149 val users_tcp_in_conf
= TextIO.openOut (Config
.Firewall
.firewallDir ^
"/users_tcp_in.conf")
150 val user_chains_conf
= TextIO.openOut (Config
.Firewall
.firewallDir ^
"/user_chains.conf")
152 val nodeFermRules
= generateNodeFermRules rules
154 fun write_tcp_in_conf_preamble outf
=
155 TextIO.output (outf
, String.concat
["@def $WEBNODES = (",
156 (String.concatWith
" " (List.map (fn (_
, ip
) => ip
)
157 (List.filter (fn (node
, _
) => List.exists (fn (n
) => n
= node
) (List.map (fn (node
, _
) => node
) (Config
.Apache
.webNodes_all @ Config
.Apache
.webNodes_admin
)))
161 fun writeUserInRules (uname
, lines
) =
162 (* We can
't match the user when listening
; SELinux or
163 similar would
let us manage this
with better
166 val _
= SysWord
.toInt (Posix
.ProcEnv
.uidToWord (Posix
.SysDB
.Passwd
.uid (Posix
.SysDB
.getpwnam uname
)))
168 TextIO.output (users_tcp_in_conf
, "proto tcp {\n");
169 TextIO.output (users_tcp_in_conf
, concat lines
);
170 TextIO.output (users_tcp_in_conf
, "\n}\n\n")
171 end handle OS
.SysErr _
=> print
"Invalid user in firewall config, skipping.\n" (* no sense
in opening ports for bad users
*)
173 fun writeUserOutRules (uname
, lines
) =
175 val uid
= SysWord
.toInt (Posix
.ProcEnv
.uidToWord (Posix
.SysDB
.Passwd
.uid (Posix
.SysDB
.getpwnam uname
)))
177 TextIO.output (users_tcp_out_conf
, "mod owner uid-owner " ^
(Int.toString uid
)
178 ^
" { jump user_" ^ uname ^
"_tcp_out"
181 TextIO.output (user_chains_conf
, "chain user_" ^ uname ^
"_tcp_out"
183 TextIO.output (user_chains_conf
, concat lines
);
184 TextIO.output (user_chains_conf
, "\n}\n\n")
185 end handle OS
.SysErr _
=> print
"Invalid user in firewall config, skipping.\n"
188 write_tcp_in_conf_preamble (users_tcp_in_conf
);
189 StringMap
.appi (writeUserOutRules
) (#output_rules nodeFermRules
);
190 StringMap
.appi (writeUserInRules
) (#input_rules nodeFermRules
);
192 TextIO.closeOut user_chains_conf
;
193 TextIO.closeOut users_tcp_out_conf
;
194 TextIO.closeOut users_tcp_in_conf
;
199 fun publishConfig _
=
200 Slave
.shell
[Config
.Firewall
.reload
]