lenses/xinetd.aug

   1 (*
   2  * Module: Xinetd
   3  *   Parses xinetd configuration files
   4  *
   5  *  The structure of the lens and allowed attributes are ripped directly
   6  *  from xinetd's parser in xinetd/parse.c in xinetd's source checkout
   7  *  The downside of being so precise here is that if attributes are added
   8  *  they need to be added here, too. Writing a catchall entry, and getting
   9  *  to typecheck correctly would be a huge pain.
  10  *
  11  *  A really enterprising soul could tighten this down even further by
  12  *  restricting the acceptable values for each attribute.
  13  *
  14  * Author: David Lutterkort
  15  *)
  16
  17 module Xinetd =
  18   autoload xfm
  19
  20   let opt_spc = Util.del_opt_ws " "
  21
  22   let spc_equal = opt_spc . Sep.equal
  23
  24   let op = ([ label "add" . opt_spc . Util.del_str "+=" ]
  25            |[ label "del" . opt_spc . Util.del_str "-=" ]
  26            | spc_equal)
  27
  28   let value = store Rx.no_spaces
  29
  30   let indent = del Rx.opt_space "\t"
  31
  32   let attr_one (n:regexp) =
  33     Build.key_value n Sep.space_equal value
  34
  35   let attr_lst (n:regexp) (op_eq: lens) =
  36     let value_entry =  [ label "value" . value ] in
  37     Build.key_value n op_eq (opt_spc . Build.opt_list value_entry Sep.space)?
  38
  39   let attr_lst_eq (n:regexp) = attr_lst n spc_equal
  40
  41   let attr_lst_op (n:regexp) = attr_lst n op
  42
  43   (* Variable: service_attr
  44    *   Note:
  45    *      It is much faster to combine, for example, all the attr_one
  46    *      attributes into one regexp and pass that to a lens instead of
  47    *      using lens union (attr_one "a" | attr_one "b"|..) because the latter
  48    *      causes the type checker to work _very_ hard.
  49    *)
  50   let service_attr =
  51    attr_one (/socket_type|protocol|wait|user|group|server|instances/i
  52      |/rpc_version|rpc_number|id|port|nice|banner|bind|interface/i
  53      |/per_source|groups|banner_success|banner_fail|disable|max_load/i
  54      |/rlimit_as|rlimit_cpu|rlimit_data|rlimit_rss|rlimit_stack|v6only/i
  55      |/deny_time|umask|mdns|libwrap/i)
  56    (* redirect and cps aren't really lists, they take exactly two values *)
  57    |attr_lst_eq (/server_args|log_type|access_times|type|flags|redirect|cps/i)
  58    |attr_lst_op (/log_on_success|log_on_failure|only_from|no_access|env|passenv/i)
  59
  60   let default_attr =
  61     attr_one (/instances|banner|bind|interface|per_source|groups/i
  62       |/banner_success|banner_fail|max_load|v6only|umask|mdns/i)
  63    |attr_lst_eq /cps/i       (* really only two values, not a whole list *)
  64    |attr_lst_op (/log_type|log_on_success|log_on_failure|disabled/i
  65       |/no_access|only_from|passenv|enabled/i)
  66
  67   (* View: body
  68    *   Note:
  69    *       We would really like to say "the body can contain any of a list
  70    *       of a list of attributes, each of them at most once"; but that
  71    *       would require that we build a lens that matches the permutation
  72    *       of all attributes; with around 40 individual attributes, that's
  73    *       not computationally feasible, even if we didn't have to worry
  74    *       about how to write that down. The resulting regular expressions
  75    *       would simply be prohibitively large.
  76    *)
  77   let body (attr:lens) = Build.block_newlines_spc
  78                             (indent . attr . Util.eol)
  79                             Util.comment
  80
  81   (* View: includes
  82    *  Note:
  83    *   It would be nice if we could use the directories given in include and
  84    *   includedir directives to parse additional files instead of hardcoding
  85    *   all the places where xinetd config files can be found; but that is
  86    *   currently not possible, and implementing that has a good amount of
  87    *   hairy corner cases to consider.
  88    *)
  89   let includes =
  90      Build.key_value_line /include(dir)?/ Sep.space (store Rx.no_spaces)
  91
  92   let service =
  93      let sto_re = /[^# \t\n\/]+/ in
  94      Build.key_value_line "service" Sep.space (store sto_re . body service_attr)
  95
  96   let defaults = [ key "defaults" . body default_attr . Util.eol ]
  97
  98   let lns = ( Util.empty | Util.comment | includes | defaults | service )*
  99
 100   let filter = incl "/etc/xinetd.d/*"
 101              . incl "/etc/xinetd.conf"
 102              . Util.stdexcl
 103
 104   let xfm = transform lns filter
 105
 106 (* Local Variables: *)
 107 (* mode: caml       *)
 108 (* End:             *)