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 query uname =
  65     (* completely broken *)
  66     let
  67         val rules = parseRules ()
  68     in
  69         (* map (fn (_, FirewallNode n, r) => (n, r)) (List.filter (fn (User u, _, _) => u = uname) rules) *)
  70         ["broken"]
  71     end
  72
  73 fun formatPorts ports = "(" ^ String.concatWith " " (map Int.toString ports) ^ ")"
  74 fun formatHosts hosts = "(" ^ String.concatWith " " hosts ^ ")"
  75
  76 fun formatOutputRule (Client (ports, hosts)) = "dport " ^ formatPorts ports ^ (case hosts of
  77                                                                                  [] => ""
  78                                                                                | _ => " daddr " ^ formatHosts hosts) ^ " ACCEPT;"
  79
  80 fun formatInputRule (Server (ports, hosts)) = "dport " ^ formatPorts ports ^ (case hosts of
  81                                                                                   [] => ""
  82                                                                                 | _ => " saddr " ^ formatHosts hosts) ^ " ACCEPT;"
  83
  84 type ferm_lines = { input_rules : (string list) DataStructures.StringMap.map,
  85                     output_rules : (string list) DataStructures.StringMap.map }
  86
  87 fun generateNodeFermRules rules  =
  88     let
  89         fun filter_node_rules rules =
  90             List.filter (fn (uname, FirewallNode node, rule) => node = Slave.hostname () orelse case rule of
  91                                                                                                     ProxiedServer _ => List.exists (fn (h,_) => h = Slave.hostname ()) Config.Apache.webNodes_all
  92                                                                                      | _ => false)
  93                         rules
  94
  95         val inputLines = ref StringMap.empty
  96         val outputLines = ref StringMap.empty
  97
  98         fun confLine r (User uname, line) =
  99             let
 100                 val line = "\t" ^ line ^ "\n"
 101                 val lines = case StringMap.find (!r, uname) of
 102                                 NONE => []
 103                               | SOME lines => lines
 104             in
 105                 r := StringMap.insert (!r, uname, line :: lines)
 106             end
 107
 108         fun confLine_in (uname, rule) = confLine inputLines (uname, formatInputRule rule)
 109         fun confLine_out (uname, rule) = confLine outputLines (uname, formatOutputRule rule)
 110
 111         fun insertConfLine (uname, ruleNode, rule) =
 112             case rule of
 113                 Client (ports, hosts) => confLine_out (uname, rule)
 114               | Server (ports, hosts) => confLine_in (uname, rule)
 115               | LocalServer ports => (insertConfLine (uname, ruleNode, Client (ports, ["127.0.0.1/8"]));
 116                                       insertConfLine (uname, ruleNode, Server (ports, ["127.0.0.1/8"])))
 117               | ProxiedServer ports => if (fn FirewallNode r => r) ruleNode = Slave.hostname () then
 118                                            (insertConfLine (uname, ruleNode, Server (ports, ["$WEBNODES"]));
 119                                             insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
 120                                        else (* we are a web server *)
 121                                            (insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode]));
 122                                             insertConfLine (User "www-data", ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
 123
 124         val _ = map insertConfLine (filter_node_rules rules)
 125     in
 126         { input_rules = !inputLines,
 127           output_rules = !outputLines }
 128
 129
 130     end
 131
 132 fun generateFirewallConfig rules =
 133     (* rule generation must happen on the node (mandating the even
 134        service users be pts users would make it possible to do on the
 135        server, but that's not happening any time soon) *)
 136     let
 137         val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
 138         val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
 139         val user_chains_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/user_chains.conf")
 140
 141         val nodeFermRules = generateNodeFermRules rules
 142
 143         fun write_tcp_in_conf_preamble outf =
 144             TextIO.output (outf, String.concat ["@def $WEBNODES = (",
 145                                                 (String.concatWith " " (List.map (fn (_, ip) => ip)
 146                                                                                  (List.filter (fn (node, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
 147                                                                                               Config.nodeIps))),
 148                                                 ");\n\n"])
 149
 150         fun writeUserInRules (uname, lines) =
 151             (* We can't match the user when listening; SELinux or
 152                similar would let us manage this with better
 153                granularity.*)
 154             (TextIO.output (users_tcp_in_conf, "proto tcp {\n");
 155              TextIO.output (users_tcp_in_conf, concat lines);
 156              TextIO.output (users_tcp_in_conf, "\n}\n\n"))
 157
 158         fun writeUserOutRules (uname, lines) =
 159             let
 160                 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
 161             in
 162                 TextIO.output (users_tcp_out_conf, "mod owner uid-owner " ^ (Int.toString uid)
 163                                                    ^ " { jump user_" ^ uname ^ "_tcp_out"
 164                                                    ^ "; DROP; }\n");
 165
 166                 TextIO.output (user_chains_conf, "chain user_" ^ uname ^ "_tcp_out"
 167                                                  ^ " proto tcp {\n");
 168                 TextIO.output (user_chains_conf, concat lines);
 169                 TextIO.output (user_chains_conf, "\n}\n\n")
 170             end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n"
 171
 172     in
 173         write_tcp_in_conf_preamble (users_tcp_in_conf);
 174         StringMap.appi (writeUserOutRules) (#output_rules nodeFermRules);
 175         StringMap.appi (writeUserInRules) (#input_rules nodeFermRules);
 176
 177         TextIO.closeOut user_chains_conf;
 178         TextIO.closeOut users_tcp_out_conf;
 179         TextIO.closeOut users_tcp_in_conf;
 180
 181         true
 182     end
 183
 184 fun publishConfig _ =
 185     Slave.shell [Config.Firewall.reload]
 186 end