Do not allow \r in comment_or_eol

Do not allow \r in comment_or_eol

(*
Module: Util
  Generic module providing useful primitives

Author: David Lutterkort

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

module Util =

(*
Variable: del_str
  Delete a string and default to it

  Parameters:
     s:string - the string to delete and default to
*)
  let del_str (s:string) = del s s

(*
Variable: del_ws
  Delete mandatory whitespace
*)
  let del_ws = del /[ \t]+/

(*
Variable: del_ws_spc
  Delete mandatory whitespace, default to single space
*)
  let del_ws_spc = del_ws " "

(*
Variable: del_ws_tab
  Delete mandatory whitespace, default to single tab
*)
  let del_ws_tab = del_ws "\t"

(*
Variable: del_opt_ws
  Delete optional whitespace
*)
  let del_opt_ws = del /[ \t]*/

(*
Variable: eol
  Delete end of line, including optional trailing whitespace
*)
  let eol = del /[ \t]*\n/ "\n"

(*
Variable: doseol
  Delete end of line with optional carriage return,
  including optional trailing whitespace
*)
  let doseol = del /[ \t]*\r?\n/ "\n"

(*
Variable: indent
  Delete indentation, including leading whitespace
*)
  let indent = del /[ \t]*/ ""

(* Group: Comment
     This is a general definition of comment
     It allows indentation for comments, removes the leading and trailing spaces
     of comments and stores them in nodes, except for empty comments which are
     ignored together with empty lines

View: comment_generic
  Map comments and set default comment sign
*)

  let comment_generic (r:regexp) (d:string) =
    [ label "#comment" . del r d
        . store /([^ \t\r\n].*[^ \t\r\n]|[^ \t\r\n])/ . eol ]

(* View: comment
  Map comments into "#comment" nodes
*)
  let comment = comment_generic /[ \t]*#[ \t]*/ "# "

(* View: comment_noindent
  Map comments into "#comment" nodes, without indentation
*)
  let comment_noindent = comment_generic /#[ \t]*/ "# "

(* View: comment_eol
  Map eol comments into "#comment" nodes
  Add a space before # for end of line comments
*)
  let comment_eol = comment_generic /[ \t]*#[ \t]*/ " # "

(* View: comment_or_eol
    A <comment_eol> or <eol>, with an optional empty comment *)
 let comment_or_eol = comment_eol | (del /[ \t]*(#[ \t]*)?\n/ "\n")

(* View: comment_multiline
    A C-style multiline comment *)
  let comment_multiline =
     let mline_re = (/[^ \t\r\n].*[^ \t\r\n]|[^ \t\r\n]/ - /.*\*\/.*/) in
     let mline = [ seq "mline"
                 . del /[ \t\r\n]*/ "\n"
                 . store mline_re ] in
     [ label "#mcomment" . del /[ \t]*\/\*/ "/*"
       . counter "mline"
       . mline . (eol . mline)*
       . del /[ \t\r\n]*\*\/[ \t]*\r?\n/ "\n*/\n" ]

(* View: comment_c_style
    A comment line, C-style *)
  let comment_c_style =
    comment_generic /[ \t]*\/\/[ \t]*/ "// "

(* View: empty_generic
  A generic definition of <empty>
  Map empty lines, including empty comments *)
  let empty_generic (r:regexp) =
    [ del r "" . del_str "\n" ]

(* View: empty
  Map empty lines, including empty comments *)
  let empty = empty_generic /[ \t]*#?[ \t]*/

(* View: empty_c_style
  Map empty lines, including C-style empty comment *)
  let empty_c_style =
    empty_generic /[ \t]*((\/\/)|(\/\*[ \t]*\*\/))?[ \t]*/

(* View: Split *)
(* Split (SEP . ELT)* into an array-like tree where each match for ELT *)
(* appears in a separate subtree. The labels for the subtrees are      *)
(* consecutive numbers, starting at 0                                  *)
  let split (elt:lens) (sep:lens) =
    let sym = gensym "split" in
    counter sym . ( [ seq sym . sep . elt ] ) *

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

(* Group: Exclusions

Variable: stdexcl
  Exclusion for files that are commonly not wanted/needed
*)
  let stdexcl = (excl "*~") .
    (excl "*.rpmnew") .
    (excl "*.rpmsave") .
    (excl "*.dpkg-old") .
    (excl "*.dpkg-new") .
    (excl "*.dpkg-bak") .
    (excl "*.dpkg-dist") .
    (excl "*.augsave") .
    (excl "*.augnew")

(*
Module: Util
  Generic module providing useful primitives

Author: David Lutterkort

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

module Util =

(*
Variable: del_str
  Delete a string and default to it

  Parameters:
     s:string - the string to delete and default to
*)
  let del_str (s:string) = del s s

(*
Variable: del_ws
  Delete mandatory whitespace
*)
  let del_ws = del /[ \t]+/

(*
Variable: del_ws_spc
  Delete mandatory whitespace, default to single space
*)
  let del_ws_spc = del_ws " "

(*
Variable: del_ws_tab
  Delete mandatory whitespace, default to single tab
*)
  let del_ws_tab = del_ws "\t"

(*
Variable: del_opt_ws
  Delete optional whitespace
*)
  let del_opt_ws = del /[ \t]*/

(*
Variable: eol
  Delete end of line, including optional trailing whitespace
*)
  let eol = del /[ \t]*\n/ "\n"

(*
Variable: doseol
  Delete end of line with optional carriage return,
  including optional trailing whitespace
*)
  let doseol = del /[ \t]*\r?\n/ "\n"

(*
Variable: indent
  Delete indentation, including leading whitespace
*)
  let indent = del /[ \t]*/ ""

(* Group: Comment
     This is a general definition of comment
     It allows indentation for comments, removes the leading and trailing spaces
     of comments and stores them in nodes, except for empty comments which are
     ignored together with empty lines

View: comment_generic
  Map comments and set default comment sign
*)

  let comment_generic (r:regexp) (d:string) =
    [ label "#comment" . del r d
        . store /([^ \t\r\n].*[^ \t\r\n]|[^ \t\r\n])/ . eol ]

(* View: comment
  Map comments into "#comment" nodes
*)
  let comment = comment_generic /[ \t]*#[ \t]*/ "# "

(* View: comment_noindent
  Map comments into "#comment" nodes, without indentation
*)
  let comment_noindent = comment_generic /#[ \t]*/ "# "

(* View: comment_eol
  Map eol comments into "#comment" nodes
  Add a space before # for end of line comments
*)
  let comment_eol = comment_generic /[ \t]*#[ \t]*/ " # "

(* View: comment_or_eol
    A <comment_eol> or <eol>, with an optional empty comment *)
 let comment_or_eol = comment_eol | (del /[ \t]*(#[ \t]*)?\r?\n/ "\n")

(* View: comment_multiline
    A C-style multiline comment *)
  let comment_multiline =
     let mline_re = (/[^ \t\r\n].*[^ \t\r\n]|[^ \t\r\n]/ - /.*\*\/.*/) in
     let mline = [ seq "mline"
                 . del /[ \t\r\n]*/ "\n"
                 . store mline_re ] in
     [ label "#mcomment" . del /[ \t]*\/\*/ "/*"
       . counter "mline"
       . mline . (eol . mline)*
       . del /[ \t\r\n]*\*\/[ \t]*\r?\n/ "\n*/\n" ]

(* View: comment_c_style
    A comment line, C-style *)
  let comment_c_style =
    comment_generic /[ \t]*\/\/[ \t]*/ "// "

(* View: empty_generic
  A generic definition of <empty>
  Map empty lines, including empty comments *)
  let empty_generic (r:regexp) =
    [ del r "" . del_str "\n" ]

(* View: empty
  Map empty lines, including empty comments *)
  let empty = empty_generic /[ \t]*#?[ \t]*/

(* View: empty_c_style
  Map empty lines, including C-style empty comment *)
  let empty_c_style =
    empty_generic /[ \t]*((\/\/)|(\/\*[ \t]*\*\/))?[ \t]*/

(* View: Split *)
(* Split (SEP . ELT)* into an array-like tree where each match for ELT *)
(* appears in a separate subtree. The labels for the subtrees are      *)
(* consecutive numbers, starting at 0                                  *)
  let split (elt:lens) (sep:lens) =
    let sym = gensym "split" in
    counter sym . ( [ seq sym . sep . elt ] ) *

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

(* Group: Exclusions

Variable: stdexcl
  Exclusion for files that are commonly not wanted/needed
*)
  let stdexcl = (excl "*~") .
    (excl "*.rpmnew") .
    (excl "*.rpmsave") .
    (excl "*.dpkg-old") .
    (excl "*.dpkg-new") .
    (excl "*.dpkg-bak") .
    (excl "*.dpkg-dist") .
    (excl "*.augsave") .
    (excl "*.augnew")


Xinetd: slight formatting improvements

Xinetd: slight formatting improvements

(*
 * 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/i
     |/rpc_version|rpc_number|id|port|nice|banner|bind|interface/i
     |/per_source|groups|banner_success|banner_fail|disable|max_load/i
     |/rlimit_as|rlimit_cpu|rlimit_data|rlimit_rss|rlimit_stack|v6only/i
     |/deny_time|umask|mdns|libwrap/i)
   (* 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/i)
   |attr_lst_op (/log_on_success|log_on_failure|only_from|no_access|env|passenv/i)

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

  (* 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) = Build.block_newlines
                            (indent . attr . Util.eol)
                            Util.comment

  (* 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 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/i)
   (* 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/i)
   |attr_lst_op (/log_on_success|log_on_failure|only_from|no_access|env|passenv/i)

  let default_attr =
    attr_one (/instances|banner|bind|interface|per_source|groups|banner_success|banner_fail|max_load|v6only|umask|mdns/i)
   |attr_lst_eq /cps/i       (* 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/i)

  (* 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) = Build.block_newlines
                            (indent . attr . Util.eol)
                            Util.comment

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


Httpd: Add unit test for comment on next line

module Test_httpd =

(* directives testing *)
let d1 = "ServerRoot \"/etc/apache2\"\n"
test Httpd.directive get d1 =
  { "directive" = "ServerRoot"
    { "arg" = "\"/etc/apache2\"" }
  }

(* simple quotes *)
let d1s = "ServerRoot '/etc/apache2'\n"
test Httpd.directive get d1s =
  { "directive" = "ServerRoot"
    { "arg" = "'/etc/apache2'" }
  }

let d2 = "ScriptAlias /cgi-bin/ /usr/lib/cgi-bin/\n"
test Httpd.directive get d2 =
  { "directive" = "ScriptAlias"
    { "arg" = "/cgi-bin/" }
    { "arg" = "/usr/lib/cgi-bin/" }
  }

let d3 = "LockFile /var/lock/apache2/accept.lock\n"
test Httpd.directive get d3 =
  { "directive" = "LockFile"
    { "arg" = "/var/lock/apache2/accept.lock" }
  }

let c1 = "
<IfModule>
</IfModule>
"
let c1_put =
"
<IfModule foo bar>
</IfModule>
"

test Httpd.lns get c1 = { }{ "IfModule" }

test Httpd.lns put c1 after set "/IfModule/arg[1]" "foo";
                            set "/IfModule/arg[2]" "bar" = c1_put

let c2 = "
<IfModule !mpm_winnt.c>
  <IfModule !mpm_netware.c>
    LockFile /var/lock/apache2/accept.lock
  </IfModule>
</IfModule>
"

test Httpd.lns get c2 =
  {  }
  { "IfModule"
    { "arg" = "!mpm_winnt.c" }
    { "IfModule"
      { "arg" = "!mpm_netware.c" }
      { "directive" = "LockFile"
        { "arg" = "/var/lock/apache2/accept.lock" }
      }
    }
  }

(* arguments must be the first child of the section *)
test Httpd.lns put c2 after rm "/IfModule/arg";
                            insb "arg" "/IfModule/*[1]";
                            set "/IfModule/arg" "foo"  =
"
<IfModule foo>
  <IfModule !mpm_netware.c>
    LockFile /var/lock/apache2/accept.lock
  </IfModule>
</IfModule>
"

let c3 = "
<IfModule mpm_event_module>
    StartServers          2
    MaxClients          150
    MinSpareThreads      25
    MaxSpareThreads      75
    ThreadLimit          64
    ThreadsPerChild      25
    MaxRequestsPerChild   0
</IfModule>
"

test Httpd.lns get c3 =
  {  }
  { "IfModule"
    { "arg" = "mpm_event_module" }
    { "directive" = "StartServers"
      { "arg" = "2" }
    }
    { "directive" = "MaxClients"
      { "arg" = "150" }
    }
    { "directive" = "MinSpareThreads"
      { "arg" = "25" }
    }
    { "directive" = "MaxSpareThreads"
      { "arg" = "75" }
    }
    { "directive" = "ThreadLimit"
      { "arg" = "64" }
    }
    { "directive" = "ThreadsPerChild"
      { "arg" = "25" }
    }
    { "directive" = "MaxRequestsPerChild"
      { "arg" = "0" }
    }
  }

let c4 = "
<Files ~ \"^\.ht\">
    Order allow,deny
    Deny from all
    Satisfy all
</Files>
"

test Httpd.lns get c4 =
  {  }
  { "Files"
    { "arg" = "~" }
    { "arg" = "\"^\.ht\"" }
    { "directive" = "Order"
      { "arg" = "allow,deny" }
    }
    { "directive" = "Deny"
      { "arg" = "from" }
      { "arg" = "all" }
    }
    { "directive" = "Satisfy"
      { "arg" = "all" }
    }
  }

let c5 = "LogFormat \"%{User-agent}i\" agent\n"
test Httpd.lns get c5 =
  { "directive" = "LogFormat"
    { "arg" = "\"%{User-agent}i\"" }
    { "arg" = "agent" }
  }

let c7 = "LogFormat \"%v:%p %h %l %u %t \\"%r\\" %>s %O \\"%{Referer}i\\" \\"%{User-Agent}i\\"\" vhost_combined\n"
test Httpd.lns get c7 =
  { "directive" = "LogFormat"
    { "arg" = "\"%v:%p %h %l %u %t \\"%r\\" %>s %O \\"%{Referer}i\\" \\"%{User-Agent}i\\"\"" }
    { "arg" = "vhost_combined" }
  }

let c8 = "IndexIgnore .??* *~ *# RCS CVS *,v *,t \n"
test Httpd.directive get c8 =
  { "directive" = "IndexIgnore"
    { "arg" = ".??*" }
    { "arg" = "*~" }
    { "arg" = "*#" }
    { "arg" = "RCS" }
    { "arg" = "CVS" }
    { "arg" = "*,v" }
    { "arg" = "*,t" }
  }

(* FIXME: not yet supported:
 * The backslash "\" may be used as the last character on a line to indicate
 * that the directive continues onto the next line. There must be no other
 * characters or white space between the backslash and the end of the line.
 *)
let multiline = "Options Indexes \
FollowSymLinks MultiViews
"

test Httpd.directive get multiline =
  { "directive" = "Options"
    { "arg" = "Indexes" }
    { "arg" = "FollowSymLinks" }
    { "arg" = "MultiViews" }
  }

let conf2 = "<VirtualHost *:80>
    ServerAdmin webmaster@localhost

    DocumentRoot /var/www
    <Directory />
        Options FollowSymLinks
        AllowOverride None
    </Directory>
    <Directory /var/www/>
        Options Indexes FollowSymLinks MultiViews
        AllowOverride None
        Order allow,deny
        allow from all
    </Directory>

    ScriptAlias /cgi-bin/ /usr/lib/cgi-bin/
    <Directory \"/usr/lib/cgi-bin\">
        AllowOverride None
        Options +ExecCGI -MultiViews +SymLinksIfOwnerMatch
        Order allow,deny
        Allow from all
    </Directory>

    ErrorLog /var/log/apache2/error.log

    # Possible values include: debug, info, notice, warn, error, crit,
    # alert, emerg.
    LogLevel warn

    CustomLog /var/log/apache2/access.log combined

    SSLRequireSSL

    Alias /doc/ \"/usr/share/doc/\"
    <Directory \"/usr/share/doc/\">
        Options Indexes MultiViews FollowSymLinks
        AllowOverride None
        Order deny,allow
        Deny from all
        Allow from 127.0.0.0/255.0.0.0 ::1/128
    </Directory>

</VirtualHost>
"

test Httpd.lns get conf2 =
   { "VirtualHost"
    { "arg" = "*:80" }
    { "directive" = "ServerAdmin"
      { "arg" = "webmaster@localhost" }
    }
    {  }
    { "directive" = "DocumentRoot"
      { "arg" = "/var/www" }
    }
    { "Directory"
      { "arg" = "/" }
      { "directive" = "Options"
        { "arg" = "FollowSymLinks" }
      }
      { "directive" = "AllowOverride"
        { "arg" = "None" }
      }
    }
    { "Directory"
      { "arg" = "/var/www/" }
      { "directive" = "Options"
        { "arg" = "Indexes" }
        { "arg" = "FollowSymLinks" }
        { "arg" = "MultiViews" }
      }
      { "directive" = "AllowOverride"
        { "arg" = "None" }
      }
      { "directive" = "Order"
        { "arg" = "allow,deny" }
      }
      { "directive" = "allow"
        { "arg" = "from" }
        { "arg" = "all" }
      }
    }
    {  }
    { "directive" = "ScriptAlias"
      { "arg" = "/cgi-bin/" }
      { "arg" = "/usr/lib/cgi-bin/" }
    }
    { "Directory"
      { "arg" = "\"/usr/lib/cgi-bin\"" }
      { "directive" = "AllowOverride"
        { "arg" = "None" }
      }
      { "directive" = "Options"
        { "arg" = "+ExecCGI" }
        { "arg" = "-MultiViews" }
        { "arg" = "+SymLinksIfOwnerMatch" }
      }
      { "directive" = "Order"
        { "arg" = "allow,deny" }
      }
      { "directive" = "Allow"
        { "arg" = "from" }
        { "arg" = "all" }
      }
    }
    {  }
    { "directive" = "ErrorLog"
      { "arg" = "/var/log/apache2/error.log" }
    }
    {  }
    { "#comment" = "Possible values include: debug, info, notice, warn, error, crit," }
    { "#comment" = "alert, emerg." }
    { "directive" = "LogLevel"
      { "arg" = "warn" }
    }
    {  }
    { "directive" = "CustomLog"
      { "arg" = "/var/log/apache2/access.log" }
      { "arg" = "combined" }
    }
    {  }
    { "directive" = "SSLRequireSSL" }
    {  }
    { "directive" = "Alias"
      { "arg" = "/doc/" }
      { "arg" = "\"/usr/share/doc/\"" }
    }
    { "Directory"
      { "arg" = "\"/usr/share/doc/\"" }
      { "directive" = "Options"
        { "arg" = "Indexes" }
        { "arg" = "MultiViews" }
        { "arg" = "FollowSymLinks" }
      }
      { "directive" = "AllowOverride"
        { "arg" = "None" }
      }
      { "directive" = "Order"
        { "arg" = "deny,allow" }
      }
      { "directive" = "Deny"
        { "arg" = "from" }
        { "arg" = "all" }
      }
      { "directive" = "Allow"
        { "arg" = "from" }
        { "arg" = "127.0.0.0/255.0.0.0" }
        { "arg" = "::1/128" }
      }
    }
    {  }
  }

(* Eol comment *)
test Httpd.lns get "<a> # a comment
MyDirective Foo
</a>\n" =
  { "a"
    { "#comment" = "a comment" }
    { "directive" = "MyDirective" { "arg" = "Foo" } } }

test Httpd.lns get "<a>
# a comment
</a>\n" =
  { "a" { "#comment" = "a comment" } }


Use Sys.getenv("HOME") in dput.aug

Use Sys.getenv("HOME") in dput.aug

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

   Reference: dput uses Python's ConfigParser:
     http://docs.python.org/lib/module-ConfigParser.html
*)

module Dput =
  autoload xfm

(************************************************************************
 * INI File settings
 *************************************************************************)
let comment  = IniFile.comment IniFile.comment_re IniFile.comment_default

let sep      = IniFile.sep IniFile.sep_re IniFile.sep_default

let setting = "allow_dcut"
            | "allow_non-us_software"
            | "allow_unsigned_uploads"
            | "check_version"
            | "default_host_main"
            | "default_host_non-us"
            | "fqdn"
            | "hash"
            | "incoming"
            | "login"
            | "method"
            | "passive_ftp"
            | "post_upload_command"
            | "pre_upload_command"
            | "progress_indicator"
            | "run_dinstall"
            | "run_lintian"
            | "scp_compress"
            | "ssh_config_options"
            | "allowed_distributions"

(************************************************************************
 * "name: value" entries, with continuations in the style of RFC 822;
 * "name=value" is also accepted
 * leading whitespace is removed from values
 *************************************************************************)
let entry = IniFile.entry setting sep comment

(************************************************************************
 * sections, led by a "[section]" header
 * We can't use titles as node names here since they could contain "/"
 * We remove #comment from possible keys
 * since it is used as label for comments
 * We also remove / as first character
 * because augeas doesn't like '/' keys (although it is legal in INI Files)
 *************************************************************************)
let title   = IniFile.title_label "target" IniFile.record_label_re
let record  = IniFile.record title entry

let lns    = IniFile.lns record comment

let filter = (incl "/etc/dput.cf")
           . (incl (Sys.getenv("HOME") . "/.dput.cf"))
           . Util.stdexcl

let xfm = transform lns filter

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

   Reference: dput uses Python's ConfigParser:
     http://docs.python.org/lib/module-ConfigParser.html
*)

module Dput =
  autoload xfm

(************************************************************************
 * INI File settings
 *************************************************************************)
let comment  = IniFile.comment IniFile.comment_re IniFile.comment_default

let sep      = IniFile.sep IniFile.sep_re IniFile.sep_default

let setting = "allow_dcut"
            | "allow_non-us_software"
            | "allow_unsigned_uploads"
            | "check_version"
            | "default_host_main"
            | "default_host_non-us"
            | "fqdn"
            | "hash"
            | "incoming"
            | "login"
            | "method"
            | "passive_ftp"
            | "post_upload_command"
            | "pre_upload_command"
            | "progress_indicator"
            | "run_dinstall"
            | "run_lintian"
            | "scp_compress"
            | "ssh_config_options"
            | "allowed_distributions"

(************************************************************************
 * "name: value" entries, with continuations in the style of RFC 822;
 * "name=value" is also accepted
 * leading whitespace is removed from values
 *************************************************************************)
let entry = IniFile.entry setting sep comment

(************************************************************************
 * sections, led by a "[section]" header
 * We can't use titles as node names here since they could contain "/"
 * We remove #comment from possible keys
 * since it is used as label for comments
 * We also remove / as first character
 * because augeas doesn't like '/' keys (although it is legal in INI Files)
 *************************************************************************)
let title   = IniFile.title_label "target" IniFile.record_label_re
let record  = IniFile.record title entry

let lns    = IniFile.lns record comment

let filter = (incl "/etc/dput.cf")
           . (incl "~/.dput.cf")
           . Util.stdexcl

let xfm = transform lns filter


Dhclient: on OpenBSD dhclient.conf lives in /etc/dhclient.conf

Fixes ticket #320

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

   Reference: man dhclient.conf
   The only difference with the reference syntax is that this lens assumes
   that statements end with a new line, while the reference syntax allows
   new statements to be started right after the trailing ";" of the
   previous statement. This should not be a problem in real-life
   configuration files as statements get usually splitted across several
   lines, rather than merged in a single one.

   TODO: support the "default", "supersede", "append" and "prepend"
   statements
*)

module Dhclient =

   autoload xfm

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

let eol               = Util.eol
let comment           = Util.comment
let comment_or_eol    = Util.comment_or_eol
let empty             = Util.empty

(* Define separators *)
let sep_spc           = del /[ \t\n]+/ " "
let sep_scl           = del /[ \t]*;/ ";"
let sep_obr           = del /[ \t\n]*\{\n]*/ " {\n"
let sep_cbr           = del /[ \t\n]*\}/ " }"
let sep_com           = del /[ \t\n]*,[ \t\n]*/ ","
let sep_slh           = del "\/" "/"
let sep_col           = del ":" ":"
let sep_eq            = del /[ \t]*=[ \t]*/ "="

(* Define basic types *)
let word              = /[A-Za-z0-9_.-]+(\[[0-9]+\])?/

(* Define fields *)

(* TODO: there could be a " " in the middle of a value ... *)
let sto_to_spc        = store /[^\\#,;{}" \t\n]+|"[^\\#"\n]+"/
let sto_to_scl        = store /[^ \t][^;\n]+[^ \t]|[^ \t;\n]+/
let rfc_code          = [ key "code" . sep_spc . store word ]
                      . sep_eq
                      . [ label "value" . sto_to_scl ]
let sto_number        = store /[0-9][0-9]*/

(************************************************************************
 *                         SIMPLE STATEMENTS
 *************************************************************************)

let stmt_simple_re    = "timeout"
                      | "retry"
                      | "select-timeout"
                      | "reboot"
                      | "backoff-cutoff"
                      | "initial-interval"
                      | "do-forward-updates"
                      | "reject"

let stmt_simple       = [ key stmt_simple_re
                        . sep_spc
                        . sto_to_spc
                        . sep_scl
                        . comment_or_eol ]

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

(* TODO: the array could also be empty, like in the request statement *)
let stmt_array_re     = "media"
                      | "request"
                      | "require"

let stmt_array        = [ key stmt_array_re
                        . sep_spc
                        . counter "stmt_array"
                        . [ seq "stmt_array" . sto_to_spc ]
                        . [ sep_com . seq "stmt_array" . sto_to_spc ]*
                        . sep_scl . comment_or_eol ]

(************************************************************************
 *                          HASH STATEMENTS
 *************************************************************************)

let stmt_hash_re      = "send"
                      | "option"

let stmt_hash         = [ key stmt_hash_re
                        . sep_spc
                        . [ key word . sep_spc . (sto_to_spc|rfc_code) ]
                        . sep_scl
                        . comment_or_eol ]

(************************************************************************
 *                         BLOCK STATEMENTS
 *************************************************************************)

let stmt_block_re     = "interface"
                      | "lease"
                      | "alias"

let stmt_block_opt_re = "interface"
                      | "script"
                      | "bootp"
                      | "fixed-address"
                      | "filename"
                      | "server-name"
                      | "medium"
                      | "vendor option space"

(* TODO: some options could take no argument like bootp *)
let stmt_block_opt    = [ key stmt_block_opt_re
                         . sep_spc
                         . sto_to_spc
                         . sep_scl
                         . comment_or_eol ]

let stmt_block_date_re
                      = "renew"
                      | "rebind"
                      | "expire"

let stmt_block_date   = [ key stmt_block_date_re
                        . [ sep_spc . label "weekday" . sto_number ]
                        . [ sep_spc . label "year"    . sto_number ]
                        . [ sep_slh . label "month"   . sto_number ]
                        . [ sep_slh . label "day"     . sto_number ]
                        . [ sep_spc . label "hour"    . sto_number ]
                        . [ sep_col . label "minute"  . sto_number ]
                        . [ sep_col . label "second"  . sto_number ]
                        . sep_scl
                        . comment_or_eol ]

let stmt_block_arg    = sep_spc . sto_to_spc

let stmt_block_entry  = sep_spc
                      . ( stmt_array
                        | stmt_hash
                        | stmt_block_opt
                        | stmt_block_date )

let stmt_block        = [ key stmt_block_re
                        . stmt_block_arg?
                        . sep_obr
                        . stmt_block_entry+
                        . sep_cbr
                        . comment_or_eol ]

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

let statement = (stmt_simple|stmt_array|stmt_hash|stmt_block)

let lns               = ( empty
                        | comment
                        | statement )*

let filter            = incl "/etc/dhcp3/dhclient.conf"
                      . incl "/etc/dhclient.conf"
                      . Util.stdexcl

let xfm                = transform lns filter

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

   Reference: man dhclient.conf
   The only difference with the reference syntax is that this lens assumes
   that statements end with a new line, while the reference syntax allows
   new statements to be started right after the trailing ";" of the
   previous statement. This should not be a problem in real-life
   configuration files as statements get usually splitted across several
   lines, rather than merged in a single one.

   TODO: support the "default", "supersede", "append" and "prepend"
   statements
*)

module Dhclient =

   autoload xfm

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

let eol               = Util.eol
let comment           = Util.comment
let comment_or_eol    = Util.comment_or_eol
let empty             = Util.empty

(* Define separators *)
let sep_spc           = del /[ \t\n]+/ " "
let sep_scl           = del /[ \t]*;/ ";"
let sep_obr           = del /[ \t\n]*\{\n]*/ " {\n"
let sep_cbr           = del /[ \t\n]*\}/ " }"
let sep_com           = del /[ \t\n]*,[ \t\n]*/ ","
let sep_slh           = del "\/" "/"
let sep_col           = del ":" ":"
let sep_eq            = del /[ \t]*=[ \t]*/ "="

(* Define basic types *)
let word              = /[A-Za-z0-9_.-]+(\[[0-9]+\])?/

(* Define fields *)

(* TODO: there could be a " " in the middle of a value ... *)
let sto_to_spc        = store /[^\\#,;{}" \t\n]+|"[^\\#"\n]+"/
let sto_to_scl        = store /[^ \t][^;\n]+[^ \t]|[^ \t;\n]+/
let rfc_code          = [ key "code" . sep_spc . store word ]
                      . sep_eq
                      . [ label "value" . sto_to_scl ]
let sto_number        = store /[0-9][0-9]*/

(************************************************************************
 *                         SIMPLE STATEMENTS
 *************************************************************************)

let stmt_simple_re    = "timeout"
                      | "retry"
                      | "select-timeout"
                      | "reboot"
                      | "backoff-cutoff"
                      | "initial-interval"
                      | "do-forward-updates"
                      | "reject"

let stmt_simple       = [ key stmt_simple_re
                        . sep_spc
                        . sto_to_spc
                        . sep_scl
                        . comment_or_eol ]

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

(* TODO: the array could also be empty, like in the request statement *)
let stmt_array_re     = "media"
                      | "request"
                      | "require"

let stmt_array        = [ key stmt_array_re
                        . sep_spc
                        . counter "stmt_array"
                        . [ seq "stmt_array" . sto_to_spc ]
                        . [ sep_com . seq "stmt_array" . sto_to_spc ]*
                        . sep_scl . comment_or_eol ]

(************************************************************************
 *                          HASH STATEMENTS
 *************************************************************************)

let stmt_hash_re      = "send"
                      | "option"

let stmt_hash         = [ key stmt_hash_re
                        . sep_spc
                        . [ key word . sep_spc . (sto_to_spc|rfc_code) ]
                        . sep_scl
                        . comment_or_eol ]

(************************************************************************
 *                         BLOCK STATEMENTS
 *************************************************************************)

let stmt_block_re     = "interface"
                      | "lease"
                      | "alias"

let stmt_block_opt_re = "interface"
                      | "script"
                      | "bootp"
                      | "fixed-address"
                      | "filename"
                      | "server-name"
                      | "medium"
                      | "vendor option space"

(* TODO: some options could take no argument like bootp *)
let stmt_block_opt    = [ key stmt_block_opt_re
                         . sep_spc
                         . sto_to_spc
                         . sep_scl
                         . comment_or_eol ]

let stmt_block_date_re
                      = "renew"
                      | "rebind"
                      | "expire"

let stmt_block_date   = [ key stmt_block_date_re
                        . [ sep_spc . label "weekday" . sto_number ]
                        . [ sep_spc . label "year"    . sto_number ]
                        . [ sep_slh . label "month"   . sto_number ]
                        . [ sep_slh . label "day"     . sto_number ]
                        . [ sep_spc . label "hour"    . sto_number ]
                        . [ sep_col . label "minute"  . sto_number ]
                        . [ sep_col . label "second"  . sto_number ]
                        . sep_scl
                        . comment_or_eol ]

let stmt_block_arg    = sep_spc . sto_to_spc

let stmt_block_entry  = sep_spc
                      . ( stmt_array
                        | stmt_hash
                        | stmt_block_opt
                        | stmt_block_date )

let stmt_block        = [ key stmt_block_re
                        . stmt_block_arg?
                        . sep_obr
                        . stmt_block_entry+
                        . sep_cbr
                        . comment_or_eol ]

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

let statement = (stmt_simple|stmt_array|stmt_hash|stmt_block)

let lns               = ( empty
                        | comment
                        | statement )*

let filter            = incl "/etc/dhcp3/dhclient.conf"
                      . Util.stdexcl

let xfm                = transform lns filter


Parse nginx sites-enabled

Parse nginx sites-enabled

On Debian/Ubuntu the active sites are configured in /etc/nginx/sites-enabled, either as files or as symlinks to files in /etc/nginx/sites-available/, so parse that path too.

(* Module: Nginx
   Nginx module for Augeas

Authors: Ian Berry <iberry@barracuda.com>
         Raphael Pinson <raphael.pinson@camptocamp.com>

About: Reference

   This module was built to support a limited subset of nginx
   configuration syntax. It works fine with simple blocks and
   field/value lines.

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

About: Lens Usage
   To be documented

About: Configuration files
   This lens applies to /etc/nginx/nginx.conf. See <filter>.

About: Examples
   The <Test_Nginx> file contains various examples and tests.

About: TODO
   * Convert statement keyworks for a regex
   * Support more advanced block syntax (location)
*)

module Nginx =

autoload xfm

(* Variable: word *)
let word = /[A-Za-z0-9_.:-]+/

(* Variable: block_re
     The keywords reserved for block entries *)
let block_re = "http" | "events" | "server" | "mail" | "stream"

(* All block keywords, including the ones we treat specially *)
let block_re_all = block_re | "if" | "location" | "geo" | "map"
  | "split_clients" | "upstream"

(* View: simple
     A simple entry *)
let simple =
     let kw = word - block_re_all
  in let mask = [ label "mask" . Util.del_str "/" . store Rx.integer ]
  in let sto = store /[^ \t\n;][^;]*/ . Sep.semicolon
  in [ Util.indent . key kw . mask? . Sep.space . sto . (Util.eol|Util.comment_eol) ]

(* View: server
     A simple server entry *)
let server =
  [ Util.indent . label "@server" . Util.del_str "server"
  . [ Sep.space . label "@address" . store word ]
  . [ Sep.space . key word . (Sep.equal . store word)? ]*
  . Sep.semicolon
  . (Util.eol|Util.comment_eol) ]

let arg (name:string) (rx:regexp) =
  [ label name . Sep.space . store rx ]

(* Match any argument (as much as possible) *)
let any_rx =
  let bare_rx = /[^" \t\n{][^ \t\n{]*/ in
  let dquote_rx = /"([^\"]|\\.)*"/ in
  bare_rx | dquote_rx

let any_arg (name:string) = arg name any_rx

(* 'if' conditions are enclosed in matching parens which we can't match
   precisely with a regular expression. Instead, we gobble up anything that
   doesn't contain an opening brace. That can of course lead to trouble if
   a condition actually contains an opening brace *)
let block_if = key "if"
             . arg "#cond" /\(([^ \t\n{]|[ \t\n][^{])*\)/

let block_location = key "location"
  . (arg "#comp" /=|~|~\*|\^~/)?
  . any_arg "#uri"

let block_geo = key "geo"
  . (any_arg "#address")?
  . any_arg "#geo"

let block_map = key "map"
  . any_arg "#source"
  . any_arg "#variable"

let block_split_clients = key "split_clients"
  . any_arg "#string"
  . any_arg "#variable"

let block_upstream = key "upstream"
  . any_arg "#name"

let block_head = key block_re
  | block_if
  | block_location
  | block_geo
  | block_map
  | block_split_clients
  | block_upstream

(* View: block
     A block containing <simple> entries *)
let block (entry : lens) =
  [ Util.indent . block_head
  . Build.block_newlines entry Util.comment
  . Util.eol ]

let rec directive = simple | server | block directive

(* View: lns *)
let lns = ( Util.comment | Util.empty | directive )*

(* Variable: filter *)
let filter = incl "/etc/nginx/nginx.conf"
           . incl "/etc/nginx/conf.d/*.conf"
           . incl "/etc/nginx/sites-available/*"
           . incl "/etc/nginx/sites-enabled/*"
           . incl "/usr/portage/www-servers/nginx/files/nginx.conf"
           . incl "/usr/local/etc/nginx/nginx.conf"
           . incl "/usr/local/etc/nginx/conf.d/*.conf"
           . incl "/usr/local/etc/nginx/sites-available/*"
           . incl "/usr/local/etc/nginx/sites-enabled/*"

let xfm = transform lns filter

(* Module: Nginx
   Nginx module for Augeas

Authors: Ian Berry <iberry@barracuda.com>
         Raphael Pinson <raphael.pinson@camptocamp.com>

About: Reference

   This module was built to support a limited subset of nginx
   configuration syntax. It works fine with simple blocks and
   field/value lines.

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

About: Lens Usage
   To be documented

About: Configuration files
   This lens applies to /etc/nginx/nginx.conf. See <filter>.

About: Examples
   The <Test_Nginx> file contains various examples and tests.

About: TODO
   * Convert statement keyworks for a regex
   * Support more advanced block syntax (location)
*)

module Nginx =

autoload xfm

(* Variable: word *)
let word = /[A-Za-z0-9_.:-]+/

(* Variable: block_re
     The keywords reserved for block entries *)
let block_re = "http" | "events" | "server" | "mail" | "stream"

(* All block keywords, including the ones we treat specially *)
let block_re_all = block_re | "if" | "location" | "geo" | "map"
  | "split_clients" | "upstream"

(* View: simple
     A simple entry *)
let simple =
     let kw = word - block_re_all
  in let mask = [ label "mask" . Util.del_str "/" . store Rx.integer ]
  in let sto = store /[^ \t\n;][^;]*/ . Sep.semicolon
  in [ Util.indent . key kw . mask? . Sep.space . sto . (Util.eol|Util.comment_eol) ]

(* View: server
     A simple server entry *)
let server =
  [ Util.indent . label "@server" . Util.del_str "server"
  . [ Sep.space . label "@address" . store word ]
  . [ Sep.space . key word . (Sep.equal . store word)? ]*
  . Sep.semicolon
  . (Util.eol|Util.comment_eol) ]

let arg (name:string) (rx:regexp) =
  [ label name . Sep.space . store rx ]

(* Match any argument (as much as possible) *)
let any_rx =
  let bare_rx = /[^" \t\n{][^ \t\n{]*/ in
  let dquote_rx = /"([^\"]|\\.)*"/ in
  bare_rx | dquote_rx

let any_arg (name:string) = arg name any_rx

(* 'if' conditions are enclosed in matching parens which we can't match
   precisely with a regular expression. Instead, we gobble up anything that
   doesn't contain an opening brace. That can of course lead to trouble if
   a condition actually contains an opening brace *)
let block_if = key "if"
             . arg "#cond" /\(([^ \t\n{]|[ \t\n][^{])*\)/

let block_location = key "location"
  . (arg "#comp" /=|~|~\*|\^~/)?
  . any_arg "#uri"

let block_geo = key "geo"
  . (any_arg "#address")?
  . any_arg "#geo"

let block_map = key "map"
  . any_arg "#source"
  . any_arg "#variable"

let block_split_clients = key "split_clients"
  . any_arg "#string"
  . any_arg "#variable"

let block_upstream = key "upstream"
  . any_arg "#name"

let block_head = key block_re
  | block_if
  | block_location
  | block_geo
  | block_map
  | block_split_clients
  | block_upstream

(* View: block
     A block containing <simple> entries *)
let block (entry : lens) =
  [ Util.indent . block_head
  . Build.block_newlines entry Util.comment
  . Util.eol ]

let rec directive = simple | server | block directive

(* View: lns *)
let lns = ( Util.comment | Util.empty | directive )*

(* Variable: filter *)
let filter = incl "/etc/nginx/nginx.conf"
           . incl "/etc/nginx/conf.d/*.conf"
           . incl "/etc/nginx/sites-available/*"
           . incl "/usr/portage/www-servers/nginx/files/nginx.conf"
           . incl "/usr/local/etc/nginx/nginx.conf"
           . incl "/usr/local/etc/nginx/conf.d/*.conf"
           . incl "/usr/local/etc/nginx/sites-available/*"

let xfm = transform lns filter


Add default_lbracket and default_rbracket to Build.block_generic


Add blkid.conf to shellvars.aug

Add blkid.conf to shellvars.aug

(* 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 comment_or_eol = Util.comment_or_eol
  let empty   = Util.empty
  let xchgs   = Build.xchgs
  let semicol = del /;?/ ""

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

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

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

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

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

  let shell_builtin_cmds = "ulimit"

  let builtin =
    [ label "@builtin"
      . store shell_builtin_cmds
      . Util.del_ws_spc
      . [ label "args" . store /[^; \t\n][^;\n]+[^; \t\n]|[^ \t;\n]+/ ]
      . semicol . eol ]

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

  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 "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 "puppet" .
      sc_incl "puppetmaster" .
      sc_incl "readonly-root" .
      sc_incl "rsyslog" .
      sc_incl "samba" .
      sc_incl "saslauthd" .
      sc_incl "selinux" .
      sc_incl "sendmail" .
      sc_incl "smartmontools" .
      sc_incl "snmpd" .
      sc_incl "snmpd.options" .
      sc_incl "snmptrapd" .
      sc_incl "snmptrapd.options" .
      sc_incl "spamassassin" .
      sc_incl "suseconfig" .
      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"
                     . incl "/etc/environment"
                     . incl "/etc/blkid.conf"

  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 comment_or_eol = Util.comment_or_eol
  let empty   = Util.empty
  let xchgs   = Build.xchgs
  let semicol = del /;?/ ""

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

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

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

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

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

  let shell_builtin_cmds = "ulimit"

  let builtin =
    [ label "@builtin"
      . store shell_builtin_cmds
      . Util.del_ws_spc
      . [ label "args" . store /[^; \t\n][^;\n]+[^; \t\n]|[^ \t;\n]+/ ]
      . semicol . eol ]

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

  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 "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 "puppet" .
      sc_incl "puppetmaster" .
      sc_incl "readonly-root" .
      sc_incl "rsyslog" .
      sc_incl "samba" .
      sc_incl "saslauthd" .
      sc_incl "selinux" .
      sc_incl "sendmail" .
      sc_incl "smartmontools" .
      sc_incl "snmpd" .
      sc_incl "snmpd.options" .
      sc_incl "snmptrapd" .
      sc_incl "snmptrapd.options" .
      sc_incl "spamassassin" .
      sc_incl "suseconfig" .
      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"
                     . incl "/etc/environment"

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

  let xfm = transform lns filter

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


cowpoke.conf

cowpoke.conf

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

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

About: Lens Usage
   To be documented
*)

module Shellvars =
  autoload xfm

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

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

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

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

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

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

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

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

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

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

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

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

  let shell_builtin_cmds = "ulimit"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  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 "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 "puppet" .
      sc_incl "puppetmaster" .
      sc_incl "readonly-root" .
      sc_incl "rsyslog" .
      sc_incl "samba" .
      sc_incl "saslauthd" .
      sc_incl "selinux" .
      sc_incl "sendmail" .
      sc_incl "smartmontools" .
      sc_incl "snmpd" .
      sc_incl "snmpd.options" .
      sc_incl "snmptrapd" .
      sc_incl "snmptrapd.options" .
      sc_incl "spamassassin" .
      sc_incl "suseconfig" .
      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"
                     . incl "/etc/environment"
                     . incl "/etc/blkid.conf"
                     . incl "/etc/adduser.conf"
                     . incl "/etc/cowpoke.conf"
                     . incl "/etc/cvs-cron.conf"
                     . incl "/etc/cvs-pserver.conf"
                     . incl "/etc/devscripts.conf"
                     . incl "/etc/lintianrc"
                     . incl "/etc/lsb-release"
                     . incl "/etc/popularity-contest.conf"
                     . incl "/etc/ucf.conf"
                     . incl "/etc/updatedb.conf"

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

  let xfm = transform lns filter

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

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

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

About: Lens Usage
   To be documented
*)

module Shellvars =
  autoload xfm

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

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

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

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

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

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

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

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

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

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

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

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

  let shell_builtin_cmds = "ulimit"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  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 "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 "puppet" .
      sc_incl "puppetmaster" .
      sc_incl "readonly-root" .
      sc_incl "rsyslog" .
      sc_incl "samba" .
      sc_incl "saslauthd" .
      sc_incl "selinux" .
      sc_incl "sendmail" .
      sc_incl "smartmontools" .
      sc_incl "snmpd" .
      sc_incl "snmpd.options" .
      sc_incl "snmptrapd" .
      sc_incl "snmptrapd.options" .
      sc_incl "spamassassin" .
      sc_incl "suseconfig" .
      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"
                     . incl "/etc/environment"
                     . incl "/etc/blkid.conf"
                     . incl "/etc/adduser.conf"
                     . incl "/etc/cowpoke"
                     . incl "/etc/cvs-cron.conf"
                     . incl "/etc/cvs-pserver.conf"
                     . incl "/etc/devscripts.conf"
                     . incl "/etc/lintianrc"
                     . incl "/etc/lsb-release"
                     . incl "/etc/popularity-contest.conf"
                     . incl "/etc/ucf.conf"
                     . incl "/etc/updatedb.conf"

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

  let xfm = transform lns filter

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


Add FreeBSD paths to dovecot

Add FreeBSD paths to dovecot

(*
Module: Dovecot
  Parses dovecot configuration files.

Author: Serge Smetana <serge.smetana@gmail.com>
  Acunote http://www.acunote.com
  Pluron, Inc. http://pluron.com

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

About: Configuration files
  This lens applies to /etc/dovecot/dovecot.conf and files in
  /etc/dovecot/conf.d/. See <filter>.

About: Examples
  The <Test_Dovecot> file contains various examples and tests.

About: TODO
  Support for multiline values like queries in dict-sql.conf
*)

module Dovecot =

  autoload xfm

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

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

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

(* View: empty
Map empty lines. *)
let empty = Util.empty

(* View: comment
Map comments in "#comment" nodes. *)
let comment = Util.comment

(* View: eq *)
let eq = del /[ \t]*=/ " ="

(* Variable: any *)
let any = Rx.no_spaces

(* Variable: value
Match any value after " =".
Should not start and end with spaces. May contain spaces inside *)
let value = any . (Rx.space . any)*

(* View: command_start *)
let command_start = Util.del_str "!"

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

(* Variable: commands *)
let commands = /include|include_try/

(* Variable: block_names *)
let block_names = /dict|userdb|passdb|protocol|service|plugin|namespace|map|fields|unix_listener|fifo_listener|inet_listener/

(* Variable: keys
Match any possible key except commands and block names. *)
let keys = Rx.word - (commands | block_names)

(* View: entry
Map simple "key = value" entries including "key =" entries with empty value. *)
let entry = [ indent . key keys. eq . (Sep.opt_space . store value)? . eol ]

(* View: command
Map commands started with "!". *)
let command = [ command_start . key commands . Sep.space . store Rx.fspath . eol ]

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

Based off Quote.dquote_spaces

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

let mailbox = indent
            . dquote_spaces
               (key /mailbox/ . Sep.space)
               (Build.block_newlines_spc entry comment . eol)

let block_ldelim_newlines_re = /[ \t]+\{([ \t\n]*\n)?/

let block_newlines (entry:lens) (comment:lens) =
      let indent = del Rx.opt_space "\t"
   in del block_ldelim_newlines_re Build.block_ldelim_default
 . ((entry | comment) . (Util.empty | entry | comment)*)?
 . del Build.block_rdelim_newlines_re Build.block_rdelim_newlines_default

(* View: block
Map block enclosed in brackets recursively.
Block may be indented and have optional argument.
Block body may have entries, comments, empty lines, and nested blocks recursively. *)
let rec block = [ indent . key block_names . (Sep.space . Quote.do_dquote_opt (store /[\/A-Za-z0-9_-]+/))? . block_newlines (entry|block|mailbox) comment . eol ]

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

(* View: lns
The Dovecot lens *)
let lns = (comment|empty|entry|command|block)*

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

let xfm = transform lns filter

(*
Module: Dovecot
  Parses dovecot configuration files.

Author: Serge Smetana <serge.smetana@gmail.com>
  Acunote http://www.acunote.com
  Pluron, Inc. http://pluron.com

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

About: Configuration files
  This lens applies to /etc/dovecot/dovecot.conf and files in
  /etc/dovecot/conf.d/. See <filter>.

About: Examples
  The <Test_Dovecot> file contains various examples and tests.

About: TODO
  Support for multiline values like queries in dict-sql.conf
*)

module Dovecot =

  autoload xfm

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

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

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

(* View: empty
Map empty lines. *)
let empty = Util.empty

(* View: comment
Map comments in "#comment" nodes. *)
let comment = Util.comment

(* View: eq *)
let eq = del /[ \t]*=/ " ="

(* Variable: any *)
let any = Rx.no_spaces

(* Variable: value
Match any value after " =".
Should not start and end with spaces. May contain spaces inside *)
let value = any . (Rx.space . any)*

(* View: command_start *)
let command_start = Util.del_str "!"

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

(* Variable: commands *)
let commands = /include|include_try/

(* Variable: block_names *)
let block_names = /dict|userdb|passdb|protocol|service|plugin|namespace|map|fields|unix_listener|fifo_listener|inet_listener/

(* Variable: keys
Match any possible key except commands and block names. *)
let keys = Rx.word - (commands | block_names)

(* View: entry
Map simple "key = value" entries including "key =" entries with empty value. *)
let entry = [ indent . key keys. eq . (Sep.opt_space . store value)? . eol ]

(* View: command
Map commands started with "!". *)
let command = [ command_start . key commands . Sep.space . store Rx.fspath . eol ]

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

Based off Quote.dquote_spaces

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

let mailbox = indent
            . dquote_spaces
               (key /mailbox/ . Sep.space)
               (Build.block_newlines_spc entry comment . eol)

let block_ldelim_newlines_re = /[ \t]+\{([ \t\n]*\n)?/

let block_newlines (entry:lens) (comment:lens) =
      let indent = del Rx.opt_space "\t"
   in del block_ldelim_newlines_re Build.block_ldelim_default
 . ((entry | comment) . (Util.empty | entry | comment)*)?
 . del Build.block_rdelim_newlines_re Build.block_rdelim_newlines_default

(* View: block
Map block enclosed in brackets recursively.
Block may be indented and have optional argument.
Block body may have entries, comments, empty lines, and nested blocks recursively. *)
let rec block = [ indent . key block_names . (Sep.space . Quote.do_dquote_opt (store /[\/A-Za-z0-9_-]+/))? . block_newlines (entry|block|mailbox) comment . eol ]

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

(* View: lns
The Dovecot lens *)
let lns = (comment|empty|entry|command|block)*

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

let xfm = transform lns filter