src/plugins/firewall.sml

   1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
   2  * Copyright (c) 2006-2007, Adam Chlipala
   3  * Copyright (c) 2011,2012,2013 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 datatype user = User of string
  27
  28 datatype fwnode = FirewallNode of string
  29
  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
  34
  35 type firewall_rules = (user * fwnode * fwrule) list
  36
  37 structure StringMap = DataStructures.StringMap
  38
  39 fun parseRules () =
  40     let
  41         val inf = TextIO.openIn Config.Firewall.firewallRules
  42
  43         fun parsePorts ports =
  44             List.mapPartial Int.fromString (String.fields (fn ch => ch = #",") ports)
  45             (* Just drop bad ports for now *)
  46
  47         fun loop parsedRules =
  48             case TextIO.inputLine inf of
  49                 NONE => parsedRules
  50               | SOME line =>
  51                 case String.tokens Char.isSpace line of
  52                     node :: uname :: rest =>
  53                     (case rest of
  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
  60     in
  61         loop []
  62     end
  63
  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)
  72
  73 fun query (node, uname) =
  74     (* completely broken *)
  75     let
  76         val rules = parseRules ()
  77     in
  78         map (fn (_, _, r) => formatQueryRule r)
  79             (List.filter (fn (User u, FirewallNode n, _) => u = uname andalso n = node) rules)
  80     end
  81
  82 fun formatPorts ports = "(" ^ String.concatWith " " (map Int.toString ports) ^ ")"
  83 fun formatHosts hosts = "(" ^ String.concatWith " " hosts ^ ")"
  84
  85 fun formatOutputRule (Client (ports, hosts)) = "dport " ^ formatPorts ports ^ (case hosts of
  86                                                                                  [] => ""
  87                                                                                | _ => " daddr " ^ formatHosts hosts) ^ " ACCEPT;"
  88
  89 fun formatInputRule (Server (ports, hosts)) = "dport " ^ formatPorts ports ^ (case hosts of
  90                                                                                   [] => ""
  91                                                                                 | _ => " saddr " ^ formatHosts hosts) ^ " ACCEPT;"
  92
  93 type ferm_lines = { input_rules : (string list) DataStructures.StringMap.map,
  94                     output_rules : (string list) DataStructures.StringMap.map }
  95
  96 fun generateNodeFermRules rules  =
  97     let
  98         fun filter_node_rules rules =
  99             List.filter (fn (uname, FirewallNode node, rule) => node = Slave.hostname () orelse case rule of
 100                                                                                                     ProxiedServer _ => List.exists (fn (h,_) => h = Slave.hostname ()) Config.Apache.webNodes_all
 101                                                                                      | _ => false)
 102                         rules
 103
 104         val inputLines = ref StringMap.empty
 105         val outputLines = ref StringMap.empty
 106
 107         fun confLine r (User uname, line) =
 108             let
 109                 val line = "\t" ^ line ^ "\n"
 110                 val lines = case StringMap.find (!r, uname) of
 111                                 NONE => []
 112                               | SOME lines => lines
 113             in
 114                 r := StringMap.insert (!r, uname, line :: lines)
 115             end
 116
 117         fun confLine_in (uname, rule) = confLine inputLines (uname, formatInputRule rule)
 118         fun confLine_out (uname, rule) = confLine outputLines (uname, formatOutputRule rule)
 119
 120         fun insertConfLine (uname, ruleNode, rule) =
 121             case rule of
 122                 Client (ports, hosts) => confLine_out (uname, rule)
 123               | Server (ports, hosts) => confLine_in (uname, rule)
 124               | LocalServer ports => (insertConfLine (uname, ruleNode, Client (ports, ["127.0.0.1/8"]));
 125                                       insertConfLine (uname, ruleNode, Server (ports, ["127.0.0.1/8"])))
 126               | ProxiedServer ports => if (fn FirewallNode r => r) ruleNode = Slave.hostname () then
 127                                            (insertConfLine (uname, ruleNode, Server (ports, ["$WEBNODES"]));
 128                                             insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
 129                                        else (* we are a web server *)
 130                                            (insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode]));
 131                                             insertConfLine (User "www-data", ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
 132
 133         val _ = map insertConfLine (filter_node_rules rules)
 134     in
 135         { input_rules = !inputLines,
 136           output_rules = !outputLines }
 137
 138
 139     end
 140
 141 fun generateFirewallConfig rules =
 142     (* rule generation must happen on the node (mandating the even
 143        service users be pts users would make it possible to do on the
 144        server, but that's not happening any time soon) *)
 145     let
 146         val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
 147         val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
 148         val user_chains_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/user_chains.conf")
 149
 150         val nodeFermRules = generateNodeFermRules rules
 151
 152         fun write_tcp_in_conf_preamble outf =
 153             TextIO.output (outf, String.concat ["@def $WEBNODES = (",
 154                                                 (String.concatWith " " (List.map (fn (_, ip) => ip)
 155                                                                                  (List.filter (fn (node, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
 156                                                                                               Config.nodeIps))),
 157                                                 ");\n\n"])
 158
 159         fun writeUserInRules (uname, lines) =
 160             (* We can't match the user when listening; SELinux or
 161                similar would let us manage this with better
 162                granularity.*)
 163             let
 164                 val _ = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
 165             in
 166                 TextIO.output (users_tcp_in_conf, "proto tcp {\n");
 167                 TextIO.output (users_tcp_in_conf, concat lines);
 168                 TextIO.output (users_tcp_in_conf, "\n}\n\n")
 169             end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n" (* no sense in opening ports for bad users *)
 170
 171         fun writeUserOutRules (uname, lines) =
 172             let
 173                 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
 174             in
 175                 TextIO.output (users_tcp_out_conf, "mod owner uid-owner " ^ (Int.toString uid)
 176                                                    ^ " { jump user_" ^ uname ^ "_tcp_out"
 177                                                    ^ "; DROP; }\n");
 178
 179                 TextIO.output (user_chains_conf, "chain user_" ^ uname ^ "_tcp_out"
 180                                                  ^ " proto tcp {\n");
 181                 TextIO.output (user_chains_conf, concat lines);
 182                 TextIO.output (user_chains_conf, "\n}\n\n")
 183             end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n"
 184
 185     in
 186         write_tcp_in_conf_preamble (users_tcp_in_conf);
 187         StringMap.appi (writeUserOutRules) (#output_rules nodeFermRules);
 188         StringMap.appi (writeUserInRules) (#input_rules nodeFermRules);
 189
 190         TextIO.closeOut user_chains_conf;
 191         TextIO.closeOut users_tcp_out_conf;
 192         TextIO.closeOut users_tcp_in_conf;
 193
 194         true
 195     end
 196
 197 fun publishConfig _ =
 198     Slave.shell [Config.Firewall.reload]
 199 end