lenses/syslog.aug

   1 (*
   2 Module: Syslog
   3   parses /etc/syslog.conf
   4
   5 Author: Mathieu Arnold <mat@FreeBSD.org>
   6
   7 About: Reference
   8   This lens tries to keep as close as possible to `man 5 resolv.conf` where possible.
   9   An online source being :
  10   http://www.freebsd.org/cgi/man.cgi?query=syslog.conf&sektion=5
  11
  12 About: Licence
  13   This file is licensed under the BSD License.
  14
  15 About: Lens Usage
  16    To be documented
  17
  18 About: Configuration files
  19   This lens applies to /etc/syslog.conf. See <filter>.
  20
  21  *)
  22 module Syslog =
  23   autoload xfm
  24
  25         (************************************************************************
  26          * Group:                 USEFUL PRIMITIVES
  27          *************************************************************************)
  28
  29         (* Group: Comments and empty lines *)
  30
  31         (* Variable: empty *)
  32         let empty      = Util.empty
  33         (* Variable: eol *)
  34         let eol        = Util.eol
  35         (* Variable: sep_tab *)
  36         let sep_tab    = del /([ \t]+|[ \t]*\\\\\n[ \t]*)/ "\t"
  37
  38         (* Variable: sep_tab_opt *)
  39         let sep_tab_opt = del /([ \t]*|[ \t]*\\\\\n[ \t]*)/ ""
  40
  41         (* View: comment
  42           Map comments into "#comment" nodes
  43           Can't use Util.comment as #+ and #! have a special meaning.
  44       However, '# !' and '# +' have no special meaning so they should be allowed.
  45      *)
  46
  47         let comment_gen (space:regexp) (sto:regexp) =
  48       [ label "#comment" . del (Rx.opt_space . "#" . space) "# "
  49         . store sto . eol ]
  50
  51         let comment =
  52                 let comment_withsign = comment_gen Rx.space /([!+-].*[^ \t\n]|[!+-])/
  53          in let comment_nosign = comment_gen Rx.opt_space /([^ \t\n+!-].*[^ \t\n]|[^ \t\n+!-])/
  54          in comment_withsign | comment_nosign
  55
  56         (* Group: single characters macro *)
  57
  58         (* Variable: comma
  59          Deletes a comma and default to it
  60          *)
  61         let comma      = sep_tab_opt . Util.del_str "," . sep_tab_opt
  62         (* Variable: colon
  63          Deletes a colon and default to it
  64          *)
  65         let colon      = sep_tab_opt . Util.del_str ":" . sep_tab_opt
  66         (* Variable: semicolon
  67          Deletes a semicolon and default to it
  68          *)
  69         let semicolon  = sep_tab_opt . Util.del_str ";" . sep_tab_opt
  70         (* Variable: dot
  71          Deletes a dot and default to it
  72          *)
  73         let dot        = Util.del_str "."
  74         (* Variable: pipe
  75          Deletes a pipe and default to it
  76          *)
  77         let pipe       = Util.del_str "|"
  78         (* Variable: plus
  79          Deletes a plus and default to it
  80          *)
  81         let plus       = Util.del_str "+"
  82         (* Variable: bang
  83          Deletes a bang and default to it
  84          *)
  85         let bang       = Util.del_str "!"
  86
  87         (* Variable: opt_hash
  88           deletes an optional # sign
  89           *)
  90         let opt_hash   = del /#?/ ""
  91         (* Variable: opt_plus
  92           deletes an optional + sign
  93           *)
  94         let opt_plus   = del /\+?/ ""
  95
  96         (* Group: various macros *)
  97
  98         (* Variable: word
  99           our version can't start with [_.-] because it would mess up the grammar
 100           *)
 101         let word      = /[A-Za-z0-9][A-Za-z0-9_.-]*/
 102
 103         (* Variable: comparison
 104           a comparison is an optional ! with optionally some of [<=>]
 105           *)
 106         let comparison = /(!|[<=>]+|![<=>]+)/
 107
 108         (* Variable: protocol
 109           @ means UDP
 110     @@ means TCP
 111           *)
 112         let protocol      = /@{1,2}/
 113
 114         (* Variable: token
 115           alphanum or "*"
 116           *)
 117         let token      = /([A-Za-z0-9]+|\*)/
 118
 119         (* Variable: file_r
 120          a file begins with a / and get almost anything else after
 121          *)
 122         let file_r     = /\/[^ \t\n;]+/
 123
 124         (* Variable: loghost_r
 125          Matches a hostname, that is labels speparated by dots, labels can't
 126          start or end with a "-".  maybe a bit too complicated for what it's worth *)
 127         let loghost_r = /[a-zA-Z0-9]([a-zA-Z0-9-]*[a-zA-Z0-9])?(\.[a-zA-Z0-9]([a-zA-Z0-9-]*[a-zA-Z0-9])?)*/ |
 128                     "[" . Rx.ipv6 . "]"
 129
 130         (* Group: Function *)
 131
 132         (* View: label_opt_list
 133          Uses Build.opt_list to generate a list of labels
 134
 135          Parameters:
 136           l:string - the label name
 137           r:lens   - the lens going after the label
 138           s:lens   - the separator lens passed to Build.opt_list
 139          *)
 140         let label_opt_list (l:string) (r:lens) (s:lens) = Build.opt_list [ label l . r ] s
 141
 142         (* View: label_opt_list_or
 143          Either label_opt_list matches something or it emits a single label
 144          with the "or" string.
 145
 146          Parameters:
 147           l:string  - the label name
 148           r:lens    - the lens going after the label
 149           s:lens    - the separator lens passed to Build.opt_list
 150           or:string - the string used if the label_opt_list does not match anything
 151          *)
 152         let label_opt_list_or (l:string) (r:lens) (s:lens) (or:string) =
 153           ( label_opt_list l r s | [ label l . store or ] )
 154
 155
 156         (************************************************************************
 157          * Group:                 LENSE DEFINITION
 158          *************************************************************************)
 159
 160         (* Group: selector *)
 161
 162         (* View: facilities
 163          a list of facilities, separated by commas
 164          *)
 165         let facilities = label_opt_list "facility" (store token) comma
 166
 167         (* View: selector
 168          a selector is a list of facilities, an optional comparison and a level
 169          *)
 170         let selector = facilities . dot .
 171                        [ label "comparison" . store comparison]? .
 172                        [ label "level" . store token ]
 173
 174         (* View: selectors
 175          a list of selectors, separated by semicolons
 176          *)
 177         let selectors = label_opt_list "selector" selector semicolon
 178
 179         (* Group: action *)
 180
 181         (* View: file
 182          a file may start with a "-" meaning it does not gets sync'ed everytime
 183          *)
 184         let file = [ Build.xchgs "-" "no_sync" ]? . [ label "file" . store file_r ]
 185
 186         (* View: loghost
 187          a loghost is an @  sign followed by the hostname and a possible port
 188          *)
 189         let loghost = [label "protocol" . store protocol] . [ label "hostname" . store loghost_r ] .
 190             (colon . [ label "port" . store /[0-9]+/ ] )?
 191
 192         (* View: users
 193          a list of users or a "*"
 194          *)
 195         let users = label_opt_list_or "user" (store word) comma "*"
 196
 197         (* View: logprogram
 198          a log program begins with a pipe
 199          *)
 200         let logprogram = pipe . [ label "program" . store /[^ \t\n][^\n]+[^ \t\n]/ ]
 201
 202         (* View: discard
 203          discards matching messages
 204          *)
 205         let discard = [ label "discard" . Util.del_str "~" ]
 206
 207         (* View: action
 208          an action is either a file, a host, users, a program, or discard
 209          *)
 210         let action = (file | loghost | users | logprogram | discard)
 211
 212         (* Group: Entry *)
 213
 214         (* View: entry
 215          an entry contains selectors and an action
 216          *)
 217         let entry = [ label "entry" .
 218             selectors . sep_tab .
 219             [ label "action" . action ] . eol ]
 220
 221         (* View: entries
 222          entries are either comments/empty lines or entries
 223          *)
 224         let entries = (empty | comment | entry )*
 225
 226         (* Group: Program matching *)
 227
 228         (* View: programs
 229          a list of programs
 230          *)
 231         let programs = label_opt_list_or "program" (store word) comma "*"
 232
 233         (* View: program
 234          a program begins with an optional hash, a bang, and an optional + or -
 235          *)
 236         let program = [ label "program" . opt_hash . bang .
 237               ( opt_plus | [ Build.xchgs "-" "reverse" ] ) .
 238               programs . eol .  entries ]
 239
 240         (* Group: Hostname maching *)
 241
 242         (* View: hostnames
 243          a list of hostnames
 244          *)
 245         let hostnames = label_opt_list_or "hostname" (store Rx.word) comma "*"
 246
 247         (* View: hostname
 248          a program begins with an optional hash, and a + or -
 249          *)
 250         let hostname = [ label "hostname" . opt_hash .
 251               ( plus | [ Build.xchgs "-" "reverse" ] ) .
 252               hostnames . eol .  entries ]
 253
 254         (* Group: Top of the tree *)
 255
 256     let include =
 257       [ key "include" . sep_tab . store file_r . eol ]
 258
 259         (* View: lns
 260          generic entries then programs or hostnames matching blocs
 261          *)
 262         let lns = entries . ( program | hostname | include )*
 263
 264         (* Variable: filter
 265          all you need is /etc/syslog.conf
 266          *)
 267         let filter = incl "/etc/syslog.conf"
 268
 269         let xfm = transform lns filter