(*

Module: Syslog

  parses /etc/syslog.conf

Author: Mathieu Arnold <mat@FreeBSD.org>

About: Reference

  This lens tries to keep as close as possible to `man 5 resolv.conf` where possible.

  An online source being :

  http://www.freebsd.org/cgi/man.cgi?query=syslog.conf&sektion=5

About: Licence

  This file is licensed under the BSD License.

About: Lens Usage

   To be documented

About: Configuration files

  This lens applies to /etc/syslog.conf. See <filter>.

 *)

module Syslog =

  autoload xfm

	(************************************************************************

	 * Group:                 USEFUL PRIMITIVES

	 *************************************************************************)

	(* Group: Comments and empty lines *)

	(* Variable: empty *)

        let empty      = Util.empty

	(* Variable: eol *)

        let eol        = Util.eol

	(* Variable: sep_tab *)

        let sep_tab    = del /([ \t]+|[ \t]*\\\\\n[ \t]*)/ "\t"

	(* Variable: sep_tab_opt *)

        let sep_tab_opt = del /([ \t]*|[ \t]*\\\\\n[ \t]*)/ ""

	(* View: comment

	  Map comments into "#comment" nodes

	  Can't use Util.comment as #+ and #! have a special meaning.

      However, '# !' and '# +' have no special meaning so they should be allowed.

     *)

	let comment_gen (space:regexp) (sto:regexp) =

      [ label "#comment" . del (Rx.opt_space . "#" . space) "# "

        . store sto . eol ]

	let comment =

		let comment_withsign = comment_gen Rx.space /([!+-].*[^ \t\n]|[!+-])/

	 in let comment_nosign = comment_gen Rx.opt_space /([^ \t\n+!-].*[^ \t\n]|[^ \t\n+!-])/

	 in comment_withsign | comment_nosign

	(* Group: single characters macro *)

        (* Variable: comma

	 Deletes a comma and default to it

	 *)

	let comma      = sep_tab_opt . Util.del_str "," . sep_tab_opt

	(* Variable: colon

	 Deletes a colon and default to it

	 *)

	let colon      = sep_tab_opt . Util.del_str ":" . sep_tab_opt

	(* Variable: semicolon

	 Deletes a semicolon and default to it

	 *)

	let semicolon  = sep_tab_opt . Util.del_str ";" . sep_tab_opt

	(* Variable: dot

	 Deletes a dot and default to it

	 *)

	let dot        = Util.del_str "."

	(* Variable: pipe

	 Deletes a pipe and default to it

	 *)

	let pipe       = Util.del_str "|"

	(* Variable: plus

	 Deletes a plus and default to it

	 *)

	let plus       = Util.del_str "+"

	(* Variable: bang

	 Deletes a bang and default to it

	 *)

	let bang       = Util.del_str "!"

	(* Variable: opt_hash

	  deletes an optional # sign

	  *)

	let opt_hash   = del /#?/ ""

	(* Variable: opt_plus

	  deletes an optional + sign

	  *)

	let opt_plus   = del /\+?/ ""

	(* Group: various macros *)

	(* Variable: word

	  our version can't start with [_.-] because it would mess up the grammar

	  *)

	let word      = /[A-Za-z0-9][A-Za-z0-9_.-]*/

	(* Variable: comparison

	  a comparison is an optional ! with optionally some of [<=>]

	  *)

        let comparison = /(!|[<=>]+|![<=>]+)/

	(* Variable: protocol

	  @ means UDP

    @@ means TCP

	  *)

        let protocol      = /@{1,2}/

	(* Variable: token

	  alphanum or "*"

	  *)

        let token      = /([A-Za-z0-9]+|\*)/

	(* Variable: file_r

	 a file begins with a / and get almost anything else after

	 *)

	let file_r     = /\/[^ \t\n;]+/

	(* Variable: loghost_r

	 Matches a hostname, that is labels speparated by dots, labels can't

	 start or end with a "-".  maybe a bit too complicated for what it's worth *)

	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])?)*/ |

                    "[" . Rx.ipv6 . "]"

	(* Group: Function *)

	(* View: label_opt_list

	 Uses Build.opt_list to generate a list of labels

	 Parameters:

	  l:string - the label name

	  r:lens   - the lens going after the label

	  s:lens   - the separator lens passed to Build.opt_list

	 *)

	let label_opt_list (l:string) (r:lens) (s:lens) = Build.opt_list [ label l . r ] s

	(* View: label_opt_list_or

	 Either label_opt_list matches something or it emits a single label

	 with the "or" string.

	 Parameters:

	  l:string  - the label name

	  r:lens    - the lens going after the label

	  s:lens    - the separator lens passed to Build.opt_list

	  or:string - the string used if the label_opt_list does not match anything

	 *)

	let label_opt_list_or (l:string) (r:lens) (s:lens) (or:string) =

	  ( label_opt_list l r s | [ label l . store or ] )

	(************************************************************************

	 * Group:                 LENSE DEFINITION

	 *************************************************************************)

	(* Group: selector *)

	(* View: facilities

	 a list of facilities, separated by commas

	 *)

	let facilities = label_opt_list "facility" (store token) comma

	(* View: selector

	 a selector is a list of facilities, an optional comparison and a level

	 *)

	let selector = facilities . dot .

                       [ label "comparison" . store comparison]? .

                       [ label "level" . store token ]

	(* View: selectors

	 a list of selectors, separated by semicolons

	 *)

        let selectors = label_opt_list "selector" selector semicolon

	(* Group: action *)

	(* View: file

	 a file may start with a "-" meaning it does not gets sync'ed everytime

	 *)

	let file = [ Build.xchgs "-" "no_sync" ]? . [ label "file" . store file_r ]

	(* View: loghost

	 a loghost is an @  sign followed by the hostname and a possible port

	 *)

	let loghost = [label "protocol" . store protocol] . [ label "hostname" . store loghost_r ] .

	    (colon . [ label "port" . store /[0-9]+/ ] )?

	(* View: users

	 a list of users or a "*"

	 *)

	let users = label_opt_list_or "user" (store word) comma "*"

	(* View: logprogram

	 a log program begins with a pipe

	 *)

	let logprogram = pipe . [ label "program" . store /[^ \t\n][^\n]+[^ \t\n]/ ]

	(* View: discard

	 discards matching messages

	 *)

	let discard = [ label "discard" . Util.del_str "~" ]

	(* View: action

	 an action is either a file, a host, users, a program, or discard

	 *)

        let action = (file | loghost | users | logprogram | discard)

	(* Group: Entry *)

	(* View: entry

	 an entry contains selectors and an action

	 *)

        let entry = [ label "entry" .

	    selectors . sep_tab .

	    [ label "action" . action ] . eol ]

	(* View: entries

	 entries are either comments/empty lines or entries

	 *)

	let entries = (empty | comment | entry )*

	(* Group: Program matching *)

	(* View: programs

	 a list of programs

	 *)

	let programs = label_opt_list_or "program" (store word) comma "*"

	(* View: program

	 a program begins with an optional hash, a bang, and an optional + or -

	 *)

	let program = [ label "program" . opt_hash . bang .

	      ( opt_plus | [ Build.xchgs "-" "reverse" ] ) .

	      programs . eol .  entries ]

	(* Group: Hostname maching *)

	(* View: hostnames

	 a list of hostnames

	 *)

	let hostnames = label_opt_list_or "hostname" (store Rx.word) comma "*"

	(* View: hostname

	 a program begins with an optional hash, and a + or -

	 *)

	let hostname = [ label "hostname" . opt_hash .

	      ( plus | [ Build.xchgs "-" "reverse" ] ) .

	      hostnames . eol .  entries ]

	(* Group: Top of the tree *)

    let include =

      [ key "include" . sep_tab . store file_r . eol ]

	(* View: lns

	 generic entries then programs or hostnames matching blocs

	 *)

        let lns = entries . ( program | hostname | include )*

	(* Variable: filter

	 all you need is /etc/syslog.conf

	 *)

        let filter = incl "/etc/syslog.conf"

        let xfm = transform lns filter