Make filter a View in sudoers.aug to make it appear properly in doc

(*
Module: Sudoers
  Parses /etc/sudoers

Author: Raphael Pinson <raphink@gmail.com>

About: Reference
  This lens tries to keep as close as possible to `man sudoers` where possible.

For example, recursive definitions such as

     > Cmnd_Spec_List ::= Cmnd_Spec |
     >                    Cmnd_Spec ',' Cmnd_Spec_List

are replaced by

  >   let cmnd_spec_list = cmnd_spec . ( sep_com . cmnd_spec )*

since Augeas cannot deal with recursive definitions.
The definitions from `man sudoers` are put as commentaries for reference
throughout the file. More information can be found in the manual.

About: License
  This file is licensed under the LGPLv2+, like the rest of Augeas.

About: Lens Usage
  Sample usage of this lens in augtool

    * Set first Defaults to apply to the "LOCALNET" network alias
      > set /files/etc/sudoers/Defaults[1]/type "@LOCALNET"
    * List all user specifications applying explicitely to the "admin" Unix group
      > match /files/etc/sudoers/spec/user "%admin"
    * Remove the full 3rd user specification
      > rm /files/etc/sudoers/spec[3]

About: Configuration files
  This lens applies to /etc/sudoers. See <filter>.
*)

module Sudoers =
  autoload xfm

(************************************************************************
 * Group:                 USEFUL PRIMITIVES
 *************************************************************************)

(* Group: Generic primitives *)
(* Variable: eol *)
let eol       = del /[ \t]*\n/ "\n"

(* Variable: indent *)
let indent    = del /[ \t]*/ ""

(* Group: Separators *)

(* Variable: sep_spc *)
let sep_spc  = del /[ \t]+/ " "

(* Variable: sep_cont *)
let sep_cont = del /([ \t]+|[ \t]*\\\\\n[ \t]*)/ " "

(* Variable: sep_cont_opt *)
let sep_cont_opt = del /([ \t]*|[ \t]*\\\\\n[ \t]*)/ " "

(* Variable: sep_com *)
let sep_com  = sep_cont_opt . Util.del_str "," . sep_cont_opt

(* Variable: sep_eq *)
let sep_eq   = sep_cont_opt . Util.del_str "=" . sep_cont_opt

(* Variable: sep_col *)
let sep_col  = sep_cont_opt . Util.del_str ":" . sep_cont_opt

(* Variable: sep_dquote *)
let sep_dquote   = Util.del_str "\""

(* Group: Stores *)

