Fai_Diskconfig: Optimize regexp substractions

(*
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 LGPL v2+, like the rest of Augeas.

About: Examples
   The <Test_FAI_DiskConfig> file contains various examples and tests.
*)

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 ]

(* Variable: generic_opt_list
   A generic key/list option *)
let generic_opt_list (type:string) (kw:regexp) =
   [ key type . Util.del_str ":" . counter "locallist"
   . Build.opt_list [seq "locallist" . store kw] Sep.comma ]

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

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

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

(* Variable: volume_lvm *)
let volume_lvm = volume_full type_label_lv size  (* lvm logical volume: vg name and lv name *)
               | volume_vg

(* Variable: volume_raid *)
let volume_raid = volume_full (key /raid[0156]/) disk_list  (* raid level *)

(* Variable: device *)
let device = [ label "device" . store Rx.fspath ]

(* Variable: volume_cryptsetup *)
let volume_cryptsetup = volume_full (key ("swap"|"tmp"|"luks")) device

(* Variable: volume *)
let volume = volume_full (key "primary") size     (* for physical disks only *)
           | volume_full (key "logical") size     (* for physical disks only *)
           | volume_full (key "raw-disk") size

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

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

(* Variable: lvmoption *)
let lvmoption =
     (* preserve partitions -- always *)
      generic_opt "preserve_always" /[^\/, \t\n-]+-[^\/, \t\n-]+(,[^\/, \t\n-]+-[^\/, \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_list "preserve_always" (Rx.integer | "all")
     (* preserve partitions -- unless the system is installed
      * for the first time *)
   | generic_opt_list "preserve_reinstall" Rx.integer
     (* 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_list "preserve_always" (Rx.integer | "all")
     (* preserve partitions -- unless the system is installed
        for the first time *)
   | generic_opt_list "preserve_reinstall" Rx.integer
     (* attempt to resize partitions *)
   | generic_opt_list "resize" Rx.integer
     (* 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/
   | generic_opt_list "always_format" Rx.integer
   | generic_opt "sameas" Rx.fspath

let cryptoption =
     [ key "randinit" ]

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

(* 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 LGPL v2+, like the rest of Augeas.

About: Examples
   The <Test_FAI_DiskConfig> file contains various examples and tests.
*)

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 ]

(* Variable: generic_opt_list
   A generic key/list option *)
let generic_opt_list (type:string) (kw:regexp) =
   [ key type . Util.del_str ":" . counter "locallist"
   . Build.opt_list [seq "locallist" . store kw] Sep.comma ]

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

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

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

(* Variable: volume_lvm *)
let volume_lvm = volume_full type_label_lv size  (* lvm logical volume: vg name and lv name *)
               | volume_vg

(* Variable: volume_raid *)
let volume_raid = volume_full (key /raid[0156]/) disk_list  (* raid level *)

(* Variable: device *)
let device = [ label "device" . store Rx.fspath ]

(* Variable: volume_cryptsetup *)
let volume_cryptsetup = volume_full (key ("swap"|"tmp"|"luks")) device

(* Variable: volume *)
let volume = volume_full (key "primary") size     (* for physical disks only *)
           | volume_full (key "logical") size     (* for physical disks only *)
           | volume_full (key "raw-disk") size

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

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

(* Variable: lvmoption *)
let lvmoption =
     (* preserve partitions -- always *)
      generic_opt "preserve_always" /[^\/, \t\n-]+-[^\/, \t\n-]+(,[^\/, \t\n-]+-[^\/, \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_list "preserve_always" (Rx.integer | "all")
     (* preserve partitions -- unless the system is installed
      * for the first time *)
   | generic_opt_list "preserve_reinstall" Rx.integer
     (* 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_list "preserve_always" (Rx.integer | "all")
     (* preserve partitions -- unless the system is installed
        for the first time *)
   | generic_opt_list "preserve_reinstall" Rx.integer
     (* attempt to resize partitions *)
   | generic_opt_list "resize" Rx.integer
     (* 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/
   | generic_opt_list "always_format" Rx.integer
   | generic_opt "sameas" Rx.fspath

let cryptoption =
     [ key "randinit" ]

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

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

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


Cleanly handle comments

Cleanly handle comments

# Parsing /etc/inittab

map
  grammar inittab
  include '/etc/inittab' '/system/config/inittab'
end

grammar inittab

  token SEP ':'
  token EOL '\n'
  token COMMENT /[ \t]*(#.*?)?\n/ = '# \n'

  file: ( comment | record ) *

  comment: [ COMMENT ]

  record: [ seq 'record' .
            [ label 'id' . store ..? ] .
            SEP .
            [ label 'runlevels' . store ..? ] .
            SEP .
            [ label 'action' . store ..? ] .
            SEP .
            [ label 'process' . store ..? ] .
            EOL
          ]
end

# Parsing /etc/inittab

map
  grammar inittab
  include '/etc/inittab' '/system/config/inittab'
end

grammar inittab

  token SEP ':'
  token EOL '\n'

  file: ( comment | record ) *

  comment: ( /#.*?\n/ | /[ \t]*\n/ )

  record: [ seq 'record' .
            [ label 'id' . store ..? ] .
            SEP .
            [ label 'runlevels' . store ..? ] .
            SEP .
            [ label 'action' . store ..? ] .
            SEP .
            [ label 'process' . store ..? ] .
            EOL
          ]
end


Quote: Improve documentation for functions

(*
Module: Quote
  Generic module providing useful primitives for quoting

Author: Raphael Pinson <raphink@gmail.com>

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

About: Lens Usage
   To be documented

About: Examples
   The <Test_Quote> file contains various examples and tests.
*)

module Quote =

(* Group: QUOTE SEPARATORS *)

(* Variable: dquote
     A double quote *)
let dquote = Util.del_str "\""

(* Variable: dquote_opt
     An optional double quote, default to double *)
let dquote_opt = del /"?/ "\""

(* Variable: dquote_opt_nil
     An optional double quote, default to nothing *)
let dquote_opt_nil = del /"?/ ""

(* Variable: squote
     A single quote *)
let squote = Util.del_str "'"

(* Variable: squote_opt
     An optional single quote, default to single *)
let squote_opt = del /'?/ "'"

(* Variable: squote_opt_nil
     An optional single quote, default to nothing *)
let squote_opt_nil = del /'?/ ""

(* Variable: quote
     A quote, either double or single, default to double *)
let quote = del /["']/ "\""

(* Variable: quote_opt
     An optional quote, either double or single, default to double *)
let quote_opt = del /["']?/ "\""

(* Variable: quote_opt_nil
     An optional quote, either double or single, default to nothing *)
let quote_opt_nil = del /["']?/ ""

(* Group: QUOTING FUNCTIONS *)

(*
View: do_dquote
  Enclose a lens in <dquote>s

  Parameters:
    body:lens - the lens to be enclosed
*)
let do_dquote (body:lens) =
  square dquote body dquote

(*
View: do_dquote_opt
  Enclose a lens in optional <dquote>s,
  use <dquote>s by default.

  Parameters:
    body:lens - the lens to be enclosed
*)
let do_dquote_opt (body:lens) =
  square dquote_opt body dquote_opt

(*
View: do_dquote_opt_nil
  Enclose a lens in optional <dquote>s,
  default to no quotes.

  Parameters:
    body:lens - the lens to be enclosed
*)
let do_dquote_opt_nil (body:lens) =
  square dquote_opt_nil body dquote_opt_nil

(*
View: do_squote
  Enclose a lens in <squote>s

  Parameters:
    body:lens - the lens to be enclosed
*)
let do_squote (body:lens) =
  square squote body squote

(*
View: do_squote_opt
  Enclose a lens in optional <squote>s,
  use <squote>s by default.

  Parameters:
    body:lens - the lens to be enclosed
*)
let do_squote_opt (body:lens) =
  square squote_opt body squote_opt

(*
View: do_squote_opt_nil
  Enclose a lens in optional <squote>s,
  default to no quotes.

  Parameters:
    body:lens - the lens to be enclosed
*)
let do_squote_opt_nil (body:lens) =
  square squote_opt_nil body squote_opt_nil

(*
View: do_quote
  Enclose a lens in <quote>s.

  Parameters:
    body:lens - the lens to be enclosed
*)
let do_quote (body:lens) =
  square quote body quote

(*
View: do_quote
  Enclose a lens in options <quote>s.

  Parameters:
    body:lens - the lens to be enclosed
*)
let do_quote_opt (body:lens) =
  square quote_opt body quote_opt

(*
View: do_quote
  Enclose a lens in options <quote>s,
  default to no quotes.

  Parameters:
    body:lens - the lens to be enclosed
*)
let do_quote_opt_nil (body:lens) =
  square quote_opt_nil body quote_opt_nil

(* Group: QUOTED VALUES *)

(* View: double
     A double-quoted value *)
let double =
     let body = store /[^\n]*/
  in do_dquote body

(* Variable: double_opt_re
     The regexp to store when value
     is optionally double-quoted *)
let double_opt_re = /[^\n\t "]([^\n"]*[^\n\t "])?/

(* View: double_opt
     An optionaly double-quoted value
     Double quotes are not allowed in value
     Value cannot begin or end with spaces *)
let double_opt =
     let body = store double_opt_re
  in do_dquote_opt body

(* View: single
     A single-quoted value *)
let single =
     let body = store /[^\n]*/
  in do_squote body

(* Variable: single_opt_re
     The regexp to store when value
     is optionally single-quoted *)
let single_opt_re = /[^\n\t ']([^\n']*[^\n\t '])?/

(* View: single_opt
     An optionaly single-quoted value
     Single quotes are not allowed in value
     Value cannot begin or end with spaces *)
let single_opt =
     let body = store single_opt_re
  in do_squote_opt body

(* View: any
     A quoted value *)
let any =
     let body = store /[^\n]*/
  in do_quote body

(* Variable: any_opt_re
     The regexp to store when value
     is optionally single- or double-quoted *)
let any_opt_re = /[^\n\t "']([^\n"']*[^\n\t "'])?/

(* View: any_opt
     An optionaly quoted value
     Double or single quotes are not allowed in value
     Value cannot begin or end with spaces *)
let any_opt =
     let body = store any_opt_re
  in do_quote_opt body

(*
View: quote_spaces
  Make quotes mandatory if value contains spaces,
  and optional if value doesn't contain spaces.

Parameters:
  lns:lens - the lens to be enclosed
*)
let quote_spaces (lns:lens) =
     (* bare has no spaces, and is optionally quoted *)
     let bare = Quote.do_quote_opt (store /[^"' \t\n]+/)
     (* quoted has at least one space, and must be quoted *)
  in let quoted = Quote.do_quote (store /[^"' \t\n]*[ \t][^"' \t\n]*/)
  in [ lns . bare ] | [ lns . quoted ]

(*
View: dquote_spaces
  Make double quotes mandatory if value contains spaces,
  and optional if value doesn't contain spaces.

Parameters:
  lns:lens - the lens to be enclosed
*)
let dquote_spaces (lns:lens) =
     (* bare has no spaces, and is optionally quoted *)
     let bare = Quote.do_dquote_opt (store /[^" \t\n]+/)
     (* quoted has at least one space, and must be quoted *)
  in let quoted = Quote.do_dquote (store /[^" \t\n]*[ \t][^" \t\n]*/)
  in [ lns . bare ] | [ lns . quoted ]

(*
View: squote_spaces
  Make single quotes mandatory if value contains spaces,
  and optional if value doesn't contain spaces.

Parameters:
  lns:lens - the lens to be enclosed
*)
let squote_spaces (lns:lens) =
     (* bare has no spaces, and is optionally quoted *)
     let bare = Quote.do_squote_opt (store /[^' \t\n]+/)
     (* quoted has at least one space, and must be quoted *)
  in let quoted = Quote.do_squote (store /[^' \t\n]*[ \t][^' \t\n]*/)
  in [ lns . bare ] | [ lns . quoted ]

(*
Module: Quote
  Generic module providing useful primitives for quoting

Author: Raphael Pinson <raphink@gmail.com>

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

About: Lens Usage
   To be documented

About: Examples
   The <Test_Quote> file contains various examples and tests.
*)

module Quote =

(* Group: QUOTE SEPARATORS *)

(* Variable: dquote
     A double quote *)
let dquote = Util.del_str "\""

(* Variable: dquote_opt
     An optional double quote, default to double *)
let dquote_opt = del /"?/ "\""

(* Variable: dquote_opt_nil
     An optional double quote, default to nothing *)
let dquote_opt_nil = del /"?/ ""

(* Variable: squote
     A single quote *)
let squote = Util.del_str "'"

(* Variable: squote_opt
     An optional single quote, default to single *)
let squote_opt = del /'?/ "'"

(* Variable: squote_opt_nil
     An optional single quote, default to nothing *)
let squote_opt_nil = del /'?/ ""

(* Variable: quote
     A quote, either double or single, default to double *)
let quote = del /["']/ "\""

(* Variable: quote_opt
     An optional quote, either double or single, default to double *)
let quote_opt = del /["']?/ "\""

(* Variable: quote_opt_nil
     An optional quote, either double or single, default to nothing *)
let quote_opt_nil = del /["']?/ ""

(* Group: QUOTING FUNCTIONS *)

(* View: do_dquote *)
let do_dquote (body:lens) =
  square dquote body dquote

(* View: do_dquote_opt *)
let do_dquote_opt (body:lens) =
  square dquote_opt body dquote_opt

(* View: do_dquote_opt *)
let do_dquote_opt_nil (body:lens) =
  square dquote_opt_nil body dquote_opt_nil

(* View: do_squote *)
let do_squote (body:lens) =
  square squote body squote

(* View: do_squote_opt *)
let do_squote_opt (body:lens) =
  square squote_opt body squote_opt

(* View: do_squote_opt_nil *)
let do_squote_opt_nil (body:lens) =
  square squote_opt_nil body squote_opt_nil

(* View: do_quote *)
let do_quote (body:lens) =
  square quote body quote

(* View: do_quote_opt *)
let do_quote_opt (body:lens) =
  square quote_opt body quote_opt

(* View: do_quote_opt_nil *)
let do_quote_opt_nil (body:lens) =
  square quote_opt_nil body quote_opt_nil

(* Group: QUOTED VALUES *)

(* View: double
     A double-quoted value *)
let double =
     let body = store /[^\n]*/
  in do_dquote body

(* Variable: double_opt_re
     The regexp to store when value
     is optionally double-quoted *)
let double_opt_re = /[^\n\t "]([^\n"]*[^\n\t "])?/

(* View: double_opt
     An optionaly double-quoted value
     Double quotes are not allowed in value
     Value cannot begin or end with spaces *)
let double_opt =
     let body = store double_opt_re
  in do_dquote_opt body

(* View: single
     A single-quoted value *)
let single =
     let body = store /[^\n]*/
  in do_squote body

(* Variable: single_opt_re
     The regexp to store when value
     is optionally single-quoted *)
let single_opt_re = /[^\n\t ']([^\n']*[^\n\t '])?/

(* View: single_opt
     An optionaly single-quoted value
     Single quotes are not allowed in value
     Value cannot begin or end with spaces *)
let single_opt =
     let body = store single_opt_re
  in do_squote_opt body

(* View: any
     A quoted value *)
let any =
     let body = store /[^\n]*/
  in do_quote body

(* Variable: any_opt_re
     The regexp to store when value
     is optionally single- or double-quoted *)
let any_opt_re = /[^\n\t "']([^\n"']*[^\n\t "'])?/

(* View: any_opt
     An optionaly quoted value
     Double or single quotes are not allowed in value
     Value cannot begin or end with spaces *)
let any_opt =
     let body = store any_opt_re
  in do_quote_opt body

(* View: quote_spaces
     Make quotes mandatory if value contains spaces,
     and optional if value doesn't contain spaces. *)
let quote_spaces (lns:lens) =
     (* bare has no spaces, and is optionally quoted *)
     let bare = Quote.do_quote_opt (store /[^"' \t\n]+/)
     (* quoted has at least one space, and must be quoted *)
  in let quoted = Quote.do_quote (store /[^"' \t\n]*[ \t][^"' \t\n]*/)
  in [ lns . bare ] | [ lns . quoted ]

(* View: dquote_spaces
     Make double quotes mandatory if value contains spaces,
     and optional if value doesn't contain spaces. *)
let dquote_spaces (lns:lens) =
     (* bare has no spaces, and is optionally quoted *)
     let bare = Quote.do_dquote_opt (store /[^" \t\n]+/)
     (* quoted has at least one space, and must be quoted *)
  in let quoted = Quote.do_dquote (store /[^" \t\n]*[ \t][^" \t\n]*/)
  in [ lns . bare ] | [ lns . quoted ]

(* View: squote_spaces
     Make single quotes mandatory if value contains spaces,
     and optional if value doesn't contain spaces. *)
let squote_spaces (lns:lens) =
     (* bare has no spaces, and is optionally quoted *)
     let bare = Quote.do_squote_opt (store /[^' \t\n]+/)
     (* quoted has at least one space, and must be quoted *)
  in let quoted = Quote.do_squote (store /[^' \t\n]*[ \t][^' \t\n]*/)
  in [ lns . bare ] | [ lns . quoted ]


* lenses/rx.aug (fspath): simplistic regex for filesystem paths


Ssh: only look for *.conf files in /etc/ssh/ssh_config.d

The previous commit would have slurped in all files in that directory, but
only *.conf files are important.

Patch by Ian Mortimer

(*
Module: Ssh
  Parses ssh client configuration

Author: Jiri Suchomel <jsuchome@suse.cz>

About: Reference
    ssh_config man page

About: License
    This file is licensed under the GPL.

About: Lens Usage
  Sample usage of this lens in augtool

(start code)
augtool> set /files/etc/ssh/ssh_config/Host example.com
augtool> set /files/etc/ssh/ssh_config/Host[.='example.com']/RemoteForward/machine1:1234 machine2:5678
augtool> set /files/etc/ssh/ssh_config/Host[.='example.com']/Ciphers/1 aes128-ctr
augtool> set /files/etc/ssh/ssh_config/Host[.='example.com']/Ciphers/2 aes192-ctr
(end code)

*)

module Ssh =
    autoload xfm

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

    let eol = Util.doseol
    let spc = Util.del_ws_spc

    let comment = Util.comment
    let empty = Util.empty
    let comma = Util.del_str ","
    let indent = Util.indent
    let value_to_eol = store Rx.space_in
    let value_to_spc = store Rx.no_spaces
    let value_to_comma = store /[^, \t\r\n]+/

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

    let array_entry (k:regexp) =
        [ indent . key k . counter "array_entry"
         . [ spc . seq "array_entry" . value_to_spc]* . eol ]

    let commas_entry (k:regexp) =
         let value = [ seq "commas_entry" . value_to_comma]
      in [ indent . key k . counter "commas_entry" . spc .
           Build.opt_list value comma . eol ]

    let spaces_entry (k:regexp) =
         let value = [ seq "spaces_entry" . value_to_spc ]
      in [ indent . key k . counter "spaces_entry" . spc .
           Build.opt_list value spc . eol ]

    let fw_entry (k:regexp) = [ indent . key k . spc .
	    [ key /[^ \t\r\n\/]+/ . spc . value_to_eol . eol ]]

    let send_env = array_entry /SendEnv/i

    let proxy_command = [ indent . key /ProxyCommand/i . spc . value_to_eol . eol ]

    let remote_fw = fw_entry /RemoteForward/i
    let local_fw = fw_entry /LocalForward/i

    let ciphers = commas_entry /Ciphers/i
    let macs	= commas_entry /MACs/i
    let algorithms = commas_entry /(HostKey|Kex)Algorithms/i
    let pubkey_accepted_key_types = commas_entry /PubkeyAcceptedKeyTypes/i

    let global_knownhosts_file = spaces_entry /GlobalKnownHostsFile/i

    let special_entry = send_env
	                    | proxy_command
	                    | remote_fw
	                    | local_fw
	                    | macs
	                    | ciphers
	                    | algorithms
	                    | pubkey_accepted_key_types
                      | global_knownhosts_file

    let key_re = /[A-Za-z0-9]+/
               - /SendEnv|Host|ProxyCommand|RemoteForward|LocalForward|MACs|Ciphers|(HostKey|Kex)Algorithms|PubkeyAcceptedKeyTypes|GlobalKnownHostsFile/i

    let other_entry = [ indent . key key_re
                    . spc . value_to_spc . eol ]

    let entry = comment | empty
              | special_entry
	            | other_entry

    let host = [ key /Host/i . spc . value_to_eol . eol . entry* ]

(************************************************************************
 * Group:                 LENS
 *************************************************************************)

    let lns = entry* . host*

    let xfm = transform lns (incl "/etc/ssh/ssh_config" .
                             incl (Sys.getenv("HOME") . "/.ssh/config") .
                             incl "/etc/ssh/ssh_config.d/*.conf")

(*
Module: Ssh
  Parses ssh client configuration

Author: Jiri Suchomel <jsuchome@suse.cz>

About: Reference
    ssh_config man page

About: License
    This file is licensed under the GPL.

About: Lens Usage
  Sample usage of this lens in augtool

(start code)
augtool> set /files/etc/ssh/ssh_config/Host example.com
augtool> set /files/etc/ssh/ssh_config/Host[.='example.com']/RemoteForward/machine1:1234 machine2:5678
augtool> set /files/etc/ssh/ssh_config/Host[.='example.com']/Ciphers/1 aes128-ctr
augtool> set /files/etc/ssh/ssh_config/Host[.='example.com']/Ciphers/2 aes192-ctr
(end code)

*)

module Ssh =
    autoload xfm

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

    let eol = Util.doseol
    let spc = Util.del_ws_spc

    let comment = Util.comment
    let empty = Util.empty
    let comma = Util.del_str ","
    let indent = Util.indent
    let value_to_eol = store Rx.space_in
    let value_to_spc = store Rx.no_spaces
    let value_to_comma = store /[^, \t\r\n]+/

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

    let array_entry (k:regexp) =
        [ indent . key k . counter "array_entry"
         . [ spc . seq "array_entry" . value_to_spc]* . eol ]

    let commas_entry (k:regexp) =
         let value = [ seq "commas_entry" . value_to_comma]
      in [ indent . key k . counter "commas_entry" . spc .
           Build.opt_list value comma . eol ]

    let spaces_entry (k:regexp) =
         let value = [ seq "spaces_entry" . value_to_spc ]
      in [ indent . key k . counter "spaces_entry" . spc .
           Build.opt_list value spc . eol ]

    let fw_entry (k:regexp) = [ indent . key k . spc .
	    [ key /[^ \t\r\n\/]+/ . spc . value_to_eol . eol ]]

    let send_env = array_entry /SendEnv/i

    let proxy_command = [ indent . key /ProxyCommand/i . spc . value_to_eol . eol ]

    let remote_fw = fw_entry /RemoteForward/i
    let local_fw = fw_entry /LocalForward/i

    let ciphers = commas_entry /Ciphers/i
    let macs	= commas_entry /MACs/i
    let algorithms = commas_entry /(HostKey|Kex)Algorithms/i
    let pubkey_accepted_key_types = commas_entry /PubkeyAcceptedKeyTypes/i

    let global_knownhosts_file = spaces_entry /GlobalKnownHostsFile/i

    let special_entry = send_env
	                    | proxy_command
	                    | remote_fw
	                    | local_fw
	                    | macs
	                    | ciphers
	                    | algorithms
	                    | pubkey_accepted_key_types
                      | global_knownhosts_file

    let key_re = /[A-Za-z0-9]+/
               - /SendEnv|Host|ProxyCommand|RemoteForward|LocalForward|MACs|Ciphers|(HostKey|Kex)Algorithms|PubkeyAcceptedKeyTypes|GlobalKnownHostsFile/i

    let other_entry = [ indent . key key_re
                    . spc . value_to_spc . eol ]

    let entry = comment | empty
              | special_entry
	            | other_entry

    let host = [ key /Host/i . spc . value_to_eol . eol . entry* ]

(************************************************************************
 * Group:                 LENS
 *************************************************************************)

    let lns = entry* . host*

    let xfm = transform lns (incl "/etc/ssh/ssh_config" .
                             incl (Sys.getenv("HOME") . "/.ssh/config") .
                             incl "/etc/ssh/ssh_config.d/*")


Xorg: autoload from /etc/X11/xorg.conf.d/*.conf

Based on patch by manugupta

Fixes bug #197

(*
Module: Xorg
 Parses /etc/X11/xorg.conf

Authors: Raphael Pinson <raphink@gmail.com>
         Matthew Booth <mbooth@redhat.com>

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

The definitions from `man xorg.conf` are put as commentaries for reference
throughout the file. More information can be found in the manual.

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

About: Lens Usage
  Sample usage of this lens in augtool

    * Get the identifier of the devices with a "Clone" option:
      > match "/files/etc/X11/xorg.conf/Device[Option = 'Clone']/Identifier"

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

module Xorg =
  autoload xfm

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

(* Group: Generic primitives *)

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

(* Variable: to_eol
 * Match everything from here to eol, cropping whitespace at both ends
 *)
let to_eol  = /[^ \t\n](.*[^ \t\n])?/

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

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

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

(* Group: Separators *)

(* Variable: sep_spc *)
let sep_spc = Util.del_ws_spc

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

(* Group: Fields and values *)

(* Variable: entries_re
 * This is a list of all patterns which have specific handlers, and should
 * therefore not be matched by the generic handler
 *)
let entries_re  = /([oO]ption|[sS]creen|[iI]nput[dD]evice|[dD]river|[sS]ub[sS]ection|[dD]isplay|[iI]dentifier|[vV]ideo[rR]am|[dD]efault[dD]epth|[dD]evice)/

(* Variable: generic_entry_re *)
let generic_entry_re = /[^# \t\n\/]+/ - entries_re

(* Variable: quoted_string_val *)
let quoted_string_val = del "\"" "\"" . store /[^"\n]+/ . del "\"" "\""
                                              (* " relax, emacs *)

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

(************************************************************************
 * Group:                          ENTRIES AND OPTIONS
 *************************************************************************)

(* View: entry_int
 * This matches an entry which takes a single integer for an argument
 *)
let entry_int (canon:string) (re:regexp) =
        [ indent . del re canon . label canon . sep_spc . store int . eol ]

(* View: entry_rgb
 * This matches an entry which takes 3 integers as arguments representing red,
 * green and blue components
 *)
let entry_rgb (canon:string) (re:regexp) =
        [ indent . del re canon . label canon
          . [ label "red"   . sep_spc . store int ]
          . [ label "green" . sep_spc . store int ]
          . [ label "blue"  . sep_spc . store int ]
          . eol ]

(* View: entry_xy
 * This matches an entry which takes 2 integers as arguments representing X and
 * Y coordinates
 *)
let entry_xy (canon:string) (re:regexp) =
        [ indent . del re canon . label canon
          . [ label "x" . sep_spc . store int ]
          . [ label "y" . sep_spc . store int ]
          . eol ]

(* View: entry_str
 * This matches an entry which takes a single quoted string
 *)
let entry_str (canon:string) (re:regexp) =
        [ indent . del re canon . label canon
          . sep_spc . quoted_string_val . eol ]

(* View: entry_generic
 * An entry without a specific handler. Store everything after the keyword,
 * cropping whitespace at both ends.
 *)
let entry_generic  = [ indent . key generic_entry_re
                       . sep_spc . store to_eol . eol ]

(* View: option *)
let option = [ indent . del /[oO]ption/ "Option" . label "Option" . sep_spc
               . quoted_string_val
               . [ label "value" . sep_spc . quoted_string_val ]*
               . eol ]

(* View: screen
 * The Screen entry of ServerLayout
 *)
let screen = [ indent . del /[sS]creen/ "Screen" . label "Screen" . sep_spc
               . [ label "num" . store int . sep_spc ]?
               . quoted_string_val
               . [ sep_spc . label "position" . store to_eol ]?
               . eol ]

(* View: input_device *)
let input_device = [ indent . del /[iI]nput[dD]evice/ "InputDevice"
                     . label "InputDevice" . sep_spc . quoted_string_val
                     . [ label "option" . sep_spc . quoted_string_val ]*
                     . eol ]

(* View: driver *)
let driver = entry_str "Driver" /[dD]river/

(* View: identifier *)
let identifier = entry_str "Identifier" /[iI]dentifier/

(* View: videoram *)
let videoram = entry_int "VideoRam" /[vV]ideo[rR]am/

(* View: default_depth *)
let default_depth = entry_int "DefaultDepth" /[dD]efault[dD]epth/

(* View: device *)
let device = entry_str "Device" /[dD]evice/

(************************************************************************
 * Group:                          DISPLAY SUBSECTION
 *************************************************************************)

(* View: display_modes *)
let display_modes = [ indent . del /[mM]odes/ "Modes" . label "Modes"
                      . [ label "mode" . sep_spc . quoted_string_val ]+
                      . eol ]

(*************************************************************************
 * View: display_entry
 *   Known values for entries in the Display subsection
 *
 *   Definition:
 *     > Depth    depth
 *     > FbBpp    bpp
 *     > Weight   red-weight green-weight blue-weight
 *     > Virtual  xdim ydim
 *     > ViewPort x0 y0
 *     > Modes    "mode-name" ...
 *     > Visual   "visual-name"
 *     > Black    red green blue
 *     > White    red green blue
 *     > Options
 *)

let display_entry = entry_int "Depth"    /[dD]epth/ |
                    entry_int "FbBpp"    /[fF]b[bB]pp/ |
                    entry_rgb "Weight"   /[wW]eight/ |
                    entry_xy  "Virtual"  /[vV]irtual/ |
                    entry_xy  "ViewPort" /[vV]iew[pP]ort/ |
                    display_modes |
                    entry_str "Visual"   /[vV]isual/ |
                    entry_rgb "Black"    /[bB]lack/ |
                    entry_rgb "White"    /[wW]hite/ |
                    entry_str "Options"  /[oO]ptions/ |
                    empty |
                    comment

(* View: display *)
let display = [ indent . del "SubSection" "SubSection" . sep_spc
                       . sep_dquote . key "Display" . sep_dquote
                       . eol
                       . display_entry*
                       . indent . del "EndSubSection" "EndSubSection" . eol ]

(************************************************************************
 * Group:                       SECTIONS
 *************************************************************************)

(************************************************************************
 * Variable: section_re
 *   Known values for Section names
 *
 *   Definition:
 *     >   The section names are:
 *     >
 *     >   Files          File pathnames
 *     >   ServerFlags    Server flags
 *     >   Module         Dynamic module loading
 *     >   Extensions     Extension Enabling
 *     >   InputDevice    Input device description
 *     >   InputClass     Input Class description
 *     >   Device         Graphics device description
 *     >   VideoAdaptor   Xv video adaptor description
 *     >   Monitor        Monitor description
 *     >   Modes          Video modes descriptions
 *     >   Screen         Screen configuration
 *     >   ServerLayout   Overall layout
 *     >   DRI            DRI-specific configuration
 *     >   Vendor         Vendor-specific configuration
 *************************************************************************)
let section_re = /(Extensions|Files|ServerFlags|Module|InputDevice|Device|VideoAdaptor|Monitor|Modes|Screen|ServerLayout|DRI|Vendor)/

(************************************************************************
 * Variable: secton_re_obsolete
 *   The  following obsolete section names are still recognised for
 *   compatibility purposes.  In new config files, the InputDevice
 *   section should be used instead.
 *
 *   Definition:
 *     >  Keyboard       Keyboard configuration
 *     >  Pointer        Pointer/mouse configuration
 *************************************************************************)
let section_re_obsolete = /(Keyboard|Pointer)/

(* View: section_entry *)
let section_entry = option |
                    screen |
                    display |
                    input_device |
                    driver |
                    identifier |
                    videoram |
                    default_depth |
                    device |
                    entry_generic |
                    empty | comment

(************************************************************************
 * View: section
 *   A section in xorg.conf
 *
 *   Definition:
 *     > Section  "SectionName"
 *     >    SectionEntry
 *     >    ...
 *     > EndSection
 *************************************************************************)
let section = [ indent . del "Section" "Section"
                       . sep_spc . sep_dquote
                       . key (section_re|section_re_obsolete) . sep_dquote
                       . eol
                .  section_entry*
                . indent . del "EndSection" "EndSection" . eol ]

(*
 * View: lns
 *   The xorg.conf lens
 *)
let lns = ( empty | comment | section )*

(* Variable: filter *)
let filter = (incl "/etc/X11/xorg.conf") .
  (incl "/etc/X11/xorg.conf.d/*.conf") .
  Util.stdexcl

let xfm = transform lns filter

(*
Module: Xorg
 Parses /etc/X11/xorg.conf

Authors: Raphael Pinson <raphink@gmail.com>
         Matthew Booth <mbooth@redhat.com>

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

The definitions from `man xorg.conf` are put as commentaries for reference
throughout the file. More information can be found in the manual.

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

About: Lens Usage
  Sample usage of this lens in augtool

    * Get the identifier of the devices with a "Clone" option:
      > match "/files/etc/X11/xorg.conf/Device[Option = 'Clone']/Identifier"

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

module Xorg =
  autoload xfm

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

(* Group: Generic primitives *)

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

(* Variable: to_eol
 * Match everything from here to eol, cropping whitespace at both ends
 *)
let to_eol  = /[^ \t\n](.*[^ \t\n])?/

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

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

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

(* Group: Separators *)

(* Variable: sep_spc *)
let sep_spc = Util.del_ws_spc

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

(* Group: Fields and values *)

(* Variable: entries_re
 * This is a list of all patterns which have specific handlers, and should
 * therefore not be matched by the generic handler
 *)
let entries_re  = /([oO]ption|[sS]creen|[iI]nput[dD]evice|[dD]river|[sS]ub[sS]ection|[dD]isplay|[iI]dentifier|[vV]ideo[rR]am|[dD]efault[dD]epth|[dD]evice)/

(* Variable: generic_entry_re *)
let generic_entry_re = /[^# \t\n\/]+/ - entries_re

(* Variable: quoted_string_val *)
let quoted_string_val = del "\"" "\"" . store /[^"\n]+/ . del "\"" "\""
                                              (* " relax, emacs *)

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

(************************************************************************
 * Group:                          ENTRIES AND OPTIONS
 *************************************************************************)

(* View: entry_int
 * This matches an entry which takes a single integer for an argument
 *)
let entry_int (canon:string) (re:regexp) =
        [ indent . del re canon . label canon . sep_spc . store int . eol ]

(* View: entry_rgb
 * This matches an entry which takes 3 integers as arguments representing red,
 * green and blue components
 *)
let entry_rgb (canon:string) (re:regexp) =
        [ indent . del re canon . label canon
          . [ label "red"   . sep_spc . store int ]
          . [ label "green" . sep_spc . store int ]
          . [ label "blue"  . sep_spc . store int ]
          . eol ]

(* View: entry_xy
 * This matches an entry which takes 2 integers as arguments representing X and
 * Y coordinates
 *)
let entry_xy (canon:string) (re:regexp) =
        [ indent . del re canon . label canon
          . [ label "x" . sep_spc . store int ]
          . [ label "y" . sep_spc . store int ]
          . eol ]

(* View: entry_str
 * This matches an entry which takes a single quoted string
 *)
let entry_str (canon:string) (re:regexp) =
        [ indent . del re canon . label canon
          . sep_spc . quoted_string_val . eol ]

(* View: entry_generic
 * An entry without a specific handler. Store everything after the keyword,
 * cropping whitespace at both ends.
 *)
let entry_generic  = [ indent . key generic_entry_re
                       . sep_spc . store to_eol . eol ]

(* View: option *)
let option = [ indent . del /[oO]ption/ "Option" . label "Option" . sep_spc
               . quoted_string_val
               . [ label "value" . sep_spc . quoted_string_val ]*
               . eol ]

(* View: screen
 * The Screen entry of ServerLayout
 *)
let screen = [ indent . del /[sS]creen/ "Screen" . label "Screen" . sep_spc
               . [ label "num" . store int . sep_spc ]?
               . quoted_string_val
               . [ sep_spc . label "position" . store to_eol ]?
               . eol ]

(* View: input_device *)
let input_device = [ indent . del /[iI]nput[dD]evice/ "InputDevice"
                     . label "InputDevice" . sep_spc . quoted_string_val
                     . [ label "option" . sep_spc . quoted_string_val ]*
                     . eol ]

(* View: driver *)
let driver = entry_str "Driver" /[dD]river/

(* View: identifier *)
let identifier = entry_str "Identifier" /[iI]dentifier/

(* View: videoram *)
let videoram = entry_int "VideoRam" /[vV]ideo[rR]am/

(* View: default_depth *)
let default_depth = entry_int "DefaultDepth" /[dD]efault[dD]epth/

(* View: device *)
let device = entry_str "Device" /[dD]evice/

(************************************************************************
 * Group:                          DISPLAY SUBSECTION
 *************************************************************************)

(* View: display_modes *)
let display_modes = [ indent . del /[mM]odes/ "Modes" . label "Modes"
                      . [ label "mode" . sep_spc . quoted_string_val ]+
                      . eol ]

(*************************************************************************
 * View: display_entry
 *   Known values for entries in the Display subsection
 *
 *   Definition:
 *     > Depth    depth
 *     > FbBpp    bpp
 *     > Weight   red-weight green-weight blue-weight
 *     > Virtual  xdim ydim
 *     > ViewPort x0 y0
 *     > Modes    "mode-name" ...
 *     > Visual   "visual-name"
 *     > Black    red green blue
 *     > White    red green blue
 *     > Options
 *)

let display_entry = entry_int "Depth"    /[dD]epth/ |
                    entry_int "FbBpp"    /[fF]b[bB]pp/ |
                    entry_rgb "Weight"   /[wW]eight/ |
                    entry_xy  "Virtual"  /[vV]irtual/ |
                    entry_xy  "ViewPort" /[vV]iew[pP]ort/ |
                    display_modes |
                    entry_str "Visual"   /[vV]isual/ |
                    entry_rgb "Black"    /[bB]lack/ |
                    entry_rgb "White"    /[wW]hite/ |
                    entry_str "Options"  /[oO]ptions/ |
                    empty |
                    comment

(* View: display *)
let display = [ indent . del "SubSection" "SubSection" . sep_spc
                       . sep_dquote . key "Display" . sep_dquote
                       . eol
                       . display_entry*
                       . indent . del "EndSubSection" "EndSubSection" . eol ]

(************************************************************************
 * Group:                       SECTIONS
 *************************************************************************)

(************************************************************************
 * Variable: section_re
 *   Known values for Section names
 *
 *   Definition:
 *     >   The section names are:
 *     >
 *     >   Files          File pathnames
 *     >   ServerFlags    Server flags
 *     >   Module         Dynamic module loading
 *     >   InputDevice    Input device description
 *     >   Device         Graphics device description
 *     >   VideoAdaptor   Xv video adaptor description
 *     >   Monitor        Monitor description
 *     >   Modes          Video modes descriptions
 *     >   Screen         Screen configuration
 *     >   ServerLayout   Overall layout
 *     >   DRI            DRI-specific configuration
 *     >   Vendor         Vendor-specific configuration
 *************************************************************************)
let section_re = /(Extensions|Files|ServerFlags|Module|InputDevice|Device|VideoAdaptor|Monitor|Modes|Screen|ServerLayout|DRI|Vendor)/

(************************************************************************
 * Variable: secton_re_obsolete
 *   The  following obsolete section names are still recognised for
 *   compatibility purposes.  In new config files, the InputDevice
 *   section should be used instead.
 *
 *   Definition:
 *     >  Keyboard       Keyboard configuration
 *     >  Pointer        Pointer/mouse configuration
 *************************************************************************)
let section_re_obsolete = /(Keyboard|Pointer)/

(* View: section_entry *)
let section_entry = option |
                    screen |
                    display |
                    input_device |
                    driver |
                    identifier |
                    videoram |
                    default_depth |
                    device |
                    entry_generic |
                    empty | comment

(************************************************************************
 * View: section
 *   A section in xorg.conf
 *
 *   Definition:
 *     > Section  "SectionName"
 *     >    SectionEntry
 *     >    ...
 *     > EndSection
 *************************************************************************)
let section = [ indent . del "Section" "Section"
                       . sep_spc . sep_dquote
                       . key (section_re|section_re_obsolete) . sep_dquote
                       . eol
                .  section_entry*
                . indent . del "EndSection" "EndSection" . eol ]

(*
 * View: lns
 *   The xorg.conf lens
 *)
let lns = ( empty | comment | section )*

(* Variable: filter *)
let filter = (incl "/etc/X11/xorg.conf")

let xfm = transform lns filter


switched the httpd.aug to the version from 1.2

(* Apache HTTPD lens for Augeas

Authors:
  David Lutterkort <lutter@redhat.com>
  Francis Giraldeau <francis.giraldeau@usherbrooke.ca>
  Raphael Pinson <raphink@gmail.com>

About: Reference
  Online Apache configuration manual: http://httpd.apache.org/docs/trunk/

About: License
    This file is licensed under the LGPL v2+.

About: Lens Usage
  Sample usage of this lens in augtool

  Apache configuration is represented by two main structures, nested sections
  and directives. Sections are used as labels, while directives are kept as a
  value. Sections and directives can have positional arguments inside values
  of "arg" nodes. Arguments of sections must be the firsts child of the
  section node.

  This lens doesn't support automatic string quoting. Hence, the string must
  be quoted when containing a space.

  Create a new VirtualHost section with one directive:
  > clear /files/etc/apache2/sites-available/foo/VirtualHost
  > set /files/etc/apache2/sites-available/foo/VirtualHost/arg "172.16.0.1:80"
  > set /files/etc/apache2/sites-available/foo/VirtualHost/directive "ServerAdmin"
  > set /files/etc/apache2/sites-available/foo/VirtualHost/*[self::directive="ServerAdmin"]/arg "admin@example.com"

About: Configuration files
  This lens applies to files in /etc/httpd and /etc/apache2. See <filter>.

*)

module Httpd =

autoload xfm

(******************************************************************
 *                           Utilities lens
 *****************************************************************)
let dels (s:string)     = del s s

(* deal with continuation lines *)
let sep_spc    =  del /([ \t]+|[ \t]*\\\\\r?\n[ \t]*)/ " "

let sep_osp             = Sep.opt_space
let sep_eq              = del /[ \t]*=[ \t]*/ "="

let nmtoken             = /[a-zA-Z:_][a-zA-Z0-9:_.-]*/
let word                = /[a-zA-Z][a-zA-Z0-9._-]*/

let comment             = Util.comment
let eol                 = Util.doseol
let empty               = Util.empty_dos
let indent              = Util.indent

(* borrowed from shellvars.aug *)
let char_arg_dir  = /[^ '"\t\r\n]|\\\\"|\\\\'/
let char_arg_sec  = /[^ '"\t\r\n>]|\\\\"|\\\\'/
let dquot = /"([^"\\\r\n]|\\\\.)*"/
let squot = /'([^'\\\r\n]|\\\\.)*'/

(******************************************************************
 *                            Attributes
 *****************************************************************)

let arg_dir = [ label "arg" . store (char_arg_dir+|dquot|squot) ]
let arg_sec = [ label "arg" . store (char_arg_sec+|dquot|squot) ]

let argv (l:lens) = l . (sep_spc . l)*

let directive = [ indent . label "directive" . store word .
                  (sep_spc . argv arg_dir)? . eol ]

let section (body:lens) =
    let inner = (sep_spc . argv arg_sec)? . sep_osp .
             dels ">" . eol . body* . indent . dels "</" in
    let kword = key word in
    let dword = del word "a" in
        [ indent . dels "<" . square kword inner dword . del ">" ">" . eol ]

let rec content = section (content|directive|comment|empty)

let lns = (content|directive|comment|empty)*

let filter = (incl "/etc/apache2/apache2.conf") .
             (incl "/etc/apache2/httpd.conf") .
             (incl "/etc/apache2/ports.conf") .
             (incl "/etc/apache2/conf.d/*") .
             (incl "/etc/apache2/mods-available/*") .
             (incl "/etc/apache2/sites-available/*") .
             (incl "/etc/httpd/conf.d/*.conf") .
             (incl "/etc/httpd/httpd.conf") .
             (incl "/etc/httpd/conf/httpd.conf") .
             Util.stdexcl

let xfm = transform lns filter

(* Apache HTTPD lens for Augeas

Authors:
  David Lutterkort <lutter@redhat.com>
  Francis Giraldeau <francis.giraldeau@usherbrooke.ca>
  Raphael Pinson <raphink@gmail.com>

About: Reference
  Online Apache configuration manual: http://httpd.apache.org/docs/trunk/

About: License
    This file is licensed under the LGPL v2+.

About: Lens Usage
  Sample usage of this lens in augtool

  Apache configuration is represented by two main structures, nested sections
  and directives. Sections are used as labels, while directives are kept as a
  value. Sections and directives can have positional arguments inside values
  of "arg" nodes. Arguments of sections must be the firsts child of the
  section node.

  This lens doesn't support automatic string quoting. Hence, the string must
  be quoted when containing a space.

  Create a new VirtualHost section with one directive:
  > clear /files/etc/apache2/sites-available/foo/VirtualHost
  > set /files/etc/apache2/sites-available/foo/VirtualHost/arg "172.16.0.1:80"
  > set /files/etc/apache2/sites-available/foo/VirtualHost/directive "ServerAdmin"
  > set /files/etc/apache2/sites-available/foo/VirtualHost/*[self::directive="ServerAdmin"]/arg "admin@example.com"

About: Configuration files
  This lens applies to files in /etc/httpd and /etc/apache2. See <filter>.

*)

module Httpd =

autoload xfm

(******************************************************************
 *                           Utilities lens
 *****************************************************************)
let dels (s:string)     = del s s

(* deal with continuation lines *)
let sep_spc    =  del /([ \t]+|[ \t]*\\\\\r?\n[ \t]*)/ " "

let sep_osp             = Sep.opt_space
let sep_eq              = del /[ \t]*=[ \t]*/ "="

let nmtoken             = /[a-zA-Z:_][a-zA-Z0-9:_.-]*/
let word                = /[a-zA-Z][a-zA-Z0-9._-]*/

let comment             = Util.comment
let eol                 = Util.doseol
let empty               = Util.empty_dos
let indent              = Util.indent

(* borrowed from shellvars.aug *)
let char_arg_dir  = /[^\\ '"\t\r\n]|\\\\"|\\\\'/
let char_arg_sec  = /[^ '"\t\r\n>]|\\\\"|\\\\'/
let cdot = /\\\\./
let cl = /\\\\\n/
let dquot =
     let no_dquot = /[^"\\\r\n]/
  in /"/ . (no_dquot|cdot|cl)* . /"/
let squot =
     let no_squot = /[^'\\\r\n]/
  in /'/ . (no_squot|cdot|cl)* . /'/
let comp = /[<>=]?=/

(******************************************************************
 *                            Attributes
 *****************************************************************)

let arg_dir = [ label "arg" . store (char_arg_dir+|dquot|squot) ]
let arg_sec = [ label "arg" . store (char_arg_sec+|comp|dquot|squot) ]

let argv (l:lens) = l . (sep_spc . l)*

let directive = [ indent . label "directive" . store word .
                  (sep_spc . argv arg_dir)? . eol ]

let section (body:lens) =
    (* opt_eol includes empty lines *)
    let opt_eol = del /([ \t]*#?\r?\n)*/ "\n" in
    let inner = (sep_spc . argv arg_sec)? . sep_osp .
             dels ">" . opt_eol . ((body|comment) . (body|empty|comment)*)? .
             indent . dels "</" in
    let kword = key word in
    let dword = del word "a" in
        [ indent . dels "<" . square kword inner dword . del ">" ">" . eol ]

let rec content = section (content|directive)

let lns = (content|directive|comment|empty)*

let filter = (incl "/etc/apache2/apache2.conf") .
             (incl "/etc/apache2/httpd.conf") .
             (incl "/etc/apache2/ports.conf") .
             (incl "/etc/apache2/conf.d/*") .
             (incl "/etc/apache2/conf-available/*.conf") .
             (incl "/etc/apache2/mods-available/*") .
             (incl "/etc/apache2/sites-available/*") .
             (incl "/etc/httpd/conf.d/*.conf") .
             (incl "/etc/httpd/httpd.conf") .
             (incl "/etc/httpd/conf/httpd.conf") .
             Util.stdexcl

let xfm = transform lns filter


Shellvars: parse /etc/rc.conf.local which is found on OpenBSD.

Fixes ticket #320

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

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

About: Lens Usage
   To be documented
*)

module Shellvars =
  autoload xfm

  let empty   = Util.empty
  let empty_part_re = Util.empty_generic_re . /\n+/
  let eol = del (/[ \t]+|[ \t]*[;\n]/ . empty_part_re*) "\n"
  let semicol_eol = del (/[ \t]*[;\n]/ . empty_part_re*) "\n"

  let key_re = /[A-Za-z0-9_]+(\[[0-9]+\])?/ - "unset" - "export"
  let matching_re = "${!" . key_re . /[\*@]\}/
  let eq = Util.del_str "="

  let eol_for_comment = del /([ \t]*\n)([ \t]*(#[ \t]*)?\n)*/ "\n"
  let comment = Util.comment_generic_seteol /[ \t]*#[ \t]*/ " # " eol_for_comment
  (* comment_eol in shell MUST begin with a space *)
  let comment_eol = Util.comment_generic_seteol /[ \t]+#[ \t]*/ " # " eol_for_comment
  let comment_or_eol = comment_eol | semicol_eol

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

  let char  = /[^`;() '"\t\n]|\\\\"/
  let dquot = /"([^"\\]|\\\\.)*"/                    (* " Emacs, relax *)
  let squot = /'[^']*'/
  let bquot = /`[^`\n]*`/
  (* dbquot don't take spaces or semi-colons *)
  let dbquot = /``[^` \t\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 | dbquot | dollar_assign | empty_array)

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

  let var_action (name:string) =
    [ Util.indent . xchgs name ("@" . name) . Util.del_ws_spc
    . store (key_re | matching_re) . 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" | "shift" | "exit"

  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+ | ("\"" . char+ . "\""))
        . del /[ \t\n]+/ " " . Util.del_str "in" . eol
        . (empty* . comment* . case_entry)*
        . empty* . comment*
        . 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 | 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_norec = empty* . (comment | source | kv | unset | bare_export | builtin | return) *

  let lns = empty* . (comment | 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 "bootloader" .
      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_excl "network" .
      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_excl "network-scripts" .
      sc_incl "network-scripts/ifcfg-*" .
      sc_excl "rhn" .
      sc_incl "rhn/allowed-actions/*" .
      sc_excl "rhn/allowed-actions/script" .
      sc_incl "rhn/allowed-actions/script/*" .
      sc_incl "rhn/rhnsd" .
      sc_excl "SuSEfirewall2.d" .
      sc_incl "SuSEfirewall2.d/cobbler" .
      sc_incl "SuSEfirewall2.d/services/*" .
      sc_excl "SuSEfirewall2.d/services/TEMPLATE"

  let filter_default = incl "/etc/default/*"
                     . excl "/etc/default/grub_installdevice*"
                     . excl "/etc/default/whoopsie"
  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/os-release"
                     . incl "/etc/popularity-contest.conf"
                     . incl "/etc/rc.conf"
                     . incl "/etc/rc.conf.local"
                     . incl "/etc/selinux/config"
                     . incl "/etc/ucf.conf"
                     . incl "/etc/locale.conf"
                     . incl "/etc/vconsole.conf"

  let filter = filter_sysconfig
             . 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 LGPL v2+, like the rest of Augeas.

About: Lens Usage
   To be documented
*)

module Shellvars =
  autoload xfm

  let empty   = Util.empty
  let empty_part_re = Util.empty_generic_re . /\n+/
  let eol = del (/[ \t]+|[ \t]*[;\n]/ . empty_part_re*) "\n"
  let semicol_eol = del (/[ \t]*[;\n]/ . empty_part_re*) "\n"

  let key_re = /[A-Za-z0-9_]+(\[[0-9]+\])?/ - "unset" - "export"
  let matching_re = "${!" . key_re . /[\*@]\}/
  let eq = Util.del_str "="

  let eol_for_comment = del /([ \t]*\n)([ \t]*(#[ \t]*)?\n)*/ "\n"
  let comment = Util.comment_generic_seteol /[ \t]*#[ \t]*/ " # " eol_for_comment
  (* comment_eol in shell MUST begin with a space *)
  let comment_eol = Util.comment_generic_seteol /[ \t]+#[ \t]*/ " # " eol_for_comment
  let comment_or_eol = comment_eol | semicol_eol

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

  let char  = /[^`;() '"\t\n]|\\\\"/
  let dquot = /"([^"\\]|\\\\.)*"/                    (* " Emacs, relax *)
  let squot = /'[^']*'/
  let bquot = /`[^`\n]*`/
  (* dbquot don't take spaces or semi-colons *)
  let dbquot = /``[^` \t\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 | dbquot | dollar_assign | empty_array)

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

  let var_action (name:string) =
    [ Util.indent . xchgs name ("@" . name) . Util.del_ws_spc
    . store (key_re | matching_re) . 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" | "shift" | "exit"

  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+ | ("\"" . char+ . "\""))
        . del /[ \t\n]+/ " " . Util.del_str "in" . eol
        . (empty* . comment* . case_entry)*
        . empty* . comment*
        . 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 | 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_norec = empty* . (comment | source | kv | unset | bare_export | builtin | return) *

  let lns = empty* . (comment | 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 "bootloader" .
      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_excl "network" .
      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_excl "network-scripts" .
      sc_incl "network-scripts/ifcfg-*" .
      sc_excl "rhn" .
      sc_incl "rhn/allowed-actions/*" .
      sc_excl "rhn/allowed-actions/script" .
      sc_incl "rhn/allowed-actions/script/*" .
      sc_incl "rhn/rhnsd" .
      sc_excl "SuSEfirewall2.d" .
      sc_incl "SuSEfirewall2.d/cobbler" .
      sc_incl "SuSEfirewall2.d/services/*" .
      sc_excl "SuSEfirewall2.d/services/TEMPLATE"

  let filter_default = incl "/etc/default/*"
                     . excl "/etc/default/grub_installdevice*"
                     . excl "/etc/default/whoopsie"
  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/os-release"
                     . incl "/etc/popularity-contest.conf"
                     . incl "/etc/rc.conf"
                     . incl "/etc/selinux/config"
                     . incl "/etc/ucf.conf"
                     . incl "/etc/locale.conf"
                     . incl "/etc/vconsole.conf"

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

  let xfm = transform lns filter

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


Yum: also read files in /etc/yum/pluginconf.d

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

  let eol = Util.del_str "\n"

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

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

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

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

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

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

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

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

  let entry = comment | kv

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

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

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

  let xfm = transform lns filter

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

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

  let eol = Util.del_str "\n"

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

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

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

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

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

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

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

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

  let entry = comment | kv

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

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

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

  let xfm = transform lns filter

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