Mdadm: use case-insensitive regexps

Mdadm: use case-insensitive regexps

(******************************************************************************
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) ]

(* 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

(******************************************************************************
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 = /[dD][eE][vV]([iI]([cC][eE]?)?)?/

let dev_containers_re = /[cC][oO][nN][tT][aA][iI][nN][eE][rR][sS]/
let dev_partitions_re = /[pP][aA][rR][tT][iI][tT][iI][oO][nN][sS]/

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  = /[aA][rR][rR]([aA][yY]?)?/

let arr_auto_re         = /[aA][uU][tT][oO]/
let arr_bitmap_re       = /[bB][iI][tT][mM][aA][pP]/
let arr_container_re    = /[cC][oO][nN][tT][aA][iI][nN][eE][rR]/
let arr_devices_re      = /[dD][eE][vV][iI][cC][eE][sS]/
let arr_disks_re        = /[dD][iI][sS][kK][sS]/ (* Undocumented *)
let arr_level_re        = /[lL][eE][vV][eE][lL]/
let arr_member_re       = /[mM][eE][mM][bB][eE][rR]/
let arr_metadata_re     = /[mM][eE][tT][aA][dD][aA][tT][aA]/
let arr_name_re         = /[nN][aA][mM][eE]/
let arr_num_devices_re  = /[nN][uU][mM]-[dD][eE][vV][iI][cC][eE][sS]/
let arr_spare_group_re  = /[sS][pP][aA][rR][eE]-[gG][rR][oO][uU][pP]/
let arr_spares_re       = /[sS][pP][aA][rR][eE][sS]/
let arr_super_minor_re  = /[sS][uU][pP][eE][rR]-[mM][iI][nN][oO][rR]/
let arr_uuid_re         = /[uU][uU][iI][dD]/

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 = /[mM][aA][iI]([lL]([aA]([dD]([dD][rR]?)?)?)?)?/

(* 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 = /[mM][aA][iI][lL][fF]([rR]([oO][mM]?)?)?/

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

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

let program_re = /[pP][rR][oO]([gG]([rR]([aA][mM]?)?)?)?/

let program = simplevalue program_re "program" "PROGRAM"

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

let create_re = /[cC][rR][eE]([aA]([tT][eE]?)?)?/

let cre_auto_re     = /[aA][uU][tT][oO]/
let cre_owner_re    = /[oO][wW][nN][eE][rR]/
let cre_group_re    = /[gG][rR][oO][uU][pP]/
let cre_mode_re     = /[mM][oO][dD][eE]/
let cre_metadata_re = /[mM][eE][tT][aA][dD][aA][tT][aA]/
let cre_symlinks_re = /[sS][yY][mM][lL][iI][nN][kK][sS]/

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 = /[hH][oO][mM]([eE]([hH]([oO]([sS][tT]?)?)?)?)?/

let homehost = simplevalue homehost_re "homehost" "HOMEHOST"

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

let auto_re = /[aA][uU][tT][oO]?/

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 = /[pP][oO][lL]([iI]([cC][yY]?)?)?/
let part_policy_re =
    /[pP][aA][rR]([tT](-([pP]([oO]([lL]([iI]([cC][yY]?)?)?)?)?)?)?)?/

(* 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


Json: improve readability

Json: improve readability

module Json =

(* A generic lens for Json files                                           *)
(* Based on the following grammar from http://www.json.org/                *)
(* Object ::= '{'Members ? '}'                                             *)
(* Members ::= Pair+                                                       *)
(* Pair ::= String ':' Value                                               *)
(* Array ::= '[' Elements ']'                                              *)
(* Elements ::= Value ( "," Value )*                                       *)
(* Value ::= String | Number | Object | Array | "true" | "false" | "null"  *)
(* String ::= "\"" Char* "\""                                              *)
(* Number ::= /-?[0-9]+(\.[0-9]+)?([eE][+-]?[0-9]+)?/                      *)

let ws = del /[ \t\n]*/ ""
let comment = Util.empty_c_style | Util.comment_c_style | Util.comment_multiline
let comments = comment* . Sep.opt_space

let comma = Util.del_str "," . comments
let colon = Util.del_str ":" . comments
let lbrace = Util.del_str "{" . comments
let rbrace = Util.del_str "}"
let lbrack = Util.del_str "[" . comments
let rbrack = Util.del_str "]"

let str_store = Quote.dquote . store /[^"]*/ . Quote.dquote  (* " Emacs, relax *)

let number = [ label "number" . store /-?[0-9]+(\.[0-9]+)?([eE][+-]?[0-9]+)?/
             . comments ]
let str = [ label "string" . str_store . comments ]

let const (r:regexp) = [ label "const" . store r . comments ]

let fix_value (value:lens) =
     let array = [ label "array" . lbrack
               . ( ( Build.opt_list value comma . rbrack . comments )
                   | (rbrack . ws) ) ]
  in let pair = [ label "entry" . str_store . ws . colon . value ]
  in let obj = [ label "dict" . lbrace
             . ( ( Build.opt_list pair comma. rbrace . comments )
                 | (rbrace . ws ) ) ]
  in (str | number | obj | array | const /true|false|null/)

(* Process arbitrarily deeply nested JSON objects *)
let rec rlns = fix_value rlns

let lns = comments . rlns

module Json =

(* A generic lens for Json files                                           *)
(* Based on the following grammar from http://www.json.org/                *)
(* Object ::= '{'Members ? '}'                                             *)
(* Members ::= Pair+                                                       *)
(* Pair ::= String ':' Value                                               *)
(* Array ::= '[' Elements ']'                                              *)
(* Elements ::= Value ( "," Value )*                                       *)
(* Value ::= String | Number | Object | Array | "true" | "false" | "null"  *)
(* String ::= "\"" Char* "\""                                              *)
(* Number ::= /-?[0-9]+(\.[0-9]+)?([eE][+-]?[0-9]+)?/                      *)

let ws = del /[ \t\n]*/ ""
let comment = Util.empty_c_style | Util.comment_c_style | Util.comment_multiline
let comments = comment* . Sep.opt_space

let comma = Util.del_str "," . comments
let colon = Util.del_str ":" . comments
let lbrace = Util.del_str "{" . comments
let rbrace = Util.del_str "}"
let lbrack = Util.del_str "[" . comments
let rbrack = Util.del_str "]"

let str_store = Quote.dquote . store /[^"]*/ . Quote.dquote  (* " Emacs, relax *)

let number = [ label "number" . store /-?[0-9]+(\.[0-9]+)?([eE][+-]?[0-9]+)?/ . comments ]
let str = [ label "string" . str_store . comments ]

let const (r:regexp) = [ label "const" . store r . comments ]

let fix_value (value:lens) =
  let array = [ label "array" . lbrack . ((Build.opt_list value comma . rbrack . comments) | (rbrack . ws)) ] in
  let pair = [ label "entry" . str_store . ws . colon . value ] in
  let obj = [ label "dict" . lbrace . ((Build.opt_list pair comma. rbrace . comments) | (rbrace . ws)) ] in
  (str | number | obj | array | const /true|false|null/)

(* Process arbitrarily deeply nested JSON objects *)
let rec rlns = fix_value rlns

let lns = comments . rlns


Disable autoload transform for the fai_diskconfig

Autoload transform with only standard exclude makes failing the glob_for_lens
xpath test. fai_diskconfig does this. As a temporary fix, we disable transform
from fai_diskconfig.

(*
Module: FAI_DiskConfig
 Parses disk_config files for FAI

Author: Raphael Pinson <raphink@gmail.com>

About: Reference
 This lens tries to keep as close as possible to the FAI wiki where possible:
 http://wiki.fai-project.org/wiki/Setup-storage#New_configuration_file_syntax

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

About: Lens Usage
*)

module FAI_DiskConfig =

(* autoload xfm *)

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

(* Group: Generic primitives *)
(* Variable: eol *)
let eol = Util.eol

(* Variable: space *)
let space = Sep.space

(* Variable: empty *)
let empty = Util.empty

(* Variable: comment *)
let comment = Util.comment

(* Variable: tag
   A generic tag beginning with a colon *)
let tag (re:regexp) = [ Util.del_str ":" . key re ]

(* Variable: generic_opt
   A generic key/value option *)
let generic_opt (type:string) (kw:regexp) =
   [ key type . Util.del_str ":" . store kw ]

(************************************************************************
 * Group:                      RECORDS
 *************************************************************************)

(* Group: volume *)

(* Variable: mountpoint_kw *)
let mountpoint_kw = "-" (* do not mount *)
         | "swap"       (* swap space *)
         (* fully qualified path; if :encrypt is given, the partition
          * will be encrypted, the key is generated automatically *)
         | /\/[^: \t\n]*/

(* Variable: encrypt
   encrypt tag *)
let encrypt = tag "encrypt"

(* Variable: mountpoint *)
let mountpoint = [ label "mountpoint" . store mountpoint_kw
                 (* encrypt is only for the fspath, but we parse it anyway *)
                 . encrypt?]

(* Variable: resize
   resize tag *)
let resize = tag "resize"

(* Variable: size_kw
   Regexps for size *)
let size_kw = /[0-9]+[kMGTP%]?(-([0-9]+[kMGTP%]?)?)?/
            | /-[0-9]+[kMGTP%]?/

(* Variable: size *)
let size = [ label "size" . store size_kw . resize? ]

(* Variable: filesystem_kw
   Regexps for filesystem *)
let filesystem_kw = "-"
         | "swap"
         (* NOTE: Restraining this regexp would improve perfs *)
         | (Rx.no_spaces - "-" - "swap") (* mkfs.xxx must exist *)

(* Variable: filesystem *)
let filesystem = [ label "filesystem" . store filesystem_kw ]

(* Variable: mount_option_value *)
let mount_option_value = [ label "value" . Util.del_str "="
                         . store /[^,= \t\n]+/ ]

(* Variable: mount_option
   Counting options *)
let mount_option = [ seq "mount_option"
                   . store /[^,= \t\n]+/
                   . mount_option_value? ]

(* Variable: mount_options
   An array of <mount_option>s *)
let mount_options = [ label "mount_options"
                    . counter "mount_option"
                    . Build.opt_list mount_option Sep.comma ]

(* Variable: fs_option *)
let fs_option =
     [ key /createopts|tuneopts/
     . Util.del_str "=\"" . store /[^"\n]*/ . Util.del_str "\"" ]

(* Variable: fs_options
   An array of <fs_option>s *)
let fs_options =
     (* options to append to mkfs.xxx and to the filesystem-specific
      * tuning tool *)
     [ label "fs_options" . Build.opt_list fs_option Sep.space ]

(* Variable: volume_full *)
let volume_full (type:lens) (third_field:lens) =
           [ type . space
           . mountpoint .space
           (* The third field changes depending on types *)
           . third_field . space
           . filesystem . space
           . mount_options
           . (space . fs_options)? ]

(* Variable: name
   LVM volume group name *)
let name = [ label "name" . store /[^\/ \t\n]+/ ]

(* Variable: partition
   An optional partition number for <disk> *)
let partition = [ label "partition" . Util.del_str "." . store /[0-9]+/ ]

(* Variable: disk *)
let disk = [ label "disk" . store /[^\., \t\n]+/ . partition? ]

(* Variable: vg_option
   An option for <volume_vg> *)
let vg_option =
     [ key "pvcreateopts"
     . Util.del_str "=\"" . store /[^"\n]*/ . Util.del_str "\"" ]

(* Variable: volume_vg *)
let volume_vg = [ key "vg"
                . space . name
                . space . disk
                . (space . vg_option)? ]

(* Variable: spare_missing *)
let spare_missing = tag /spare|missing/

(* Variable: disk_with_opt
   A <disk> with a spare/missing option for raids *)
let disk_with_opt = [ label "disk" . store /[^:\., \t\n]+/ . partition?
                    . spare_missing* ]

(* Variable: disk_list
   A list of <disk_with_opt>s *)
let disk_list = Build.opt_list disk_with_opt Sep.comma

(* Variable: type_label_lv *)
let type_label_lv = label "lv"
                    . [ label "vg" . store (/[^# \t\n-]+/ - "raw") ]
                    . Util.del_str "-"
                    . [ label "name" . store /[^ \t\n]+/ ]

(* Variable: volume_tmpfs *)
let volume_tmpfs =
           [ key "tmpfs" . space
           . mountpoint .space
           . size . space
           . mount_options
           . (space . fs_options)? ]

(* TODO: assign each volume type to a specific disk_config type *)
(* Variable: volume_entry
   An <volume> entry *)
let volume_entry = volume_full (key "primary") size     (* for physical disks only *)
                 | volume_full (key "logical") size     (* for physical disks only *)
                 | volume_full (key /raid[0156]/) disk_list  (* raid level *)
                 | volume_full (key "raw-disk") size
                 | volume_full type_label_lv size  (* lvm logical volume: vg name and lv name *)
                 | volume_vg
                 | volume_tmpfs

(* Variable: volume *)
let volume = volume_entry . eol

(* Variable: volume_or_comment
   A succesion of <volume>s and <comment>s *)
let volume_or_comment =
      volume | (volume . (volume|empty|comment)* . volume)

(* Variable: disk_config_entry *)
let disk_config_entry (kw:regexp) (opt:lens) =
                  [ key "disk_config" . space . store kw
                  . (space . opt)* . eol
                  . volume_or_comment? ]

(* Variable: lvmoption *)
let lvmoption =
     (* preserve partitions -- always *)
      generic_opt "preserve_always" /[^\/, \t\n-]+-[^\/, \t\n-]+(,[^\/,\s\-]+-[^\/, \t\n-]+)*/
     (* preserve partitions -- unless the system is installed
      * for the first time *)
   | generic_opt "preserve_reinstall" /[^\/, \t\n-]+-[^\/, \t\n-]+(,[^\/, \t\n-]+-[^\/, \t\n-]+)*/
     (* attempt to resize partitions *)
   | generic_opt "resize" /[^\/, \t\n-]+-[^\/, \t\n-]+(,[^\/, \t\n-]+-[^\/, \t\n-]+)*/
     (* when creating the fstab, the key used for defining the device
      * may be the device (/dev/xxx), a label given using -L, or the uuid *)
   | generic_opt "fstabkey" /device|label|uuid/

(* Variable: raidoption *)
let raidoption =
     (* preserve partitions -- always *)
     generic_opt "preserve_always" /[0-9]+(,[0-9]+)*/
     (* preserve partitions -- unless the system is installed
      * for the first time *)
   | generic_opt "preserve_reinstall" /[0-9]+(,[0-9]+)*/
     (* when creating the fstab, the key used for defining the device
      * may be the device (/dev/xxx), a label given using -L, or the uuid *)
   | generic_opt "fstabkey" /device|label|uuid/

(* Variable: option *)
let option =
     (* preserve partitions -- always *)
     generic_opt "preserve_always" /[0-9]+(,[0-9]+)*/
     (* preserve partitions -- unless the system is installed
        for the first time *)
   | generic_opt "preserve_reinstall" /[0-9]+(,[0-9]+)*/
     (* attempt to resize partitions *)
   | generic_opt "resize" /[0-9]+(,[0-9]+)*/
     (* write a disklabel - default is msdos *)
   | generic_opt "disklabel" /msdos|gpt/
     (* mark a partition bootable, default is / *)
   | generic_opt "bootable" Rx.integer
     (* do not assume the disk to be a physical device, use with xen *)
   | [ key "virtual" ]
     (* when creating the fstab, the key used for defining the device
      * may be the device (/dev/xxx), a label given using -L, or the uuid *)
   | generic_opt "fstabkey" /device|label|uuid/

(* Variable: disk_config *)
let disk_config =
    let other_label = Rx.fspath - "lvm" - "raid" - "end" - /disk[0-9]+/ in
                  disk_config_entry "lvm" lvmoption
                | disk_config_entry "raid" raidoption
                | disk_config_entry "end" option (* there shouldn't be an option here *)
                | disk_config_entry /disk[0-9]+/ option
                | disk_config_entry other_label option

(* Variable: lns
   The disk_config lens *)
let lns = (disk_config|comment|empty)*

(* let xfm = transform lns Util.stdexcl *)

(*
Module: FAI_DiskConfig
 Parses disk_config files for FAI

Author: Raphael Pinson <raphink@gmail.com>

About: Reference
 This lens tries to keep as close as possible to the FAI wiki where possible:
 http://wiki.fai-project.org/wiki/Setup-storage#New_configuration_file_syntax

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

About: Lens Usage
*)

module FAI_DiskConfig =

autoload xfm

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

(* Group: Generic primitives *)
(* Variable: eol *)
let eol = Util.eol

(* Variable: space *)
let space = Sep.space

(* Variable: empty *)
let empty = Util.empty

(* Variable: comment *)
let comment = Util.comment

(* Variable: tag
   A generic tag beginning with a colon *)
let tag (re:regexp) = [ Util.del_str ":" . key re ]

(* Variable: generic_opt
   A generic key/value option *)
let generic_opt (type:string) (kw:regexp) =
   [ key type . Util.del_str ":" . store kw ]

(************************************************************************
 * Group:                      RECORDS
 *************************************************************************)

(* Group: volume *)

(* Variable: mountpoint_kw *)
let mountpoint_kw = "-" (* do not mount *)
         | "swap"       (* swap space *)
         (* fully qualified path; if :encrypt is given, the partition
          * will be encrypted, the key is generated automatically *)
         | /\/[^: \t\n]*/

(* Variable: encrypt
   encrypt tag *)
let encrypt = tag "encrypt"

(* Variable: mountpoint *)
let mountpoint = [ label "mountpoint" . store mountpoint_kw
                 (* encrypt is only for the fspath, but we parse it anyway *)
                 . encrypt?]

(* Variable: resize
   resize tag *)
let resize = tag "resize"

(* Variable: size_kw
   Regexps for size *)
let size_kw = /[0-9]+[kMGTP%]?(-([0-9]+[kMGTP%]?)?)?/
            | /-[0-9]+[kMGTP%]?/

(* Variable: size *)
let size = [ label "size" . store size_kw . resize? ]

(* Variable: filesystem_kw
   Regexps for filesystem *)
let filesystem_kw = "-"
         | "swap"
         (* NOTE: Restraining this regexp would improve perfs *)
         | (Rx.no_spaces - "-" - "swap") (* mkfs.xxx must exist *)

(* Variable: filesystem *)
let filesystem = [ label "filesystem" . store filesystem_kw ]

(* Variable: mount_option_value *)
let mount_option_value = [ label "value" . Util.del_str "="
                         . store /[^,= \t\n]+/ ]

(* Variable: mount_option
   Counting options *)
let mount_option = [ seq "mount_option"
                   . store /[^,= \t\n]+/
                   . mount_option_value? ]

(* Variable: mount_options
   An array of <mount_option>s *)
let mount_options = [ label "mount_options"
                    . counter "mount_option"
                    . Build.opt_list mount_option Sep.comma ]

(* Variable: fs_option *)
let fs_option =
     [ key /createopts|tuneopts/
     . Util.del_str "=\"" . store /[^"\n]*/ . Util.del_str "\"" ]

(* Variable: fs_options
   An array of <fs_option>s *)
let fs_options =
     (* options to append to mkfs.xxx and to the filesystem-specific
      * tuning tool *)
     [ label "fs_options" . Build.opt_list fs_option Sep.space ]

(* Variable: volume_full *)
let volume_full (type:lens) (third_field:lens) =
           [ type . space
           . mountpoint .space
           (* The third field changes depending on types *)
           . third_field . space
           . filesystem . space
           . mount_options
           . (space . fs_options)? ]

(* Variable: name
   LVM volume group name *)
let name = [ label "name" . store /[^\/ \t\n]+/ ]

(* Variable: partition
   An optional partition number for <disk> *)
let partition = [ label "partition" . Util.del_str "." . store /[0-9]+/ ]

(* Variable: disk *)
let disk = [ label "disk" . store /[^\., \t\n]+/ . partition? ]

(* Variable: vg_option
   An option for <volume_vg> *)
let vg_option =
     [ key "pvcreateopts"
     . Util.del_str "=\"" . store /[^"\n]*/ . Util.del_str "\"" ]

(* Variable: volume_vg *)
let volume_vg = [ key "vg"
                . space . name
                . space . disk
                . (space . vg_option)? ]

(* Variable: spare_missing *)
let spare_missing = tag /spare|missing/

(* Variable: disk_with_opt
   A <disk> with a spare/missing option for raids *)
let disk_with_opt = [ label "disk" . store /[^:\., \t\n]+/ . partition?
                    . spare_missing* ]

(* Variable: disk_list
   A list of <disk_with_opt>s *)
let disk_list = Build.opt_list disk_with_opt Sep.comma

(* Variable: type_label_lv *)
let type_label_lv = label "lv"
                    . [ label "vg" . store (/[^# \t\n-]+/ - "raw") ]
                    . Util.del_str "-"
                    . [ label "name" . store /[^ \t\n]+/ ]

(* Variable: volume_tmpfs *)
let volume_tmpfs =
           [ key "tmpfs" . space
           . mountpoint .space
           . size . space
           . mount_options
           . (space . fs_options)? ]

(* TODO: assign each volume type to a specific disk_config type *)
(* Variable: volume_entry
   An <volume> entry *)
let volume_entry = volume_full (key "primary") size     (* for physical disks only *)
                 | volume_full (key "logical") size     (* for physical disks only *)
                 | volume_full (key /raid[0156]/) disk_list  (* raid level *)
                 | volume_full (key "raw-disk") size
                 | volume_full type_label_lv size  (* lvm logical volume: vg name and lv name *)
                 | volume_vg
                 | volume_tmpfs

(* Variable: volume *)
let volume = volume_entry . eol

(* Variable: volume_or_comment
   A succesion of <volume>s and <comment>s *)
let volume_or_comment =
      volume | (volume . (volume|empty|comment)* . volume)

(* Variable: disk_config_entry *)
let disk_config_entry (kw:regexp) (opt:lens) =
                  [ key "disk_config" . space . store kw
                  . (space . opt)* . eol
                  . volume_or_comment? ]

(* Variable: lvmoption *)
let lvmoption =
     (* preserve partitions -- always *)
      generic_opt "preserve_always" /[^\/, \t\n-]+-[^\/, \t\n-]+(,[^\/,\s\-]+-[^\/, \t\n-]+)*/
     (* preserve partitions -- unless the system is installed
      * for the first time *)
   | generic_opt "preserve_reinstall" /[^\/, \t\n-]+-[^\/, \t\n-]+(,[^\/, \t\n-]+-[^\/, \t\n-]+)*/
     (* attempt to resize partitions *)
   | generic_opt "resize" /[^\/, \t\n-]+-[^\/, \t\n-]+(,[^\/, \t\n-]+-[^\/, \t\n-]+)*/
     (* when creating the fstab, the key used for defining the device
      * may be the device (/dev/xxx), a label given using -L, or the uuid *)
   | generic_opt "fstabkey" /device|label|uuid/

(* Variable: raidoption *)
let raidoption =
     (* preserve partitions -- always *)
     generic_opt "preserve_always" /[0-9]+(,[0-9]+)*/
     (* preserve partitions -- unless the system is installed
      * for the first time *)
   | generic_opt "preserve_reinstall" /[0-9]+(,[0-9]+)*/
     (* when creating the fstab, the key used for defining the device
      * may be the device (/dev/xxx), a label given using -L, or the uuid *)
   | generic_opt "fstabkey" /device|label|uuid/

(* Variable: option *)
let option =
     (* preserve partitions -- always *)
     generic_opt "preserve_always" /[0-9]+(,[0-9]+)*/
     (* preserve partitions -- unless the system is installed
        for the first time *)
   | generic_opt "preserve_reinstall" /[0-9]+(,[0-9]+)*/
     (* attempt to resize partitions *)
   | generic_opt "resize" /[0-9]+(,[0-9]+)*/
     (* write a disklabel - default is msdos *)
   | generic_opt "disklabel" /msdos|gpt/
     (* mark a partition bootable, default is / *)
   | generic_opt "bootable" Rx.integer
     (* do not assume the disk to be a physical device, use with xen *)
   | [ key "virtual" ]
     (* when creating the fstab, the key used for defining the device
      * may be the device (/dev/xxx), a label given using -L, or the uuid *)
   | generic_opt "fstabkey" /device|label|uuid/

(* Variable: disk_config *)
let disk_config =
    let other_label = Rx.fspath - "lvm" - "raid" - "end" - /disk[0-9]+/ in
                  disk_config_entry "lvm" lvmoption
                | disk_config_entry "raid" raidoption
                | disk_config_entry "end" option (* there shouldn't be an option here *)
                | disk_config_entry /disk[0-9]+/ option
                | disk_config_entry other_label option

(* Variable: lns
   The disk_config lens *)
let lns = (disk_config|comment|empty)*

let xfm = transform lns Util.stdexcl


Shellvars: exclude non-shell files in tests/root/etc/sysconfig

(*
Module: Shellvars
 Generic lens for shell-script config files like the ones found
 in /etc/sysconfig

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

About: Lens Usage
   To be documented
*)

module Shellvars =
  autoload xfm

  let eol = del /[ \t]+|[ \t]*[;\n]/ "\n"
  let semicol_eol = del /[ \t]*[;\n]/ "\n"

  let key_re = /[A-Za-z0-9_]+(\[[0-9]+\])?/ - "unset" - "export"
  let eq = Util.del_str "="

  let comment = Util.comment
  let comment_eol = Util.comment_eol
  let comment_or_eol = comment_eol | semicol_eol

  let empty   = Util.empty
  let xchgs   = Build.xchgs
  let semicol = del /;?/ ""

  let char  = /[^;#() '"\t\n]|\\\\"/
  let dquot = /"([^"\\\n]|\\\\.)*"/                    (* " Emacs, relax *)
  let squot = /'[^'\n]*'/
  (* For some reason, `` conflicts with comment_or_eol *)
  let bquot = /`[^#`\n]*`/
  let dollar_assign = /\$\([^#`\n]*\)/

  let sto_to_semicol = store /[^#; \t\n][^#;\n]+[^#; \t\n]|[^#; \t\n]+/

  (* Array values of the form '(val1 val2 val3)'. We do not handle empty *)
  (* arrays here because of typechecking headaches. Instead, they are    *)
  (* treated as a simple value                                           *)
  let array =
    let array_value = store (char+ | dquot) in
    del /\([ \t]*/ "(" . counter "values" .
      [ seq "values" . array_value ] .
      [ del /[ \t\n]+/ " " . seq "values" . array_value ] *
      . del /[ \t]*\)/ ")"

  (* Treat an empty list () as a value '()'; that's not quite correct *)
  (* but fairly close.                                                *)
  let simple_value =
    let empty_array = /\([ \t]*\)/ in
      store (char* | dquot | squot | bquot | dollar_assign | empty_array)

  let export = [ key "export" . Util.del_ws_spc ]
  let kv = [ Util.indent . export? . key key_re
           . eq . (simple_value | array) . semicol . comment_or_eol ]

  let var_action (name:string) =
    [ Util.indent . xchgs name ("@" . name) . Util.del_ws_spc
    . store key_re . semicol . comment_or_eol ]

  let unset = var_action "unset"
  let bare_export = var_action "export"

  let source =
    [ Util.indent
      . del /\.|source/ "." . label ".source"
      . Util.del_ws_spc . store /[^;=# \t\n]+/ . comment_or_eol ]

  let shell_builtin_cmds = "ulimit"

  let builtin =
    [ Util.indent . label "@builtin"
      . store shell_builtin_cmds
      . Util.del_ws_spc
      . [ label "args" . sto_to_semicol ]
      . comment_or_eol ]

  let keyword (kw:string) = Util.indent . Util.del_str kw
  let keyword_label (kw:string) (lbl:string) = keyword kw . label lbl

  let return =
    [ Util.indent . label "@return"
      . Util.del_str "return"
      . ( Util.del_ws_spc . store Rx.integer )?
      . comment_or_eol ]

(************************************************************************
 * Group:                 CONDITIONALS AND LOOPS
 *************************************************************************)

  let generic_cond_start (start_kw:string) (lbl:string)
                         (then_kw:string) (contents:lens) =
      keyword_label start_kw lbl . Sep.space
      . sto_to_semicol . semicol_eol
      . keyword then_kw . eol
      . contents

  let generic_cond (start_kw:string) (lbl:string)
                       (then_kw:string) (contents:lens) (end_kw:string) =
      [ generic_cond_start start_kw lbl then_kw contents
        . keyword end_kw . comment_or_eol ]

  let cond_if (entry:lens) =
    let elif = [ generic_cond_start "elif" "@elif" "then" entry+ ] in
    let else = [ keyword_label "else" "@else" . eol . entry+ ] in
    generic_cond "if" "@if" "then" (entry+ . elif* . else?) "fi"

  let loop_for (entry:lens) =
    generic_cond "for" "@for" "do" entry+ "done"

  let loop_while (entry:lens) =
    generic_cond "while" "@while" "do" entry+ "done"

  let loop_until (entry:lens) =
    generic_cond "until" "@until" "do" entry+ "done"

  let loop_select (entry:lens) =
    generic_cond "select" "@select" "do" entry+ "done"

  let case (entry:lens) =
    let case_entry = [ label "@case_entry"
                       . Util.indent . store /[^ \t\n\)]+/
                       . Util.del_str ")" . eol
                       . entry+
                       . Util.indent . Util.del_str ";;" . eol ] in
      [ keyword_label "case" "@case" . Sep.space
        . store char+
        . del /[ \t\n]+/ " " . Util.del_str "in" . eol
        . case_entry+
        . keyword "esac" . comment_or_eol ]

  let function (entry:lens) =
    [ Util.indent . label "@function"
      . del /(function[ \t]+)?/ ""
      . store Rx.word . del /[ \t]*\(\)/ "()"
      . eol . Util.del_str "{" . eol
      . entry+
      . Util.indent . Util.del_str "}" . eol ]

  let rec rec_entry =
    let entry = comment | empty | source | kv
              | unset | bare_export | builtin | return | rec_entry in
        cond_if entry
      | loop_for entry
      | loop_select entry
      | loop_while entry
      | loop_until entry
      | case entry
      | function entry

  let lns = (comment | empty | source | kv | unset | bare_export | builtin | return | rec_entry) *

  let sc_incl (n:string) = (incl ("/etc/sysconfig/" . n))
  let sc_excl (n:string) = (excl ("/etc/sysconfig/" . n))

  let filter_sysconfig =
      sc_incl "*" .
      sc_excl "hw-uuid" .
      sc_excl "hwconf" .
      sc_excl "ip*tables" .
      sc_excl "kernel" .
      sc_excl "*.pub" .
      sc_excl "sysstat.ioconf" .
      sc_excl "system-config-firewall" .
      sc_excl "system-config-securitylevel" .
      sc_incl "network/config" .
      sc_incl "network/dhcp" .
      sc_incl "network/dhcp6r" .
      sc_incl "network/dhcp6s" .
      sc_incl "network/ifcfg-*" .
      sc_incl "network/if-down.d/*" .
      sc_incl "network/ifroute-*" .
      sc_incl "network/if-up.d/*" .
      sc_incl "network/providers/*" .
      sc_incl "rhn/allowed-actions/*" .
      sc_incl "rhn/allowed-actions/script/*" .
      sc_incl "rhn/rhnsd" .
      sc_incl "SuSEfirewall2.d/cobbler" .
      sc_incl "SuSEfirewall2.d/services/*" .
      sc_excl "SuSEfirewall2.d/services/TEMPLATE"

  let filter_ifcfg   = incl "/etc/sysconfig/network-scripts/ifcfg-*"
                     . incl "/etc/sysconfig/network/ifcfg-*"
  let filter_default = incl "/etc/default/*"
  let filter_misc    = incl "/etc/arno-iptables-firewall/debconf.cfg"
                     . incl "/etc/cron-apt/config"
                     . incl "/etc/environment"
                     . incl "/etc/blkid.conf"
                     . incl "/etc/adduser.conf"
                     . incl "/etc/cowpoke.conf"
                     . incl "/etc/cvs-cron.conf"
                     . incl "/etc/cvs-pserver.conf"
                     . incl "/etc/devscripts.conf"
                     . incl "/etc/lintianrc"
                     . incl "/etc/lsb-release"
                     . incl "/etc/popularity-contest.conf"
                     . incl "/etc/rc.conf"
                     . incl "/etc/selinux/config"
                     . incl "/etc/ucf.conf"

  let filter = filter_sysconfig
             . filter_ifcfg
             . filter_default
             . filter_misc
             . Util.stdexcl

  let xfm = transform lns filter

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

(*
Module: Shellvars
 Generic lens for shell-script config files like the ones found
 in /etc/sysconfig

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

About: Lens Usage
   To be documented
*)

module Shellvars =
  autoload xfm

  let eol = del /[ \t]+|[ \t]*[;\n]/ "\n"
  let semicol_eol = del /[ \t]*[;\n]/ "\n"

  let key_re = /[A-Za-z0-9_]+(\[[0-9]+\])?/ - "unset" - "export"
  let eq = Util.del_str "="

  let comment = Util.comment
  let comment_eol = Util.comment_eol
  let comment_or_eol = comment_eol | semicol_eol

  let empty   = Util.empty
  let xchgs   = Build.xchgs
  let semicol = del /;?/ ""

  let char  = /[^;#() '"\t\n]|\\\\"/
  let dquot = /"([^"\\\n]|\\\\.)*"/                    (* " Emacs, relax *)
  let squot = /'[^'\n]*'/
  (* For some reason, `` conflicts with comment_or_eol *)
  let bquot = /`[^#`\n]*`/
  let dollar_assign = /\$\([^#`\n]*\)/

  let sto_to_semicol = store /[^#; \t\n][^#;\n]+[^#; \t\n]|[^#; \t\n]+/

  (* Array values of the form '(val1 val2 val3)'. We do not handle empty *)
  (* arrays here because of typechecking headaches. Instead, they are    *)
  (* treated as a simple value                                           *)
  let array =
    let array_value = store (char+ | dquot) in
    del /\([ \t]*/ "(" . counter "values" .
      [ seq "values" . array_value ] .
      [ del /[ \t\n]+/ " " . seq "values" . array_value ] *
      . del /[ \t]*\)/ ")"

  (* Treat an empty list () as a value '()'; that's not quite correct *)
  (* but fairly close.                                                *)
  let simple_value =
    let empty_array = /\([ \t]*\)/ in
      store (char* | dquot | squot | bquot | dollar_assign | empty_array)

  let export = [ key "export" . Util.del_ws_spc ]
  let kv = [ Util.indent . export? . key key_re
           . eq . (simple_value | array) . semicol . comment_or_eol ]

  let var_action (name:string) =
    [ Util.indent . xchgs name ("@" . name) . Util.del_ws_spc
    . store key_re . semicol . comment_or_eol ]

  let unset = var_action "unset"
  let bare_export = var_action "export"

  let source =
    [ Util.indent
      . del /\.|source/ "." . label ".source"
      . Util.del_ws_spc . store /[^;=# \t\n]+/ . comment_or_eol ]

  let shell_builtin_cmds = "ulimit"

  let builtin =
    [ Util.indent . label "@builtin"
      . store shell_builtin_cmds
      . Util.del_ws_spc
      . [ label "args" . sto_to_semicol ]
      . comment_or_eol ]

  let keyword (kw:string) = Util.indent . Util.del_str kw
  let keyword_label (kw:string) (lbl:string) = keyword kw . label lbl

  let return =
    [ Util.indent . label "@return"
      . Util.del_str "return"
      . ( Util.del_ws_spc . store Rx.integer )?
      . comment_or_eol ]

(************************************************************************
 * Group:                 CONDITIONALS AND LOOPS
 *************************************************************************)

  let generic_cond_start (start_kw:string) (lbl:string)
                         (then_kw:string) (contents:lens) =
      keyword_label start_kw lbl . Sep.space
      . sto_to_semicol . semicol_eol
      . keyword then_kw . eol
      . contents

  let generic_cond (start_kw:string) (lbl:string)
                       (then_kw:string) (contents:lens) (end_kw:string) =
      [ generic_cond_start start_kw lbl then_kw contents
        . keyword end_kw . comment_or_eol ]

  let cond_if (entry:lens) =
    let elif = [ generic_cond_start "elif" "@elif" "then" entry+ ] in
    let else = [ keyword_label "else" "@else" . eol . entry+ ] in
    generic_cond "if" "@if" "then" (entry+ . elif* . else?) "fi"

  let loop_for (entry:lens) =
    generic_cond "for" "@for" "do" entry+ "done"

  let loop_while (entry:lens) =
    generic_cond "while" "@while" "do" entry+ "done"

  let loop_until (entry:lens) =
    generic_cond "until" "@until" "do" entry+ "done"

  let loop_select (entry:lens) =
    generic_cond "select" "@select" "do" entry+ "done"

  let case (entry:lens) =
    let case_entry = [ label "@case_entry"
                       . Util.indent . store /[^ \t\n\)]+/
                       . Util.del_str ")" . eol
                       . entry+
                       . Util.indent . Util.del_str ";;" . eol ] in
      [ keyword_label "case" "@case" . Sep.space
        . store char+
        . del /[ \t\n]+/ " " . Util.del_str "in" . eol
        . case_entry+
        . keyword "esac" . comment_or_eol ]

  let function (entry:lens) =
    [ Util.indent . label "@function"
      . del /(function[ \t]+)?/ ""
      . store Rx.word . del /[ \t]*\(\)/ "()"
      . eol . Util.del_str "{" . eol
      . entry+
      . Util.indent . Util.del_str "}" . eol ]

  let rec rec_entry =
    let entry = comment | empty | source | kv
              | unset | bare_export | builtin | return | rec_entry in
        cond_if entry
      | loop_for entry
      | loop_select entry
      | loop_while entry
      | loop_until entry
      | case entry
      | function entry

  let lns = (comment | empty | source | kv | unset | bare_export | builtin | return | rec_entry) *

  let sc_incl (n:string) = (incl ("/etc/sysconfig/" . n))
  let sc_excl (n:string) = (excl ("/etc/sysconfig/" . n))

  let filter_sysconfig =
      sc_incl "*" .
      sc_excl "kernel" .
      sc_excl "ip*tables" .
      sc_excl "sysstat.ioconf" .
      sc_excl "system-config-firewall" .
      sc_incl "network/config" .
      sc_incl "network/dhcp" .
      sc_incl "network/dhcp6r" .
      sc_incl "network/dhcp6s" .
      sc_incl "network/ifcfg-*" .
      sc_incl "network/if-down.d/*" .
      sc_incl "network/ifroute-*" .
      sc_incl "network/if-up.d/*" .
      sc_incl "network/providers/*" .
      sc_incl "rhn/allowed-actions/*" .
      sc_incl "rhn/allowed-actions/script/*" .
      sc_incl "rhn/rhnsd" .
      sc_incl "SuSEfirewall2.d/cobbler" .
      sc_incl "SuSEfirewall2.d/services/*" .
      sc_excl "SuSEfirewall2.d/services/TEMPLATE"

  let filter_ifcfg   = incl "/etc/sysconfig/network-scripts/ifcfg-*"
                     . incl "/etc/sysconfig/network/ifcfg-*"
  let filter_default = incl "/etc/default/*"
  let filter_misc    = incl "/etc/arno-iptables-firewall/debconf.cfg"
                     . incl "/etc/cron-apt/config"
                     . incl "/etc/environment"
                     . incl "/etc/blkid.conf"
                     . incl "/etc/adduser.conf"
                     . incl "/etc/cowpoke.conf"
                     . incl "/etc/cvs-cron.conf"
                     . incl "/etc/cvs-pserver.conf"
                     . incl "/etc/devscripts.conf"
                     . incl "/etc/lintianrc"
                     . incl "/etc/lsb-release"
                     . incl "/etc/popularity-contest.conf"
                     . incl "/etc/rc.conf"
                     . incl "/etc/selinux/config"
                     . incl "/etc/ucf.conf"

  let filter = filter_sysconfig
             . filter_ifcfg
             . filter_default
             . filter_misc
             . Util.stdexcl

  let xfm = transform lns filter

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


Support configuration file for Squid 3

Support configuration file for Squid 3

(* Squid module for Augeas
   Author: Free Ekanayaka <free@64studio.com>

   Reference: the self-documented default squid.conf file

*)

module Squid =
  autoload xfm

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

let eol         = Util.eol
let spc         = Util.del_ws_spc
let indent      = Util.indent

let word        =  /[A-Za-z0-9!_.-]+(\[[0-9]+\])?/
let sto_to_spc  = store /[^# \t\n]+/
let sto_to_eol  = store /([^# \t\n][^#\n]*[^# \t\n])|[^# \t\n]/

let comment     = Util.comment
let empty       = Util.empty
let comment_or_eol = Util.comment_or_eol
let value (kw:string)
                = [ spc . label kw . sto_to_spc ]

let value_space_in (kw:string)
                = [ spc . label kw . sto_to_eol ]

let parameters  = [ label "parameters"
                   . counter "parameters"
                   . [ spc . seq "parameters" . sto_to_spc ]+ ]

(************************************************************************
 *                          SPACEVARS SETTINGS
 *************************************************************************)

let entry_re =    "accept_filter"
                | "access_log"
                | "acl_uses_indirect_client"
                | "adaptation_access"
                | "adaptation_service_set"
                | "allow_underscore"
                | "always_direct"
                | "announce_file"
                | "announce_host"
                | "announce_period"
                | "announce_port"
                | "append_domain"
                | "as_whois_server"
                | "authenticate_cache_garbage_interval"
                | "authenticate_ip_shortcircuit_access"
                | "authenticate_ip_shortcircuit_ttl"
                | "authenticate_ip_ttl"
                | "authenticate_ttl"
                | "background_ping_rate"
                | "balance_on_multiple_ip"
                | "broken_posts"
                | "buffered_logs"
                | "cache"
                | "cache_dir"
                | "cache_dns_program"
                | "cache_effective_group"
                | "cache_effective_user"
                | "cache_log"
                | "cache_mem"
                | "cache_mgr"
                | "cachemgr_passwd"
                | "cache_peer"
                | "cache_peer_access"
                | "cache_peer_domain"
                | "cache_replacement_policy"
                | "cache_store_log"
                | "cache_swap_high"
                | "cache_swap_low"
                | "cache_swap_state"
                | "cache_vary"
                | "check_hostnames"
                | "chroot"
                | "client_db"
                | "client_lifetime"
                | "client_netmask"
                | "client_persistent_connections"
                | "clientside_tos"
                | "collapsed_forwarding"
                | "connect_timeout"
                | "coredump_dir"
                | "dead_peer_timeout"
                | "debug_options"
                | "delay_access"
                | "delay_class"
                | "delay_initial_bucket_level"
                | "delay_parameters"
                | "delay_pools"
                | "delay_pool_uses_indirect_client"
                | "deny_info"
                | "detect_broken_pconn"
                | "digest_bits_per_entry"
                | "digest_generation"
                | "digest_rebuild_chunk_percentage"
                | "digest_rebuild_period"
                | "digest_rewrite_period"
                | "digest_swapout_chunk_size"
                | "diskd_program"
                | "dns_children"
                | "dns_defnames"
                | "dns_nameservers"
                | "dns_retransmit_interval"
                | "dns_testnames"
                | "dns_timeout"
                | "dns_v4_fallback"
                | "ecap_enable"
                | "ecap_service"
                | "email_err_data"
                | "emulate_httpd_log"
                | "err_html_text"
                | "error_default_language"
                | "error_directory"
                | "error_log_languages"
                | "error_map"
                | "err_page_stylesheet"
                | "esi_parser"
                | "external_acl_type"
                | "external_refresh_check"
                | "follow_x_forwarded_for"
                | "forwarded_for"
                | "forward_log"
                | "forward_timeout"
                | "fqdncache_size"
                | "ftp_epsv_all"
                | "ftp_list_width"
                | "ftp_passive"
                | "ftp_sanitycheck"
                | "ftp_telnet_protocol"
                | "ftp_user"
                | "global_internal_static"
                | "half_closed_clients"
                | "header_access"
                | "header_replace"
                | "hierarchy_stoplist"
                | "high_memory_warning"
                | "high_page_fault_warning"
                | "high_response_time_warning"
                | "hostname_aliases"
                | "hosts_file"
                | "htcp_access"
                | "htcp_clr_access"
                | "htcp_port"
                | "http_accel_surrogate_remote"
                | "http_access2"
                | "httpd_accel_no_pmtu_disc"
                | "httpd_accel_surrogate_id"
                | "httpd_suppress_version_string"
                | "http_port"
                | "http_reply_access"
                | "https_port"
                | "icap_access"
                | "icap_class"
                | "icap_client_username_encode"
                | "icap_client_username_header"
                | "icap_connect_timeout"
                | "icap_default_options_ttl"
                | "icap_enable"
                | "icap_io_timeout"
                | "icap_persistent_connections"
                | "icap_preview_enable"
                | "icap_preview_size"
                | "icap_send_client_ip"
                | "icap_send_client_username"
                | "icap_service"
                | "icap_service_failure_limit"
                | "icap_service_revival_delay"
                | "icon_directory"
                | "icp_access"
                | "icp_hit_stale"
                | "icp_port"
                | "icp_query_timeout"
                | "ident_lookup_access"
                | "ident_timeout"
                | "ie_refresh"
                | "ignore_expect_100"
                | "ignore_ims_on_miss"
                | "ignore_unknown_nameservers"
                | "incoming_dns_average"
                | "incoming_http_average"
                | "incoming_icp_average"
                | "incoming_rate"
                | "ipcache_high"
                | "ipcache_low"
                | "ipcache_size"
                | "loadable_modules"
                | "location_rewrite_access"
                | "location_rewrite_children"
                | "location_rewrite_concurrency"
                | "location_rewrite_program"
                | "log_access"
                | "logfile_daemon"
                | "logfile_rotate"
                | "logformat"
                | "log_fqdn"
                | "log_icp_queries"
                | "log_ip_on_direct"
                | "log_mime_hdrs"
                | "log_uses_indirect_client"
                | "mail_from"
                | "mail_program"
                | "max_filedescriptors"
                | "maximum_icp_query_timeout"
                | "maximum_object_size"
                | "maximum_object_size_in_memory"
                | "maximum_single_addr_tries"
                | "max_open_disk_fds"
                | "max_stale"
                | "mcast_groups"
                | "mcast_icp_query_timeout"
                | "mcast_miss_addr"
                | "mcast_miss_encode_key"
                | "mcast_miss_port"
                | "mcast_miss_ttl"
                | "memory_pools"
                | "memory_pools_limit"
                | "memory_replacement_policy"
                | "mime_table"
                | "min_dns_poll_cnt"
                | "min_http_poll_cnt"
                | "min_icp_poll_cnt"
                | "minimum_direct_hops"
                | "minimum_direct_rtt"
                | "minimum_expiry_time"
                | "minimum_icp_query_timeout"
                | "minimum_object_size"
                | "miss_access"
                | "negative_dns_ttl"
                | "negative_ttl"
                | "neighbor_type_domain"
                | "netdb_filename"
                | "netdb_high"
                | "netdb_low"
                | "netdb_ping_period"
                | "never_direct"
                | "no_cache"
                | "nonhierarchical_direct"
                | "offline_mode"
                | "pconn_timeout"
                | "peer_connect_timeout"
                | "persistent_connection_after_error"
                | "persistent_request_timeout"
                | "pid_filename"
                | "pinger_enable"
                | "pinger_program"
                | "pipeline_prefetch"
                | "positive_dns_ttl"
                | "prefer_direct"
                | "qos_flows"
                | "query_icmp"
                | "quick_abort_max"
                | "quick_abort_min"
                | "quick_abort_pct"
                | "range_offset_limit"
                | "read_ahead_gap"
                | "read_timeout"
                | "redirector_bypass"
                | "referer_log"
                | "refresh_all_ims"
                | "refresh_stale_hit"
                | "relaxed_header_parser"
                | "reload_into_ims"
                | "reply_body_max_size"
                | "reply_header_access"
                | "reply_header_max_size"
                | "request_body_max_size"
                | "request_entities"
                | "request_header_access"
                | "request_header_max_size"
                | "request_timeout"
                | "retry_on_error"
                | "server_http11"
                | "server_persistent_connections"
                | "short_icon_urls"
                | "shutdown_lifetime"
                | "sleep_after_fork"
                | "snmp_access"
                | "snmp_incoming_address"
                | "snmp_outgoing_address"
                | "snmp_port"
                | "ssl_bump"
                | "ssl_engine"
                | "sslpassword_program"
                | "sslproxy_cafile"
                | "sslproxy_capath"
                | "sslproxy_cert_error"
                | "sslproxy_cipher"
                | "sslproxy_client_certificate"
                | "sslproxy_client_key"
                | "sslproxy_flags"
                | "sslproxy_options"
                | "sslproxy_version"
                | "ssl_unclean_shutdown"
                | "store_avg_object_size"
                | "store_dir_select_algorithm"
                | "store_objects_per_bucket"
                | "storeurl_access"
                | "storeurl_rewrite_children"
                | "storeurl_rewrite_concurrency"
                | "storeurl_rewrite_program"
                | "strip_query_terms"
                | "tcp_outgoing_address"
                | "tcp_outgoing_tos"
                | "tcp_recv_bufsize"
                | "test_reachability"
                | "udp_incoming_address"
                | "udp_outgoing_address"
                | "umask"
                | "unique_hostname"
                | "unlinkd_program"
                | "update_headers"
                | "uri_whitespace"
                | "url_rewrite_access"
                | "url_rewrite_bypass"
                | "url_rewrite_children"
                | "url_rewrite_concurrency"
                | "url_rewrite_host_header"
                | "url_rewrite_program"
                | "useragent_log"
                | "vary_ignore_expire"
                | "via"
                | "visible_hostname"
                | "wccp2_address"
                | "wccp2_assignment_method"
                | "wccp2_forwarding_method"
                | "wccp2_rebuild_wait"
                | "wccp2_return_method"
                | "wccp2_router"
                | "wccp2_service"
                | "wccp2_service_info"
                | "wccp2_weight"
                | "wccp_address"
                | "wccp_router"
                | "wccp_version"
                | "windows_ipaddrchangemonitor"
                | "zero_buffers"
                | "zph_local"
                | "zph_mode"
                | "zph_option"
                | "zph_parent"
                | "zph_sibling"

let entry       = indent . (Build.key_ws_value entry_re)

(************************************************************************
 *                                AUTH
 *************************************************************************)

let auth_re     = "auth_param"
let auth        = indent
                  . [ key "auth_param"
                  . value "scheme"
                  . value "parameter"
                  . (value_space_in "setting") ?
                  . comment_or_eol ]

(************************************************************************
 *                                ACL
 *************************************************************************)

let acl_re     = "acl"
let acl        = indent
                 . [ key acl_re . spc
                 . [ key word
                   . value "type"
                   . value "setting"
                   . parameters?
                   . comment_or_eol ] ]

(************************************************************************
 *                             HTTP ACCESS
 *************************************************************************)

let http_access_re
               = "http_access"
               | "upgrade_http0.9"
               | "broken_vary_encoding"

let http_access
               = indent
                 . [ key http_access_re
                 . spc
                 . [ key /allow|deny/
                   . spc
                   . sto_to_spc
                   . parameters? ]
                 . comment_or_eol ]

(************************************************************************
 *                             REFRESH PATTERN
 *************************************************************************)

let refresh_pattern_option_re = "override-expire"
		              | "override-lastmod"
		              | "reload-into-ims"
		              | "ignore-reload"
		              | "ignore-no-cache"
		              | "ignore-no-store"
		              | "ignore-must-revalidate"
		              | "ignore-private"
		              | "ignore-auth"
		              | "refresh-ims"
		              | "store-stale"

let refresh_pattern = indent . [ key "refresh_pattern" . spc
                      . [ label "case_insensitive" . Util.del_str "-i" . spc ]?
                      . store /[^ \t\n]+/ . spc
                      . [ label "min" . store Rx.integer ] . spc
                      . [ label "percent" . store Rx.integer . Util.del_str "%" ] . spc
                      . [ label "max" . store Rx.integer ]
                      . (spc . Build.opt_list [ label "option" . store refresh_pattern_option_re ] spc)?
                      . comment_or_eol ]

(************************************************************************
 *                             EXTENSION METHODS
 *************************************************************************)

let extension_methods = indent . [ key "extension_methods" . spc
                        . Build.opt_list [ seq "extension_method" . store Rx.word ] spc
                        . comment_or_eol ]

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

let lns         = (comment|empty|entry|auth|acl|http_access|refresh_pattern|extension_methods)*

let filter      = incl "/etc/squid/squid.conf"
                . incl "/etc/squid3/squid.conf"

let xfm         = transform lns filter

(* Squid module for Augeas
   Author: Free Ekanayaka <free@64studio.com>

   Reference: the self-documented default squid.conf file

*)

module Squid =
  autoload xfm

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

let eol         = Util.eol
let spc         = Util.del_ws_spc
let indent      = Util.indent

let word        =  /[A-Za-z0-9!_.-]+(\[[0-9]+\])?/
let sto_to_spc  = store /[^# \t\n]+/
let sto_to_eol  = store /([^# \t\n][^#\n]*[^# \t\n])|[^# \t\n]/

let comment     = Util.comment
let empty       = Util.empty
let comment_or_eol = Util.comment_or_eol
let value (kw:string)
                = [ spc . label kw . sto_to_spc ]

let value_space_in (kw:string)
                = [ spc . label kw . sto_to_eol ]

let parameters  = [ label "parameters"
                   . counter "parameters"
                   . [ spc . seq "parameters" . sto_to_spc ]+ ]

(************************************************************************
 *                          SPACEVARS SETTINGS
 *************************************************************************)

let entry_re =    "accept_filter"
                | "access_log"
                | "acl_uses_indirect_client"
                | "adaptation_access"
                | "adaptation_service_set"
                | "allow_underscore"
                | "always_direct"
                | "announce_file"
                | "announce_host"
                | "announce_period"
                | "announce_port"
                | "append_domain"
                | "as_whois_server"
                | "authenticate_cache_garbage_interval"
                | "authenticate_ip_shortcircuit_access"
                | "authenticate_ip_shortcircuit_ttl"
                | "authenticate_ip_ttl"
                | "authenticate_ttl"
                | "background_ping_rate"
                | "balance_on_multiple_ip"
                | "broken_posts"
                | "buffered_logs"
                | "cache"
                | "cache_dir"
                | "cache_dns_program"
                | "cache_effective_group"
                | "cache_effective_user"
                | "cache_log"
                | "cache_mem"
                | "cache_mgr"
                | "cachemgr_passwd"
                | "cache_peer"
                | "cache_peer_access"
                | "cache_peer_domain"
                | "cache_replacement_policy"
                | "cache_store_log"
                | "cache_swap_high"
                | "cache_swap_low"
                | "cache_swap_state"
                | "cache_vary"
                | "check_hostnames"
                | "chroot"
                | "client_db"
                | "client_lifetime"
                | "client_netmask"
                | "client_persistent_connections"
                | "clientside_tos"
                | "collapsed_forwarding"
                | "connect_timeout"
                | "coredump_dir"
                | "dead_peer_timeout"
                | "debug_options"
                | "delay_access"
                | "delay_class"
                | "delay_initial_bucket_level"
                | "delay_parameters"
                | "delay_pools"
                | "delay_pool_uses_indirect_client"
                | "deny_info"
                | "detect_broken_pconn"
                | "digest_bits_per_entry"
                | "digest_generation"
                | "digest_rebuild_chunk_percentage"
                | "digest_rebuild_period"
                | "digest_rewrite_period"
                | "digest_swapout_chunk_size"
                | "diskd_program"
                | "dns_children"
                | "dns_defnames"
                | "dns_nameservers"
                | "dns_retransmit_interval"
                | "dns_testnames"
                | "dns_timeout"
                | "dns_v4_fallback"
                | "ecap_enable"
                | "ecap_service"
                | "email_err_data"
                | "emulate_httpd_log"
                | "err_html_text"
                | "error_default_language"
                | "error_directory"
                | "error_log_languages"
                | "error_map"
                | "err_page_stylesheet"
                | "esi_parser"
                | "external_acl_type"
                | "external_refresh_check"
                | "follow_x_forwarded_for"
                | "forwarded_for"
                | "forward_log"
                | "forward_timeout"
                | "fqdncache_size"
                | "ftp_epsv_all"
                | "ftp_list_width"
                | "ftp_passive"
                | "ftp_sanitycheck"
                | "ftp_telnet_protocol"
                | "ftp_user"
                | "global_internal_static"
                | "half_closed_clients"
                | "header_access"
                | "header_replace"
                | "hierarchy_stoplist"
                | "high_memory_warning"
                | "high_page_fault_warning"
                | "high_response_time_warning"
                | "hostname_aliases"
                | "hosts_file"
                | "htcp_access"
                | "htcp_clr_access"
                | "htcp_port"
                | "http_accel_surrogate_remote"
                | "http_access2"
                | "httpd_accel_no_pmtu_disc"
                | "httpd_accel_surrogate_id"
                | "httpd_suppress_version_string"
                | "http_port"
                | "http_reply_access"
                | "https_port"
                | "icap_access"
                | "icap_class"
                | "icap_client_username_encode"
                | "icap_client_username_header"
                | "icap_connect_timeout"
                | "icap_default_options_ttl"
                | "icap_enable"
                | "icap_io_timeout"
                | "icap_persistent_connections"
                | "icap_preview_enable"
                | "icap_preview_size"
                | "icap_send_client_ip"
                | "icap_send_client_username"
                | "icap_service"
                | "icap_service_failure_limit"
                | "icap_service_revival_delay"
                | "icon_directory"
                | "icp_access"
                | "icp_hit_stale"
                | "icp_port"
                | "icp_query_timeout"
                | "ident_lookup_access"
                | "ident_timeout"
                | "ie_refresh"
                | "ignore_expect_100"
                | "ignore_ims_on_miss"
                | "ignore_unknown_nameservers"
                | "incoming_dns_average"
                | "incoming_http_average"
                | "incoming_icp_average"
                | "incoming_rate"
                | "ipcache_high"
                | "ipcache_low"
                | "ipcache_size"
                | "loadable_modules"
                | "location_rewrite_access"
                | "location_rewrite_children"
                | "location_rewrite_concurrency"
                | "location_rewrite_program"
                | "log_access"
                | "logfile_daemon"
                | "logfile_rotate"
                | "logformat"
                | "log_fqdn"
                | "log_icp_queries"
                | "log_ip_on_direct"
                | "log_mime_hdrs"
                | "log_uses_indirect_client"
                | "mail_from"
                | "mail_program"
                | "max_filedescriptors"
                | "maximum_icp_query_timeout"
                | "maximum_object_size"
                | "maximum_object_size_in_memory"
                | "maximum_single_addr_tries"
                | "max_open_disk_fds"
                | "max_stale"
                | "mcast_groups"
                | "mcast_icp_query_timeout"
                | "mcast_miss_addr"
                | "mcast_miss_encode_key"
                | "mcast_miss_port"
                | "mcast_miss_ttl"
                | "memory_pools"
                | "memory_pools_limit"
                | "memory_replacement_policy"
                | "mime_table"
                | "min_dns_poll_cnt"
                | "min_http_poll_cnt"
                | "min_icp_poll_cnt"
                | "minimum_direct_hops"
                | "minimum_direct_rtt"
                | "minimum_expiry_time"
                | "minimum_icp_query_timeout"
                | "minimum_object_size"
                | "miss_access"
                | "negative_dns_ttl"
                | "negative_ttl"
                | "neighbor_type_domain"
                | "netdb_filename"
                | "netdb_high"
                | "netdb_low"
                | "netdb_ping_period"
                | "never_direct"
                | "no_cache"
                | "nonhierarchical_direct"
                | "offline_mode"
                | "pconn_timeout"
                | "peer_connect_timeout"
                | "persistent_connection_after_error"
                | "persistent_request_timeout"
                | "pid_filename"
                | "pinger_enable"
                | "pinger_program"
                | "pipeline_prefetch"
                | "positive_dns_ttl"
                | "prefer_direct"
                | "qos_flows"
                | "query_icmp"
                | "quick_abort_max"
                | "quick_abort_min"
                | "quick_abort_pct"
                | "range_offset_limit"
                | "read_ahead_gap"
                | "read_timeout"
                | "redirector_bypass"
                | "referer_log"
                | "refresh_all_ims"
                | "refresh_stale_hit"
                | "relaxed_header_parser"
                | "reload_into_ims"
                | "reply_body_max_size"
                | "reply_header_access"
                | "reply_header_max_size"
                | "request_body_max_size"
                | "request_entities"
                | "request_header_access"
                | "request_header_max_size"
                | "request_timeout"
                | "retry_on_error"
                | "server_http11"
                | "server_persistent_connections"
                | "short_icon_urls"
                | "shutdown_lifetime"
                | "sleep_after_fork"
                | "snmp_access"
                | "snmp_incoming_address"
                | "snmp_outgoing_address"
                | "snmp_port"
                | "ssl_bump"
                | "ssl_engine"
                | "sslpassword_program"
                | "sslproxy_cafile"
                | "sslproxy_capath"
                | "sslproxy_cert_error"
                | "sslproxy_cipher"
                | "sslproxy_client_certificate"
                | "sslproxy_client_key"
                | "sslproxy_flags"
                | "sslproxy_options"
                | "sslproxy_version"
                | "ssl_unclean_shutdown"
                | "store_avg_object_size"
                | "store_dir_select_algorithm"
                | "store_objects_per_bucket"
                | "storeurl_access"
                | "storeurl_rewrite_children"
                | "storeurl_rewrite_concurrency"
                | "storeurl_rewrite_program"
                | "strip_query_terms"
                | "tcp_outgoing_address"
                | "tcp_outgoing_tos"
                | "tcp_recv_bufsize"
                | "test_reachability"
                | "udp_incoming_address"
                | "udp_outgoing_address"
                | "umask"
                | "unique_hostname"
                | "unlinkd_program"
                | "update_headers"
                | "uri_whitespace"
                | "url_rewrite_access"
                | "url_rewrite_bypass"
                | "url_rewrite_children"
                | "url_rewrite_concurrency"
                | "url_rewrite_host_header"
                | "url_rewrite_program"
                | "useragent_log"
                | "vary_ignore_expire"
                | "via"
                | "visible_hostname"
                | "wccp2_address"
                | "wccp2_assignment_method"
                | "wccp2_forwarding_method"
                | "wccp2_rebuild_wait"
                | "wccp2_return_method"
                | "wccp2_router"
                | "wccp2_service"
                | "wccp2_service_info"
                | "wccp2_weight"
                | "wccp_address"
                | "wccp_router"
                | "wccp_version"
                | "windows_ipaddrchangemonitor"
                | "zero_buffers"
                | "zph_local"
                | "zph_mode"
                | "zph_option"
                | "zph_parent"
                | "zph_sibling"

let entry       = indent . (Build.key_ws_value entry_re)

(************************************************************************
 *                                AUTH
 *************************************************************************)

let auth_re     = "auth_param"
let auth        = indent
                  . [ key "auth_param"
                  . value "scheme"
                  . value "parameter"
                  . (value_space_in "setting") ?
                  . comment_or_eol ]

(************************************************************************
 *                                ACL
 *************************************************************************)

let acl_re     = "acl"
let acl        = indent
                 . [ key acl_re . spc
                 . [ key word
                   . value "type"
                   . value "setting"
                   . parameters?
                   . comment_or_eol ] ]

(************************************************************************
 *                             HTTP ACCESS
 *************************************************************************)

let http_access_re
               = "http_access"
               | "upgrade_http0.9"
               | "broken_vary_encoding"

let http_access
               = indent
                 . [ key http_access_re
                 . spc
                 . [ key /allow|deny/
                   . spc
                   . sto_to_spc
                   . parameters? ]
                 . comment_or_eol ]

(************************************************************************
 *                             REFRESH PATTERN
 *************************************************************************)

let refresh_pattern_option_re = "override-expire"
		              | "override-lastmod"
		              | "reload-into-ims"
		              | "ignore-reload"
		              | "ignore-no-cache"
		              | "ignore-no-store"
		              | "ignore-must-revalidate"
		              | "ignore-private"
		              | "ignore-auth"
		              | "refresh-ims"
		              | "store-stale"

let refresh_pattern = indent . [ key "refresh_pattern" . spc
                      . [ label "case_insensitive" . Util.del_str "-i" . spc ]?
                      . store /[^ \t\n]+/ . spc
                      . [ label "min" . store Rx.integer ] . spc
                      . [ label "percent" . store Rx.integer . Util.del_str "%" ] . spc
                      . [ label "max" . store Rx.integer ]
                      . (spc . Build.opt_list [ label "option" . store refresh_pattern_option_re ] spc)?
                      . comment_or_eol ]

(************************************************************************
 *                             EXTENSION METHODS
 *************************************************************************)

let extension_methods = indent . [ key "extension_methods" . spc
                        . Build.opt_list [ seq "extension_method" . store Rx.word ] spc
                        . comment_or_eol ]

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

let lns         = (comment|empty|entry|auth|acl|http_access|refresh_pattern|extension_methods)*

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

let xfm         = transform lns filter


Add big WARNING to aptconf.aug

Add big WARNING to aptconf.aug

(*
Module: AptConf
 Parses /etc/apt/apt.conf and /etc/apt/apt.conf.d/*

Author: Raphael Pinson <raphink@gmail.com>

About: Reference
 This lens tries to keep as close as possible to `man 5 apt.conf`
where possible.

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

About: Lens Usage
  To be documented

About: Configuration files
  This lens applies to /etc/apt/apt.conf and /etc/apt/apt.conf.d/*.
See <filter>.
*)

module AptConf =
 autoload xfm

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

(* View: eol
   And <Util.eol> end of line *)
let eol = Util.eol

(* View: empty
   A C-style empty line *)
let empty = Util.empty_c_style

(* View: indent
   An indentation *)
let indent = Util.indent

(* View: comment_simple
   A one-line comment, C-style *)
let comment_simple = Util.comment_c_style

(* View: comment_multi
   A multiline comment, C-style *)
let comment_multi = Util.comment_multiline

(* View: comment
   A comment, either <comment_simple> or <comment_multi> *)
let comment = comment_simple | comment_multi

(************************************************************************
 * Group:                 ENTRIES
 *************************************************************************)

(* View: name_re
   Regex for entry names *)
let name_re = /[A-Za-z][A-Za-z-]*/

(* View: name_re_colons
   Regex for entry names with colons *)
let name_re_colons = /[A-Za-z][A-Za-z:-]*/

(* View: entry
   An apt.conf entry, recursive

   WARNING:
     This lens exploits a put ambiguity
     since apt.conf allows for both
     APT { Clean-Installed { "true" } }
     and APT::Clean-Installed "true";
     but we're chosing to map them the same way

     The recursive lens doesn't seem
     to care and defaults to the first
     item in the union.

     This is why the APT { Clean-Installed { "true"; } }
     form is listed first, since it supports
     all subnodes (which Dpkg::Conf) doesn't.

     Exchanging these two expressions in the union
     makes tests fails since the tree cannot
     be mapped back.

     This situation results in existing
     configuration being modified when the
     associated tree is modified. For example,
     changing the value of
     APT::Clean-Installed "true"; to "false"
     results in
     APT { Clean-Installed "false"; }
     (see unit tests)
 *)
let rec entry_noeol =
 let value =
    Util.del_str "\"" . store /[^"\n]+/
                      . del /";?/ "\";" in
 let opt_eol = del /[ \t\n]*/ "\n" in
 let long_eol = del /[ \t]*\n+/ "\n" in
 let list_elem = [ opt_eol . label "@elem" . value ] in
 let eol_comment = del /([ \t\n]*\n)?/ "" . comment in
     [ key name_re . Sep.space . value ]
   | [ key name_re . del /[ \t\n]*\{/ " {" .
         ( (opt_eol . entry_noeol) |
           list_elem |
           eol_comment
           )* .
         del /[ \t\n]*\};?/ "\n};" ]
   | [ key name_re . Util.del_str "::" . entry_noeol ]

let entry = indent . entry_noeol . eol

(* View: include
   A file inclusion
   /!\ The manpage is not clear on the syntax *)
let include =
 [ indent . key "#include" . Sep.space
          . store Rx.fspath . eol ]

(* View: clear
   A list of variables to clear
   /!\ The manpage is not clear on the syntax *)
let clear =
 let name = [ label "name" . store name_re_colons ] in
 [ indent . key "#clear" . Sep.space
          . Build.opt_list name Sep.space
          . eol ]

(************************************************************************
 * Group:                 LENS AND FILTER
 *************************************************************************)

(* View: lns
    The apt.conf lens *)
let lns = (empty|comment|entry|include|clear)*

(* View: filter *)
let filter = incl "/etc/apt/apt.conf"
   . incl "/etc/apt/apt.conf.d/*"
   . Util.stdexcl

let xfm = transform lns filter

(*
Module: AptConf
 Parses /etc/apt/apt.conf and /etc/apt/apt.conf.d/*

Author: Raphael Pinson <raphink@gmail.com>

About: Reference
 This lens tries to keep as close as possible to `man 5 apt.conf`
where possible.

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

About: Lens Usage
  To be documented

About: Configuration files
  This lens applies to /etc/apt/apt.conf and /etc/apt/apt.conf.d/*.
See <filter>.
*)

module AptConf =
 autoload xfm

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

(* View: eol
   And <Util.eol> end of line *)
let eol = Util.eol

(* View: empty
   A C-style empty line *)
let empty = Util.empty_c_style

(* View: indent
   An indentation *)
let indent = Util.indent

(* View: comment_simple
   A one-line comment, C-style *)
let comment_simple = Util.comment_c_style

(* View: comment_multi
   A multiline comment, C-style *)
let comment_multi = Util.comment_multiline

(* View: comment
   A comment, either <comment_simple> or <comment_multi> *)
let comment = comment_simple | comment_multi

(************************************************************************
 * Group:                 ENTRIES
 *************************************************************************)

(* View: name_re
   Regex for entry names *)
let name_re = /[A-Za-z][A-Za-z-]*/

(* View: name_re_colons
   Regex for entry names with colons *)
let name_re_colons = /[A-Za-z][A-Za-z:-]*/

(* View: entry
   An apt.conf entry, recursive *)
let rec entry_noeol =
 let value =
    Util.del_str "\"" . store /[^"\n]+/
                      . del /";?/ "\";" in
 let opt_eol = del /[ \t\n]*/ "\n" in
 let long_eol = del /[ \t]*\n+/ "\n" in
 let list_elem = [ opt_eol . label "@elem" . value ] in
 let eol_comment = del /([ \t\n]*\n)?/ "" . comment in
     [ key name_re . Sep.space . value ]
   | [ key name_re . del /[ \t\n]*\{/ " {" .
         ( (opt_eol . entry_noeol) |
           list_elem |
           eol_comment
           )* .
         del /[ \t\n]*\};?/ "\n};" ]
   | [ key name_re . Util.del_str "::" . entry_noeol ]

let entry = indent . entry_noeol . eol

(* View: include
   A file inclusion
   /!\ The manpage is not clear on the syntax *)
let include =
 [ indent . key "#include" . Sep.space
          . store Rx.fspath . eol ]

(* View: clear
   A list of variables to clear
   /!\ The manpage is not clear on the syntax *)
let clear =
 let name = [ label "name" . store name_re_colons ] in
 [ indent . key "#clear" . Sep.space
          . Build.opt_list name Sep.space
          . eol ]

(************************************************************************
 * Group:                 LENS AND FILTER
 *************************************************************************)

(* View: lns
    The apt.conf lens *)
let lns = (empty|comment|entry|include|clear)*

(* View: filter *)
let filter = incl "/etc/apt/apt.conf"
   . incl "/etc/apt/apt.conf.d/*"
   . Util.stdexcl

let xfm = transform lns filter