lenses/dovecot.aug

   1 (*
   2 Module: Dovecot
   3   Parses dovecot configuration files.
   4
   5 Author: Serge Smetana <serge.smetana@gmail.com>
   6   Acunote http://www.acunote.com
   7   Pluron, Inc. http://pluron.com
   8
   9 About: License
  10   This file is licensed under the LGPL v2+.
  11
  12 About: Configuration files
  13   This lens applies to /etc/dovecot/dovecot.conf and files in
  14   /etc/dovecot/conf.d/. See <filter>.
  15
  16 About: Examples
  17   The <Test_Dovecot> file contains various examples and tests.
  18
  19 About: TODO
  20   Support for multiline values like queries in dict-sql.conf
  21 *)
  22
  23 module Dovecot =
  24
  25   autoload xfm
  26
  27 (******************************************************************
  28  * Group:                 USEFUL PRIMITIVES
  29  ******************************************************************)
  30
  31 (* View: indent *)
  32 let indent = Util.indent
  33
  34 (* View: eol *)
  35 let eol = Util.eol
  36
  37 (* View: empty
  38 Map empty lines. *)
  39 let empty = Util.empty
  40
  41 (* View: comment
  42 Map comments in "#comment" nodes. *)
  43 let comment = Util.comment
  44
  45 (* View: eq *)
  46 let eq = del /[ \t]*=/ " ="
  47
  48 (* Variable: any *)
  49 let any = Rx.no_spaces
  50
  51 (* Variable: value
  52 Match any value after " =".
  53 Should not start and end with spaces. May contain spaces inside *)
  54 let value = any . (Rx.space . any)*
  55
  56 (* View: command_start *)
  57 let command_start = Util.del_str "!"
  58
  59
  60 (******************************************************************
  61  * Group:                        ENTRIES
  62  ******************************************************************)
  63
  64 (* Variable: commands *)
  65 let commands = /include|include_try/
  66
  67 (* Variable: block_names *)
  68 let block_names = /dict|userdb|passdb|protocol|service|plugin|namespace|map|fields|unix_listener|fifo_listener|inet_listener/
  69
  70 (* Variable: keys
  71 Match any possible key except commands and block names. *)
  72 let keys = Rx.word - (commands | block_names)
  73
  74 (* View: entry
  75 Map simple "key = value" entries including "key =" entries with empty value. *)
  76 let entry = [ indent . key keys. eq . (Sep.opt_space . store value)? . eol ]
  77
  78 (* View: command
  79 Map commands started with "!". *)
  80 let command = [ command_start . key commands . Sep.space . store Rx.fspath . eol ]
  81
  82 (*
  83 View: dquote_spaces
  84   Make double quotes mandatory if value contains spaces,
  85   and optional if value doesn't contain spaces.
  86
  87 Based off Quote.dquote_spaces
  88
  89 Parameters:
  90   lns1:lens - the lens before
  91   lns2:lens - the lens after
  92 *)
  93 let dquote_spaces (lns1:lens) (lns2:lens) =
  94      (* bare has no spaces, and is optionally quoted *)
  95      let bare = Quote.do_dquote_opt (store /[^" \t\n]+/)
  96      (* quoted has at least one space, and must be quoted *)
  97   in let quoted = Quote.do_dquote (store /[^"\n]*[ \t]+[^"\n]*/)
  98   in [ lns1 . bare . lns2 ] | [ lns1 . quoted . lns2 ]
  99
 100 let mailbox = indent
 101             . dquote_spaces
 102                (key /mailbox/ . Sep.space)
 103                (Build.block_newlines_spc entry comment . eol)
 104
 105 let block_ldelim_newlines_re = /[ \t]+\{([ \t\n]*\n)?/
 106
 107 let block_newlines (entry:lens) (comment:lens) =
 108       let indent = del Rx.opt_space "\t"
 109    in del block_ldelim_newlines_re Build.block_ldelim_default
 110  . ((entry | comment) . (Util.empty | entry | comment)*)?
 111  . del Build.block_rdelim_newlines_re Build.block_rdelim_newlines_default
 112
 113 (* View: block
 114 Map block enclosed in brackets recursively.
 115 Block may be indented and have optional argument.
 116 Block body may have entries, comments, empty lines, and nested blocks recursively. *)
 117 let rec block = [ indent . key block_names . (Sep.space . Quote.do_dquote_opt (store /[\/A-Za-z0-9_-]+/))? . block_newlines (entry|block|mailbox) comment . eol ]
 118
 119
 120 (******************************************************************
 121  * Group:                   LENS AND FILTER
 122  ******************************************************************)
 123
 124 (* View: lns
 125 The Dovecot lens *)
 126 let lns = (comment|empty|entry|command|block)*
 127
 128 (* Variable: filter *)
 129 let filter = incl "/etc/dovecot/dovecot.conf"
 130            . (incl "/etc/dovecot/conf.d/*.conf")
 131            . Util.stdexcl
 132
 133 let xfm = transform lns filter