(* Variable: sto_to_com_cmnd
sto_to_com_cmnd does not begin or end with a space *)
let sto_to_com_cmnd = store /([^,=:#() \t\n\\\\]([^,=:#()\n\\\\]|\\\\[=:,\\\\])*[^,=:#() \t\n\\\\])|[^,=:#() \t\n\\\\]/

(* Variable: sto_to_com

There could be a \ in the middle of a command *)
let sto_to_com      = store /([^,=:#() \t\n\\\\][^,=:#()\n]*[^,=:#() \t\n\\\\])|[^,=:#() \t\n\\\\]/

(* Variable: sto_to_com_host *)
let sto_to_com_host = store /[^,=:#() \t\n\\\\]+/

(* Variable: sto_to_com_user
Escaped spaces are allowed *)
let sto_to_com_user = store ( /([^,=:#() \t\n]([^,=:#() \t\n]|(\\\\[ \t]))*[^,=:#() \t\n])|[^,=:#() \t\n]/
                              - /(User|Runas|Host|Cmnd)_Alias|Defaults.*/ )

(* Variable: sto_to_com_col *)
let sto_to_com_col      = store /[^",=#() \t\n\\\\]+/ (* " relax emacs *)

(* Variable: sto_to_eq *)
let sto_to_eq  = store /[^,=:#() \t\n\\\\]+/

(* Variable: sto_to_spc *)
let sto_to_spc = store /[^", \t\n\\\\]+|"[^", \t\n\\\\]+"/

(* Variable: sto_to_spc_no_dquote *)
let sto_to_spc_no_dquote = store /[^", \t\n\\\\]+/ (* " relax emacs *)

(* Variable: sto_integer *)
let sto_integer = store /[0-9]+/

(* Group: Comments and empty lines *)

(* View: comment
Map comments in "#comment" nodes *)
let comment =
  let sto_to_eol = store /([^ \t\n].*[^ \t\n]|[^ \t\n])/ in
  [ label "#comment" . del /[ \t]*#[ \t]*/ "# " . sto_to_eol . eol ]

(* View: empty
Map empty lines *)
let empty   = [ del /[ \t]*#?[ \t]*\n/ "\n" ]

(************************************************************************
 * Group:                                    ALIASES
 *************************************************************************)

(************************************************************************
 * View: alias_field
 *   Generic alias field to gather all Alias definitions
 *
 *   Definition:
 *     > User_Alias ::= NAME '=' User_List
 *     > Runas_Alias ::= NAME '=' Runas_List
 *     > Host_Alias ::= NAME '=' Host_List
 *     > Cmnd_Alias ::= NAME '=' Cmnd_List
 *
 *   Parameters:
 *     kw:string - the label string
 *     sto:lens  - the store lens
 *************************************************************************)
let alias_field (kw:string) (sto:lens) = [ label kw . sto ]

(* View: alias_list
     List of <alias_fields>, separated by commas *)
let alias_list  (kw:string) (sto:lens) =
  alias_field kw sto . ( sep_com . alias_field kw sto )*

(************************************************************************
 * View: alias_name
 *   Name of an <alias_entry_single>
 *
 *   Definition:
 *     > NAME ::= [A-Z]([A-Z][0-9]_)*
 *************************************************************************)
let alias_name
    = [ label "name" . store /[A-Z][A-Z0-9_]*/ ]

(************************************************************************
 * View: alias_entry_single
 *   Single <alias_entry>, named using <alias_name> and listing <alias_list>
 *
 *   Definition:
 *     > Alias_Type NAME = item1, item2, ...
 *
 *   Parameters:
 *     field:string - the field name, passed to <alias_list>
 *     sto:lens     - the store lens, passed to <alias_list>
 *************************************************************************)
let alias_entry_single (field:string) (sto:lens)
    = [ label "alias" . alias_name . sep_eq . alias_list field sto ]

(************************************************************************
 * View: alias_entry
 *   Alias entry, a list of comma-separated <alias_entry_single> fields
 *
 *   Definition:
 *     > Alias_Type NAME = item1, item2, item3 : NAME = item4, item5
 *
 *   Parameters:
 *     kw:string    - the alias keyword string
 *     field:string - the field name, passed to <alias_entry_single>
 *     sto:lens     - the store lens, passed to <alias_entry_single>
 *************************************************************************)
let alias_entry (kw:string) (field:string) (sto:lens)
    = [ indent . key kw . sep_cont . alias_entry_single field sto
          . ( sep_col . alias_entry_single field sto )* . eol ]

(* TODO: go further in user definitions *)
(* View: user_alias
     User_Alias, see <alias_field> *)
let user_alias  = alias_entry "User_Alias" "user" sto_to_com
(* View: runas_alias
     Run_Alias, see <alias_field> *)
let runas_alias = alias_entry "Runas_Alias" "runas_user" sto_to_com
(* View: host_alias
     Host_Alias, see <alias_field> *)
let host_alias  = alias_entry "Host_Alias" "host" sto_to_com
(* View: cmnd_alias
     Cmnd_Alias, see <alias_field> *)
let cmnd_alias  = alias_entry "Cmnd_Alias" "command" sto_to_com_cmnd

(************************************************************************
 * View: alias
 *   Every kind of Alias entry,
 *     see <user_alias>, <runas_alias>, <host_alias> and <cmnd_alias>
 *
 *   Definition:
 *     > Alias ::= 'User_Alias'  User_Alias (':' User_Alias)* |
 *     >           'Runas_Alias' Runas_Alias (':' Runas_Alias)* |
 *     >           'Host_Alias'  Host_Alias (':' Host_Alias)* |
 *     >           'Cmnd_Alias'  Cmnd_Alias (':' Cmnd_Alias)*
 *************************************************************************)
let alias = user_alias | runas_alias | host_alias | cmnd_alias
(************************************************************************
 * Group:                          DEFAULTS
 *************************************************************************)

(************************************************************************
 * View: default_type
 *   Type definition for <defaults>
 *
 *   Definition:
 *     > Default_Type ::= 'Defaults' |
 *     >                  'Defaults' '@' Host_List |
 *     >                  'Defaults' ':' User_List |
 *     >                  'Defaults' '>' Runas_List
 *************************************************************************)
let default_type     =
  let value = store /[@:>][^ \t\n\\\\]+/ in
  [ label "type" . value ]

(************************************************************************
 * View: del_negate
 *   Delete an even number of '!' signs
 *************************************************************************)
let del_negate = del /(!!)*/ ""

(************************************************************************
 * View: negate_node
 *   Negation of boolean values for <defaults>. Accept one optional '!'
 *   and produce a 'negate' node if there is one.
 *************************************************************************)
let negate_node = [ del "!" "!" . label "negate" ]

let negate_or_value (key:lens) (value:lens) =
  [ del_negate . (negate_node . key | key . value) ]

(************************************************************************
 * View: parameter_flag
 *   A flag parameter for <defaults>
 *
 *   Flags are implicitly boolean and can be turned off via the '!'  operator.
 *   Some integer, string and list parameters may also be used in a boolean
 *     context to disable them.
 *************************************************************************)
let parameter_flag_kw    = "always_set_home" | "authenticate" | "env_editor"
                         | "env_reset" | "fqdn" | "ignore_dot"
                         | "ignore_local_sudoers" | "insults" | "log_host"
                         | "log_year" | "long_otp_prompt" | "mail_always"
                         | "mail_badpass" | "mail_no_host" | "mail_no_perms"
                         | "mail_no_user" | "noexec" | "path_info"
                         | "passprompt_override" | "preserve_groups"
                         | "requiretty" | "root_sudo" | "rootpw" | "runaspw"
                         | "set_home" | "set_logname" | "setenv"
                         | "shell_noargs" | "stay_setuid" | "targetpw"
                         | "tty_tickets" | "visiblepw"

let parameter_flag       = [ del_negate . negate_node?
                               . key parameter_flag_kw ]

(************************************************************************
 * View: parameter_integer
 *   An integer parameter for <defaults>
 *************************************************************************)
let parameter_integer_nobool_kw = "passwd_tries"

let parameter_integer_nobool    = [ key parameter_integer_nobool_kw . sep_eq
                                      . del /"?/ "" . sto_integer
                                      . del /"?/ "" ]

let parameter_integer_bool_kw   = "loglinelen" | "passwd_timeout"
                                | "timestamp_timeout" | "umask"

let parameter_integer_bool      =
  negate_or_value
    (key parameter_integer_bool_kw)
    (sep_eq . del /"?/ "" . sto_integer . del /"?/ "")

let parameter_integer           = parameter_integer_nobool
                                | parameter_integer_bool

(************************************************************************
 * View: parameter_string
 *   A string parameter for <defaults>
 *
 *   An odd number of '!' operators negate the value of the item;
 *      an even number just cancel each other out.
 *************************************************************************)
let parameter_string_nobool_kw = "badpass_message" | "editor" | "mailsub"
                               | "noexec_file" | "passprompt" | "runas_default"
                               | "syslog_badpri" | "syslog_goodpri"
                               | "timestampdir" | "timestampowner" | "secure_path"

let parameter_string_nobool    = [ key parameter_string_nobool_kw . sep_eq
                                     . del /"?/ "" . sto_to_com_col
                                     . del /"?/ "" ]

let parameter_string_bool_kw   = "exempt_group" | "lecture" | "lecture_file"
                               | "listpw" | "logfile" | "mailerflags"
                               | "mailerpath" | "mailto" | "exempt_group"
                               | "syslog" | "verifypw" | "logfile"
                               | "mailerflags" | "mailerpath" | "mailto"
                               | "syslog" | "verifypw"

let parameter_string_bool      =
  negate_or_value
    (key parameter_string_bool_kw)
    (sep_eq . sto_to_com_col)

let parameter_string           = parameter_string_nobool
                               | parameter_string_bool

(************************************************************************
 * View: parameter_lists
 *   A single list parameter for <defaults>
 *
 *   All lists can be used in a boolean context
 *   The argument may be a double-quoted, space-separated list or a single
 *      value without double-quotes.
 *   The list can be replaced, added to, deleted from, or disabled
 *      by using the =, +=, -=, and ! operators respectively.
 *   An odd number of '!' operators negate the value of the item;
 *      an even number just cancel each other out.
 *************************************************************************)
let parameter_lists_kw           = "env_check" | "env_delete" | "env_keep"
let parameter_lists_value        = [ label "var" . sto_to_spc_no_dquote ]
let parameter_lists_value_dquote = [ label "var"
                                     . del /"?/ "" . sto_to_spc_no_dquote
                                     . del /"?/ "" ]

let parameter_lists_values = parameter_lists_value_dquote
                           | ( sep_dquote . parameter_lists_value
                               . ( sep_cont . parameter_lists_value )+
                               . sep_dquote )

let parameter_lists_sep    = sep_cont_opt
                             . ( [ del "+" "+" . label "append" ]
                               | [ del "-" "-" . label "remove" ] )?
                             . del "=" "=" . sep_cont_opt

let parameter_lists        =
  negate_or_value
    (key parameter_lists_kw)
    (parameter_lists_sep . parameter_lists_values)

(************************************************************************
 * View: parameter
 *   A single parameter for <defaults>
 *
 *   Definition:
 *     > Parameter ::= Parameter '=' Value |
 *     >               Parameter '+=' Value |
 *     >               Parameter '-=' Value |
 *     >               '!'* Parameter
 *
 *     Parameters may be flags, integer values, strings, or lists.
 *
 *************************************************************************)
let parameter        = parameter_flag | parameter_integer
                     | parameter_string | parameter_lists

(************************************************************************
 * View: parameter_list
 *   A list of comma-separated <parameters> for <defaults>
 *
 *   Definition:
 *     > Parameter_List ::= Parameter |
 *     >                    Parameter ',' Parameter_List
 *************************************************************************)
let parameter_list   = parameter . ( sep_com . parameter )*

(************************************************************************
 * View: defaults
 *   A Defaults entry
 *
 *   Definition:
 *     > Default_Entry ::= Default_Type Parameter_List
 *************************************************************************)
let defaults = [ indent . key "Defaults" . default_type? . sep_cont
                   . parameter_list . eol ]

(************************************************************************
 * Group:                     USER SPECIFICATION
 *************************************************************************)

(************************************************************************
 * View: runas_spec
 *   A runas specification for <spec>, using <alias_list>
 *
 *   Definition:
 *     > Runas_Spec ::= '(' Runas_List ')'
 *************************************************************************)
let runas_spec = Util.del_str "(" . alias_list "runas_user" sto_to_com
    . Util.del_str ")" . sep_cont_opt

(************************************************************************
 * View: tag_spec
 *   Tag specification for <spec>
 *
 *   Definition:
 *     > Tag_Spec ::= ('NOPASSWD:' | 'PASSWD:' | 'NOEXEC:' | 'EXEC:' |
 *     >              'SETENV:' | 'NOSETENV:')
 *************************************************************************)
let tag_spec   =
  [ label "tag" . store /(NO)?(PASSWD|EXEC|SETENV)/ . sep_col ]

(************************************************************************
 * View: cmnd_spec
 *   Command specification for <spec>,
 *     with optional <runas_spec> and any amount of <tag_specs>
 *
 *   Definition:
 *     > Cmnd_Spec ::= Runas_Spec? Tag_Spec* Cmnd
 *************************************************************************)
let cmnd_spec  =
  [ label "command" .  runas_spec? . tag_spec* . sto_to_com_cmnd ]

(************************************************************************
 * View: cmnd_spec_list
 *   A list of comma-separated <cmnd_specs>
 *
 *   Definition:
 *     > Cmnd_Spec_List ::= Cmnd_Spec |
 *     >                    Cmnd_Spec ',' Cmnd_Spec_List
 *************************************************************************)
let cmnd_spec_list = cmnd_spec . ( sep_com . cmnd_spec )*

(************************************************************************
 * View: spec_list
 *   Group of hosts with <cmnd_spec_list>
 *************************************************************************)
let spec_list = [ label "host_group" . alias_list "host" sto_to_com_host
                    . sep_eq . cmnd_spec_list ]

(************************************************************************
 * View: spec
 *   A user specification, listing colon-separated <spec_lists>
 *
 *   Definition:
 *     > User_Spec ::= User_List Host_List '=' Cmnd_Spec_List \
 *     >               (':' Host_List '=' Cmnd_Spec_List)*
 *************************************************************************)
let spec = [ label "spec" . indent
               . alias_list "user" sto_to_com_user . sep_cont
               . spec_list
               . ( sep_col . spec_list )* . eol ]

(************************************************************************
 * Group:                        LENS & FILTER
 *************************************************************************)

(* View: lns
     The sudoers lens, any amount of
       * <empty> lines
       * <comments>
       * <aliases>
       * <defaults>
       * <specs>
*)
let lns = ( empty | comment | alias | defaults | spec  )*

(* View: filter *)
let filter = (incl "/etc/sudoers")
    . (incl "/usr/local/etc/sudoers")
    . (incl "/etc/sudoers.d/*")
    . (incl "/usr/local/etc/sudoers.d/*")
    . Util.stdexcl

let xfm = transform lns filter

(*
Module: Sudoers
  Parses /etc/sudoers

Author: Raphael Pinson <raphink@gmail.com>

About: Reference
  This lens tries to keep as close as possible to `man sudoers` where possible.

For example, recursive definitions such as

     > Cmnd_Spec_List ::= Cmnd_Spec |
     >                    Cmnd_Spec ',' Cmnd_Spec_List

are replaced by

  >   let cmnd_spec_list = cmnd_spec . ( sep_com . cmnd_spec )*

since Augeas cannot deal with recursive definitions.
The definitions from `man sudoers` are put as commentaries for reference
throughout the file. More information can be found in the manual.

About: License
  This file is licensed under the LGPLv2+, like the rest of Augeas.

About: Lens Usage
  Sample usage of this lens in augtool

    * Set first Defaults to apply to the "LOCALNET" network alias
      > set /files/etc/sudoers/Defaults[1]/type "@LOCALNET"
    * List all user specifications applying explicitely to the "admin" Unix group
      > match /files/etc/sudoers/spec/user "%admin"
    * Remove the full 3rd user specification
      > rm /files/etc/sudoers/spec[3]

About: Configuration files
  This lens applies to /etc/sudoers. See <filter>.
*)

module Sudoers =
  autoload xfm

(************************************************************************
 * Group:                 USEFUL PRIMITIVES
 *************************************************************************)

(* Group: Generic primitives *)
(* Variable: eol *)
let eol       = del /[ \t]*\n/ "\n"

(* Variable: indent *)
let indent    = del /[ \t]*/ ""

(* Group: Separators *)

(* Variable: sep_spc *)
let sep_spc  = del /[ \t]+/ " "

(* Variable: sep_cont *)
let sep_cont = del /([ \t]+|[ \t]*\\\\\n[ \t]*)/ " "

(* Variable: sep_cont_opt *)
let sep_cont_opt = del /([ \t]*|[ \t]*\\\\\n[ \t]*)/ " "

(* Variable: sep_com *)
let sep_com  = sep_cont_opt . Util.del_str "," . sep_cont_opt

(* Variable: sep_eq *)
let sep_eq   = sep_cont_opt . Util.del_str "=" . sep_cont_opt

(* Variable: sep_col *)
let sep_col  = sep_cont_opt . Util.del_str ":" . sep_cont_opt

(* Variable: sep_dquote *)
let sep_dquote   = Util.del_str "\""

(* Group: Stores *)

(* Variable: sto_to_com_cmnd
sto_to_com_cmnd does not begin or end with a space *)
let sto_to_com_cmnd = store /([^,=:#() \t\n\\\\]([^,=:#()\n\\\\]|\\\\[=:,\\\\])*[^,=:#() \t\n\\\\])|[^,=:#() \t\n\\\\]/

(* Variable: sto_to_com

There could be a \ in the middle of a command *)
let sto_to_com      = store /([^,=:#() \t\n\\\\][^,=:#()\n]*[^,=:#() \t\n\\\\])|[^,=:#() \t\n\\\\]/

(* Variable: sto_to_com_host *)
let sto_to_com_host = store /[^,=:#() \t\n\\\\]+/

(* Variable: sto_to_com_user
Escaped spaces are allowed *)
let sto_to_com_user = store ( /([^,=:#() \t\n]([^,=:#() \t\n]|(\\\\[ \t]))*[^,=:#() \t\n])|[^,=:#() \t\n]/
                              - /(User|Runas|Host|Cmnd)_Alias|Defaults.*/ )

(* Variable: sto_to_com_col *)
let sto_to_com_col      = store /[^",=#() \t\n\\\\]+/ (* " relax emacs *)

(* Variable: sto_to_eq *)
let sto_to_eq  = store /[^,=:#() \t\n\\\\]+/

(* Variable: sto_to_spc *)
let sto_to_spc = store /[^", \t\n\\\\]+|"[^", \t\n\\\\]+"/

(* Variable: sto_to_spc_no_dquote *)
let sto_to_spc_no_dquote = store /[^", \t\n\\\\]+/ (* " relax emacs *)

(* Variable: sto_integer *)
let sto_integer = store /[0-9]+/

(* Group: Comments and empty lines *)

(* View: comment
Map comments in "#comment" nodes *)
let comment =
  let sto_to_eol = store /([^ \t\n].*[^ \t\n]|[^ \t\n])/ in
  [ label "#comment" . del /[ \t]*#[ \t]*/ "# " . sto_to_eol . eol ]

(* View: empty
Map empty lines *)
let empty   = [ del /[ \t]*#?[ \t]*\n/ "\n" ]

(************************************************************************
 * Group:                                    ALIASES
 *************************************************************************)

(************************************************************************
 * View: alias_field
 *   Generic alias field to gather all Alias definitions
 *
 *   Definition:
 *     > User_Alias ::= NAME '=' User_List
 *     > Runas_Alias ::= NAME '=' Runas_List
 *     > Host_Alias ::= NAME '=' Host_List
 *     > Cmnd_Alias ::= NAME '=' Cmnd_List
 *
 *   Parameters:
 *     kw:string - the label string
 *     sto:lens  - the store lens
 *************************************************************************)
let alias_field (kw:string) (sto:lens) = [ label kw . sto ]

(* View: alias_list
     List of <alias_fields>, separated by commas *)
let alias_list  (kw:string) (sto:lens) =
  alias_field kw sto . ( sep_com . alias_field kw sto )*

(************************************************************************
 * View: alias_name
 *   Name of an <alias_entry_single>
 *
 *   Definition:
 *     > NAME ::= [A-Z]([A-Z][0-9]_)*
 *************************************************************************)
let alias_name
    = [ label "name" . store /[A-Z][A-Z0-9_]*/ ]

(************************************************************************
 * View: alias_entry_single
 *   Single <alias_entry>, named using <alias_name> and listing <alias_list>
 *
 *   Definition:
 *     > Alias_Type NAME = item1, item2, ...
 *
 *   Parameters:
 *     field:string - the field name, passed to <alias_list>
 *     sto:lens     - the store lens, passed to <alias_list>
 *************************************************************************)
let alias_entry_single (field:string) (sto:lens)
    = [ label "alias" . alias_name . sep_eq . alias_list field sto ]

(************************************************************************
 * View: alias_entry
 *   Alias entry, a list of comma-separated <alias_entry_single> fields
 *
 *   Definition:
 *     > Alias_Type NAME = item1, item2, item3 : NAME = item4, item5
 *
 *   Parameters:
 *     kw:string    - the alias keyword string
 *     field:string - the field name, passed to <alias_entry_single>
 *     sto:lens     - the store lens, passed to <alias_entry_single>
 *************************************************************************)
let alias_entry (kw:string) (field:string) (sto:lens)
    = [ indent . key kw . sep_cont . alias_entry_single field sto
          . ( sep_col . alias_entry_single field sto )* . eol ]

(* TODO: go further in user definitions *)
(* View: user_alias
     User_Alias, see <alias_field> *)
let user_alias  = alias_entry "User_Alias" "user" sto_to_com
(* View: runas_alias
     Run_Alias, see <alias_field> *)
let runas_alias = alias_entry "Runas_Alias" "runas_user" sto_to_com
(* View: host_alias
     Host_Alias, see <alias_field> *)
let host_alias  = alias_entry "Host_Alias" "host" sto_to_com
(* View: cmnd_alias
     Cmnd_Alias, see <alias_field> *)
let cmnd_alias  = alias_entry "Cmnd_Alias" "command" sto_to_com_cmnd

(************************************************************************
 * View: alias
 *   Every kind of Alias entry,
 *     see <user_alias>, <runas_alias>, <host_alias> and <cmnd_alias>
 *
 *   Definition:
 *     > Alias ::= 'User_Alias'  User_Alias (':' User_Alias)* |
 *     >           'Runas_Alias' Runas_Alias (':' Runas_Alias)* |
 *     >           'Host_Alias'  Host_Alias (':' Host_Alias)* |
 *     >           'Cmnd_Alias'  Cmnd_Alias (':' Cmnd_Alias)*
 *************************************************************************)
let alias = user_alias | runas_alias | host_alias | cmnd_alias
(************************************************************************
 * Group:                          DEFAULTS
 *************************************************************************)

(************************************************************************
 * View: default_type
 *   Type definition for <defaults>
 *
 *   Definition:
 *     > Default_Type ::= 'Defaults' |
 *     >                  'Defaults' '@' Host_List |
 *     >                  'Defaults' ':' User_List |
 *     >                  'Defaults' '>' Runas_List
 *************************************************************************)
let default_type     =
  let value = store /[@:>][^ \t\n\\\\]+/ in
  [ label "type" . value ]

(************************************************************************
 * View: del_negate
 *   Delete an even number of '!' signs
 *************************************************************************)
let del_negate = del /(!!)*/ ""

(************************************************************************
 * View: negate_node
 *   Negation of boolean values for <defaults>. Accept one optional '!'
 *   and produce a 'negate' node if there is one.
 *************************************************************************)
let negate_node = [ del "!" "!" . label "negate" ]

let negate_or_value (key:lens) (value:lens) =
  [ del_negate . (negate_node . key | key . value) ]

(************************************************************************
 * View: parameter_flag
 *   A flag parameter for <defaults>
 *
 *   Flags are implicitly boolean and can be turned off via the '!'  operator.
 *   Some integer, string and list parameters may also be used in a boolean
 *     context to disable them.
 *************************************************************************)
let parameter_flag_kw    = "always_set_home" | "authenticate" | "env_editor"
                         | "env_reset" | "fqdn" | "ignore_dot"
                         | "ignore_local_sudoers" | "insults" | "log_host"
                         | "log_year" | "long_otp_prompt" | "mail_always"
                         | "mail_badpass" | "mail_no_host" | "mail_no_perms"
                         | "mail_no_user" | "noexec" | "path_info"
                         | "passprompt_override" | "preserve_groups"
                         | "requiretty" | "root_sudo" | "rootpw" | "runaspw"
                         | "set_home" | "set_logname" | "setenv"
                         | "shell_noargs" | "stay_setuid" | "targetpw"
                         | "tty_tickets" | "visiblepw"

let parameter_flag       = [ del_negate . negate_node?
                               . key parameter_flag_kw ]

(************************************************************************
 * View: parameter_integer
 *   An integer parameter for <defaults>
 *************************************************************************)
let parameter_integer_nobool_kw = "passwd_tries"

let parameter_integer_nobool    = [ key parameter_integer_nobool_kw . sep_eq
                                      . del /"?/ "" . sto_integer
                                      . del /"?/ "" ]

let parameter_integer_bool_kw   = "loglinelen" | "passwd_timeout"
                                | "timestamp_timeout" | "umask"

let parameter_integer_bool      =
  negate_or_value
    (key parameter_integer_bool_kw)
    (sep_eq . del /"?/ "" . sto_integer . del /"?/ "")

let parameter_integer           = parameter_integer_nobool
                                | parameter_integer_bool

(************************************************************************
 * View: parameter_string
 *   A string parameter for <defaults>
 *
 *   An odd number of '!' operators negate the value of the item;
 *      an even number just cancel each other out.
 *************************************************************************)
let parameter_string_nobool_kw = "badpass_message" | "editor" | "mailsub"
                               | "noexec_file" | "passprompt" | "runas_default"
                               | "syslog_badpri" | "syslog_goodpri"
                               | "timestampdir" | "timestampowner" | "secure_path"

let parameter_string_nobool    = [ key parameter_string_nobool_kw . sep_eq
                                     . del /"?/ "" . sto_to_com_col
                                     . del /"?/ "" ]

let parameter_string_bool_kw   = "exempt_group" | "lecture" | "lecture_file"
                               | "listpw" | "logfile" | "mailerflags"
                               | "mailerpath" | "mailto" | "exempt_group"
                               | "syslog" | "verifypw" | "logfile"
                               | "mailerflags" | "mailerpath" | "mailto"
                               | "syslog" | "verifypw"

let parameter_string_bool      =
  negate_or_value
    (key parameter_string_bool_kw)
    (sep_eq . sto_to_com_col)

let parameter_string           = parameter_string_nobool
                               | parameter_string_bool

(************************************************************************
 * View: parameter_lists
 *   A single list parameter for <defaults>
 *
 *   All lists can be used in a boolean context
 *   The argument may be a double-quoted, space-separated list or a single
 *      value without double-quotes.
 *   The list can be replaced, added to, deleted from, or disabled
 *      by using the =, +=, -=, and ! operators respectively.
 *   An odd number of '!' operators negate the value of the item;
 *      an even number just cancel each other out.
 *************************************************************************)
let parameter_lists_kw           = "env_check" | "env_delete" | "env_keep"
let parameter_lists_value        = [ label "var" . sto_to_spc_no_dquote ]
let parameter_lists_value_dquote = [ label "var"
                                     . del /"?/ "" . sto_to_spc_no_dquote
                                     . del /"?/ "" ]

let parameter_lists_values = parameter_lists_value_dquote
                           | ( sep_dquote . parameter_lists_value
                               . ( sep_cont . parameter_lists_value )+
                               . sep_dquote )

let parameter_lists_sep    = sep_cont_opt
                             . ( [ del "+" "+" . label "append" ]
                               | [ del "-" "-" . label "remove" ] )?
                             . del "=" "=" . sep_cont_opt

let parameter_lists        =
  negate_or_value
    (key parameter_lists_kw)
    (parameter_lists_sep . parameter_lists_values)

(************************************************************************
 * View: parameter
 *   A single parameter for <defaults>
 *
 *   Definition:
 *     > Parameter ::= Parameter '=' Value |
 *     >               Parameter '+=' Value |
 *     >               Parameter '-=' Value |
 *     >               '!'* Parameter
 *
 *     Parameters may be flags, integer values, strings, or lists.
 *
 *************************************************************************)
let parameter        = parameter_flag | parameter_integer
                     | parameter_string | parameter_lists

(************************************************************************
 * View: parameter_list
 *   A list of comma-separated <parameters> for <defaults>
 *
 *   Definition:
 *     > Parameter_List ::= Parameter |
 *     >                    Parameter ',' Parameter_List
 *************************************************************************)
let parameter_list   = parameter . ( sep_com . parameter )*

(************************************************************************
 * View: defaults
 *   A Defaults entry
 *
 *   Definition:
 *     > Default_Entry ::= Default_Type Parameter_List
 *************************************************************************)
let defaults = [ indent . key "Defaults" . default_type? . sep_cont
                   . parameter_list . eol ]

(************************************************************************
 * Group:                     USER SPECIFICATION
 *************************************************************************)

(************************************************************************
 * View: runas_spec
 *   A runas specification for <spec>, using <alias_list>
 *
 *   Definition:
 *     > Runas_Spec ::= '(' Runas_List ')'
 *************************************************************************)
let runas_spec = Util.del_str "(" . alias_list "runas_user" sto_to_com
    . Util.del_str ")" . sep_cont_opt

(************************************************************************
 * View: tag_spec
 *   Tag specification for <spec>
 *
 *   Definition:
 *     > Tag_Spec ::= ('NOPASSWD:' | 'PASSWD:' | 'NOEXEC:' | 'EXEC:' |
 *     >              'SETENV:' | 'NOSETENV:')
 *************************************************************************)
let tag_spec   =
  [ label "tag" . store /(NO)?(PASSWD|EXEC|SETENV)/ . sep_col ]

(************************************************************************
 * View: cmnd_spec
 *   Command specification for <spec>,
 *     with optional <runas_spec> and any amount of <tag_specs>
 *
 *   Definition:
 *     > Cmnd_Spec ::= Runas_Spec? Tag_Spec* Cmnd
 *************************************************************************)
let cmnd_spec  =
  [ label "command" .  runas_spec? . tag_spec* . sto_to_com_cmnd ]

(************************************************************************
 * View: cmnd_spec_list
 *   A list of comma-separated <cmnd_specs>
 *
 *   Definition:
 *     > Cmnd_Spec_List ::= Cmnd_Spec |
 *     >                    Cmnd_Spec ',' Cmnd_Spec_List
 *************************************************************************)
let cmnd_spec_list = cmnd_spec . ( sep_com . cmnd_spec )*

(************************************************************************
 * View: spec_list
 *   Group of hosts with <cmnd_spec_list>
 *************************************************************************)
let spec_list = [ label "host_group" . alias_list "host" sto_to_com_host
                    . sep_eq . cmnd_spec_list ]

(************************************************************************
 * View: spec
 *   A user specification, listing colon-separated <spec_lists>
 *
 *   Definition:
 *     > User_Spec ::= User_List Host_List '=' Cmnd_Spec_List \
 *     >               (':' Host_List '=' Cmnd_Spec_List)*
 *************************************************************************)
let spec = [ label "spec" . indent
               . alias_list "user" sto_to_com_user . sep_cont
               . spec_list
               . ( sep_col . spec_list )* . eol ]

(************************************************************************
 * Group:                        LENS & FILTER
 *************************************************************************)

(* View: lns
     The sudoers lens, any amount of
       * <empty> lines
       * <comments>
       * <aliases>
       * <defaults>
       * <specs>
*)
let lns = ( empty | comment | alias | defaults | spec  )*

(* Variable: filter *)
let filter = (incl "/etc/sudoers")
    . (incl "/usr/local/etc/sudoers")
    . (incl "/etc/sudoers.d/*")
    . (incl "/usr/local/etc/sudoers.d/*")
    . Util.stdexcl

let xfm = transform lns filter


Debian-based distributions use /etc/mdadm/mdadm.conf

(******************************************************************************
Mdadm_conf module for Augeas

Author: Matthew Booth <mbooth@redhat.com>

Copyright (C):
    2011 Red Hat Inc.

Reference:
    mdadm(5)
    config.c and policy.c from mdadm-3.2.2

License:
    This file is licensed under the LGPLv2+.

This is a lens for /etc/mdadm.conf. It aims to parse every valid configuration
file as of version 3.2.2, and many invalid ones too. This last point is a
feature, not a bug! madm will generate warnings for invalid configuration which
do not prevent correct operation of the tool. Wherever possible, we try to
allow for this behaviour.

Keywords in mdadm.conf are matched with a case-insensitive prefix match of at
least 3 characters. Keys in key/value pairs are also matched case-insensitively,
but require a full match. The exception is POLICY and PART-POLICY, where keys
are matched case-sensitively.

N.B. We can't use case-insensitive regular expressions in most places due to bug
#147.
*******************************************************************************)

module Mdadm_conf =

   autoload xfm

(******************************************************************************
 * PRIMITIVES
 ******************************************************************************)

let eol             = Util.comment_or_eol
let comment         = Util.comment
let empty           = Util.empty
let value           = /[^ \t\n#]+/
let value_no_eq     = /[^ \t\n#=]+/
let value_no_eq_sl  = /[^ \t\n#=\/]+/

let continuation = /\n[ \t]+/
let space = /[ \t]+/
let value_sep = ( del ( continuation | space . continuation? ) " "
                  | comment . del space " " )

(* We parse specific keys rather than having a catch-all owing to the varying
case of the syntax. This means the user can rely on 'array/uuid' rather than
additionally testing for 'array/UUID'.

It would be good to have an additional catchall, but I haven't been able to make
that work.
*)
let keyvalue (r:regexp) (lc:string) (uc:string) =
    [ del ( r . /=/ ) ( uc . "=" ) . label lc . store value ]

let simplevalue (r:regexp) (lc:string) (uc:string) =
    [ del r uc . label lc
      . ( value_sep . [ label "value" . store value ] )* . eol ]

(******************************************************************************
 * DEVICES
 ******************************************************************************)

let dev_re = /dev(i(ce?)?)?/i

let dev_containers_re = /containers/i
let dev_partitions_re = /partitions/i

let dev_containers = [ del dev_containers_re "containers" . label "containers" ]
let dev_partitions = [ del dev_partitions_re "partitions" . label "partitions" ]
let dev_device = [ label "name". store ( value - dev_containers_re - dev_partitions_re) ]

(* Strictly there must be at least 1 device, but we err on the side of parsing
*)
let dev_devices = ( value_sep . ( dev_containers
                                  | dev_partitions
                                  | dev_device ) )*

let device = [ del dev_re "DEVICE" . label "device" . dev_devices . eol ]

(******************************************************************************
 * ARRAY
 ******************************************************************************)

let array_re  = /arr(ay?)?/i

let arr_auto_re         = /auto/i
let arr_bitmap_re       = /bitmap/i
let arr_container_re    = /container/i
let arr_devices_re      = /devices/i
let arr_disks_re        = /disks/i (* Undocumented *)
let arr_level_re        = /level/i
let arr_member_re       = /member/i
let arr_metadata_re     = /metadata/i
let arr_name_re         = /name/i
let arr_num_devices_re  = /num-devices/i
let arr_spare_group_re  = /spare-group/i
let arr_spares_re       = /spares/i
let arr_super_minor_re  = /super-minor/i
let arr_uuid_re         = /uuid/i

let arr_devicename      = [ store value_no_eq . label "devicename" ]

let arr_auto        = keyvalue arr_auto_re "auto" "AUTO"
let arr_bitmap      = keyvalue arr_bitmap_re "bitmap" "BITMAP"
let arr_container   = keyvalue arr_container_re "container" "CONTAINER"
let arr_devices     = keyvalue arr_devices_re "devices" "DEVICES"
let arr_disks       = keyvalue arr_disks_re "disks" "DISKS"
let arr_level       = keyvalue arr_level_re "level" "LEVEL"
let arr_member      = keyvalue arr_member_re "member" "MEMBER"
let arr_metadata    = keyvalue arr_metadata_re "metadata" "METADATA"
let arr_name        = keyvalue arr_name_re "name" "NAME"
let arr_num_devices = keyvalue arr_num_devices_re "num-devices" "NUM-DEVICES"
let arr_spare_group = keyvalue arr_spare_group_re "spare-group" "SPARE-GROUP"
let arr_spares      = keyvalue arr_spares_re "spares" "SPARES"
let arr_super_minor = keyvalue arr_super_minor_re "super-minor" "SUPER-MINOR"
let arr_uuid        = keyvalue arr_uuid_re "uuid" "UUID"

let arr_options = ( value_sep . ( arr_devicename
                                  | arr_auto
                                  | arr_bitmap
                                  | arr_container
                                  | arr_devices
                                  | arr_disks
                                  | arr_level
                                  | arr_member
                                  | arr_metadata
                                  | arr_name
                                  | arr_num_devices
                                  | arr_spare_group
                                  | arr_spares
                                  | arr_super_minor
                                  | arr_uuid ) )*

let array  = [ del array_re "ARRAY" . label "array" . arr_options . eol ]

(******************************************************************************
 * MAILADDR
 ******************************************************************************)

let mailaddr_re = /mai(l(a(d(dr?)?)?)?)?/i

(* We intentially allow multiple mailaddr values here, even though this is
invalid and would produce a warning. This is better than not parsing the file.
*)
let mailaddr = simplevalue mailaddr_re "mailaddr" "MAILADDR"

(******************************************************************************
 * MAILFROM
 ******************************************************************************)

(* N.B. MAILFROM can only be abbreviated to 5 characters *)
let mailfrom_re = /mailf(r(om?)?)?/i

let mailfrom = [ del mailfrom_re "MAILFROM" . label "mailfrom"
                 . ( value_sep . [ label "value" . store value ] )* . eol ]

(******************************************************************************
 * PROGRAM
 ******************************************************************************)

let program_re = /pro(g(r(am?)?)?)?/i

let program = simplevalue program_re "program" "PROGRAM"

(******************************************************************************
 * CREATE
 ******************************************************************************)

let create_re = /cre(a(te?)?)?/i

let cre_auto_re     = /auto/i
let cre_owner_re    = /owner/i
let cre_group_re    = /group/i
let cre_mode_re     = /mode/i
let cre_metadata_re = /metadata/i
let cre_symlinks_re = /symlinks/i

let cre_auto        = keyvalue cre_auto_re "auto" "AUTO"
let cre_group       = keyvalue cre_group_re "group" "GROUP"
let cre_metadata    = keyvalue cre_metadata_re "metadata" "METADATA"
let cre_mode        = keyvalue cre_mode_re "mode" "MODE"
let cre_owner       = keyvalue cre_owner_re "owner" "OWNER"
let cre_symlinks    = keyvalue cre_symlinks_re "symlinks" "SYMLINKS"

let cre_options = ( value_sep . ( arr_auto
                                  | cre_owner
                                  | cre_group
                                  | cre_mode
                                  | cre_metadata
                                  | cre_symlinks) )*

let create  = [ del create_re "CREATE" . label "create" . cre_options . eol ]

(******************************************************************************
 * HOMEHOST
 ******************************************************************************)

let homehost_re = /hom(e(h(o(st?)?)?)?)?/i

let homehost = simplevalue homehost_re "homehost" "HOMEHOST"

(******************************************************************************
 * AUTO
 ******************************************************************************)

let auto_re = /auto?/i

let aut_plus        = [ key "+" . store value ]
let aut_minus       = [ key "-" . store value ]
let aut_homehost    = [ del /homehost/i "homehost" . label "homehost" ]

let aut_list = ( value_sep . ( aut_plus | aut_minus | aut_homehost ) )*

let auto = [ del auto_re "AUTO" . label "auto" . aut_list . eol ]

(******************************************************************************
 * POLICY and PART-POLICY
 ******************************************************************************)

(* PART-POLICY is undocumented. A cursory inspection of the parsing code
suggests it's parsed the same way as POLICY, but treated slightly differently
thereafter. *)

let policy_re = /pol(i(cy?)?)?/i
let part_policy_re = /par(t(-(p(o(l(i(cy?)?)?)?)?)?)?)?/i

(* Unlike everything else, policy keys are matched case sensitive. This means we
don't have to mess around with explicit option matching, as the match string is
fixed for a working configuration. *)

let pol_option (act:string) =
    [ del ( act . "=" ) ( act . "=" ) . label act . store value ]

let pol_options = ( value_sep . [ key value_no_eq_sl . del "=" "="
                                  . store value ] )*

let policy      = [ del policy_re "POLICY" . label "policy"
                    . pol_options . eol ]
let part_policy = [ del part_policy_re "PART-POLICY" . label "part-policy"
                    . pol_options . eol ]

(******************************************************************************
 * LENS
 ******************************************************************************)

let lns = (comment
           | empty
           | device
           | array
           | mailaddr
           | mailfrom
           | program
           | create
           | homehost
           | auto
           | policy
           | part_policy )*

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

let xfm        = transform lns filter

(******************************************************************************
Mdadm_conf module for Augeas

Author: Matthew Booth <mbooth@redhat.com>

Copyright (C):
    2011 Red Hat Inc.

Reference:
    mdadm(5)
    config.c and policy.c from mdadm-3.2.2

License:
    This file is licensed under the LGPLv2+.

This is a lens for /etc/mdadm.conf. It aims to parse every valid configuration
file as of version 3.2.2, and many invalid ones too. This last point is a
feature, not a bug! madm will generate warnings for invalid configuration which
do not prevent correct operation of the tool. Wherever possible, we try to
allow for this behaviour.

Keywords in mdadm.conf are matched with a case-insensitive prefix match of at
least 3 characters. Keys in key/value pairs are also matched case-insensitively,
but require a full match. The exception is POLICY and PART-POLICY, where keys
are matched case-sensitively.

N.B. We can't use case-insensitive regular expressions in most places due to bug
#147.
*******************************************************************************)

module Mdadm_conf =

   autoload xfm

(******************************************************************************
 * PRIMITIVES
 ******************************************************************************)

let eol             = Util.comment_or_eol
let comment         = Util.comment
let empty           = Util.empty
let value           = /[^ \t\n#]+/
let value_no_eq     = /[^ \t\n#=]+/
let value_no_eq_sl  = /[^ \t\n#=\/]+/

let continuation = /\n[ \t]+/
let space = /[ \t]+/
let value_sep = ( del ( continuation | space . continuation? ) " "
                  | comment . del space " " )

(* We parse specific keys rather than having a catch-all owing to the varying
case of the syntax. This means the user can rely on 'array/uuid' rather than
additionally testing for 'array/UUID'.

It would be good to have an additional catchall, but I haven't been able to make
that work.
*)
let keyvalue (r:regexp) (lc:string) (uc:string) =
    [ del ( r . /=/ ) ( uc . "=" ) . label lc . store value ]

let simplevalue (r:regexp) (lc:string) (uc:string) =
    [ del r uc . label lc
      . ( value_sep . [ label "value" . store value ] )* . eol ]

(******************************************************************************
 * DEVICES
 ******************************************************************************)

let dev_re = /dev(i(ce?)?)?/i

let dev_containers_re = /containers/i
let dev_partitions_re = /partitions/i

let dev_containers = [ del dev_containers_re "containers" . label "containers" ]
let dev_partitions = [ del dev_partitions_re "partitions" . label "partitions" ]
let dev_device = [ label "name". store ( value - dev_containers_re - dev_partitions_re) ]

(* Strictly there must be at least 1 device, but we err on the side of parsing
*)
let dev_devices = ( value_sep . ( dev_containers
                                  | dev_partitions
                                  | dev_device ) )*

let device = [ del dev_re "DEVICE" . label "device" . dev_devices . eol ]

(******************************************************************************
 * ARRAY
 ******************************************************************************)

let array_re  = /arr(ay?)?/i

let arr_auto_re         = /auto/i
let arr_bitmap_re       = /bitmap/i
let arr_container_re    = /container/i
let arr_devices_re      = /devices/i
let arr_disks_re        = /disks/i (* Undocumented *)
let arr_level_re        = /level/i
let arr_member_re       = /member/i
let arr_metadata_re     = /metadata/i
let arr_name_re         = /name/i
let arr_num_devices_re  = /num-devices/i
let arr_spare_group_re  = /spare-group/i
let arr_spares_re       = /spares/i
let arr_super_minor_re  = /super-minor/i
let arr_uuid_re         = /uuid/i

let arr_devicename      = [ store value_no_eq . label "devicename" ]

let arr_auto        = keyvalue arr_auto_re "auto" "AUTO"
let arr_bitmap      = keyvalue arr_bitmap_re "bitmap" "BITMAP"
let arr_container   = keyvalue arr_container_re "container" "CONTAINER"
let arr_devices     = keyvalue arr_devices_re "devices" "DEVICES"
let arr_disks       = keyvalue arr_disks_re "disks" "DISKS"
let arr_level       = keyvalue arr_level_re "level" "LEVEL"
let arr_member      = keyvalue arr_member_re "member" "MEMBER"
let arr_metadata    = keyvalue arr_metadata_re "metadata" "METADATA"
let arr_name        = keyvalue arr_name_re "name" "NAME"
let arr_num_devices = keyvalue arr_num_devices_re "num-devices" "NUM-DEVICES"
let arr_spare_group = keyvalue arr_spare_group_re "spare-group" "SPARE-GROUP"
let arr_spares      = keyvalue arr_spares_re "spares" "SPARES"
let arr_super_minor = keyvalue arr_super_minor_re "super-minor" "SUPER-MINOR"
let arr_uuid        = keyvalue arr_uuid_re "uuid" "UUID"

let arr_options = ( value_sep . ( arr_devicename
                                  | arr_auto
                                  | arr_bitmap
                                  | arr_container
                                  | arr_devices
                                  | arr_disks
                                  | arr_level
                                  | arr_member
                                  | arr_metadata
                                  | arr_name
                                  | arr_num_devices
                                  | arr_spare_group
                                  | arr_spares
                                  | arr_super_minor
                                  | arr_uuid ) )*

let array  = [ del array_re "ARRAY" . label "array" . arr_options . eol ]

(******************************************************************************
 * MAILADDR
 ******************************************************************************)

let mailaddr_re = /mai(l(a(d(dr?)?)?)?)?/i

(* We intentially allow multiple mailaddr values here, even though this is
invalid and would produce a warning. This is better than not parsing the file.
*)
let mailaddr = simplevalue mailaddr_re "mailaddr" "MAILADDR"

(******************************************************************************
 * MAILFROM
 ******************************************************************************)

(* N.B. MAILFROM can only be abbreviated to 5 characters *)
let mailfrom_re = /mailf(r(om?)?)?/i

let mailfrom = [ del mailfrom_re "MAILFROM" . label "mailfrom"
                 . ( value_sep . [ label "value" . store value ] )* . eol ]

(******************************************************************************
 * PROGRAM
 ******************************************************************************)

let program_re = /pro(g(r(am?)?)?)?/i

let program = simplevalue program_re "program" "PROGRAM"

(******************************************************************************
 * CREATE
 ******************************************************************************)

let create_re = /cre(a(te?)?)?/i

let cre_auto_re     = /auto/i
let cre_owner_re    = /owner/i
let cre_group_re    = /group/i
let cre_mode_re     = /mode/i
let cre_metadata_re = /metadata/i
let cre_symlinks_re = /symlinks/i

let cre_auto        = keyvalue cre_auto_re "auto" "AUTO"
let cre_group       = keyvalue cre_group_re "group" "GROUP"
let cre_metadata    = keyvalue cre_metadata_re "metadata" "METADATA"
let cre_mode        = keyvalue cre_mode_re "mode" "MODE"
let cre_owner       = keyvalue cre_owner_re "owner" "OWNER"
let cre_symlinks    = keyvalue cre_symlinks_re "symlinks" "SYMLINKS"

let cre_options = ( value_sep . ( arr_auto
                                  | cre_owner
                                  | cre_group
                                  | cre_mode
                                  | cre_metadata
                                  | cre_symlinks) )*

let create  = [ del create_re "CREATE" . label "create" . cre_options . eol ]

(******************************************************************************
 * HOMEHOST
 ******************************************************************************)

let homehost_re = /hom(e(h(o(st?)?)?)?)?/i

let homehost = simplevalue homehost_re "homehost" "HOMEHOST"

(******************************************************************************
 * AUTO
 ******************************************************************************)

let auto_re = /auto?/i

let aut_plus        = [ key "+" . store value ]
let aut_minus       = [ key "-" . store value ]
let aut_homehost    = [ del /homehost/i "homehost" . label "homehost" ]

let aut_list = ( value_sep . ( aut_plus | aut_minus | aut_homehost ) )*

let auto = [ del auto_re "AUTO" . label "auto" . aut_list . eol ]

(******************************************************************************
 * POLICY and PART-POLICY
 ******************************************************************************)

(* PART-POLICY is undocumented. A cursory inspection of the parsing code
suggests it's parsed the same way as POLICY, but treated slightly differently
thereafter. *)

let policy_re = /pol(i(cy?)?)?/i
let part_policy_re = /par(t(-(p(o(l(i(cy?)?)?)?)?)?)?)?/i

(* Unlike everything else, policy keys are matched case sensitive. This means we
don't have to mess around with explicit option matching, as the match string is
fixed for a working configuration. *)

let pol_option (act:string) =
    [ del ( act . "=" ) ( act . "=" ) . label act . store value ]

let pol_options = ( value_sep . [ key value_no_eq_sl . del "=" "="
                                  . store value ] )*

let policy      = [ del policy_re "POLICY" . label "policy"
                    . pol_options . eol ]
let part_policy = [ del part_policy_re "PART-POLICY" . label "part-policy"
                    . pol_options . eol ]

(******************************************************************************
 * LENS
 ******************************************************************************)

let lns = (comment
           | empty
           | device
           | array
           | mailaddr
           | mailfrom
           | program
           | create
           | homehost
           | auto
           | policy
           | part_policy )*

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

let xfm        = transform lns filter


Relicense pg_hba.aug as LGPLv2+ as the rest of Augeas.

(*
Module: Pg_Hba
  Parses PostgreSQL's pg_hba.conf

Author: Aurelien Bompard <aurelien@bompard.org>

About: Reference
  The file format is described in PostgreSQL's documentation:
  http://www.postgresql.org/docs/current/static/auth-pg-hba-conf.html

About: License
  This file is licensed under the LGPLv2+, like the rest of Augeas.

About: Configuration files
  This lens applies to pg_hba.conf. See <filter> for exact locations.
*)

module Pg_Hba =
    autoload xfm

    (* Group: Generic primitives *)

    let eol     = Util.eol
    let word    = Rx.neg1
    (* Variable: ipaddr
       CIDR or ip+netmask *)
    let ipaddr   = /[0-9a-fA-F:\.]+(\/[0-9]+|[ \t]+[0-9\.]+)/

    let comma_sep_list (l:string) =
        let lns = [ label l . store word ] in
            Build.opt_list lns Sep.comma

    (* Group: Columns definitions *)

    (* View: database
       TODO: support for quoted strings *)
    let database = comma_sep_list "database"
    (* View: user
       TODO: support for quoted strings *)
    let user = comma_sep_list "user"
    (* View: address *)
    let address = [ label "address" . store ipaddr ]
    (* View: option
       part of <method> *)
    let option = [ label "option" . store word ]
    (* View: method
       can contain an <option> *)
    let method = [ label "method" . store Rx.word . ( Sep.tab . option )? ]

    (* Group: Records definitions *)

    (* View: record_local
       when type is "local", there is no "address" field *)
    let record_local = [ label "type" . store "local" ] . Sep.tab .
                       database . Sep.tab . user . Sep.tab . method

    (* Variable: remtypes
       non-local connection types *)
    let remtypes = "host" | "hostssl" | "hostnossl"

    (* View: record_remote *)
    let record_remote = [ label "type" . store remtypes ] . Sep.tab .
                        database . Sep.tab .  user . Sep.tab .
                        address . Sep.tab . method

    (* View: record
        A sequence of <record_local> or <record_remote> entries *)
    let record = [ seq "entries" . (record_local | record_remote) . eol ]

    (* View: filter
        The pg_hba.conf conf file *)
    let filter = (incl "/var/lib/pgsql/data/pg_hba.conf" .
                  incl "/etc/postgresql/*/*/pg_hba.conf" )

    (* View: lns
        The pg_hba.conf lens *)
    let lns = ( record | Util.comment | Util.empty ) *

    let xfm = transform lns filter

(*
Module: Pg_Hba
  Parses PostgreSQL's pg_hba.conf

Author: Aurelien Bompard <aurelien@bompard.org>

About: Reference
  The file format is described in PostgreSQL's documentation:
  http://www.postgresql.org/docs/current/static/auth-pg-hba-conf.html

About: License
  This file is licensed under the GPL.

About: Configuration files
  This lens applies to pg_hba.conf. See <filter> for exact locations.
*)

module Pg_Hba =
    autoload xfm

    (* Group: Generic primitives *)

    let eol     = Util.eol
    let word    = Rx.neg1
    (* Variable: ipaddr
       CIDR or ip+netmask *)
    let ipaddr   = /[0-9a-fA-F:\.]+(\/[0-9]+|[ \t]+[0-9\.]+)/

    let comma_sep_list (l:string) =
        let lns = [ label l . store word ] in
            Build.opt_list lns Sep.comma

    (* Group: Columns definitions *)

    (* View: database
       TODO: support for quoted strings *)
    let database = comma_sep_list "database"
    (* View: user
       TODO: support for quoted strings *)
    let user = comma_sep_list "user"
    (* View: address *)
    let address = [ label "address" . store ipaddr ]
    (* View: option
       part of <method> *)
    let option = [ label "option" . store word ]
    (* View: method
       can contain an <option> *)
    let method = [ label "method" . store Rx.word . ( Sep.tab . option )? ]

    (* Group: Records definitions *)

    (* View: record_local
       when type is "local", there is no "address" field *)
    let record_local = [ label "type" . store "local" ] . Sep.tab .
                       database . Sep.tab . user . Sep.tab . method

    (* Variable: remtypes
       non-local connection types *)
    let remtypes = "host" | "hostssl" | "hostnossl"

    (* View: record_remote *)
    let record_remote = [ label "type" . store remtypes ] . Sep.tab .
                        database . Sep.tab .  user . Sep.tab .
                        address . Sep.tab . method

    (* View: record
        A sequence of <record_local> or <record_remote> entries *)
    let record = [ seq "entries" . (record_local | record_remote) . eol ]

    (* View: filter
        The pg_hba.conf conf file *)
    let filter = (incl "/var/lib/pgsql/data/pg_hba.conf" .
                  incl "/etc/postgresql/*/*/pg_hba.conf" )

    (* View: lns
        The pg_hba.conf lens *)
    let lns = ( record | Util.comment | Util.empty ) *

    let xfm = transform lns filter


Add "indomU" Debian setting to grub.aug (Fix ticket #162)

module Grub =
  autoload xfm

    (* This only covers the most basic grub directives. Needs to be *)
    (* expanded to cover more (and more esoteric) directives        *)
    (* It is good enough to handle the grub.conf on my Fedora 8 box *)

    let value_to_eol = store /[^= \t\n][^\n]*[^= \t\n]|[^= \t\n]/
    let eol = Util.eol
    let del_to_eol = del /[^ \t\n]*/ ""
    let spc = Util.del_ws_spc
    let opt_ws = Util.del_opt_ws ""
    let dels (s:string) = Util.del_str s
    let eq = dels "="
    let switch (n:regexp) = dels "--" . key n
    let switch_arg (n:regexp) = switch n . eq . store Rx.no_spaces
    let value_sep (dflt:string) = del /[ \t]*[ \t=][ \t]*/ dflt

    let comment_re = /([^ \t\n].*[^ \t\n]|[^ \t\n])/
                       - /# ## (Start|End) Default Options ##/

    let comment    =
        [ Util.indent . label "#comment" . del /#[ \t]*/ "# "
            . store comment_re . eol ]
    let empty   = Util.empty

    let command (kw:string) (indent:string) =
      Util.del_opt_ws indent . key kw

    let kw_arg (kw:string) (indent:string) (dflt_sep:string) =
      [ command kw indent . value_sep dflt_sep . value_to_eol . eol ]

    let kw_boot_arg (kw:string) = kw_arg kw "\t" " "
    let kw_menu_arg (kw:string) = kw_arg kw "" " "
    let password_arg = [ key "password" .
      (spc . [ switch "md5" ])? .
      spc . store (/[^ \t\n]+/ - "--md5") .
      (spc . [ label "file" . store /[^ \t\n]+/ ])? .
      eol ]

    let kw_pres (kw:string) = [ opt_ws . key kw . del_to_eol . eol ]

    let color =
      (* Should we nail it down to exactly the color names that *)
      (* grub supports ? *)
      let color_name = store /[A-Za-z-]+/ in
      let color_spec =
        [ label "foreground" . color_name] .
        dels "/" .
        [ label "background" . color_name ] in
      [ opt_ws . key "color" .
        spc . [ label "normal" . color_spec ] .
        (spc . [ label "highlight" . color_spec ])? .
        eol ]

    let serial =
      [ command "serial" "" .
        [ spc . switch_arg /unit|port|speed|word|parity|stop|device/ ]* .
        eol ]

    let terminal =
      [ command "terminal" "" .
          ([ spc . switch /dumb|no-echo|no-edit|silent/ ]
          |[ spc . switch_arg /timeout|lines/ ])* .
          [ spc . key /console|serial|hercules/ ]* . eol ]

    let menu_setting = kw_menu_arg "default"
                     | kw_menu_arg "fallback"
                     | kw_pres "hiddenmenu"
                     | kw_menu_arg "timeout"
                     | kw_menu_arg "splashimage"
                     | kw_menu_arg "gfxmenu"
                     | serial
                     | terminal
                     | password_arg
                     | color

    let title = del /title[ \t=]+/ "title " . value_to_eol . eol

    (* Parse the file name and args on a kernel or module line *)
    let kernel_args =
      let arg = Rx.word - /type|no-mem-option/  in
      store /\/[^ \t\n]*/ .
            (spc . [ key arg . (eq. store /([^ \t\n])*/)?])* . eol

    let module_line =
      [ command "module" "\t" . spc . kernel_args ]

    let kernel =
        [ command "kernel" "\t" .
          (spc .
             ([switch "type" . eq . store /[a-z]+/]
             |[switch "no-mem-option"]))* .
          spc . kernel_args ]

    let chainloader =
      [ command "chainloader" "\t" .
          [ spc . switch "force" ]? . spc . store Rx.no_spaces . eol ]

    let savedefault =
      [ command "savedefault" "\t" . (spc . store Rx.integer)? . eol ]

    let boot_setting = kw_boot_arg "root"
                     | kernel
                     | kw_boot_arg "initrd"
                     | kw_boot_arg "rootnoverify"
                     | chainloader
                     | kw_boot_arg "uuid"
                     | kw_pres "quiet"  (* Seems to be a Ubuntu extension *)
                     | savedefault
                     | module_line

    let boot =
      let line = ((boot_setting|comment)* . boot_setting)? in
      [ label "title" . title . line ]

    let debian_header  = "## ## Start Default Options ##\n"
    let debian_footer  = "## ## End Default Options ##\n"
    let debian_comment_re = /([^ \t\n].*[^ \t\n]|[^ \t\n])/
                            - "## End Default Options ##"
    let debian_comment =
        [ Util.indent . label "#comment" . del /##[ \t]*/ "## "
            . store debian_comment_re . eol ]
    let debian_value_sep = del /[ \t]*=/ "="
    let debian_kw_arg (kw:regexp) =
      [ Util.del_opt_ws "" . key kw . debian_value_sep
          . value_to_eol? . eol ]

    let debian_setting_re = "kopt"
                          | "groot"
                          | "alternative"
                          | "lockalternative"
                          | "defoptions"
                          | "lockold"
                          | "xenhopt"
                          | "xenkopt"
                          | "altoptions"
                          | "howmany"
                          | "memtest86"
                          | "updatedefaultentry"
                          | "savedefault"
                          | "indomU"

    let debian_setting = debian_kw_arg debian_setting_re

    let debian_entry   = del "#" "#" . debian_setting
    let debian         = [ label "debian"
                    . del debian_header debian_header
                    . (debian_comment|empty|debian_entry)*
                    . del debian_footer debian_footer ]

    let lns = (comment | empty | menu_setting | boot | debian)*
    let xfm = transform lns (incl "/boot/grub/menu.lst"
                           . incl "/etc/grub.conf")

module Grub =
  autoload xfm

    (* This only covers the most basic grub directives. Needs to be *)
    (* expanded to cover more (and more esoteric) directives        *)
    (* It is good enough to handle the grub.conf on my Fedora 8 box *)

    let value_to_eol = store /[^= \t\n][^\n]*[^= \t\n]|[^= \t\n]/
    let eol = Util.eol
    let del_to_eol = del /[^ \t\n]*/ ""
    let spc = Util.del_ws_spc
    let opt_ws = Util.del_opt_ws ""
    let dels (s:string) = Util.del_str s
    let eq = dels "="
    let switch (n:regexp) = dels "--" . key n
    let switch_arg (n:regexp) = switch n . eq . store Rx.no_spaces
    let value_sep (dflt:string) = del /[ \t]*[ \t=][ \t]*/ dflt

    let comment_re = /([^ \t\n].*[^ \t\n]|[^ \t\n])/
                       - /# ## (Start|End) Default Options ##/

    let comment    =
        [ Util.indent . label "#comment" . del /#[ \t]*/ "# "
            . store comment_re . eol ]
    let empty   = Util.empty

    let command (kw:string) (indent:string) =
      Util.del_opt_ws indent . key kw

    let kw_arg (kw:string) (indent:string) (dflt_sep:string) =
      [ command kw indent . value_sep dflt_sep . value_to_eol . eol ]

    let kw_boot_arg (kw:string) = kw_arg kw "\t" " "
    let kw_menu_arg (kw:string) = kw_arg kw "" " "
    let password_arg = [ key "password" .
      (spc . [ switch "md5" ])? .
      spc . store (/[^ \t\n]+/ - "--md5") .
      (spc . [ label "file" . store /[^ \t\n]+/ ])? .
      eol ]

    let kw_pres (kw:string) = [ opt_ws . key kw . del_to_eol . eol ]

    let color =
      (* Should we nail it down to exactly the color names that *)
      (* grub supports ? *)
      let color_name = store /[A-Za-z-]+/ in
      let color_spec =
        [ label "foreground" . color_name] .
        dels "/" .
        [ label "background" . color_name ] in
      [ opt_ws . key "color" .
        spc . [ label "normal" . color_spec ] .
        (spc . [ label "highlight" . color_spec ])? .
        eol ]

    let serial =
      [ command "serial" "" .
        [ spc . switch_arg /unit|port|speed|word|parity|stop|device/ ]* .
        eol ]

    let terminal =
      [ command "terminal" "" .
          ([ spc . switch /dumb|no-echo|no-edit|silent/ ]
          |[ spc . switch_arg /timeout|lines/ ])* .
          [ spc . key /console|serial|hercules/ ]* . eol ]

    let menu_setting = kw_menu_arg "default"
                     | kw_menu_arg "fallback"
                     | kw_pres "hiddenmenu"
                     | kw_menu_arg "timeout"
                     | kw_menu_arg "splashimage"
                     | kw_menu_arg "gfxmenu"
                     | serial
                     | terminal
                     | password_arg
                     | color

    let title = del /title[ \t=]+/ "title " . value_to_eol . eol

    (* Parse the file name and args on a kernel or module line *)
    let kernel_args =
      let arg = Rx.word - /type|no-mem-option/  in
      store /\/[^ \t\n]*/ .
            (spc . [ key arg . (eq. store /([^ \t\n])*/)?])* . eol

    let module_line =
      [ command "module" "\t" . spc . kernel_args ]

    let kernel =
        [ command "kernel" "\t" .
          (spc .
             ([switch "type" . eq . store /[a-z]+/]
             |[switch "no-mem-option"]))* .
          spc . kernel_args ]

    let chainloader =
      [ command "chainloader" "\t" .
          [ spc . switch "force" ]? . spc . store Rx.no_spaces . eol ]

    let savedefault =
      [ command "savedefault" "\t" . (spc . store Rx.integer)? . eol ]

    let boot_setting = kw_boot_arg "root"
                     | kernel
                     | kw_boot_arg "initrd"
                     | kw_boot_arg "rootnoverify"
                     | chainloader
                     | kw_boot_arg "uuid"
                     | kw_pres "quiet"  (* Seems to be a Ubuntu extension *)
                     | savedefault
                     | module_line

    let boot =
      let line = ((boot_setting|comment)* . boot_setting)? in
      [ label "title" . title . line ]

    let debian_header  = "## ## Start Default Options ##\n"
    let debian_footer  = "## ## End Default Options ##\n"
    let debian_comment_re = /([^ \t\n].*[^ \t\n]|[^ \t\n])/
                            - "## End Default Options ##"
    let debian_comment =
        [ Util.indent . label "#comment" . del /##[ \t]*/ "## "
            . store debian_comment_re . eol ]
    let debian_value_sep = del /[ \t]*=/ "="
    let debian_kw_arg (kw:regexp) =
      [ Util.del_opt_ws "" . key kw . debian_value_sep
          . value_to_eol? . eol ]

    let debian_setting_re = "kopt"
                          | "groot"
                          | "alternative"
                          | "lockalternative"
                          | "defoptions"
                          | "lockold"
                          | "xenhopt"
                          | "xenkopt"
                          | "altoptions"
                          | "howmany"
                          | "memtest86"
                          | "updatedefaultentry"
                          | "savedefault"

    let debian_setting = debian_kw_arg debian_setting_re

    let debian_entry   = del "#" "#" . debian_setting
    let debian         = [ label "debian"
                    . del debian_header debian_header
                    . (debian_comment|empty|debian_entry)*
                    . del debian_footer debian_footer ]

    let lns = (comment | empty | menu_setting | boot | debian)*
    let xfm = transform lns (incl "/boot/grub/menu.lst"
                           . incl "/etc/grub.conf")


Fstab: remove unneeded brackets

Fstab: remove unneeded brackets

(* Parsing /etc/fstab *)

module Fstab =
  autoload xfm

  let sep_tab = Sep.tab
  let sep_spc = Sep.space
  let comma   = Sep.comma
  let eol     = Util.eol

  let comment = Util.comment
  let empty   = Util.empty

  let file    = /[^# \t\n]+/

  (* An option label can't contain comma, comment, equals, or space *)
  let optlabel = /[^,#= \n\t]+/
  let spec    = /[^,# \n\t][^ \n\t]*/

  let comma_sep_list (l:string) =
    let value = [ label "value" . Util.del_str "=" . ( store Rx.neg1 )? ] in
      let lns = [ label l . store optlabel . value? ] in
         Build.opt_list lns comma

  let record = [ seq "mntent" .
                   [ label "spec" . store spec ] . sep_tab .
                   [ label "file" . store file ] . sep_tab .
                   comma_sep_list "vfstype" .
                   (sep_tab . comma_sep_list "opt" .
                    (sep_tab . [ label "dump" . store /[0-9]+/ ] .
                     ( sep_spc . [ label "passno" . store /[0-9]+/ ])? )? )?
                 . Util.comment_or_eol ]

  let lns = ( empty | comment | record ) *
  let filter = incl "/etc/fstab"
             . incl "/etc/mtab"

  let xfm = transform lns filter

(* Local Variables: *)
(* mode: caml *)
(* End: *)

(* Parsing /etc/fstab *)

module Fstab =
  autoload xfm

  let sep_tab = Sep.tab
  let sep_spc = Sep.space
  let comma   = Sep.comma
  let eol     = Util.eol

  let comment = Util.comment
  let empty   = Util.empty

  let file    = /[^# \t\n]+/

  (* An option label can't contain comma, comment, equals, or space *)
  let optlabel = /[^,#= \n\t]+/
  let spec    = /[^,# \n\t][^ \n\t]*/

  let comma_sep_list (l:string) =
    let value = [ label "value" . Util.del_str "=" . ( store Rx.neg1 )? ] in
      let lns = [ label l . store optlabel . value? ] in
         Build.opt_list lns comma

  let record = [ seq "mntent" .
                   [ label "spec" . store spec ] . sep_tab .
                   [ label "file" . store file ] . sep_tab .
                   comma_sep_list "vfstype" .
                   (sep_tab . comma_sep_list "opt" .
                    (sep_tab . [ label "dump" . store /[0-9]+/ ] .
                     ( sep_spc . [ label "passno" . store /[0-9]+/ ])? )? )?
                 . Util.comment_or_eol ]

  let lns = ( empty | comment | record ) *
  let filter = (incl "/etc/fstab")
             . (incl "/etc/mtab")

  let xfm = transform lns filter

(* Local Variables: *)
(* mode: caml *)
(* End: *)


Exclude /etc/yum/pluginconf.d/versionlock.list from yum.aug

The versionlock plugin puts a file in /etc/yum/pluginconf.d that is
not a yum config file so yum.aug shouldn't try to parse it.

(* Parsing yum's config files *)
module Yum =
  autoload xfm

  let eol = Util.del_str "\n"

  let key_re = /[^#;:= \t\n[\/]+/ - /baseurl|gpgkey/

  let eq = del /[ \t]*[:=][ \t]*/ "="
  let secname = /[^]\/]+/

  let value = /[^ \t\n][^\n]*/

  (* We really need to allow comments starting with REM and rem but that     *)
  (* leads to ambiguities with keys 'rem=' and 'REM=' The regular expression *)
  (* to do that cleanly is somewhat annoying to craft by hand; we'd need to  *)
  (* define KEY_RE as /[A-Za-z0-9]+/ - "REM" - "rem"                         *)
  let comment = [ del /([;#].*)?[ \t]*\n/ "\n" ]

  let list_sep = del /([ \t]*(,[ \t]*|\n[ \t]+))|[ \t]+/ "\n\t"
  let list_value = store /[^ \t\n,]+/

  let kv_list(s:string) =
    [ key s . eq . list_value ] .
      [ list_sep . label s . list_value ]* . eol

  let kv = [ key key_re . eq . store value . eol ]

  let sechead = Util.del_str "[" . key secname . Util.del_str "]"
      . del /[ \t]*[;#]?.*/ ""
      . eol

  let entry = comment | kv

  (* A section is a section head, followed by any number of key value    *)
  (* entries, with comments and blank lines freely interspersed. The     *)
  (* continuation lines allowed for baseurl entries make this a little   *)
  (* more interesting: there can be at most one baseurl entry in each    *)
  (* section (more precisely, yum will only obey one of them, but we act *)
  (* as if yum would actually barf)                                      *)
  let section =
    let list_baseurl = kv_list "baseurl" in
      let list_gpgkey = kv_list "gpgkey" in
    [ sechead . (  entry*
                 | entry* . list_baseurl . entry*
                 | entry* . list_gpgkey . entry*
                 | entry* . list_baseurl . entry* . list_gpgkey . entry*
                 | entry* . list_gpgkey . entry* . list_baseurl . entry*)]

  let lns = (comment) * . (section) *

  let filter = (incl "/etc/yum.conf")
      . (incl "/etc/yum.repos.d/*")
      . (incl "/etc/yum/pluginconf.d/*")
      . (excl "/etc/yum/pluginconf.d/versionlock.list")
      . Util.stdexcl

  let xfm = transform lns filter

(* Local Variables: *)
(* mode: caml       *)
(* End:             *)

(* Parsing yum's config files *)
module Yum =
  autoload xfm

  let eol = Util.del_str "\n"

  let key_re = /[^#;:= \t\n[\/]+/ - /baseurl|gpgkey/

  let eq = del /[ \t]*[:=][ \t]*/ "="
  let secname = /[^]\/]+/

  let value = /[^ \t\n][^\n]*/

  (* We really need to allow comments starting with REM and rem but that     *)
  (* leads to ambiguities with keys 'rem=' and 'REM=' The regular expression *)
  (* to do that cleanly is somewhat annoying to craft by hand; we'd need to  *)
  (* define KEY_RE as /[A-Za-z0-9]+/ - "REM" - "rem"                         *)
  let comment = [ del /([;#].*)?[ \t]*\n/ "\n" ]

  let list_sep = del /([ \t]*(,[ \t]*|\n[ \t]+))|[ \t]+/ "\n\t"
  let list_value = store /[^ \t\n,]+/

  let kv_list(s:string) =
    [ key s . eq . list_value ] .
      [ list_sep . label s . list_value ]* . eol

  let kv = [ key key_re . eq . store value . eol ]

  let sechead = Util.del_str "[" . key secname . Util.del_str "]"
      . del /[ \t]*[;#]?.*/ ""
      . eol

  let entry = comment | kv

  (* A section is a section head, followed by any number of key value    *)
  (* entries, with comments and blank lines freely interspersed. The     *)
  (* continuation lines allowed for baseurl entries make this a little   *)
  (* more interesting: there can be at most one baseurl entry in each    *)
  (* section (more precisely, yum will only obey one of them, but we act *)
  (* as if yum would actually barf)                                      *)
  let section =
    let list_baseurl = kv_list "baseurl" in
      let list_gpgkey = kv_list "gpgkey" in
    [ sechead . (  entry*
                 | entry* . list_baseurl . entry*
                 | entry* . list_gpgkey . entry*
                 | entry* . list_baseurl . entry* . list_gpgkey . entry*
                 | entry* . list_gpgkey . entry* . list_baseurl . entry*)]

  let lns = (comment) * . (section) *

  let filter = (incl "/etc/yum.conf")
      . (incl "/etc/yum.repos.d/*")
      . (incl "/etc/yum/pluginconf.d/*")
      . Util.stdexcl

  let xfm = transform lns filter

(* Local Variables: *)
(* mode: caml       *)
(* End:             *)


Add test for ticket 313

Add test for ticket 313

module Test_pg_hba =

    (* Main test *)
    let conf ="# TYPE  DATABASE    USER        CIDR-ADDRESS          METHOD

local   all         all                               ident sameuser
# IPv4 local connections:
host    all         all         127.0.0.1/32          md5
# Remote connections by hostname:
host    all         all         foo.example.com       md5
# Remote connections by suffix of hostname/fqdn:
host    all         all         .example.com          md5
# IPv6 local connections:
host    all         all         ::1/128               md5
"

    test Pg_Hba.lns get conf =
        { "#comment" = "TYPE  DATABASE    USER        CIDR-ADDRESS          METHOD" }
        {}
        { "1"
            { "type" = "local" }
            { "database" = "all" }
            { "user"  = "all" }
            { "method" = "ident"
                { "option" = "sameuser" } }
        }
        { "#comment" = "IPv4 local connections:" }
        { "2"
            { "type" = "host" }
            { "database" = "all" }
            { "user"  = "all" }
            { "address" = "127.0.0.1/32" }
            { "method" = "md5" }
        }
        { "#comment" = "Remote connections by hostname:" }
        { "3"
            { "type" = "host" }
            { "database" = "all" }
            { "user"  = "all" }
            { "address" = "foo.example.com" }
            { "method" = "md5" }
        }
        { "#comment" = "Remote connections by suffix of hostname/fqdn:" }
        { "4"
            { "type" = "host" }
            { "database" = "all" }
            { "user"  = "all" }
            { "address" = ".example.com" }
            { "method" = "md5" }
        }
        { "#comment" = "IPv6 local connections:" }
        { "5"
            { "type" = "host" }
            { "database" = "all" }
            { "user"  = "all" }
            { "address" = "::1/128" }
            { "method" = "md5" }
        }

(* ------------------------------------------------------------- *)

    (* Simple local test *)
    test Pg_Hba.lns get "local all all trust\n" =
        { "1"
            { "type" = "local" }
            { "database" = "all" }
            { "user"  = "all" }
            { "method" = "trust" }
        }

    (* Remote test with comma-sparated database names *)
    test Pg_Hba.lns get "hostssl db1,db2,db3 +pgusers 127.0.0.1/32 trust\n" =
        { "1"
            { "type" = "hostssl" }
            { "database" = "db1" }
            { "database" = "db2" }
            { "database" = "db3" }
            { "user"  = "+pgusers" }
            { "address" = "127.0.0.1/32" }
            { "method" = "trust" }
        }

    (* Test with comma-sparated user names *)
    test Pg_Hba.lns get "hostnossl sameuser u1,u2,u3 127.0.0.1/32 trust\n" =
        { "1"
            { "type" = "hostnossl" }
            { "database" = "sameuser" }
            { "user"  = "u1" }
            { "user"  = "u2" }
            { "user"  = "u3" }
            { "address" = "127.0.0.1/32" }
            { "method" = "trust" }
        }

    (* Test with quoted database and user names *)
    test Pg_Hba.lns get "host \"sameuser\" \"all\" 127.0.0.1/32 trust\n" =
        { "1"
            { "type" = "host" }
            { "database" = "\"sameuser\"" }
            { "user"  = "\"all\"" }
            { "address" = "127.0.0.1/32" }
            { "method" = "trust" }
        }

    (* Test with IP + netmask address format *)
    test Pg_Hba.lns get "host all all 192.168.1.1 255.255.0.0 trust\n" =
        { "1"
            { "type" = "host" }
            { "database" = "all" }
            { "user"  = "all" }
            { "address" = "192.168.1.1 255.255.0.0" }
            { "method" = "trust" }
        }

    (* Test with fqdn as address *)
    test Pg_Hba.lns get "host all all foo.example.com md5\n" =
        { "1"
            { "type" = "host" }
            { "database" = "all" }
            { "user" = "all" }
            { "address" = "foo.example.com" }
            { "method" = "md5" }
        }

    (* Test with fqdn suffix as address *)
    test Pg_Hba.lns get "host all all .example.com md5\n" =
        { "1"
            { "type" = "host" }
            { "database" = "all" }
            { "user" = "all" }
            { "address" = ".example.com" }
            { "method" = "md5" }
        }

    (* Local types may not have and address *)
    test Pg_Hba.lns get "local all all 127.0.0.1/32 trust\n" = *

    (* Remote types must have an address *)
    test Pg_Hba.lns get "host all all trust\n" = *

    (* The space between the IP and the netmask must not be considered as a
       column separator ("method" is missing here) *)
    test Pg_Hba.lns get "host all all 192.168.1.1 255.255.0.0\n" = *

    (* Ticket #313: support authentication method options *)
    test Pg_Hba.lns get "host all all .dev.example.com gss include_realm=0 krb_realm=EXAMPLE.COM map=somemap
host all all .dev.example.com ldap ldapserver=auth.example.com ldaptls=1 ldapprefix=\"uid=\" ldapsuffix=\",ou=people,dc=example,dc=com\"\n" =
        { "1"
            { "type" = "host" }
            { "database" = "all" }
            { "user" = "all" }
            { "address" = ".dev.example.com" }
            { "method" = "gss"
              { "options"
                { "include_realm" = "0" }
                { "krb_realm" = "EXAMPLE.COM" }
                { "map" = "somemap" } } } }
        { "2"
            { "type" = "host" }
            { "database" = "all" }
            { "user" = "all" }
            { "address" = ".dev.example.com" }
            { "method" = "ldap"
              { "options"
                { "ldapserver" = "auth.example.com" }
                { "ldaptls" = "1" }
                { "ldapprefix" = "uid=" }
                { "ldapsuffix" = ",ou=people,dc=example,dc=com" } } } }

    test Pg_Hba.lns get "host all all .dev.example.com ldap ldapserver=auth.example.com ldaptls=1 ldapprefix=\"uid=\" ldapsuffix=\",ou=people,dc=example,dc=com\"\n" = ?

    (* Unsupported yet *)
    (* test Pg_Hba.lns get "host \"db with spaces\" \"user with spaces\" 127.0.0.1/32 trust\n" =? *)
    (* test Pg_Hba.lns get "host \"db,with,commas\" \"user,with,commas\" 127.0.0.1/32 trust\n" =? *)

module Test_pg_hba =

    (* Main test *)
    let conf ="# TYPE  DATABASE    USER        CIDR-ADDRESS          METHOD

local   all         all                               ident sameuser
# IPv4 local connections:
host    all         all         127.0.0.1/32          md5
# Remote connections by hostname:
host    all         all         foo.example.com       md5
# Remote connections by suffix of hostname/fqdn:
host    all         all         .example.com          md5
# IPv6 local connections:
host    all         all         ::1/128               md5
"

    test Pg_Hba.lns get conf =
        { "#comment" = "TYPE  DATABASE    USER        CIDR-ADDRESS          METHOD" }
        {}
        { "1"
            { "type" = "local" }
            { "database" = "all" }
            { "user"  = "all" }
            { "method" = "ident"
                { "option" = "sameuser" } }
        }
        { "#comment" = "IPv4 local connections:" }
        { "2"
            { "type" = "host" }
            { "database" = "all" }
            { "user"  = "all" }
            { "address" = "127.0.0.1/32" }
            { "method" = "md5" }
        }
        { "#comment" = "Remote connections by hostname:" }
        { "3"
            { "type" = "host" }
            { "database" = "all" }
            { "user"  = "all" }
            { "address" = "foo.example.com" }
            { "method" = "md5" }
        }
        { "#comment" = "Remote connections by suffix of hostname/fqdn:" }
        { "4"
            { "type" = "host" }
            { "database" = "all" }
            { "user"  = "all" }
            { "address" = ".example.com" }
            { "method" = "md5" }
        }
        { "#comment" = "IPv6 local connections:" }
        { "5"
            { "type" = "host" }
            { "database" = "all" }
            { "user"  = "all" }
            { "address" = "::1/128" }
            { "method" = "md5" }
        }

(* ------------------------------------------------------------- *)

    (* Simple local test *)
    test Pg_Hba.lns get "local all all trust\n" =
        { "1"
            { "type" = "local" }
            { "database" = "all" }
            { "user"  = "all" }
            { "method" = "trust" }
        }

    (* Remote test with comma-sparated database names *)
    test Pg_Hba.lns get "hostssl db1,db2,db3 +pgusers 127.0.0.1/32 trust\n" =
        { "1"
            { "type" = "hostssl" }
            { "database" = "db1" }
            { "database" = "db2" }
            { "database" = "db3" }
            { "user"  = "+pgusers" }
            { "address" = "127.0.0.1/32" }
            { "method" = "trust" }
        }

    (* Test with comma-sparated user names *)
    test Pg_Hba.lns get "hostnossl sameuser u1,u2,u3 127.0.0.1/32 trust\n" =
        { "1"
            { "type" = "hostnossl" }
            { "database" = "sameuser" }
            { "user"  = "u1" }
            { "user"  = "u2" }
            { "user"  = "u3" }
            { "address" = "127.0.0.1/32" }
            { "method" = "trust" }
        }

    (* Test with quoted database and user names *)
    test Pg_Hba.lns get "host \"sameuser\" \"all\" 127.0.0.1/32 trust\n" =
        { "1"
            { "type" = "host" }
            { "database" = "\"sameuser\"" }
            { "user"  = "\"all\"" }
            { "address" = "127.0.0.1/32" }
            { "method" = "trust" }
        }

    (* Test with IP + netmask address format *)
    test Pg_Hba.lns get "host all all 192.168.1.1 255.255.0.0 trust\n" =
        { "1"
            { "type" = "host" }
            { "database" = "all" }
            { "user"  = "all" }
            { "address" = "192.168.1.1 255.255.0.0" }
            { "method" = "trust" }
        }

    (* Test with fqdn as address *)
    test Pg_Hba.lns get "host all all foo.example.com md5\n" =
        { "1"
            { "type" = "host" }
            { "database" = "all" }
            { "user" = "all" }
            { "address" = "foo.example.com" }
            { "method" = "md5" }
        }

    (* Test with fqdn suffix as address *)
    test Pg_Hba.lns get "host all all .example.com md5\n" =
        { "1"
            { "type" = "host" }
            { "database" = "all" }
            { "user" = "all" }
            { "address" = ".example.com" }
            { "method" = "md5" }
        }

    (* Local types may not have and address *)
    test Pg_Hba.lns get "local all all 127.0.0.1/32 trust\n" = *

    (* Remote types must have an address *)
    test Pg_Hba.lns get "host all all trust\n" = *

    (* The space between the IP and the netmask must not be considered as a
       column separator ("method" is missing here) *)
    test Pg_Hba.lns get "host all all 192.168.1.1 255.255.0.0\n" = *

    (* Unsupported yet *)
    (* test Pg_Hba.lns get "host \"db with spaces\" \"user with spaces\" 127.0.0.1/32 trust\n" =? *)
    (* test Pg_Hba.lns get "host \"db,with,commas\" \"user,with,commas\" 127.0.0.1/32 trust\n" =? *)


Really test Avahi.lns in test_avahi.aug

Really test Avahi.lns in test_avahi.aug

module Test_avahi =

   let conf = "
[server]
host-name=web
domain=example.com

[wide-area]
enable-wide-area=yes
"

   test Avahi.lns get conf =
      {}
      { "server"
         { "host-name" = "web" }
         { "domain" = "example.com" }
         {} }
      { "wide-area"
         { "enable-wide-area" = "yes" } }

    test Avahi.lns put conf after
       set "server/use-ipv4" "yes";
       set "server/clients-max" "4096"
    = "
[server]
host-name=web
domain=example.com

use-ipv4=yes
clients-max=4096
[wide-area]
enable-wide-area=yes
"

module Test_avahi =

   let conf = "
[server]
host-name=web
domain=example.com

[wide-area]
enable-wide-area=yes
"

   test Avahi.lns get conf =
      {}
      { "server"
         { "host-name" = "web" }
         { "domain" = "example.com" }
         {} }
      { "wide-area"
         { "enable-wide-area" = "yes" } }

    test Puppet.lns put conf after
       set "server/use-ipv4" "yes";
       set "server/clients-max" "4096"
    = "
[server]
host-name=web
domain=example.com

use-ipv4=yes
clients-max=4096
[wide-area]
enable-wide-area=yes
"


* lenses/tests/test_sysconfig.aug: use a variable 'lns' for Sysconfig.lns

(* Test for sysconfig lens *)
module Test_sysconfig =

  let lns = Sysconfig.lns

  let eth_static = "# Intel Corporation PRO/100 VE Network Connection
DEVICE=eth0
BOOTPROTO=static
BROADCAST=172.31.0.255
HWADDR=ab:cd:ef:12:34:56
export IPADDR=172.31.0.31
#DHCP_HOSTNAME=host.example.com
NETMASK=255.255.255.0
NETWORK=172.31.0.0
unset ONBOOT
"
  let empty_val = "EMPTY=\nDEVICE=eth0\n"

  let key_brack = "SOME_KEY[1]=\nDEVICE=eth0\n"

  test lns get eth_static =
    { "#comment" = "Intel Corporation PRO/100 VE Network Connection" }
    { "DEVICE" = "eth0" }
    { "BOOTPROTO" = "static" }
    { "BROADCAST" = "172.31.0.255" }
    { "HWADDR" = "ab:cd:ef:12:34:56" }
    { "IPADDR" = "172.31.0.31"
        { "export" } }
    { "#comment" = "DHCP_HOSTNAME=host.example.com" }
    { "NETMASK" = "255.255.255.0" }
    { "NETWORK" = "172.31.0.0" }
    { "@unset"   = "ONBOOT" }

  test lns put eth_static after
      set "BOOTPROTO" "dhcp" ;
      rm "IPADDR" ;
      rm "BROADCAST" ;
      rm "NETMASK" ;
      rm "NETWORK"
  = "# Intel Corporation PRO/100 VE Network Connection
DEVICE=eth0
BOOTPROTO=dhcp
HWADDR=ab:cd:ef:12:34:56
#DHCP_HOSTNAME=host.example.com
unset ONBOOT
"
  test lns get empty_val =
    { "EMPTY" = "" } { "DEVICE" = "eth0" }

  test lns get key_brack =
    { "SOME_KEY[1]" = "" } { "DEVICE" = "eth0" }

  test lns get "smartd_opts=\"-q never\"\n" =
    { "smartd_opts" = "-q never" }

  test lns get "var=val  \n" = { "var" = "val" }

  test lns get ". /etc/java/java.conf\n" =
    { ".source" = "/etc/java/java.conf" }

  (* Quoted strings and other oddities *)
  test lns get "var=\"foo 'bar'\"\n" =
    { "var" = "foo 'bar'" }

  test lns get "var=\"eth0\"\n" =
    { "var" = "eth0" }

  test lns get "var='eth0'\n" =
    { "var" = "eth0" }

  test lns get "var='Some \"funny\" value'\n" =
    { "var" = "Some \"funny\" value" }

  test lns get "var=\"\\\"\"\n" =
    { "var" = "\\\"" }

  test lns get "var=\\\"\n" =
    { "var" = "\\\"" }

  test lns get "var=ab#c\n" =
    { "var" = "ab#c" }

  (* We don't handle backticks *)
  test lns get
      "var=`grep nameserver /etc/resolv.conf | head -1`\n" = *

  (* We don't handle comments at the end of a line yet *)
  test lns get "var=ab #c\n" = *

  (* Bug 109: allow a bare export *)
  test lns get "export FOO\n" =
  { "@export" = "FOO" }

  (* Check we put quotes in when changes require them *)
  test lns put "var=\"v\"\n" after rm "/foo" =
    "var=\"v\"\n"

  test lns put "var=v\n" after set "/var" "v w"=
    "var=\"v w\"\n"

  test lns put "var='v'\n" after set "/var" "v w"=
    "var='v w'\n"

  test lns put "var=v\n" after set "/var" "v'w"=
    "var=\"v'w\"\n"

  test lns put "var=v\n" after set "/var" "v\"w"=
    "var='v\"w'\n"

(* Local Variables: *)
(* mode: caml       *)
(* End:             *)

(* Test for sysconfig lens *)
module Test_sysconfig =

  let eth_static = "# Intel Corporation PRO/100 VE Network Connection
DEVICE=eth0
BOOTPROTO=static
BROADCAST=172.31.0.255
HWADDR=ab:cd:ef:12:34:56
export IPADDR=172.31.0.31
#DHCP_HOSTNAME=host.example.com
NETMASK=255.255.255.0
NETWORK=172.31.0.0
unset ONBOOT
"
  let empty_val = "EMPTY=\nDEVICE=eth0\n"

  let key_brack = "SOME_KEY[1]=\nDEVICE=eth0\n"

  test Sysconfig.lns get eth_static =
    { "#comment" = "Intel Corporation PRO/100 VE Network Connection" }
    { "DEVICE" = "eth0" }
    { "BOOTPROTO" = "static" }
    { "BROADCAST" = "172.31.0.255" }
    { "HWADDR" = "ab:cd:ef:12:34:56" }
    { "IPADDR" = "172.31.0.31"
        { "export" } }
    { "#comment" = "DHCP_HOSTNAME=host.example.com" }
    { "NETMASK" = "255.255.255.0" }
    { "NETWORK" = "172.31.0.0" }
    { "@unset"   = "ONBOOT" }

  test Sysconfig.lns put eth_static after
      set "BOOTPROTO" "dhcp" ;
      rm "IPADDR" ;
      rm "BROADCAST" ;
      rm "NETMASK" ;
      rm "NETWORK"
  = "# Intel Corporation PRO/100 VE Network Connection
DEVICE=eth0
BOOTPROTO=dhcp
HWADDR=ab:cd:ef:12:34:56
#DHCP_HOSTNAME=host.example.com
unset ONBOOT
"
  test Sysconfig.lns get empty_val =
    { "EMPTY" = "" } { "DEVICE" = "eth0" }

  test Sysconfig.lns get key_brack =
    { "SOME_KEY[1]" = "" } { "DEVICE" = "eth0" }

  test Sysconfig.lns get "smartd_opts=\"-q never\"\n" =
    { "smartd_opts" = "-q never" }

  test Sysconfig.lns get "var=val  \n" = { "var" = "val" }

  test Sysconfig.lns get ". /etc/java/java.conf\n" =
    { ".source" = "/etc/java/java.conf" }

  (* Quoted strings and other oddities *)
  test Sysconfig.lns get "var=\"foo 'bar'\"\n" =
    { "var" = "foo 'bar'" }

  test Sysconfig.lns get "var=\"eth0\"\n" =
    { "var" = "eth0" }

  test Sysconfig.lns get "var='eth0'\n" =
    { "var" = "eth0" }

  test Sysconfig.lns get "var='Some \"funny\" value'\n" =
    { "var" = "Some \"funny\" value" }

  test Sysconfig.lns get "var=\"\\\"\"\n" =
    { "var" = "\\\"" }

  test Sysconfig.lns get "var=\\\"\n" =
    { "var" = "\\\"" }

  test Sysconfig.lns get "var=ab#c\n" =
    { "var" = "ab#c" }

  (* We don't handle backticks *)
  test Sysconfig.lns get
      "var=`grep nameserver /etc/resolv.conf | head -1`\n" = *

  (* We don't handle comments at the end of a line yet *)
  test Sysconfig.lns get "var=ab #c\n" = *

  (* Bug 109: allow a bare export *)
  test Sysconfig.lns get "export FOO\n" =
  { "@export" = "FOO" }

  (* Check we put quotes in when changes require them *)
  test Sysconfig.lns put "var=\"v\"\n" after rm "/foo" =
    "var=\"v\"\n"

  test Sysconfig.lns put "var=v\n" after set "/var" "v w"=
    "var=\"v w\"\n"

  test Sysconfig.lns put "var='v'\n" after set "/var" "v w"=
    "var='v w'\n"

  test Sysconfig.lns put "var=v\n" after set "/var" "v'w"=
    "var=\"v'w\"\n"

  test Sysconfig.lns put "var=v\n" after set "/var" "v\"w"=
    "var='v\"w'\n"

(* Local Variables: *)
(* mode: caml       *)
(* End:             *)