Rewrite xinetd.aug with Build, Sep, Rx

Rewrite xinetd.aug with Build, Sep, Rx

(*
 * Module: Xinetd
 *   Parses xinetd configuration files
 *
 *  The structure of the lens and allowed attributes are ripped directly
 *  from xinetd's parser in xinetd/parse.c in xinetd's source checkout
 *  The downside of being so precise here is that if attributes are added
 *  they need to be added here, too. Writing a catchall entry, and getting
 *  to typecheck correctly would be a huge pain.
 *
 *  A really enterprising soul could tighten this down even further by
 *  restricting the acceptable values for each attribute.
 *
 * Author: David Lutterkort
 *)

module Xinetd =
  autoload xfm

  let op = ([ label "add" . Util.delim "+=" ]
           |[ label "del" . Util.delim "-=" ]
           | Sep.space_equal)

  let value = store Rx.no_spaces

  let indent = del Rx.opt_space "\t"

  let attr_one (n:regexp) =
    Build.key_value n Sep.space_equal value

  let attr_lst (n:regexp) (op_eq: lens) =
    let value_entry =  [ label "value" . value ] in
    Build.key_value n op_eq (Build.opt_list value_entry Sep.space)

  let attr_lst_eq (n:regexp) = attr_lst n Sep.space_equal

  let attr_lst_op (n:regexp) = attr_lst n op

  (* Variable: service_attr
   *   Note:
   *      It is much faster to combine, for example, all the attr_one
   *      attributes into one regexp and pass that to a lens instead of
   *      using lens union (attr_one "a" | attr_one "b"|..) because the latter
   *      causes the type checker to work _very_ hard.
   *)
  let service_attr =
    attr_one ("socket_type" | "protocol" | "wait" | "user" | "group"
             |"server" | "instances"  | "rpc_version" | "rpc_number"
             | "id" | "port" | "nice" | "banner" | "bind" | "interface"
             | "per_source" | "groups" | "banner_success" | "banner_fail"
             | "disable" | "max_load" | "rlimit_as" | "rlimit_cpu"
             | "rlimit_data" | "rlimit_rss" | "rlimit_stack" | "v6only"
             | "deny_time" | "umask" | "mdns" | "libwrap")
   (* redirect and cps aren't really lists, they take exactly two values *)
   |attr_lst_eq ("server_args" | "log_type" |  "access_times" | "type"
                | "flags" | "redirect" | "cps")
   |attr_lst_op ( "log_on_success" | "log_on_failure"| "only_from"
                | "no_access" | "env" | "passenv")

  let default_attr =
    attr_one ( "instances" | "banner" | "bind" | "interface" | "per_source"
             | "groups" | "banner_success" | "banner_fail" | "max_load"
             | "v6only" | "umask" | "mdns")
   |attr_lst_eq "cps"       (* really only two values, not a whole list *)
   |attr_lst_op ( "log_type" | "log_on_success" | "log_on_failure" | "disabled"
                | "no_access" | "only_from" | "passenv" | "enabled" )

  (* View: body
   *   Note:
   *       We would really like to say "the body can contain any of a list
   *       of a list of attributes, each of them at most once"; but that
   *       would require that we build a lens that matches the permutation
   *       of all attributes; with around 40 individual attributes, that's
   *       not computationally feasible, even if we didn't have to worry
   *       about how to write that down. The resulting regular expressions
   *       would simply be prohibitively large.
   *)
  let body (attr:lens) =
     let entry = indent . attr . Util.eol in
     let comment = indent . Util.comment_noindent in
     Build.block_generic entry entry entry entry (* ignore noindent and noeol *)
                         comment comment         (* ignore noindent and noeol *)
                         /[ \t\n]+\{[ \t]*\n/ /[ \t]*\}/  (* force newlines *)
                         "\n{\n" "}"                      (* force newlines *)

  (* View: includes
   *  Note:
   *   It would be nice if we could use the directories given in include and
   *   includedir directives to parse additional files instead of hardcoding
   *   all the places where xinetd config files can be found; but that is
   *   currently not possible, and implementing that has a good amount of
   *   hairy corner cases to consider.
   *)
  let includes =
     Build.key_value_line /include(dir)?/ Sep.space (store Rx.no_spaces)

  let service =
     let sto_re = /[^# \t\n\/]+/ in
     Build.key_value_line "service" Sep.space (store sto_re . body service_attr)

  let defaults = [ key "defaults" . body default_attr . Util.eol ]

  let lns = ( Util.empty | Util.comment | includes | defaults | service )*

  let filter = incl "/etc/xinetd.d/*"
             . incl "/etc/xinetd.conf"
             . Util.stdexcl

  let xfm = transform lns filter

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

(*
 * Module: Xinetd
 *   Parses xinetd configuration files
 *
 *  The structure of the lens and allowed attributes are ripped directly
 *  from xinetd's parser in xinetd/parse.c in xinetd's source checkout
 *  The downside of being so precise here is that if attributes are added
 *  they need to be added here, too. Writing a catchall entry, and getting
 *  to typecheck correctly would be a huge pain.
 *
 *  A really enterprising soul could tighten this down even further by
 *  restricting the acceptable values for each attribute.
 *
 * Author: David Lutterkort
 *)

module Xinetd =
  autoload xfm

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

  let name = key /[^ \t\n\/=+-]+/
  let bol_spc = del /[ \t]*/ "\t"
  let spc = del /[ \t]+/ " "
  let eol = del /[ \t]*\n/ "\n"

  let op_delim (op:string) = del (/[ \t]*/ . op . /[ \t]*/) (" " . op . " ")
  let eq       = op_delim "="

  let op = ([ label "add" . op_delim "+=" ]
           |[ label "del" . op_delim "-=" ]
           | eq)

  let value = store /[^ \t\n]+/

  let attr_one (n:regexp) =
    [ bol_spc . key n . eq . value . eol ]

  let attr_lst (n:regexp) (op_eq: lens) =
    [ bol_spc . key n . op_eq .
        [label "value" . value] . [label "value" . spc . value]* .
      eol ]

  let attr_lst_eq (n:regexp) = attr_lst n eq

  let attr_lst_op (n:regexp) = attr_lst n op

  (* Variable: service_attr
   *   Note:
   *      It is much faster to combine, for example, all the attr_one
   *      attributes into one regexp and pass that to a lens instead of
   *      using lens union (attr_one "a" | attr_one "b"|..) because the latter
   *      causes the type checker to work _very_ hard.
   *)

  let service_attr =
    attr_one ("socket_type" | "protocol" | "wait" | "user" | "group"
             |"server" | "instances"  | "rpc_version" | "rpc_number"
             | "id" | "port" | "nice" | "banner" | "bind" | "interface"
             | "per_source" | "groups" | "banner_success" | "banner_fail"
             | "disable" | "max_load" | "rlimit_as" | "rlimit_cpu"
             | "rlimit_data" | "rlimit_rss" | "rlimit_stack" | "v6only"
             | "deny_time" | "umask" | "mdns" | "libwrap")
   (* redirect and cps aren't really lists, they take exactly two values *)
   |attr_lst_eq ("server_args" | "log_type" |  "access_times" | "type"
                | "flags" | "redirect" | "cps")
   |attr_lst_op ( "log_on_success" | "log_on_failure"| "only_from"
                | "no_access" | "env" | "passenv")

  let default_attr =
    attr_one ( "instances" | "banner" | "bind" | "interface" | "per_source"
             | "groups" | "banner_success" | "banner_fail" | "max_load"
             | "v6only" | "umask" | "mdns")
   |attr_lst_eq "cps"       (* really only two values, not a whole list *)
   |attr_lst_op ( "log_type" | "log_on_success" | "log_on_failure" | "disabled"
                | "no_access" | "only_from" | "passenv" | "enabled" )

  (* View: body
   *   Note:
   *       We would really like to say "the body can contain any of a list
   *       of a list of attributes, each of them at most once"; but that
   *       would require that we build a lens that matches the permutation
   *       of all attributes; with around 40 individual attributes, that's
   *       not computationally feasible, even if we didn't have to worry
   *       about how to write that down. The resulting regular expressions
   *       would simply be prohibitively large.
   *)
  let body (attr:lens) = del /\n\{[ \t]*\n/ "\n{\n"
                       . (empty|comment|attr)*
                       . del /[ \t]*\}[ \t]*\n/ "}\n"

  (* View: includes
   *  Note:
   *   It would be nice if we could use the directories given in include and
   *   includedir directives to parse additional files instead of hardcoding
   *   all the places where xinetd config files can be found; but that is
   *   currently not possible, and implementing that has a good amount of
   *   hairy corner cases to consider.
   *)
  let includes = [ key /include|includedir/
                     . Util.del_ws_spc . store /[^ \t\n]+/ . eol ]

  let service =
     let sto_re = /[^# \t\n\/]+/ in
     [ key "service" . Sep.space . store sto_re . body service_attr ]

  let defaults = [ key "defaults" . del /[ \t]*/ "" . body default_attr ]

  let lns = ( empty | comment | includes | defaults | service )*

  let filter = incl "/etc/xinetd.d/*"
             . incl "/etc/xinetd.conf"
             . Util.stdexcl

  let xfm = transform lns filter

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


Spacevars: add two more filse to parse by default

Fixes ticket #202

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

 Reference: man interfaces
 This is a generic lens for simple key/value configuration files where
 keys and values are separated by a sequence of spaces or tabs.

*)

module Spacevars =
  autoload xfm

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

let eol     = Util.eol
let spc     = Util.del_ws_spc
let comment = Util.comment
let empty   = Util.empty

let sto_to_eol = store /([^ \t\n].*[^ \t\n]|[^ \t\n])/

(************************************************************************
 *                               ENTRIES
 *************************************************************************)

let entry (kw:regexp)
               = [ key kw . spc . sto_to_eol . eol ]
let entry_re   = /[A-Za-z0-9\._-]+(\[[0-9]+\])?/

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

let lns (entry:lens) = (comment|empty|entry) *

let simple_lns = lns (entry entry_re)

(* configuration files that can be parsed without customizing the lens *)
let filter = Util.stdexcl
           . incl "/etc/havp/havp.config"
           . incl "/etc/ldap.conf"
           . incl "/etc/ldap/ldap.conf"
           . incl "/etc/libnss-ldap.conf"
           . incl "/etc/pam_ldap.conf"

let xfm = transform simple_lns filter

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

 Reference: man interfaces
 This is a generic lens for simple key/value configuration files where
 keys and values are separated by a sequence of spaces or tabs.

*)

module Spacevars =
  autoload xfm

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

let eol     = Util.eol
let spc     = Util.del_ws_spc
let comment = Util.comment
let empty   = Util.empty

let sto_to_eol = store /([^ \t\n].*[^ \t\n]|[^ \t\n])/

(************************************************************************
 *                               ENTRIES
 *************************************************************************)

let entry (kw:regexp)
               = [ key kw . spc . sto_to_eol . eol ]
let entry_re   = /[A-Za-z0-9\._-]+(\[[0-9]+\])?/

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

let lns (entry:lens) = (comment|empty|entry) *

let simple_lns = lns (entry entry_re)

(* configuration files that can be parsed without customizing the lens *)
let filter = Util.stdexcl
           . incl "/etc/havp/havp.config"
           . incl "/etc/ldap.conf"
           . incl "/etc/ldap/ldap.conf"

let xfm = transform simple_lns filter


Inifile: support empty comments

Inifile: support empty comments

Empty comments are lines beginning with ";" or "#" but without any more text


Support \r\n in xml.aug

Support \r\n in xml.aug

(* XML lens for Augeas
   Author: Francis Giraldeau <francis.giraldeau@usherbrooke.ca>

   Reference: http://www.w3.org/TR/2006/REC-xml11-20060816/
*)

module Xml =

autoload xfm

(************************************************************************
 *                           Utilities lens
 *************************************************************************)

let dels (s:string)   = del s s
let spc               = /[ \t\r\n]+/
let osp               = /[ \t\r\n]*/
let sep_spc           = del /[ \t\r\n]+/ " "
let sep_osp           = del /[ \t\r\n]*/ ""
let sep_eq            = del /[ \t\r\n]*=[ \t\r\n]*/ "="

let nmtoken             = /[a-zA-Z:_][a-zA-Z0-9:_.-]*/
let word                = /[a-zA-Z][a-zA-Z0-9._-]*/
let char                = /.|(\r?\n)/
(* if we hide the quotes, then we can only accept single or double quotes *)
(* otherwise a put ambiguity is raised *)
let sto_dquote          = dels "\"" . store /[^"]*/ . dels "\""
let sto_squote          = dels "'" . store /[^']*/ . dels "'"

let comment             = [ label "#comment" .
                            dels "<!--" .
                            store /([^-]|-[^-])*/ .
                            dels "-->" ]

let pi_target           = nmtoken - /[Xx][Mm][Ll]/
let empty               = Util.empty
let del_end             = del />[\r?\n]?/ ">\n"
let del_end_simple      = dels ">"

(* This is siplified version of processing instruction
 * pi has to not start or end with a white space and the string
 * must not contain "?>". We restrict too much by not allowing any
 * "?" nor ">" in PI
 *)
let pi                  = /[^ \r\n\t]|[^ \r\n\t][^?>]*[^ \r\n\t]/

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

let decl          = [ label "#decl" . sep_spc .
                      store /[^> \t\n\r]|[^> \t\n\r][^>\t\n\r]*[^> \t\n\r]/ ]

let decl_def (r:regexp) (b:lens) = [ dels "<" . key r .
                                     sep_spc . store word .
                                     b . sep_osp . del_end_simple ]

let elem_def      = decl_def /!ELEMENT/ decl

let enum          = "(" . osp . nmtoken . ( osp . "|" . osp . nmtoken )* . osp . ")"

let att_type      = /CDATA|ID|IDREF|IDREFS|ENTITY|ENTITIES|NMTOKEN|NMTOKENS/ |
                     enum

let id_def        = [ sep_spc . key /PUBLIC/ .
                      [ label "#literal" . sep_spc . sto_dquote ]* ] |
                    [ sep_spc . key /SYSTEM/ . sep_spc . sto_dquote ]

let notation_def  = decl_def /!NOTATION/ id_def

let att_def       = counter "att_id" .
                    [ sep_spc . seq "att_id" .
                      [ label "#name" . store word . sep_spc ] .
                      [ label "#type" . store att_type . sep_spc ] .
                      ([ key   /#REQUIRED|#IMPLIED/ ] |
                       [ label "#FIXED" . del /#FIXED[ \r\n\t]*|/ "" . sto_dquote ]) ]*

let att_list_def = decl_def /!ATTLIST/ att_def

let entity_def    = decl_def /!ENTITY/ ([sep_spc . label "#decl" . sto_dquote ])

let decl_def_item = elem_def | entity_def | att_list_def | notation_def

let decl_outer    = sep_osp . del /\[[ \n\t\r]*/ "[\n" .
                    (decl_def_item . sep_osp )* . dels "]"

(* let dtd_def       = [ sep_spc . key "SYSTEM" . sep_spc . sto_dquote ] *)

let doctype       = decl_def /!DOCTYPE/ (decl_outer|id_def)

let attributes    = [ label "#attribute" .
                      [ sep_spc . key nmtoken . sep_eq . sto_dquote ]+ ]

let prolog        = [ label "#declaration" .
                      dels "<?xml" .
                      attributes .
                      sep_osp .
                      dels "?>" ]

(************************************************************************
 *                            Tags
 *************************************************************************)

(* we consider entities as simple text *)
let text_re   = /[^<]+/ - /([^<]*\]\]>[^<]*)/
let text      = [ label "#text" . store text_re ]
let cdata     = [ label "#CDATA" . dels "<![CDATA[" .
                  store (char* - (char* . "]]>" . char*)) . dels "]]>" ]

let element (body:lens) =
    let h = attributes? . sep_osp . dels ">" . body* . dels "</" in
        [ dels "<" . square nmtoken h . sep_osp . del_end ]

let empty_element = [ dels "<" . key nmtoken . value "#empty" .
                      attributes? . sep_osp . del /\/>[\r?\n]?/ "/>\n" ]

let pi_instruction = [ dels "<?" . label "#pi" .
                       [ label "#target" . store pi_target ] .
                       [ sep_spc . label "#instruction" . store pi ]? .
                       sep_osp . del /\?>/ "?>" ]

(* Typecheck is weaker on rec lens, detected by unfolding *)
(*
let content1 = element text
let rec content2 = element (content1|text|comment)
*)

let rec content = element (text|comment|content|empty_element|pi_instruction)

(* Constraints are weaker here, but it's better than being too strict *)
let doc = (sep_osp . (prolog  | comment | doctype | pi_instruction))* .
          ((sep_osp . content) | (sep_osp . empty_element)) .
          (sep_osp . (comment | pi_instruction ))* . sep_osp

let lns = doc

let filter = (incl "/etc/xml/*.xml")
    . (incl "/etc/xml/catalog")
    . Util.stdexcl

let xfm = transform lns filter

(* XML lens for Augeas
   Author: Francis Giraldeau <francis.giraldeau@usherbrooke.ca>

   Reference: http://www.w3.org/TR/2006/REC-xml11-20060816/
*)

module Xml =

autoload xfm

(************************************************************************
 *                           Utilities lens
 *************************************************************************)

let dels (s:string)   = del s s
let spc               = /[ \t\n]+/
let osp               = /[ \t\n]*/
let sep_spc           = del /[ \t\n]+/ " "
let sep_osp           = del /[ \t\n]*/ ""
let sep_eq            = del /[ \t\n]*=[ \t\n]*/ "="

let nmtoken             = /[a-zA-Z:_][a-zA-Z0-9:_.-]*/
let word                = /[a-zA-Z][a-zA-Z0-9._-]*/
let char                = /.|\n/
(* if we hide the quotes, then we can only accept single or double quotes *)
(* otherwise a put ambiguity is raised *)
let sto_dquote          = dels "\"" . store /[^"]*/ . dels "\""
let sto_squote          = dels "'" . store /[^']*/ . dels "'"

let comment             = [ label "#comment" .
                            dels "<!--" .
                            store /([^-]|-[^-])*/ .
                            dels "-->" ]

let pi_target           = nmtoken - /[Xx][Mm][Ll]/
let empty               = Util.empty
let del_end             = del />[\n]?/ ">\n"
let del_end_simple      = dels ">"

(* This is siplified version of processing instruction
 * pi has to not start or end with a white space and the string
 * must not contain "?>". We restrict too much by not allowing any
 * "?" nor ">" in PI
 *)
let pi                  = /[^ \n\t]|[^ \n\t][^?>]*[^ \n\t]/

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

let decl          = [ label "#decl" . sep_spc .
                      store /[^> \t\n\r]|[^> \t\n\r][^>\t\n\r]*[^> \t\n\r]/ ]

let decl_def (r:regexp) (b:lens) = [ dels "<" . key r .
                                     sep_spc . store word .
                                     b . sep_osp . del_end_simple ]

let elem_def      = decl_def /!ELEMENT/ decl

let enum          = "(" . osp . nmtoken . ( osp . "|" . osp . nmtoken )* . osp . ")"

let att_type      = /CDATA|ID|IDREF|IDREFS|ENTITY|ENTITIES|NMTOKEN|NMTOKENS/ |
                     enum

let id_def        = [ sep_spc . key /PUBLIC/ .
                      [ label "#literal" . sep_spc . sto_dquote ]* ] |
                    [ sep_spc . key /SYSTEM/ . sep_spc . sto_dquote ]

let notation_def  = decl_def /!NOTATION/ id_def

let att_def       = counter "att_id" .
                    [ sep_spc . seq "att_id" .
                      [ label "#name" . store word . sep_spc ] .
                      [ label "#type" . store att_type . sep_spc ] .
                      ([ key   /#REQUIRED|#IMPLIED/ ] |
                       [ label "#FIXED" . del /#FIXED[ \n\t]*|/ "" . sto_dquote ]) ]*

let att_list_def = decl_def /!ATTLIST/ att_def

let entity_def    = decl_def /!ENTITY/ ([sep_spc . label "#decl" . sto_dquote ])

let decl_def_item = elem_def | entity_def | att_list_def | notation_def

let decl_outer    = sep_osp . del /\[[ \n\t\r]*/ "[\n" .
                    (decl_def_item . sep_osp )* . dels "]"

(* let dtd_def       = [ sep_spc . key "SYSTEM" . sep_spc . sto_dquote ] *)

let doctype       = decl_def /!DOCTYPE/ (decl_outer|id_def)

let attributes    = [ label "#attribute" .
                      [ sep_spc . key nmtoken . sep_eq . sto_dquote ]+ ]

let prolog        = [ label "#declaration" .
                      dels "<?xml" .
                      attributes .
                      sep_osp .
                      dels "?>" ]

(************************************************************************
 *                            Tags
 *************************************************************************)

(* we consider entities as simple text *)
let text_re   = /[^<]+/ - /([^<]*\]\]>[^<]*)/
let text      = [ label "#text" . store text_re ]
let cdata     = [ label "#CDATA" . dels "<![CDATA[" .
                  store (char* - (char* . "]]>" . char*)) . dels "]]>" ]

let element (body:lens) =
    let h = attributes? . sep_osp . dels ">" . body* . dels "</" in
        [ dels "<" . square nmtoken h . sep_osp . del_end ]

let empty_element = [ dels "<" . key nmtoken . value "#empty" .
                      attributes? . sep_osp . del /\/>[\n]?/ "/>\n" ]

let pi_instruction = [ dels "<?" . label "#pi" .
                       [ label "#target" . store pi_target ] .
                       [ sep_spc . label "#instruction" . store pi ]? .
                       sep_osp . del /\?>/ "?>" ]

(* Typecheck is weaker on rec lens, detected by unfolding *)
(*
let content1 = element text
let rec content2 = element (content1|text|comment)
*)

let rec content = element (text|comment|content|empty_element|pi_instruction)

(* Constraints are weaker here, but it's better than being too strict *)
let doc = (sep_osp . (prolog  | comment | doctype | pi_instruction))* .
          ((sep_osp . content) | (sep_osp . empty_element)) .
          (sep_osp . (comment | pi_instruction ))* . sep_osp

let lns = doc

let filter = (incl "/etc/xml/*.xml")
    . (incl "/etc/xml/catalog")
    . Util.stdexcl

let xfm = transform lns filter


Build: remove unused indent definition

Build: remove unused indent definition


Added support for conf-available apache config file location

(* 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) =
    let eol_comment = Util.comment_generic /[ \t\n]*#[ \t]*/ "# " in
    let inner = (sep_spc . argv arg_sec)? . sep_osp .
             dels ">" . (eol|eol_comment) . (body . (body|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|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/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

(* 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) =
    let eol_comment = Util.comment_generic /[ \t\n]*#[ \t]*/ "# " in
    let inner = (sep_spc . argv arg_sec)? . sep_osp .
             dels ">" . (eol|eol_comment) . (body . (body|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|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


Fix syntax error in test

Fix syntax error in test

module Fail_union_atype =
  (* This is illegal, otherwise we don't know which alternative *)
  (* to take for a tree { "a" = "?" }                           *)

  let del_str (s:string) = del s s

  let lns = [ key /a/ . store /b/ . del_str " (l)" ]
          | [ key /a/ . store /c/ . del_str " (r)" ]

  (* To make this a passing test, make sure that this also works: *)
  (* test lns put "ac (r)" after set "a" "b" = "ab (l)"           *)

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

module Fail_union_atype =
  (* This is illegal, otherwise we don't know which alternative *)
  (* to take for a tree { "a" = "?" }                           *)

  let del_str (s:string) = del s s

  let lns = [ key /a/ . store /b/ . del_str " (l)"
          | [ key /a/ . store /c/ . del_str " (r)" ]

  (* To make this a passing test, make sure that this also works: *)
  (* test lns put "ac (r)" after set "a" "b" = "ab (l)"           *)

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


Add comments for NaturalDocs parsing Reorganize a bit

(*
Module: IniFile
  Generic module to create INI files lenses

Author: Raphael Pinson <raphink@gmail.com>

About: License
  This file is licensed under the GPL.

About: TODO
  Things to add in the future
  - Support double quotes in value
  - Support multiline values (is it standard?)

About: Lens usage
  This lens is made to provide generic primitives to construct INI File lenses.
  See <Puppet>, <PHP>, <MySQL> or <Dput> for examples of real life lenses using it.

*)

module IniFile  =

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

(* Group: Internal primitives *)

(*
Variable: eol
  End of line, inherited from <Util.eol>
*)
let eol                = Util.eol

(*
View: empty
  Empty line, an <eol> subnode
*)
let empty              = [ eol ]

(* Group: Separators *)

(*
Variable: sep
  Generic separator

  Parameters:
    pat:regexp - the pattern to delete
    default:string - the default string to use
*)
let sep (pat:regexp) (default:string)
                       = Util.del_opt_ws "" . del pat default

(*
Variable: sep_re
  The default regexp for a separator
*)

let sep_re             = /[=:]/

(*
Variable: sep_default
  The default separator value
*)
let sep_default        = "="

(* Group: Stores *)

(*
Variable: sto_to_eol
  Store until end of line
*)
let sto_to_eol         = Util.del_opt_ws ""
                         . store /([^ \t\n].*[^ \t\n]|[^ \t\n])/
(*
Variable: sto_to_comment
  Store until comment
*)
let sto_to_comment     = Util.del_opt_ws ""
                         . store /[^;# \t\n][^;#\n]*[^;# \t\n]|[^;# \t\n]/

(* Group: Define comment and defaults *)

(*
View: comment
  Map comments into "#comment" nodes

  Parameters:
    pat:regexp - pattern to delete before commented data
    default:string - default pattern before commented data

  Sample Usage:
  (start code)
    let comment  = IniFile.comment "#" "#"
    let comment  = IniFile.comment IniFile.comment_re IniFile.comment_default
  (end code)
*)
let comment (pat:regexp) (default:string)
                       = [ label "#comment" . sep pat default
		         . sto_to_eol? . eol ]
(*
Variable: comment_re
  Default regexp for <comment> pattern
*)

let comment_re         = /[;#]/

(*
Variable: comment_default
  Default value for <comment> pattern
*)
let comment_default    = ";"

(************************************************************************
 * Group:                     ENTRY
 *************************************************************************)

(* Group: entry includes comments *)

(*
View: entry
  Generic INI File entry

  Parameters:
    kw:regexp    - keyword regexp for the label
    sep:lens     - lens to use as key/value separator
    comment:lens - lens to use as comment

  Sample Usage:
     > let entry = IniFile.entry setting sep comment
*)
let entry (kw:regexp) (sep:lens) (comment:lens)
                       = [ key kw . sep . sto_to_comment? . (comment|eol) ] | comment

(*
Variable: entry_re
  Default regexp for <entry> keyword
*)
let entry_re           = ( /[A-Za-z][A-Za-z0-9\._-]+/ )

(************************************************************************
 * Group:                      RECORD
 *************************************************************************)

(* Group: Title definition *)

(*
View: title
  Title for <record>. This maps the title of a record as a node in the abstract tree.

  Parameters:
    kw:regexp - keyword regexp for the label

  Sample Usage:
    > let title   = IniFile.title IniFile.record_re
*)
let title (kw:regexp)
                       = Util.del_str "[" . key kw
                         . Util.del_str "]". eol

(*
View: title_label
  Title for <record>. This maps the title of a record as a value in the abstract tree.

  Parameters:
    name:string - name for the title label
    kw:regexp   - keyword regexp for the label

  Sample Usage:
    > let title   = IniFile.title_label "target" IniFile.record_label_re
*)
let title_label (name:string) (kw:regexp)
                       = label name
                         . Util.del_str "[" . store kw
                         . Util.del_str "]". eol

(*
Variable: record_re
  Default regexp for <title> keyword pattern
*)
let record_re          = ( /[^]\n\/]+/ - /#comment/ )

(*
Variable: record_label_re
  Default regexp for <title_label> keyword pattern
*)
let record_label_re    = /[^]\n]+/

(* Group: Record definition *)

(*
View: record_noempty
  INI File Record with no empty lines allowed.

  Parameters:
    title:lens - lens to use for title. Use either <title> or <title_label>.
    entry:lens - lens to use for entries in the record. See <entry>.
*)
let record_noempty (title:lens) (entry:lens)
                       = [ title
		       . entry* ]

(*
View: record
  Generic INI File record

  Parameters:
    title:lens - lens to use for title. Use either <title> or <title_label>.
    entry:lens - lens to use for entries in the record. See <entry>.

  Sample Usage:
    > let record  = IniFile.record title entry
*)
let record (title:lens) (entry:lens)
                       = record_noempty title ( entry | empty )

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

(*

Group: Lens definition

View: lns_noempty
  Generic INI File lens with no empty lines

  Parameters:
    record:lens  - record lens to use. See <record_noempty>.
    comment:lens - comment lens to use. See <comment>.

  Sample Usage:
    > let lns     = IniFile.lns_noempty record comment
*)
let lns_noempty (record:lens) (comment:lens)
                       = comment* . record*

(*
View: lns
  Generic INI File lens

  Parameters:
    record:lens  - record lens to use. See <record>.
    comment:lens - comment lens to use. See <comment>.

  Sample Usage:
    > let lns     = IniFile.lns record comment
*)
let lns (record:lens) (comment:lens)
                       = lns_noempty record (comment|empty)


Sudoers: clean up comment definition

Sudoers: clean up comment definition

(* Sudoers module for Augeas
 Author: Raphael Pinson <raphink@gmail.com>

 Reference: `man sudoers`
 This lens tries to keep as close as possible to `man sudoers` where possible.
 For example, recursive definitions such as:

     Cmnd_Spec_List ::= Cmnd_Spec |
                        Cmnd_Spec ',' Cmnd_Spec_List

 are replaced by

     let cmnd_spec_list = cmnd_spec . ( sep_com . cmnd_spec )*

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

module Sudoers =
  autoload xfm

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

let eol       = del /[ \t]*\n/ "\n"
let indent    = del /[ \t]+/ ""

(* Define separators *)
let sep_spc  = del /[ \t]+/ " "
let sep_cont = del /([ \t]+|[ \t]*\\\\\n[ \t]*)/ " "
let sep_com  = sep_cont? . Util.del_str "," . sep_cont?
let sep_eq   = sep_cont? . Util.del_str "=" . sep_cont?
let sep_col  = sep_cont? . Util.del_str ":" . sep_cont?

(* Define fields *)
let sto_to_com_cmnd = store /([^,=:#() \t\n\\\\][^,=:#()\n\\\\]*[^,=:#() \t\n\\\\])|[^,=:#() \t\n\\\\]/
let sto_to_com      = store /[^,=:#() \t\n\\\\]+/

(* sto_to_com does not begin or end with a space *)
(* TODO: there could be a \ in the middle of a command... *)
let sto_to_com_user = store ( /[^,=:#() \t\n]+/
                              - /(User|Runas|Host|Cmnd)_Alias|Defaults.*/ )
let sto_to_eq  = store /[^,=:#() \t\n\\\\]+/
let sto_to_spc = store /[^() \t\n\\\\]+/

(* define comments and empty lines *)
let comment =
  let sto_to_eol = store /([^ \t\n].*[^ \t\n]|[^ \t\n])/ in
  [ label "comment" . del /[ \t]*#[ \t]*/ "# " . sto_to_eol . eol ]

let empty   = [ del /[ \t]*#?[ \t]*\n/ "" ]

(************************************************************************
 *                                     ALIASES
 *************************************************************************)

(************************************************************************
 *   User_Alias ::= NAME '=' User_List
 *   Runas_Alias ::= NAME '=' Runas_List
 *   Host_Alias ::= NAME '=' Host_List
 *   Cmnd_Alias ::= NAME '=' Cmnd_List
 *************************************************************************)
let alias_field (kw:string) (sto:lens) = [ label kw . sto ]
let alias_list  (kw:string) (sto:lens) =
  alias_field kw sto . ( sep_com . alias_field kw sto )*

(************************************************************************
 *  NAME ::= [A-Z]([A-Z][0-9]_)*
 *************************************************************************)
let alias_name
    = [ label "name" . store /[A-Z][A-Z0-9_]*/ ]

(************************************************************************
 *  Alias_Type NAME = item1, item2, ...
 *************************************************************************)
let alias_entry_single (field:string) (sto:lens)
    = [ label "alias" . alias_name . sep_eq . alias_list field sto ]

(************************************************************************
 *  Alias_Type NAME = item1, item2, item3 : NAME = item4, item5
 *************************************************************************)
let alias_entry (kw:string) (field:string) (sto:lens)
    = [ indent? . key kw . sep_cont . alias_entry_single field sto
          . ( sep_col . alias_entry_single field sto )* . eol ]

(* TODO: go further in user definitions *)
let user_alias  = alias_entry "User_Alias" "user" sto_to_com
let runas_alias = alias_entry "Runas_Alias" "runas_user" sto_to_com
let host_alias  = alias_entry "Host_Alias" "host" sto_to_com
let cmnd_alias  = alias_entry "Cmnd_Alias" "command" sto_to_com_cmnd

(************************************************************************
 *  Alias ::= 'User_Alias'  User_Alias (':' User_Alias)* |
 *            'Runas_Alias' Runas_Alias (':' Runas_Alias)* |
 *            'Host_Alias'  Host_Alias (':' Host_Alias)* |
 *            'Cmnd_Alias'  Cmnd_Alias (':' Cmnd_Alias)*
 *************************************************************************)
let alias = user_alias | runas_alias | host_alias | cmnd_alias

(************************************************************************
 *                                 DEFAULTS
 *************************************************************************)

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

(************************************************************************
 *  Parameter ::= Parameter '=' Value |
 *                Parameter '+=' Value |
 *                Parameter '-=' Value |
 *                '!'* Parameter
 *************************************************************************)
let parameter        =
  let value = /([^,:= \t\n\\\\][^,\n\\\\]*[^, \t\n\\\\])|[^,:= \t\n\\\\]/ in
  [ label "parameter" . store value ]

(************************************************************************
 *  Parameter_List ::= Parameter |
 *                     Parameter ',' Parameter_List
 *************************************************************************)
let parameter_list   = parameter . ( sep_com . parameter )*

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

(************************************************************************
 *                              USER SPECIFICATION
 *************************************************************************)

(************************************************************************
 *  Runas_Spec ::= '(' Runas_List ')'
 *************************************************************************)
let runas_spec = Util.del_str "(" . alias_list "runas_user" sto_to_com
    . Util.del_str ")" . sep_cont?

(************************************************************************
 * Tag_Spec ::= ('NOPASSWD:' | 'PASSWD:' | 'NOEXEC:' | 'EXEC:' |
 *              'SETENV:' | 'NOSETENV:')
 *************************************************************************)
let tag_spec   =
  [ label "tag" . store /(NO)?(PASSWD|EXEC|SETENV)/ . sep_col ]

(************************************************************************
 *  Cmnd_Spec ::= Runas_Spec? Tag_Spec* Cmnd
 *************************************************************************)
let cmnd_spec  =
  [ label "command" .  runas_spec? . tag_spec* . sto_to_com_cmnd ]

(************************************************************************
 * Cmnd_Spec_List ::= Cmnd_Spec |
 *                    Cmnd_Spec ',' Cmnd_Spec_List
 *************************************************************************)
let cmnd_spec_list = cmnd_spec . ( sep_com . cmnd_spec )*

(************************************************************************
 * User_Spec ::= User_List Host_List '=' Cmnd_Spec_List \
 *               (':' Host_List '=' Cmnd_Spec_List)*
 *************************************************************************)
let spec_list = [ label "host_group" . alias_list "host" sto_to_com
                    . sep_eq . cmnd_spec_list ]

let spec = [ label "spec" . indent?
               . alias_list "user" sto_to_com_user . sep_cont
               . spec_list
    	       . ( sep_col . spec_list )* . eol ]

(************************************************************************
 *                              LENS & FILTER
 *************************************************************************)

let lns = ( empty | comment | alias | defaults | spec  )*

let filter = (incl "/etc/sudoers")
    . Util.stdexcl

let xfm = transform lns filter

(* Sudoers module for Augeas
 Author: Raphael Pinson <raphink@gmail.com>

 Reference: `man sudoers`
 This lens tries to keep as close as possible to `man sudoers` where possible.
 For example, recursive definitions such as:

     Cmnd_Spec_List ::= Cmnd_Spec |
                        Cmnd_Spec ',' Cmnd_Spec_List

 are replaced by

     let cmnd_spec_list = cmnd_spec . ( sep_com . cmnd_spec )*

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

module Sudoers =
  autoload xfm

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

let eol       = del /[ \t]*\n/ "\n"
let indent    = del /[ \t]+/ ""

(* Define separators *)
let sep_spc  = del /[ \t]+/ " "
let sep_cont = del /([ \t]+|[ \t]*\\\\\n[ \t]*)/ " "
let sep_com  = sep_cont? . Util.del_str "," . sep_cont?
let sep_eq   = sep_cont? . Util.del_str "=" . sep_cont?
let sep_col  = sep_cont? . Util.del_str ":" . sep_cont?

(* Define fields *)
let sto_to_com_cmnd = store /([^,=:#() \t\n\\\\][^,=:#()\n\\\\]*[^,=:#() \t\n\\\\])|[^,=:#() \t\n\\\\]/
let sto_to_com      = store /[^,=:#() \t\n\\\\]+/

(* sto_to_com does not begin or end with a space *)
(* TODO: there could be a \ in the middle of a command... *)
let sto_to_com_user = store ( /[^,=:#() \t\n]+/
                              - /(User|Runas|Host|Cmnd)_Alias|Defaults.*/ )
let sto_to_eq  = store /[^,=:#() \t\n\\\\]+/
let sto_to_spc = store /[^() \t\n\\\\]+/

(* define comments and empty lines *)
let comment =
  let value_to_eol = del /[ \t]*/ " " . store /([^ \t\n].*[^ \t\n]|[^ \t\n])/ in
  [ label "comment" . del /[ \t]*#/ "# " .  value_to_eol . eol ]

let empty   = [ del /[ \t]*#?[ \t]*\n/ "" ]

(************************************************************************
 *                                     ALIASES
 *************************************************************************)

(************************************************************************
 *   User_Alias ::= NAME '=' User_List
 *   Runas_Alias ::= NAME '=' Runas_List
 *   Host_Alias ::= NAME '=' Host_List
 *   Cmnd_Alias ::= NAME '=' Cmnd_List
 *************************************************************************)
let alias_field (kw:string) (sto:lens) = [ label kw . sto ]
let alias_list  (kw:string) (sto:lens) =
  alias_field kw sto . ( sep_com . alias_field kw sto )*

(************************************************************************
 *  NAME ::= [A-Z]([A-Z][0-9]_)*
 *************************************************************************)
let alias_name
    = [ label "name" . store /[A-Z][A-Z0-9_]*/ ]

(************************************************************************
 *  Alias_Type NAME = item1, item2, ...
 *************************************************************************)
let alias_entry_single (field:string) (sto:lens)
    = [ label "alias" . alias_name . sep_eq . alias_list field sto ]

(************************************************************************
 *  Alias_Type NAME = item1, item2, item3 : NAME = item4, item5
 *************************************************************************)
let alias_entry (kw:string) (field:string) (sto:lens)
    = [ indent? . key kw . sep_cont . alias_entry_single field sto
          . ( sep_col . alias_entry_single field sto )* . eol ]

(* TODO: go further in user definitions *)
let user_alias  = alias_entry "User_Alias" "user" sto_to_com
let runas_alias = alias_entry "Runas_Alias" "runas_user" sto_to_com
let host_alias  = alias_entry "Host_Alias" "host" sto_to_com
let cmnd_alias  = alias_entry "Cmnd_Alias" "command" sto_to_com_cmnd

(************************************************************************
 *  Alias ::= 'User_Alias'  User_Alias (':' User_Alias)* |
 *            'Runas_Alias' Runas_Alias (':' Runas_Alias)* |
 *            'Host_Alias'  Host_Alias (':' Host_Alias)* |
 *            'Cmnd_Alias'  Cmnd_Alias (':' Cmnd_Alias)*
 *************************************************************************)
let alias = user_alias | runas_alias | host_alias | cmnd_alias

(************************************************************************
 *                                 DEFAULTS
 *************************************************************************)

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

(************************************************************************
 *  Parameter ::= Parameter '=' Value |
 *                Parameter '+=' Value |
 *                Parameter '-=' Value |
 *                '!'* Parameter
 *************************************************************************)
let parameter        =
  let value = /([^,:= \t\n\\\\][^,\n\\\\]*[^, \t\n\\\\])|[^,:= \t\n\\\\]/ in
  [ label "parameter" . store value ]

(************************************************************************
 *  Parameter_List ::= Parameter |
 *                     Parameter ',' Parameter_List
 *************************************************************************)
let parameter_list   = parameter . ( sep_com . parameter )*

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

(************************************************************************
 *                              USER SPECIFICATION
 *************************************************************************)

(************************************************************************
 *  Runas_Spec ::= '(' Runas_List ')'
 *************************************************************************)
let runas_spec = Util.del_str "(" . alias_list "runas_user" sto_to_com
    . Util.del_str ")" . sep_cont?

(************************************************************************
 * Tag_Spec ::= ('NOPASSWD:' | 'PASSWD:' | 'NOEXEC:' | 'EXEC:' |
 *              'SETENV:' | 'NOSETENV:')
 *************************************************************************)
let tag_spec   =
  [ label "tag" . store /(NO)?(PASSWD|EXEC|SETENV)/ . sep_col ]

(************************************************************************
 *  Cmnd_Spec ::= Runas_Spec? Tag_Spec* Cmnd
 *************************************************************************)
let cmnd_spec  =
  [ label "command" .  runas_spec? . tag_spec* . sto_to_com_cmnd ]

(************************************************************************
 * Cmnd_Spec_List ::= Cmnd_Spec |
 *                    Cmnd_Spec ',' Cmnd_Spec_List
 *************************************************************************)
let cmnd_spec_list = cmnd_spec . ( sep_com . cmnd_spec )*

(************************************************************************
 * User_Spec ::= User_List Host_List '=' Cmnd_Spec_List \
 *               (':' Host_List '=' Cmnd_Spec_List)*
 *************************************************************************)
let spec_list = [ label "host_group" . alias_list "host" sto_to_com
                    . sep_eq . cmnd_spec_list ]

let spec = [ label "spec" . indent?
               . alias_list "user" sto_to_com_user . sep_cont
               . spec_list
    	       . ( sep_col . spec_list )* . eol ]

(************************************************************************
 *                              LENS & FILTER
 *************************************************************************)

let lns = ( empty | comment | alias | defaults | spec  )*

let filter = (incl "/etc/sudoers")
    . Util.stdexcl

let xfm = transform lns filter


Shellvars: Suse includes

Shellvars: Suse includes

* lenses/shellvars.aug:
    added include for /etc/sysconfig/network/ifcfg-

(* Generic lens for shell-script config files like the ones found *)
(* in /etc/sysconfig                                              *)
module Shellvars =
  autoload xfm

  let eol = Util.eol

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

  let char  = /[^() '"\t\n]|\\\\"/
  let dquot = /"([^"\\\n]|\\\\.)*"/                    (* " Emacs, relax *)
  let squot = /'[^'\n]*'/
  let bquot = /`[^`\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 | empty_array)

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

  let unset = [ key "unset" . Util.del_ws_spc . store key_re . eol ]

  let source =
    [
      del /\.|source/ "." . label ".source" .
      Util.del_ws_spc . store /[^= \t\n]+/ . eol
    ]

  let lns = (comment | empty | source | kv | unset) *

  let sc_incl (n:string) = (incl ("/etc/sysconfig/" . n))
  let filter_sysconfig =
      sc_incl "atd" .
      sc_incl "authconfig" .
      sc_incl "autofs" .
      sc_incl "clock" .
      sc_incl "cpuspeed" .
      sc_incl "crond" .
      sc_incl "crontab" .
      sc_incl "desktop" .
      sc_incl "firstboot" .
      sc_incl "grub" .
      sc_incl "hsqldb" .
      sc_incl "httpd" .
      sc_incl "i18n" .
      sc_incl "init" .
      sc_incl "iptables-config" .
      sc_incl "irda" .
      sc_incl "irqbalance" .
      sc_incl "kdump" .
      sc_incl "kernel" .
      sc_incl "keyboard" .
      sc_incl "kudzu" .
      sc_incl "libvirtd" .
      sc_incl "lircd" .
      sc_incl "nasd" .
      sc_incl "netconsole" .
      sc_incl "network" .
      sc_incl "nfs" .
      sc_incl "ntpd" .
      sc_incl "prelink" .
      sc_incl "readonly-root" .
      sc_incl "rsyslog" .
      sc_incl "samba" .
      sc_incl "saslauthd" .
      sc_incl "selinux" .
      sc_incl "sendmail" .
      sc_incl "smartmontools" .
      sc_incl "spamassassin" .
      sc_incl "sysstat" .
      sc_incl "system-config-users" .
      sc_incl "vncservers" .
      sc_incl "wpa_supplicant" .
      sc_incl "xend" .
      sc_incl "xendomains"

  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"
  let filter = filter_sysconfig
             . filter_ifcfg
             . filter_default
             . filter_misc
             . Util.stdexcl

  let xfm = transform lns filter

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

(* Generic lens for shell-script config files like the ones found *)
(* in /etc/sysconfig                                              *)
module Shellvars =
  autoload xfm

  let eol = Util.eol

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

  let char  = /[^() '"\t\n]|\\\\"/
  let dquot = /"([^"\\\n]|\\\\.)*"/                    (* " Emacs, relax *)
  let squot = /'[^'\n]*'/
  let bquot = /`[^`\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 | empty_array)

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

  let unset = [ key "unset" . Util.del_ws_spc . store key_re . eol ]

  let source =
    [
      del /\.|source/ "." . label ".source" .
      Util.del_ws_spc . store /[^= \t\n]+/ . eol
    ]

  let lns = (comment | empty | source | kv | unset) *

  let sc_incl (n:string) = (incl ("/etc/sysconfig/" . n))
  let filter_sysconfig =
      sc_incl "atd" .
      sc_incl "authconfig" .
      sc_incl "autofs" .
      sc_incl "clock" .
      sc_incl "cpuspeed" .
      sc_incl "crond" .
      sc_incl "crontab" .
      sc_incl "desktop" .
      sc_incl "firstboot" .
      sc_incl "grub" .
      sc_incl "hsqldb" .
      sc_incl "httpd" .
      sc_incl "i18n" .
      sc_incl "init" .
      sc_incl "iptables-config" .
      sc_incl "irda" .
      sc_incl "irqbalance" .
      sc_incl "kdump" .
      sc_incl "kernel" .
      sc_incl "keyboard" .
      sc_incl "kudzu" .
      sc_incl "libvirtd" .
      sc_incl "lircd" .
      sc_incl "nasd" .
      sc_incl "netconsole" .
      sc_incl "network" .
      sc_incl "nfs" .
      sc_incl "ntpd" .
      sc_incl "prelink" .
      sc_incl "readonly-root" .
      sc_incl "rsyslog" .
      sc_incl "samba" .
      sc_incl "saslauthd" .
      sc_incl "selinux" .
      sc_incl "sendmail" .
      sc_incl "smartmontools" .
      sc_incl "spamassassin" .
      sc_incl "sysstat" .
      sc_incl "system-config-users" .
      sc_incl "vncservers" .
      sc_incl "wpa_supplicant" .
      sc_incl "xend" .
      sc_incl "xendomains"

  let filter_ifcfg   = incl "/etc/sysconfig/network-scripts/ifcfg-*"
  let filter_default = incl "/etc/default/*"
  let filter_misc    = incl "/etc/arno-iptables-firewall/debconf.cfg"
                     . incl "/etc/cron-apt/config"
  let filter = filter_sysconfig
             . filter_ifcfg
             . filter_default
             . filter_misc
             . Util.stdexcl

  let xfm = transform lns filter

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


Shellvars: use sto_to_semicol in condition lens

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

  (* Delete a blank line, rather than mapping it *)
  let del_empty = del (Util.empty_generic_re . "\n") "\n"

  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-9A-Za-z_,]+\])?/ - ("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  = /[^`;()'"|\n\\# \t]#*|\\\\(.|\n)/
  let dquot =
       let char = /[^"\\]|\\\\./ | Rx.cl
    in "\"" . char* . "\""                    (* " Emacs, relax *)
  let squot = /'[^']*'/
  let bquot = /`[^`\n]+`/
  (* dbquot don't take spaces or semi-colons *)
  let dbquot = /``[^` \t\n;]+``/
  let dollar_assign = /\$\([^\(\)#\n]*\)/
  let dollar_arithm = /\$\(\([^\)#\n]*\)\)/

  let anyquot = (char|dquot|squot|dollar_assign|dollar_arithm)+ | bquot | dbquot
  let sto_to_semicol = store (anyquot . (Rx.space . anyquot)*)

  (* 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 anyquot 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 (anyquot | empty_array)?

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

  let var_action (name:string) =
    Util.indent . del name name . Util.del_ws_spc
    . label ("@" . name) . counter "var_action"
    . Build.opt_list [ seq "var_action" . store (key_re | matching_re) ] Util.del_ws_spc

  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]+/

  let shell_builtin_cmds = "ulimit" | "shift" | "exit"

  let eval =
    Util.indent . Util.del_str "eval" . Util.del_ws_spc
    . label "@eval" . store anyquot

  let alias =
    Util.indent . Util.del_str "alias" . Util.del_ws_spc
    . label "@alias" . store key_re . eq
    . [ label "value" . store anyquot ]

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

  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 )?

  let condition =
       let cond (start:string) (end:string) = [ label "type" . store start ]
                                            . Util.del_ws_spc . sto_to_semicol
                                            . Util.del_ws_spc . Util.del_str end
    in Util.indent . label "@condition" . (cond "[" "]" | cond "[[" "]]")

(************************************************************************
 * 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) (entry_noeol:lens) =
       let pattern = [ label "@pattern" . sto_to_semicol . Sep.opt_space ]
    in let case_entry = [ label "@case_entry"
                       . Util.indent . pattern
                       . (Util.del_str "|" . Sep.opt_space . pattern)*
                       . Util.del_str ")" . eol
                       . entry* . entry_noeol?
                       . 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 entry_eol =
    let entry_eol_item (item:lens) =
      [ item . comment_or_eol ] in
      entry_eol_item source
        | entry_eol_item kv
        | entry_eol_item unset
        | entry_eol_item bare_export
        | entry_eol_item builtin
        | entry_eol_item return
        | entry_eol_item condition
        | entry_eol_item eval
        | entry_eol_item alias

  let entry_noeol =
    let entry_item (item:lens) = [ item ] in
      entry_item source
        | entry_item kv
        | entry_item unset
        | entry_item bare_export
        | entry_item builtin
        | entry_item return
        | entry_item condition
        | entry_item eval
        | entry_item alias

  let rec rec_entry =
    let entry = comment | entry_eol | rec_entry in
        cond_if entry
      | loop_for entry
      | loop_select entry
      | loop_while entry
      | loop_until entry
      | case entry entry_noeol
      | function entry

  let lns_norec = del_empty* . (comment | entry_eol) *

  let lns = del_empty* . (comment | entry_eol | 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 "ip*tables.save" .
      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_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" .
      sc_excl "*.systemd"

  let filter_default = incl "/etc/default/*"
                     . excl "/etc/default/grub_installdevice*"
                     . excl "/etc/default/rmt"
                     . excl "/etc/default/whoopsie"
  let filter_misc    = incl "/etc/arno-iptables-firewall/debconf.cfg"
                     . incl "/etc/cron-apt/config"
                     . incl "/etc/environment"
                     . incl "/etc/firewalld/firewalld.conf"
                     . 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/periodic.conf"
                     . 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

  (* Delete a blank line, rather than mapping it *)
  let del_empty = del (Util.empty_generic_re . "\n") "\n"

  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-9A-Za-z_,]+\])?/ - ("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  = /[^`;()'"|\n\\# \t]#*|\\\\(.|\n)/
  let dquot =
       let char = /[^"\\]|\\\\./ | Rx.cl
    in "\"" . char* . "\""                    (* " Emacs, relax *)
  let squot = /'[^']*'/
  let bquot = /`[^`\n]+`/
  (* dbquot don't take spaces or semi-colons *)
  let dbquot = /``[^` \t\n;]+``/
  let dollar_assign = /\$\([^\(\)#\n]*\)/
  let dollar_arithm = /\$\(\([^\)#\n]*\)\)/

  let anyquot = (char|dquot|squot|dollar_assign|dollar_arithm)+ | bquot | dbquot
  let sto_to_semicol = store (anyquot . (Rx.space . anyquot)*)

  (* 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 anyquot 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 (anyquot | empty_array)?

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

  let var_action (name:string) =
    Util.indent . del name name . Util.del_ws_spc
    . label ("@" . name) . counter "var_action"
    . Build.opt_list [ seq "var_action" . store (key_re | matching_re) ] Util.del_ws_spc

  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]+/

  let shell_builtin_cmds = "ulimit" | "shift" | "exit"

  let eval =
    Util.indent . Util.del_str "eval" . Util.del_ws_spc
    . label "@eval" . store anyquot

  let alias =
    Util.indent . Util.del_str "alias" . Util.del_ws_spc
    . label "@alias" . store key_re . eq
    . [ label "value" . store anyquot ]

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

  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 )?

  let condition =
       let sto_cond = store /[^[#; \t\n][^#;\n]+[^]#; \t\n]|[^[]#; \t\n]+/
    in let cond (start:string) (end:string) = [ label "type" . store start ]
                                            . Util.del_ws_spc . sto_cond
                                            . Util.del_ws_spc . Util.del_str end
    in Util.indent . label "@condition" . (cond "[" "]" | cond "[[" "]]")

(************************************************************************
 * 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) (entry_noeol:lens) =
       let pattern = [ label "@pattern" . sto_to_semicol . Sep.opt_space ]
    in let case_entry = [ label "@case_entry"
                       . Util.indent . pattern
                       . (Util.del_str "|" . Sep.opt_space . pattern)*
                       . Util.del_str ")" . eol
                       . entry* . entry_noeol?
                       . 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 entry_eol =
    let entry_eol_item (item:lens) =
      [ item . comment_or_eol ] in
      entry_eol_item source
        | entry_eol_item kv
        | entry_eol_item unset
        | entry_eol_item bare_export
        | entry_eol_item builtin
        | entry_eol_item return
        | entry_eol_item condition
        | entry_eol_item eval
        | entry_eol_item alias

  let entry_noeol =
    let entry_item (item:lens) = [ item ] in
      entry_item source
        | entry_item kv
        | entry_item unset
        | entry_item bare_export
        | entry_item builtin
        | entry_item return
        | entry_item condition
        | entry_item eval
        | entry_item alias

  let rec rec_entry =
    let entry = comment | entry_eol | rec_entry in
        cond_if entry
      | loop_for entry
      | loop_select entry
      | loop_while entry
      | loop_until entry
      | case entry entry_noeol
      | function entry

  let lns_norec = del_empty* . (comment | entry_eol) *

  let lns = del_empty* . (comment | entry_eol | 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 "ip*tables.save" .
      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_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" .
      sc_excl "*.systemd"

  let filter_default = incl "/etc/default/*"
                     . excl "/etc/default/grub_installdevice*"
                     . excl "/etc/default/rmt"
                     . excl "/etc/default/whoopsie"
  let filter_misc    = incl "/etc/arno-iptables-firewall/debconf.cfg"
                     . incl "/etc/cron-apt/config"
                     . incl "/etc/environment"
                     . incl "/etc/firewalld/firewalld.conf"
                     . 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/periodic.conf"
                     . 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:             *)


bugfix/#14 Parse single and double-quotes in XML prolog

(* XML lens for Augeas
   Author: Francis Giraldeau <francis.giraldeau@usherbrooke.ca>

   Reference: http://www.w3.org/TR/2006/REC-xml11-20060816/

   This file is based on xml.aug lens from augeas v0.10.0
*)

module JBXml =

autoload xfm

(************************************************************************
 *                           Utilities lens
 *************************************************************************)

let dels (s:string)   = del s s
let spc               = /[ \t\n]+/
let osp               = /[ \t\n]*/
let sep_spc           = del /[ \t\n]+/ " "
let sep_osp           = del /[ \t\n]*/ ""
let sep_eq            = del /[ \t\n]*=[ \t\n]*/ "="

let nmtoken             = /[a-zA-Z:_][a-zA-Z0-9:_.-]*/
let word                = /[a-zA-Z][a-zA-Z0-9._-]*/
let char                = /.|\n/
(* if we hide the quotes, then we can only accept single or double quotes *)
(* otherwise a put ambiguity is raised *)
let sto_dquote          = dels "\"" . store /[^"]*/ . dels "\""
let sto_squote          = dels "'" . store /[^']*/ . dels "'"

let comment             = [ label "#comment" .
                            dels "<!--" .
                            store /([^-]|-[^-])*/ .
                            dels "-->" ]

let pi_target           = nmtoken - /[Xx][Mm][Ll]/
let empty               = Util.empty
let del_end             = del />[\n]?/ ">\n"
let del_end_simple      = dels ">"

(* This is siplified version of processing instruction
 * pi has to not start or end with a white space and the string
 * must not contain "?>". We restrict too much by not allowing any
 * "?" nor ">" in PI
 *)
let pi                  = /[^ \n\t]|[^ \n\t][^?>]*[^ \n\t]/

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

let decl          = [ label "#decl" . sep_spc .
                      store /[^> \t\n\r]|[^> \t\n\r][^>\t\n\r]*[^> \t\n\r]/ ]

let decl_def (r:regexp) (b:lens) = [ dels "<" . key r .
                                     sep_spc . store word .
                                     b . sep_osp . del_end_simple ]

let elem_def      = decl_def /!ELEMENT/ decl

let enum          = "(" . osp . nmtoken . ( osp . "|" . osp . nmtoken )* . osp . ")"

let att_type      = /CDATA|ID|IDREF|IDREFS|ENTITY|ENTITIES|NMTOKEN|NMTOKENS/ |
                     enum

let id_def        = [ sep_spc . key /PUBLIC/ .
                      [ label "#literal" . sep_spc . sto_dquote ]* ] |
                    [ sep_spc . key /SYSTEM/ . sep_spc . sto_dquote ]

let notation_def  = decl_def /!NOTATION/ id_def

let att_def       = counter "att_id" .
                    [ sep_spc . seq "att_id" .
                      [ label "#name" . store word . sep_spc ] .
                      [ label "#type" . store att_type . sep_spc ] .
                      ([ key   /#REQUIRED|#IMPLIED/ ] |
                       [ label "#FIXED" . del /#FIXED[ \n\t]*|/ "" . sto_dquote ]) ]*

let att_list_def = decl_def /!ATTLIST/ att_def

let entity_def    = decl_def /!ENTITY/ ([sep_spc . label "#decl" . sto_dquote ])

let decl_def_item = elem_def | entity_def | att_list_def | notation_def

let decl_outer    = sep_osp . del /\[[ \n\t\r]*/ "[\n" .
                    (decl_def_item . sep_osp )* . dels "]"

(* let dtd_def       = [ sep_spc . key "SYSTEM" . sep_spc . sto_dquote ] *)

let doctype       = decl_def /!DOCTYPE/ (decl_outer|id_def)

let attributes    = [ label "#attribute" .
                      [ sep_spc . key nmtoken . sep_eq . sto_dquote ]+ ]
let attributes_sq = [ label "#attribute" .
                      [ sep_spc . key nmtoken . sep_eq . (sto_dquote|sto_squote) ]+ ]

let prolog        = [ label "#declaration" .
                      dels "<?xml" .
                      attributes_sq .
                      sep_osp .
                      dels "?>" ]

(************************************************************************
 *                            Tags
 *************************************************************************)

(* we consider entities as simple text *)
let text_re   = /[^<]+/ - /([^<]*\]\]>[^<]*)/
let text      = [ label "#text" . store text_re ]
let cdata     = [ label "#CDATA" . dels "<![CDATA[" .
                  store (char* - (char* . "]]>" . char*)) . dels "]]>" ]

let element (body:lens) =
    let h = attributes? . sep_osp . dels ">" . body* . dels "</" in
        [ dels "<" . square nmtoken h . sep_osp . del_end ]

let empty_element = [ dels "<" . key nmtoken . value "#empty" .
                      attributes? . sep_osp . del /\/>[\n]?/ "/>\n" ]

let pi_instruction = [ dels "<?" . label "#pi" .
                       [ label "#target" . store pi_target ] .
                       [ sep_spc . label "#instruction" . store pi ]? .
                       sep_osp . del /\?>/ "?>" ]

(* Typecheck is weaker on rec lens, detected by unfolding *)
(*
let content1 = element text
let rec content2 = element (content1|text|comment)
*)

let rec content = element (text|comment|content|empty_element|pi_instruction)

(* Constraints are weaker here, but it's better than being too strict *)
let doc = (sep_osp . (prolog  | comment | doctype | pi_instruction))* .
          ((sep_osp . content) | (sep_osp . empty_element)) .
          (sep_osp . (comment | pi_instruction ))* . sep_osp

let lns = doc

let filter = (excl "*")

let xfm = transform lns filter

(* XML lens for Augeas
   Author: Francis Giraldeau <francis.giraldeau@usherbrooke.ca>

   Reference: http://www.w3.org/TR/2006/REC-xml11-20060816/
*)

module JBXml =

autoload xfm

(************************************************************************
 *                           Utilities lens
 *************************************************************************)

let dels (s:string)   = del s s
let spc               = /[ \t\n]+/
let osp               = /[ \t\n]*/
let sep_spc           = del /[ \t\n]+/ " "
let sep_osp           = del /[ \t\n]*/ ""
let sep_eq            = del /[ \t\n]*=[ \t\n]*/ "="

let nmtoken             = /[a-zA-Z:_][a-zA-Z0-9:_.-]*/
let word                = /[a-zA-Z][a-zA-Z0-9._-]*/
let char                = /.|\n/
(* if we hide the quotes, then we can only accept single or double quotes *)
(* otherwise a put ambiguity is raised *)
let sto_dquote          = dels "\"" . store /[^"]*/ . dels "\""
let sto_squote          = dels "'" . store /[^']*/ . dels "'"

let comment             = [ label "#comment" .
                            dels "<!--" .
                            store /([^-]|-[^-])*/ .
                            dels "-->" ]

let pi_target           = nmtoken - /[Xx][Mm][Ll]/
let empty               = Util.empty
let del_end             = del />[\n]?/ ">\n"
let del_end_simple      = dels ">"

(* This is siplified version of processing instruction
 * pi has to not start or end with a white space and the string
 * must not contain "?>". We restrict too much by not allowing any
 * "?" nor ">" in PI
 *)
let pi                  = /[^ \n\t]|[^ \n\t][^?>]*[^ \n\t]/

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

let decl          = [ label "#decl" . sep_spc .
                      store /[^> \t\n\r]|[^> \t\n\r][^>\t\n\r]*[^> \t\n\r]/ ]

let decl_def (r:regexp) (b:lens) = [ dels "<" . key r .
                                     sep_spc . store word .
                                     b . sep_osp . del_end_simple ]

let elem_def      = decl_def /!ELEMENT/ decl

let enum          = "(" . osp . nmtoken . ( osp . "|" . osp . nmtoken )* . osp . ")"

let att_type      = /CDATA|ID|IDREF|IDREFS|ENTITY|ENTITIES|NMTOKEN|NMTOKENS/ |
                     enum

let id_def        = [ sep_spc . key /PUBLIC/ .
                      [ label "#literal" . sep_spc . sto_dquote ]* ] |
                    [ sep_spc . key /SYSTEM/ . sep_spc . sto_dquote ]

let notation_def  = decl_def /!NOTATION/ id_def

let att_def       = counter "att_id" .
                    [ sep_spc . seq "att_id" .
                      [ label "#name" . store word . sep_spc ] .
                      [ label "#type" . store att_type . sep_spc ] .
                      ([ key   /#REQUIRED|#IMPLIED/ ] |
                       [ label "#FIXED" . del /#FIXED[ \n\t]*|/ "" . sto_dquote ]) ]*

let att_list_def = decl_def /!ATTLIST/ att_def

let entity_def    = decl_def /!ENTITY/ ([sep_spc . label "#decl" . sto_dquote ])

let decl_def_item = elem_def | entity_def | att_list_def | notation_def

let decl_outer    = sep_osp . del /\[[ \n\t\r]*/ "[\n" .
                    (decl_def_item . sep_osp )* . dels "]"

(* let dtd_def       = [ sep_spc . key "SYSTEM" . sep_spc . sto_dquote ] *)

let doctype       = decl_def /!DOCTYPE/ (decl_outer|id_def)

let attributes    = [ label "#attribute" .
                      [ sep_spc . key nmtoken . sep_eq . sto_dquote ]+ ]
let attributes_sq = [ label "#attribute" .
                      [ sep_spc . key nmtoken . sep_eq . sto_squote ]+ ]

let prolog        = [ label "#declaration" .
                      dels "<?xml" .
                      attributes_sq .
                      sep_osp .
                      dels "?>" ]

(************************************************************************
 *                            Tags
 *************************************************************************)

(* we consider entities as simple text *)
let text_re   = /[^<]+/ - /([^<]*\]\]>[^<]*)/
let text      = [ label "#text" . store text_re ]
let cdata     = [ label "#CDATA" . dels "<![CDATA[" .
                  store (char* - (char* . "]]>" . char*)) . dels "]]>" ]

let element (body:lens) =
    let h = attributes? . sep_osp . dels ">" . body* . dels "</" in
        [ dels "<" . square nmtoken h . sep_osp . del_end ]

let empty_element = [ dels "<" . key nmtoken . value "#empty" .
                      attributes? . sep_osp . del /\/>[\n]?/ "/>\n" ]

let pi_instruction = [ dels "<?" . label "#pi" .
                       [ label "#target" . store pi_target ] .
                       [ sep_spc . label "#instruction" . store pi ]? .
                       sep_osp . del /\?>/ "?>" ]

(* Typecheck is weaker on rec lens, detected by unfolding *)
(*
let content1 = element text
let rec content2 = element (content1|text|comment)
*)

let rec content = element (text|comment|content|empty_element|pi_instruction)

(* Constraints are weaker here, but it's better than being too strict *)
let doc = (sep_osp . (prolog  | comment | doctype | pi_instruction))* .
          ((sep_osp . content) | (sep_osp . empty_element)) .
          (sep_osp . (comment | pi_instruction ))* . sep_osp

let lns = doc

let filter = (excl "*")

let xfm = transform lns filter


Yum: optimize regexp substractions

Yum: optimize regexp substractions