Use the Quote module in openvpn.aug

Use the Quote module in openvpn.aug

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

 Reference: http://openvpn.net/index.php/documentation/howto.html
*)

module OpenVPN =
  autoload xfm

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

let eol    = Util.eol
let indent = Util.indent

(* Define separators *)
let sep    = Util.del_ws_spc

(* Define value regexps *)
let ip_re  = Rx.ipv4
let num_re = Rx.integer
let fn_re  = /[^#; \t\n][^#;\n]*[^#; \t\n]|[^#; \t\n]/
let an_re  = /[a-z][a-z0-9_-]*/

(* Define store aliases *)
let ip     = store ip_re
let num    = store num_re
let filename = store fn_re
let sto_to_dquote = store /[^"\n]+/   (* " Emacs, relax *)

(* define comments and empty lines *)
let comment = Util.comment_generic /[ \t]*[;#][ \t]*/ "# "
let comment_or_eol = eol | Util.comment_generic /[ \t]*[;#][ \t]*/ " # "

let empty   = Util.empty

(************************************************************************
 *                               SINGLE VALUES
 *
 *   - local => IP
 *   - port  => num
 *   - proto => tcp|udp
 *   - dev   => (tun|tap)\d*
 *   - dev-node => MyTap
 *   - ca    => filename
 *   - cert  => filename
 *   - key   => filename
 *   - dh    => filename
 *   - ifconfig-pool-persist => filename
 *   - learn-address => filename
 *   - cipher => [A-Z0-9-]+
 *   - max-clients => num
 *   - user  => alphanum
 *   - group => alphanum
 *   - status => filename
 *   - log   => filename
 *   - log-append => filename
 *   - verb => num
 *   - mute => num
 *   - ns-cert-type => "server"
 *   - resolv-retry => "infinite"
 *************************************************************************)

let single_ip  = "local"
let single_num = "port"
               | "max-clients"
               | "verb"
	       | "mute"
let single_fn  = "ca"
               | "cert"
	       | "key"
	       | "dh"
	       | "ifconfig-pool-persist"
	       | "learn-address"
	       | "status"
	       | "log"
	       | "log-append"
let single_an  = "user"
               | "group"

let single_entry (kw:regexp) (re:regexp)
               = [ key kw . sep . store re . comment_or_eol ]

let single     = single_entry single_num num_re
      	       | single_entry single_fn  fn_re
	       | single_entry single_an  an_re
	       | single_entry "local"    ip_re
	       | single_entry "proto"    /(tcp|udp)/
               | single_entry "dev"      /(tun|tap)[0-9]*/
	       | single_entry "dev-node" "MyTap"
	       | single_entry "cipher"   /[A-Z][A-Z0-9-]*/
	       | single_entry "ns-cert-type" "server"
	       | single_entry "resolv-retry" "infinite"

(************************************************************************
 *                               FLAGS
 *
 *   - client-to-client
 *   - duplicate-cn
 *   - comp-lzo
 *   - persist-key
 *   - persist-tun
 *   - client
 *   - remote-random
 *   - nobind
 *   - mute-replay-warnings
 *   - http-proxy-retry
 *************************************************************************)

let flag_words = "client-to-client"
               | "duplicate-cn"
	       | "comp-lzo"
	       | "persist-key"
	       | "persist-tun"
	       | "client"
	       | "remote-random"
	       | "nobind"
	       | "mute-replay-warnings"
	       | "http-proxy-retry"

let flag_entry (kw:regexp)
               = [ key kw . comment_or_eol ]

let flag       = flag_entry flag_words

(************************************************************************
 *                               OTHER FIELDS
 *
 *   - server        => IP IP
 *   - server-bridge => IP IP IP IP
 *   - push          => "string"
 *   - keepalive     => num num
 *   - tls-auth      => filename [01]
 *   - remote        => hostname/IP num
 *************************************************************************)

let server        = [ key "server" . sep
                    . [ label "address" . ip ] . sep
		    . [ label "netmask" . ip ] . comment_or_eol
		    ]

let server_bridge = [ key "server-bridge" . sep
                    . [ label "address" . ip ] . sep
		    . [ label "netmask" . ip ] . sep
		    . [ label "start"   . ip ] . sep
		    . [ label "end"     . ip ] . comment_or_eol
		    ]

let push          = [ key "push" . sep
                    . Quote.do_dquote sto_to_dquote
		    . comment_or_eol
                    ]

let keepalive     = [ key "keepalive" . sep
                    . [ label "ping"    . num ] . sep
		    . [ label "timeout" . num ] . comment_or_eol
                    ]

let tls_auth      = [ key "tls-auth" . sep
                    . [ label "key"       . filename     ] . sep
		    . [ label "is_client" . store /[01]/ ] . comment_or_eol
                    ]

let remote        = [ key "remote" . sep
                    . [ label "server" . filename ] . sep
		    . [ label "port"   . num      ] . comment_or_eol
		    ]

let http_proxy    = [ key "http-proxy" .
                    ( sep . [ label "server" . store /[A-Za-z0-9._-]+/ ] .
		    ( sep . [ label "port"   . num      ] )? )?
		    . comment_or_eol
		    ]

let other         = server
                  | server_bridge
                  | push
		  | keepalive
		  | tls_auth
		  | remote
		  | http_proxy

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

let lns    = ( comment | empty | single | flag | other )*

let filter = (incl "/etc/openvpn/client.conf")
           . (incl "/etc/openvpn/server.conf")

let xfm = transform lns filter

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

 Reference: http://openvpn.net/index.php/documentation/howto.html
*)

module OpenVPN =
  autoload xfm

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

let eol    = Util.eol
let indent = Util.indent

(* Define separators *)
let sep    = Util.del_ws_spc
let sep_dquote = Util.del_str "\""

(* Define value regexps *)
let ip_re  = Rx.ipv4
let num_re = Rx.integer
let fn_re  = /[^#; \t\n][^#;\n]*[^#; \t\n]|[^#; \t\n]/
let an_re  = /[a-z][a-z0-9_-]*/

(* Define store aliases *)
let ip     = store ip_re
let num    = store num_re
let filename = store fn_re
let sto_to_dquote = store /[^"\n]+/   (* " Emacs, relax *)

(* define comments and empty lines *)
let comment = Util.comment_generic /[ \t]*[;#][ \t]*/ "# "
let comment_or_eol = eol | Util.comment_generic /[ \t]*[;#][ \t]*/ " # "

let empty   = Util.empty

(************************************************************************
 *                               SINGLE VALUES
 *
 *   - local => IP
 *   - port  => num
 *   - proto => tcp|udp
 *   - dev   => (tun|tap)\d*
 *   - dev-node => MyTap
 *   - ca    => filename
 *   - cert  => filename
 *   - key   => filename
 *   - dh    => filename
 *   - ifconfig-pool-persist => filename
 *   - learn-address => filename
 *   - cipher => [A-Z0-9-]+
 *   - max-clients => num
 *   - user  => alphanum
 *   - group => alphanum
 *   - status => filename
 *   - log   => filename
 *   - log-append => filename
 *   - verb => num
 *   - mute => num
 *   - ns-cert-type => "server"
 *   - resolv-retry => "infinite"
 *************************************************************************)

let single_ip  = "local"
let single_num = "port"
               | "max-clients"
               | "verb"
	       | "mute"
let single_fn  = "ca"
               | "cert"
	       | "key"
	       | "dh"
	       | "ifconfig-pool-persist"
	       | "learn-address"
	       | "status"
	       | "log"
	       | "log-append"
let single_an  = "user"
               | "group"

let single_entry (kw:regexp) (re:regexp)
               = [ key kw . sep . store re . comment_or_eol ]

let single     = single_entry single_num num_re
      	       | single_entry single_fn  fn_re
	       | single_entry single_an  an_re
	       | single_entry "local"    ip_re
	       | single_entry "proto"    /(tcp|udp)/
               | single_entry "dev"      /(tun|tap)[0-9]*/
	       | single_entry "dev-node" "MyTap"
	       | single_entry "cipher"   /[A-Z][A-Z0-9-]*/
	       | single_entry "ns-cert-type" "server"
	       | single_entry "resolv-retry" "infinite"

(************************************************************************
 *                               FLAGS
 *
 *   - client-to-client
 *   - duplicate-cn
 *   - comp-lzo
 *   - persist-key
 *   - persist-tun
 *   - client
 *   - remote-random
 *   - nobind
 *   - mute-replay-warnings
 *   - http-proxy-retry
 *************************************************************************)

let flag_words = "client-to-client"
               | "duplicate-cn"
	       | "comp-lzo"
	       | "persist-key"
	       | "persist-tun"
	       | "client"
	       | "remote-random"
	       | "nobind"
	       | "mute-replay-warnings"
	       | "http-proxy-retry"

let flag_entry (kw:regexp)
               = [ key kw . comment_or_eol ]

let flag       = flag_entry flag_words

(************************************************************************
 *                               OTHER FIELDS
 *
 *   - server        => IP IP
 *   - server-bridge => IP IP IP IP
 *   - push          => "string"
 *   - keepalive     => num num
 *   - tls-auth      => filename [01]
 *   - remote        => hostname/IP num
 *************************************************************************)

let server        = [ key "server" . sep
                    . [ label "address" . ip ] . sep
		    . [ label "netmask" . ip ] . comment_or_eol
		    ]

let server_bridge = [ key "server-bridge" . sep
                    . [ label "address" . ip ] . sep
		    . [ label "netmask" . ip ] . sep
		    . [ label "start"   . ip ] . sep
		    . [ label "end"     . ip ] . comment_or_eol
		    ]

let push          = [ key "push" . sep
                    . sep_dquote
		    . sto_to_dquote
		    . sep_dquote
		    . comment_or_eol
                    ]

let keepalive     = [ key "keepalive" . sep
                    . [ label "ping"    . num ] . sep
		    . [ label "timeout" . num ] . comment_or_eol
                    ]

let tls_auth      = [ key "tls-auth" . sep
                    . [ label "key"       . filename     ] . sep
		    . [ label "is_client" . store /[01]/ ] . comment_or_eol
                    ]

let remote        = [ key "remote" . sep
                    . [ label "server" . filename ] . sep
		    . [ label "port"   . num      ] . comment_or_eol
		    ]

let http_proxy    = [ key "http-proxy" .
                    ( sep . [ label "server" . store /[A-Za-z0-9._-]+/ ] .
		    ( sep . [ label "port"   . num      ] )? )?
		    . comment_or_eol
		    ]

let other         = server
                  | server_bridge
                  | push
		  | keepalive
		  | tls_auth
		  | remote
		  | http_proxy

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

let lns    = ( comment | empty | single | flag | other )*

let filter = (incl "/etc/openvpn/client.conf")
           . (incl "/etc/openvpn/server.conf")

let xfm = transform lns filter


Shellvars.lns: add unit test for continued lines in double quoted values

(* Test for shell lens *)
module Test_shellvars =

  let lns = Shellvars.lns

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  test lns put "var=ab; #c\n" after
    set "/#comment" "d" =
    "var=ab; #d\n"

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

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

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

  test lns get "ESSID='Joe'\"'\"'s net'\n" =
    { "ESSID" = "'Joe'\"'\"'s net'" }

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

  test lns get "var=`grep nameserver /etc/resolv.conf | head -1`\n" =
    { "var" = "`grep nameserver /etc/resolv.conf | head -1`" }

  test lns put "var=ab #c\n"
    after rm "/var/#comment" = "var=ab\n"

  test lns put "var=ab\n"
    after set "/var/#comment" "this is a var" =
       "var=ab # this is a var\n"

  (* Handling of arrays *)
  test lns get "var=(val1 \"val\\\"2\\\"\" val3)\n" =
    { "var"
        { "1" = "val1" }
        { "2" = "\"val\\\"2\\\"\"" }
        { "3" = "val3" } }

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

  test lns put "var=()\n" after
      set "var" "value"
  = "var=value\n"

  test lns put "var=(v1 v2)\n" after
      rm "var/*" ;
      set "var" "value"
  = "var=value\n"

  test lns put "var=(v1 v2)\n" after
    set "var/3" "v3"
  = "var=(v1 v2 v3)\n"

  test lns get "var=(v1 v2   \n    \t v3)\n" =
  { "var"
    { "1" = "v1" }
    { "2" = "v2" }
    { "3" = "v3" } }

  (* Allow spaces after/before opening/closing parens for array *)
  test lns get "config_eth1=( \"10.128.0.48/24\" )\n" =
  { "config_eth1"  { "1" = "\"10.128.0.48/24\"" } }

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

  (* Bug 73: allow ulimit builtin *)
  test lns get "ulimit -c unlimited\n" =
  { "@builtin" = "ulimit" { "args" = "-c unlimited" } }

  (* Allow shift builtin *)
  test Shellvars.lns get "shift\nshift 2\n" =
  { "@builtin" = "shift" }
  { "@builtin" = "shift" { "args" = "2" } }

  (* Allow exit builtin *)
  test Shellvars.lns get "exit\nexit 2\n" =
  { "@builtin" = "exit" }
  { "@builtin" = "exit" { "args" = "2" } }

  (* Test semicolons *)
  test lns get "VAR1=\"this;is;a;test\"\nVAR2=this;\n" =
  { "VAR1" = "\"this;is;a;test\"" }
  { "VAR2" = "this" }

  (* Bug 230: parse conditions *)
  test lns get "if [ -f /etc/default/keyboard ]; then\n. /etc/default/keyboard\nfi\n" =
  { "@if" = "[ -f /etc/default/keyboard ]" { ".source" = "/etc/default/keyboard" } }

  (* Recursive condition *)
  test lns get "if [ -f /tmp/file1 ]; then
  if [ -f /tmp/file2 ]
  then
    . /tmp/file2
  elif [ -f /tmp/file3 ]; then
    . /tmp/file3; else; . /tmp/file4
  fi
else
  . /tmp/file3
fi\n" =
  { "@if" = "[ -f /tmp/file1 ]"
    { "@if" = "[ -f /tmp/file2 ]"
      { ".source" = "/tmp/file2" }
      { "@elif" = "[ -f /tmp/file3 ]"
        { ".source" = "/tmp/file3" } }
      { "@else"
        { ".source" = "/tmp/file4" }
      }
    }
    { "@else"
      { ".source" = "/tmp/file3" }
    }
  }

  (* Multiple elif *)
  test Shellvars.lns get "if [ -f /tmp/file1 ]; then
  . /tmp/file1
  elif [ -f /tmp/file2 ]; then
  . /tmp/file2
  elif [ -f /tmp/file3 ]; then
  . /tmp/file3
  fi\n" =
  { "@if" = "[ -f /tmp/file1 ]"
    { ".source" = "/tmp/file1" }
    { "@elif" = "[ -f /tmp/file2 ]"
      { ".source" = "/tmp/file2" }
    }
    { "@elif" = "[ -f /tmp/file3 ]"
      { ".source" = "/tmp/file3" }
    }
  }

  (* Comment or eol *)
  test lns get "VAR=value # eol-comment\n" =
  { "VAR" = "value"
    { "#comment" = "eol-comment" }
  }

  (* One-liners *)
  test lns get "if [ -f /tmp/file1 ]; then . /tmp/file1; else . /tmp/file2; fi\n" =
  { "@if" = "[ -f /tmp/file1 ]"
    { ".source" = "/tmp/file1" }
    { "@else"
      { ".source" = "/tmp/file2" }
    }
  }

  (* Loops *)
  test lns get "for f in /tmp/file*; do
  while [ 1 ]; do . $f; done
done\n" =
  { "@for" = "f in /tmp/file*"
    { "@while" = "[ 1 ]"
      { ".source" = "$f" }
    }
  }

  (* Case *)
  test lns get "case $f in
  /tmp/file1)
    . /tmp/file1
    ;;
  /tmp/file2)
    . /tmp/file2
    ;;
  *)
    unset f
    ;;
esac\n" =
  { "@case" = "$f"
    { "@case_entry" = "/tmp/file1"
      { ".source" = "/tmp/file1" } }
    { "@case_entry" = "/tmp/file2"
      { ".source" = "/tmp/file2" } }
    { "@case_entry" = "*"
      { "@unset" = "f" } } }

  (* Select *)
  test lns get "select i in a b c; do . /tmp/file$i
   done\n" =
  { "@select" = "i in a b c"
    { ".source" = "/tmp/file$i" }
  }

  (* Return *)
  test lns get "return\nreturn 2\n" =
  { "@return" }
  { "@return" = "2" }

  (* Functions *)
  test Shellvars.lns get "foo() {
  . /tmp/bar
  }\n" =
  { "@function" = "foo"
    { ".source" = "/tmp/bar" }
  }

  test Shellvars.lns get "function foo () {
  . /tmp/bar
  }\n" =
  { "@function" = "foo"
    { ".source" = "/tmp/bar" }
  }

  (* Dollar assignment *)
  test Shellvars.lns get "FOO=$(bar arg)\n" =
  { "FOO" = "$(bar arg)" }

  (* Empty lines before esac *)
  test Shellvars.lns get "case $f in
  a)
    B=C
    ;;

  esac\n" =
  { "@case" = "$f"
    { "@case_entry" = "a"
      { "B" = "C" } }
    }

  (* Empty lines before a case_entry *)
  test Shellvars.lns get "case $f in

  a)
    B=C
    ;;

  b)
    A=D
    ;;
  esac\n" =
  { "@case" = "$f"
    { "@case_entry" = "a"
      { "B" = "C" } }
    { "@case_entry" = "b"
      { "A" = "D" } } }

  (* Comments anywhere *)
  test Shellvars.lns get "case ${INTERFACE} in
# comment before
eth0)
# comment in
OPTIONS=()
;;

# comment before 2
*)
# comment in 2
unset f
;;
# comment after
esac\n" =
  { "@case" = "${INTERFACE}"
    { "#comment" = "comment before" }
    { "@case_entry" = "eth0"
      { "#comment" = "comment in" }
      { "OPTIONS" = "()" } }
    { "#comment" = "comment before 2" }
    { "@case_entry" = "*"
      { "#comment" = "comment in 2" }
      { "@unset" = "f" } }
    { "#comment" = "comment after" } }

  (* Empty case *)
  test Shellvars.lns get "case $a in
  *)
  ;;
  esac\n" =
  { "@case" = "$a"
    { "@case_entry" = "*" } }

  (* case variables can be surrounded by double quotes *)
  test Shellvars.lns get "case \"${options}\" in
*debug*)
  shift
  ;;
esac\n" =
  { "@case" = "\"${options}\""
    { "@case_entry" = "*debug*"
      { "@builtin" = "shift" } } }

  (* Double quoted values can have newlines *)
  test Shellvars.lns get "FOO=\"123\n456\"\n" =
  { "FOO" = "\"123\n456\"" }

  (* Single quoted values can have newlines *)
  test Shellvars.lns get "FOO='123\n456'\n" =
  { "FOO" = "'123\n456'" }

  (* bquoted values can have semi-colons *)
  test Shellvars.lns get "FOO=`bar=date;$bar`\n" =
  { "FOO" = "`bar=date;$bar`" }

  (* dollar-assigned values can have semi-colons *)
  test Shellvars.lns get "FOO=$(bar=date;$bar)\n" =
  { "FOO" = "$(bar=date;$bar)" }

  (* dollar-assigned value in bquot *)
  test Shellvars.lns get "FOO=`echo $(date)`\n" =
  { "FOO" = "`echo $(date)`" }

  (* bquot value in dollar-assigned value *)
  test Shellvars.lns get "FOO=$(echo `date`)\n" =
  { "FOO" = "$(echo `date`)" }

  (* dbquot *)
  test Shellvars.lns get "FOO=``bar``\n" =
  { "FOO" = "``bar``" }

  (* unset can be used on wildcard variables *)
  test Shellvars.lns get "unset ${!LC_*}\n" =
  { "@unset" = "${!LC_*}" }

  (* Empty comment before entries *)
  test Shellvars.lns get "# \nfoo=bar\n" =
  { }
  { "foo" = "bar" }

  (* Empty comment after entries *)
  test Shellvars.lns get "foo=bar\n# \n\n" =
  { "foo" = "bar" }

  (* Whitespace between lines *)
  test Shellvars.lns get "DEVICE=eth0\n\nBOOTPROTO=static\n" =
    { "DEVICE" = "eth0" }
    { "BOOTPROTO" = "static" }

  (* Whitespace after line *)
  test Shellvars.lns get "DEVICE=eth0\n\n" =
    { "DEVICE" = "eth0" }

  (* Fails adding variable assignment between comment and blank line *)
  let ins_after_comment = "# foo

"
  test lns put ins_after_comment after
      insa "foo" "#comment" ;
      set "foo" "yes"
  = "# foo\n\nfoo=yes\n"

  (* Make sure to support empty comments *)
  test lns get "# foo
  #
  #
  foo=bar
  #\n" =
    { "#comment" = "foo" }
    { "foo" = "bar" }

  (* Single quotes in arrays, ticket #357 *)
  test lns get "DLAGENTS=('ftp::/usr/bin/curl -fC - --ftp-pasv --retry 3 --retry-delay 3 -o %o %u'
          'scp::/usr/bin/scp -C %u %o')\n" =
    { "DLAGENTS"
      { "1" = "'ftp::/usr/bin/curl -fC - --ftp-pasv --retry 3 --retry-delay 3 -o %o %u'" }
      { "2" = "'scp::/usr/bin/scp -C %u %o'" } }

  (* Accept continued lines in quoted values *)
  test lns get "BLAH=\" \\\\
test \\\\
test2\"\n" =
  { "BLAH" = "\" \\\\\ntest \\\\\ntest2\"" }

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

(* Test for shell lens *)
module Test_shellvars =

  let lns = Shellvars.lns

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  test lns put "var=ab; #c\n" after
    set "/#comment" "d" =
    "var=ab; #d\n"

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

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

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

  test lns get "ESSID='Joe'\"'\"'s net'\n" =
    { "ESSID" = "'Joe'\"'\"'s net'" }

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

  test lns get "var=`grep nameserver /etc/resolv.conf | head -1`\n" =
    { "var" = "`grep nameserver /etc/resolv.conf | head -1`" }

  test lns put "var=ab #c\n"
    after rm "/var/#comment" = "var=ab\n"

  test lns put "var=ab\n"
    after set "/var/#comment" "this is a var" =
       "var=ab # this is a var\n"

  (* Handling of arrays *)
  test lns get "var=(val1 \"val\\\"2\\\"\" val3)\n" =
    { "var"
        { "1" = "val1" }
        { "2" = "\"val\\\"2\\\"\"" }
        { "3" = "val3" } }

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

  test lns put "var=()\n" after
      set "var" "value"
  = "var=value\n"

  test lns put "var=(v1 v2)\n" after
      rm "var/*" ;
      set "var" "value"
  = "var=value\n"

  test lns put "var=(v1 v2)\n" after
    set "var/3" "v3"
  = "var=(v1 v2 v3)\n"

  test lns get "var=(v1 v2   \n    \t v3)\n" =
  { "var"
    { "1" = "v1" }
    { "2" = "v2" }
    { "3" = "v3" } }

  (* Allow spaces after/before opening/closing parens for array *)
  test lns get "config_eth1=( \"10.128.0.48/24\" )\n" =
  { "config_eth1"  { "1" = "\"10.128.0.48/24\"" } }

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

  (* Bug 73: allow ulimit builtin *)
  test lns get "ulimit -c unlimited\n" =
  { "@builtin" = "ulimit" { "args" = "-c unlimited" } }

  (* Allow shift builtin *)
  test Shellvars.lns get "shift\nshift 2\n" =
  { "@builtin" = "shift" }
  { "@builtin" = "shift" { "args" = "2" } }

  (* Allow exit builtin *)
  test Shellvars.lns get "exit\nexit 2\n" =
  { "@builtin" = "exit" }
  { "@builtin" = "exit" { "args" = "2" } }

  (* Test semicolons *)
  test lns get "VAR1=\"this;is;a;test\"\nVAR2=this;\n" =
  { "VAR1" = "\"this;is;a;test\"" }
  { "VAR2" = "this" }

  (* Bug 230: parse conditions *)
  test lns get "if [ -f /etc/default/keyboard ]; then\n. /etc/default/keyboard\nfi\n" =
  { "@if" = "[ -f /etc/default/keyboard ]" { ".source" = "/etc/default/keyboard" } }

  (* Recursive condition *)
  test lns get "if [ -f /tmp/file1 ]; then
  if [ -f /tmp/file2 ]
  then
    . /tmp/file2
  elif [ -f /tmp/file3 ]; then
    . /tmp/file3; else; . /tmp/file4
  fi
else
  . /tmp/file3
fi\n" =
  { "@if" = "[ -f /tmp/file1 ]"
    { "@if" = "[ -f /tmp/file2 ]"
      { ".source" = "/tmp/file2" }
      { "@elif" = "[ -f /tmp/file3 ]"
        { ".source" = "/tmp/file3" } }
      { "@else"
        { ".source" = "/tmp/file4" }
      }
    }
    { "@else"
      { ".source" = "/tmp/file3" }
    }
  }

  (* Multiple elif *)
  test Shellvars.lns get "if [ -f /tmp/file1 ]; then
  . /tmp/file1
  elif [ -f /tmp/file2 ]; then
  . /tmp/file2
  elif [ -f /tmp/file3 ]; then
  . /tmp/file3
  fi\n" =
  { "@if" = "[ -f /tmp/file1 ]"
    { ".source" = "/tmp/file1" }
    { "@elif" = "[ -f /tmp/file2 ]"
      { ".source" = "/tmp/file2" }
    }
    { "@elif" = "[ -f /tmp/file3 ]"
      { ".source" = "/tmp/file3" }
    }
  }

  (* Comment or eol *)
  test lns get "VAR=value # eol-comment\n" =
  { "VAR" = "value"
    { "#comment" = "eol-comment" }
  }

  (* One-liners *)
  test lns get "if [ -f /tmp/file1 ]; then . /tmp/file1; else . /tmp/file2; fi\n" =
  { "@if" = "[ -f /tmp/file1 ]"
    { ".source" = "/tmp/file1" }
    { "@else"
      { ".source" = "/tmp/file2" }
    }
  }

  (* Loops *)
  test lns get "for f in /tmp/file*; do
  while [ 1 ]; do . $f; done
done\n" =
  { "@for" = "f in /tmp/file*"
    { "@while" = "[ 1 ]"
      { ".source" = "$f" }
    }
  }

  (* Case *)
  test lns get "case $f in
  /tmp/file1)
    . /tmp/file1
    ;;
  /tmp/file2)
    . /tmp/file2
    ;;
  *)
    unset f
    ;;
esac\n" =
  { "@case" = "$f"
    { "@case_entry" = "/tmp/file1"
      { ".source" = "/tmp/file1" } }
    { "@case_entry" = "/tmp/file2"
      { ".source" = "/tmp/file2" } }
    { "@case_entry" = "*"
      { "@unset" = "f" } } }

  (* Select *)
  test lns get "select i in a b c; do . /tmp/file$i
   done\n" =
  { "@select" = "i in a b c"
    { ".source" = "/tmp/file$i" }
  }

  (* Return *)
  test lns get "return\nreturn 2\n" =
  { "@return" }
  { "@return" = "2" }

  (* Functions *)
  test Shellvars.lns get "foo() {
  . /tmp/bar
  }\n" =
  { "@function" = "foo"
    { ".source" = "/tmp/bar" }
  }

  test Shellvars.lns get "function foo () {
  . /tmp/bar
  }\n" =
  { "@function" = "foo"
    { ".source" = "/tmp/bar" }
  }

  (* Dollar assignment *)
  test Shellvars.lns get "FOO=$(bar arg)\n" =
  { "FOO" = "$(bar arg)" }

  (* Empty lines before esac *)
  test Shellvars.lns get "case $f in
  a)
    B=C
    ;;

  esac\n" =
  { "@case" = "$f"
    { "@case_entry" = "a"
      { "B" = "C" } }
    }

  (* Empty lines before a case_entry *)
  test Shellvars.lns get "case $f in

  a)
    B=C
    ;;

  b)
    A=D
    ;;
  esac\n" =
  { "@case" = "$f"
    { "@case_entry" = "a"
      { "B" = "C" } }
    { "@case_entry" = "b"
      { "A" = "D" } } }

  (* Comments anywhere *)
  test Shellvars.lns get "case ${INTERFACE} in
# comment before
eth0)
# comment in
OPTIONS=()
;;

# comment before 2
*)
# comment in 2
unset f
;;
# comment after
esac\n" =
  { "@case" = "${INTERFACE}"
    { "#comment" = "comment before" }
    { "@case_entry" = "eth0"
      { "#comment" = "comment in" }
      { "OPTIONS" = "()" } }
    { "#comment" = "comment before 2" }
    { "@case_entry" = "*"
      { "#comment" = "comment in 2" }
      { "@unset" = "f" } }
    { "#comment" = "comment after" } }

  (* Empty case *)
  test Shellvars.lns get "case $a in
  *)
  ;;
  esac\n" =
  { "@case" = "$a"
    { "@case_entry" = "*" } }

  (* case variables can be surrounded by double quotes *)
  test Shellvars.lns get "case \"${options}\" in
*debug*)
  shift
  ;;
esac\n" =
  { "@case" = "\"${options}\""
    { "@case_entry" = "*debug*"
      { "@builtin" = "shift" } } }

  (* Double quoted values can have newlines *)
  test Shellvars.lns get "FOO=\"123\n456\"\n" =
  { "FOO" = "\"123\n456\"" }

  (* Single quoted values can have newlines *)
  test Shellvars.lns get "FOO='123\n456'\n" =
  { "FOO" = "'123\n456'" }

  (* bquoted values can have semi-colons *)
  test Shellvars.lns get "FOO=`bar=date;$bar`\n" =
  { "FOO" = "`bar=date;$bar`" }

  (* dollar-assigned values can have semi-colons *)
  test Shellvars.lns get "FOO=$(bar=date;$bar)\n" =
  { "FOO" = "$(bar=date;$bar)" }

  (* dollar-assigned value in bquot *)
  test Shellvars.lns get "FOO=`echo $(date)`\n" =
  { "FOO" = "`echo $(date)`" }

  (* bquot value in dollar-assigned value *)
  test Shellvars.lns get "FOO=$(echo `date`)\n" =
  { "FOO" = "$(echo `date`)" }

  (* dbquot *)
  test Shellvars.lns get "FOO=``bar``\n" =
  { "FOO" = "``bar``" }

  (* unset can be used on wildcard variables *)
  test Shellvars.lns get "unset ${!LC_*}\n" =
  { "@unset" = "${!LC_*}" }

  (* Empty comment before entries *)
  test Shellvars.lns get "# \nfoo=bar\n" =
  { }
  { "foo" = "bar" }

  (* Empty comment after entries *)
  test Shellvars.lns get "foo=bar\n# \n\n" =
  { "foo" = "bar" }

  (* Whitespace between lines *)
  test Shellvars.lns get "DEVICE=eth0\n\nBOOTPROTO=static\n" =
    { "DEVICE" = "eth0" }
    { "BOOTPROTO" = "static" }

  (* Whitespace after line *)
  test Shellvars.lns get "DEVICE=eth0\n\n" =
    { "DEVICE" = "eth0" }

  (* Fails adding variable assignment between comment and blank line *)
  let ins_after_comment = "# foo

"
  test lns put ins_after_comment after
      insa "foo" "#comment" ;
      set "foo" "yes"
  = "# foo\n\nfoo=yes\n"

  (* Make sure to support empty comments *)
  test lns get "# foo
  #
  #
  foo=bar
  #\n" =
    { "#comment" = "foo" }
    { "foo" = "bar" }

  (* Single quotes in arrays, ticket #357 *)
  test lns get "DLAGENTS=('ftp::/usr/bin/curl -fC - --ftp-pasv --retry 3 --retry-delay 3 -o %o %u'
          'scp::/usr/bin/scp -C %u %o')\n" =
    { "DLAGENTS"
      { "1" = "'ftp::/usr/bin/curl -fC - --ftp-pasv --retry 3 --retry-delay 3 -o %o %u'" }
      { "2" = "'scp::/usr/bin/scp -C %u %o'" } }

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


Sshd: Also make Host entries case-insensitive

(*
Module: Ssh
  Parses ssh client configuration

Author: Jiri Suchomel <jsuchome@suse.cz>

About: Reference
    ssh_config man page

About: License
    This file is licensed under the GPL.

About: Lens Usage
  Sample usage of this lens in augtool

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

*)

module Ssh =
    autoload xfm

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

    let eol = del /[ \t]*\n/ "\n"
    let spc = Util.del_ws_spc

    let comment = Util.comment
    let empty = Util.empty
    let comma = Util.del_str ","
    let indent = Util.indent
    let value_to_eol = store /([^ \t\n].*[^ \t\n]|[^ \t\n])/
    let value_to_spc = store /[^ \t\n]+/
    let value_to_comma = store /[^, \t\n]+/

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

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

    let commas_entry (k:regexp) =
	    [ key k . counter "commas_entry" . spc .
	      [ seq "commas_entry" . value_to_comma]
        . ([ seq "commas_entry" . comma . value_to_comma])* . eol ]

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

    let send_env = array_entry /SendEnv/i

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

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

    let ciphers = commas_entry /Ciphers/i
    let macs	= commas_entry /MACs/i

    let special_entry = send_env
	                    | proxy_command
	                    | remote_fw
	                    | local_fw
	                    | macs
	                    | ciphers

    let key_re = /[A-Za-z0-9]+/
               - /SendEnv|Host|ProxyCommand|RemoteForward|LocalForward|MACs|Ciphers/i

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

    let entry = comment | empty
              | special_entry
	            | other_entry

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

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

    let lns = entry* . host*

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

(*
Module: Ssh
  Parses ssh client configuration

Author: Jiri Suchomel <jsuchome@suse.cz>

About: Reference
    ssh_config man page

About: License
    This file is licensed under the GPL.

About: Lens Usage
  Sample usage of this lens in augtool

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

*)

module Ssh =
    autoload xfm

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

    let eol = del /[ \t]*\n/ "\n"
    let spc = Util.del_ws_spc

    let comment = Util.comment
    let empty = Util.empty
    let comma = Util.del_str ","
    let indent = Util.indent
    let value_to_eol = store /([^ \t\n].*[^ \t\n]|[^ \t\n])/
    let value_to_spc = store /[^ \t\n]+/
    let value_to_comma = store /[^, \t\n]+/

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

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

    let commas_entry (k:regexp) =
	    [ key k . counter "commas_entry" . spc .
	      [ seq "commas_entry" . value_to_comma]
        . ([ seq "commas_entry" . comma . value_to_comma])* . eol ]

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

    let send_env = array_entry /SendEnv/i

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

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

    let ciphers = commas_entry /Ciphers/i
    let macs	= commas_entry /MACs/i

    let special_entry = send_env
	                    | proxy_command
	                    | remote_fw
	                    | local_fw
	                    | macs
	                    | ciphers

    let key_re = /[A-Za-z0-9]+/
               - /SendEnv|Host|ProxyCommand|RemoteForward|LocalForward|MACs|Ciphers/i

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

    let entry = comment | empty
              | special_entry
	            | other_entry

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

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

    let lns = entry* . host*

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


httpd: include  /etc/httpd/conf.modules.d

Fedora/RHEL uses this directory for modules config.

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

(* The continuation sequence that indicates that we should consider the
 * next line part of the current line *)
let cont = /\\\\\r?\n/

(* Whitespace within a line: space, tab, and the continuation sequence *)
let ws = /[ \t]/ | cont

(* Any possible character - '.' does not match \n *)
let any = /(.|\n)/

(* Any character preceded by a backslash *)
let esc_any = /\\\\(.|\n)/

(* Newline sequence - both for Unix and DOS newlines *)
let nl = /\r?\n/

(* Whitespace at the end of a line *)
let eol = del (ws* . nl) "\n"

(* deal with continuation lines *)
let sep_spc             = del ws+ " "
let sep_osp             = del ws* ""
let sep_eq              = del (ws* . "=" . ws*) "="

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

(* A complete line that is either just whitespace or a comment that only
 * contains whitespace *)
let empty = [ del (ws* . /#?/ . ws* . nl) "\n" ]

let indent              = Util.indent

(* A comment that is not just whitespace. We define it in terms of the
 * things that are not allowed as part of such a comment:
 *   1) Starts with whitespace
 *   2) Ends with whitespace, a backslash or \r
 *   3) Unescaped newlines
 *)
let comment =
  let comment_start = del (ws* . "#" . ws* ) "# " in
  let unesc_eol = /[^\]?/ . nl in
  let w = /[^\t\n\r \\]/ in
  let r = /[\r\\]/ in
  let s = /[\t\r ]/ in
  (*
   * we'd like to write
   * let b = /\\\\/ in
   * let t = /[\t\n\r ]/ in
   * let x = b . (t? . (s|w)* ) in
   * but the definition of b depends on commit 244c0edd in 1.9.0 and
   * would make the lens unusable with versions before 1.9.0. So we write
   * x out which works in older versions, too
   *)
  let x = /\\\\[\t\n\r ]?[^\n\\]*/ in
  let line = ((r . s* . w|w|r) . (s|w)* . x*|(r.s* )?).w.(s*.w)* in
  [ label "#comment" . comment_start . store line . eol ]

(* borrowed from shellvars.aug *)
let char_arg_sec  = /([^\\ '"\t\r\n>]|[^ '"\t\r\n>]+[^\\ \t\r\n>])|\\\\"|\\\\'|\\\\ /
let char_arg_wl   = /([^\\ '"},\t\r\n]|[^ '"},\t\r\n]+[^\\ '"},\t\r\n])/

let dquot =
     let no_dquot = /[^"\\\r\n]/
  in /"/ . (no_dquot|esc_any)* . /"/
let dquot_msg =
     let no_dquot = /([^ \t"\\\r\n]|[^"\\\r\n]+[^ \t"\\\r\n])/
  in /"/ . (no_dquot|esc_any)* . no_dquot

let squot =
     let no_squot = /[^'\\\r\n]/
  in /'/ . (no_squot|esc_any)* . /'/
let comp = /[<>=]?=/

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

(* The arguments for a directive come in two flavors: quoted with single or
 * double quotes, or bare. Bare arguments may not start with a single or
 * double quote; since we also treat "word lists" special, i.e. lists
 * enclosed in curly braces, bare arguments may not start with those,
 * either.
 *
 * Bare arguments may not contain unescaped spaces, but we allow escaping
 * with '\\'. Quoted arguments can contain anything, though the quote must
 * be escaped with '\\'.
 *)
let bare = /([^{"' \t\n\r]|\\\\.)([^ \t\n\r]|\\\\.)*[^ \t\n\r\\]|[^{"' \t\n\r\\]/

let arg_quoted = [ label "arg" . store (dquot|squot) ]
let arg_bare = [ label "arg" . store bare ]

(* message argument starts with " but ends at EOL *)
let arg_dir_msg = [ label "arg" . store dquot_msg ]
let arg_wl  = [ label "arg" . store (char_arg_wl+|dquot|squot) ]

(* comma-separated wordlist as permitted in the SSLRequire directive *)
let arg_wordlist =
     let wl_start = dels "{" in
     let wl_end   = dels "}" in
     let wl_sep   = del /[ \t]*,[ \t]*/ ", "
  in [ label "wordlist" . wl_start . arg_wl . (wl_sep . arg_wl)* . wl_end ]

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

(* the arguments of a directive. We use this once we have parsed the name
 * of the directive, and the space right after it. When dir_args is used,
 * we also know that we have at least one argument. We need to be careful
 * with the spacing between arguments: quoted arguments and word lists do
 * not need to have space between them, but bare arguments do.
 *
 * Apache apparently is also happy if the last argument starts with a double
 * quote, but has no corresponding closing duoble quote, which is what
 * arg_dir_msg handles
 *)
let dir_args =
  let arg_nospc = arg_quoted|arg_wordlist in
  (arg_bare . sep_spc | arg_nospc . sep_osp)* . (arg_bare|arg_nospc|arg_dir_msg)

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

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

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

let perl_section = [ indent . label "Perl" . del /<perl>/i "<Perl>"
                   . store /[^<]*/
                   . del /<\/perl>/i "</Perl>" . eol ]

let rec content = section (content|directive)
                | perl_section

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/apache2/vhosts.d/*.conf") .
             (incl "/etc/httpd/conf.d/*.conf") .
             (incl "/etc/httpd/httpd.conf") .
             (incl "/etc/httpd/conf/httpd.conf") .
             (incl "/etc/httpd/conf.modules.d/*.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

(* The continuation sequence that indicates that we should consider the
 * next line part of the current line *)
let cont = /\\\\\r?\n/

(* Whitespace within a line: space, tab, and the continuation sequence *)
let ws = /[ \t]/ | cont

(* Any possible character - '.' does not match \n *)
let any = /(.|\n)/

(* Any character preceded by a backslash *)
let esc_any = /\\\\(.|\n)/

(* Newline sequence - both for Unix and DOS newlines *)
let nl = /\r?\n/

(* Whitespace at the end of a line *)
let eol = del (ws* . nl) "\n"

(* deal with continuation lines *)
let sep_spc             = del ws+ " "
let sep_osp             = del ws* ""
let sep_eq              = del (ws* . "=" . ws*) "="

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

(* A complete line that is either just whitespace or a comment that only
 * contains whitespace *)
let empty = [ del (ws* . /#?/ . ws* . nl) "\n" ]

let indent              = Util.indent

(* A comment that is not just whitespace. We define it in terms of the
 * things that are not allowed as part of such a comment:
 *   1) Starts with whitespace
 *   2) Ends with whitespace, a backslash or \r
 *   3) Unescaped newlines
 *)
let comment =
  let comment_start = del (ws* . "#" . ws* ) "# " in
  let unesc_eol = /[^\]?/ . nl in
  let w = /[^\t\n\r \\]/ in
  let r = /[\r\\]/ in
  let s = /[\t\r ]/ in
  (*
   * we'd like to write
   * let b = /\\\\/ in
   * let t = /[\t\n\r ]/ in
   * let x = b . (t? . (s|w)* ) in
   * but the definition of b depends on commit 244c0edd in 1.9.0 and
   * would make the lens unusable with versions before 1.9.0. So we write
   * x out which works in older versions, too
   *)
  let x = /\\\\[\t\n\r ]?[^\n\\]*/ in
  let line = ((r . s* . w|w|r) . (s|w)* . x*|(r.s* )?).w.(s*.w)* in
  [ label "#comment" . comment_start . store line . eol ]

(* borrowed from shellvars.aug *)
let char_arg_sec  = /([^\\ '"\t\r\n>]|[^ '"\t\r\n>]+[^\\ \t\r\n>])|\\\\"|\\\\'|\\\\ /
let char_arg_wl   = /([^\\ '"},\t\r\n]|[^ '"},\t\r\n]+[^\\ '"},\t\r\n])/

let dquot =
     let no_dquot = /[^"\\\r\n]/
  in /"/ . (no_dquot|esc_any)* . /"/
let dquot_msg =
     let no_dquot = /([^ \t"\\\r\n]|[^"\\\r\n]+[^ \t"\\\r\n])/
  in /"/ . (no_dquot|esc_any)* . no_dquot

let squot =
     let no_squot = /[^'\\\r\n]/
  in /'/ . (no_squot|esc_any)* . /'/
let comp = /[<>=]?=/

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

(* The arguments for a directive come in two flavors: quoted with single or
 * double quotes, or bare. Bare arguments may not start with a single or
 * double quote; since we also treat "word lists" special, i.e. lists
 * enclosed in curly braces, bare arguments may not start with those,
 * either.
 *
 * Bare arguments may not contain unescaped spaces, but we allow escaping
 * with '\\'. Quoted arguments can contain anything, though the quote must
 * be escaped with '\\'.
 *)
let bare = /([^{"' \t\n\r]|\\\\.)([^ \t\n\r]|\\\\.)*[^ \t\n\r\\]|[^{"' \t\n\r\\]/

let arg_quoted = [ label "arg" . store (dquot|squot) ]
let arg_bare = [ label "arg" . store bare ]

(* message argument starts with " but ends at EOL *)
let arg_dir_msg = [ label "arg" . store dquot_msg ]
let arg_wl  = [ label "arg" . store (char_arg_wl+|dquot|squot) ]

(* comma-separated wordlist as permitted in the SSLRequire directive *)
let arg_wordlist =
     let wl_start = dels "{" in
     let wl_end   = dels "}" in
     let wl_sep   = del /[ \t]*,[ \t]*/ ", "
  in [ label "wordlist" . wl_start . arg_wl . (wl_sep . arg_wl)* . wl_end ]

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

(* the arguments of a directive. We use this once we have parsed the name
 * of the directive, and the space right after it. When dir_args is used,
 * we also know that we have at least one argument. We need to be careful
 * with the spacing between arguments: quoted arguments and word lists do
 * not need to have space between them, but bare arguments do.
 *
 * Apache apparently is also happy if the last argument starts with a double
 * quote, but has no corresponding closing duoble quote, which is what
 * arg_dir_msg handles
 *)
let dir_args =
  let arg_nospc = arg_quoted|arg_wordlist in
  (arg_bare . sep_spc | arg_nospc . sep_osp)* . (arg_bare|arg_nospc|arg_dir_msg)

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

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

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

let perl_section = [ indent . label "Perl" . del /<perl>/i "<Perl>"
                   . store /[^<]*/
                   . del /<\/perl>/i "</Perl>" . eol ]

let rec content = section (content|directive)
                | perl_section

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/apache2/vhosts.d/*.conf") .
             (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 sudoers lens: "always_query_group_plugin" (#588)

The option is now enabled by default in the default sudoers of
RHEL 7.6 (and probably soon CentOS 7).

(*
Module: Sudoers
  Parses /etc/sudoers

Author: Raphael Pinson <raphink@gmail.com>

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

For example, recursive definitions such as

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

are replaced by

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

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

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

About: Lens Usage
  Sample usage of this lens in augtool

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

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

module Sudoers =
  autoload xfm

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

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

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

(* Group: Separators *)

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

(* Variable: sep_cont *)
let sep_cont = Sep.cl_or_space

(* Variable: sep_cont_opt *)
let sep_cont_opt = Sep.cl_or_opt_space

(* Variable: sep_cont_opt_build *)
let sep_cont_opt_build (sep:string) =
   del (Rx.cl_or_opt_space . sep . Rx.cl_or_opt_space) (" " . sep . " ")

(* Variable: sep_com *)
let sep_com = sep_cont_opt_build ","

(* Variable: sep_eq *)
let sep_eq   = sep_cont_opt_build "="

(* Variable: sep_col *)
let sep_col  = sep_cont_opt_build ":"

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

(* Group: Negation expressions *)

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

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

(************************************************************************
 * View: negate_or_value
 *   A <del_negate>, followed by either a negated key, or a key/value pair
 *************************************************************************)
let negate_or_value (key:lens) (value:lens) =
  [ del_negate . (negate_node . key | key . value) ]

(* Group: Stores *)

(* Variable: sto_to_com_cmnd
sto_to_com_cmnd does not begin or end with a space *)

let sto_to_com_cmnd = del_negate . negate_node? . (
      let alias = Rx.word - /(NO)?(PASSWD|EXEC|SETENV)/
     in let non_alias = /[\/a-z]([^,:#()\n\\]|\\\\[=:,\\])*[^,=:#() \t\n\\]|[^,=:#() \t\n\\]/
   in store (alias | non_alias))

(* Variable: sto_to_com

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

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

(* Variable: sto_to_com_user
Escaped spaces and NIS domains and allowed*)
let sto_to_com_user =
      let nis_re = /([A-Z]([-A-Z0-9]|(\\\\[ \t]))*+\\\\\\\\)/
   in let user_re = /[%+@a-z]([-A-Za-z0-9._+]|(\\\\[ \t]))*/
   in let alias_re = /[A-Z_]+/
   in store ((nis_re? . user_re) | alias_re)

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

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

(* Variable: sto_to_com_dquot *)
let sto_to_com_dquot    = store (to_com_chars|to_com_dquot)

(* Variable: sto_to_com_col *)
let sto_to_com_col      = store to_com_chars

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

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

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

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

(* Group: Comments and empty lines *)

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

(* View: comment_eol
Requires a space before the # *)
let comment_eol = Util.comment_generic /[ \t]+#[ \t]*/ " # "

(* View: comment_or_eol
A <comment_eol> or <eol> *)
let comment_or_eol = comment_eol | (del /([ \t]+#\n|[ \t]*\n)/ "\n")

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

(* View: includedir *)
let includedir =
  [ key /#include(dir)?/ . Sep.space . store Rx.fspath . eol ]

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

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

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

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

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

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

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

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

(************************************************************************
 * Group:                          DEFAULTS
 *************************************************************************)

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

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

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

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

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

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

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

let parameter_integer           = parameter_integer_nobool
                                | parameter_integer_bool

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

let parameter_string_nobool    = [ key parameter_string_nobool_kw . sep_eq
                                     . sto_to_com_dquot ]

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

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

let parameter_string           = parameter_string_nobool
                               | parameter_string_bool

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

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

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

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

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

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

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

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

(************************************************************************
 * View: runas_spec
 *   A runas specification for <spec>, using <alias_list> for listing
 *   users and/or groups used to run a command
 *
 *   Definition:
 *     > Runas_Spec ::= '(' Runas_List ')' |
 *     >                '(:' Runas_List ')' |
 *     >                '(' Runas_List ':' Runas_List ')'
 *************************************************************************)
let runas_spec_user       = alias_list "runas_user" sto_to_com
let runas_spec_group      = Util.del_str ":" . indent
                            . alias_list "runas_group" sto_to_com

let runas_spec_usergroup  = runas_spec_user . indent . runas_spec_group

let runas_spec = Util.del_str "("
                 . (runas_spec_user
                    | runas_spec_group
                    | runas_spec_usergroup )
                 . Util.del_str ")" . sep_cont_opt

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

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

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

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

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

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

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

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

let xfm = transform lns filter

(*
Module: Sudoers
  Parses /etc/sudoers

Author: Raphael Pinson <raphink@gmail.com>

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

For example, recursive definitions such as

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

are replaced by

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

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

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

About: Lens Usage
  Sample usage of this lens in augtool

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

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

module Sudoers =
  autoload xfm

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

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

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

(* Group: Separators *)

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

(* Variable: sep_cont *)
let sep_cont = Sep.cl_or_space

(* Variable: sep_cont_opt *)
let sep_cont_opt = Sep.cl_or_opt_space

(* Variable: sep_cont_opt_build *)
let sep_cont_opt_build (sep:string) =
   del (Rx.cl_or_opt_space . sep . Rx.cl_or_opt_space) (" " . sep . " ")

(* Variable: sep_com *)
let sep_com = sep_cont_opt_build ","

(* Variable: sep_eq *)
let sep_eq   = sep_cont_opt_build "="

(* Variable: sep_col *)
let sep_col  = sep_cont_opt_build ":"

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

(* Group: Negation expressions *)

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

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

(************************************************************************
 * View: negate_or_value
 *   A <del_negate>, followed by either a negated key, or a key/value pair
 *************************************************************************)
let negate_or_value (key:lens) (value:lens) =
  [ del_negate . (negate_node . key | key . value) ]

(* Group: Stores *)

(* Variable: sto_to_com_cmnd
sto_to_com_cmnd does not begin or end with a space *)

let sto_to_com_cmnd = del_negate . negate_node? . (
      let alias = Rx.word - /(NO)?(PASSWD|EXEC|SETENV)/
     in let non_alias = /[\/a-z]([^,:#()\n\\]|\\\\[=:,\\])*[^,=:#() \t\n\\]|[^,=:#() \t\n\\]/
   in store (alias | non_alias))

(* Variable: sto_to_com

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

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

(* Variable: sto_to_com_user
Escaped spaces and NIS domains and allowed*)
let sto_to_com_user =
      let nis_re = /([A-Z]([-A-Z0-9]|(\\\\[ \t]))*+\\\\\\\\)/
   in let user_re = /[%+@a-z]([-A-Za-z0-9._+]|(\\\\[ \t]))*/
   in let alias_re = /[A-Z_]+/
   in store ((nis_re? . user_re) | alias_re)

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

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

(* Variable: sto_to_com_dquot *)
let sto_to_com_dquot    = store (to_com_chars|to_com_dquot)

(* Variable: sto_to_com_col *)
let sto_to_com_col      = store to_com_chars

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

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

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

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

(* Group: Comments and empty lines *)

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

(* View: comment_eol
Requires a space before the # *)
let comment_eol = Util.comment_generic /[ \t]+#[ \t]*/ " # "

(* View: comment_or_eol
A <comment_eol> or <eol> *)
let comment_or_eol = comment_eol | (del /([ \t]+#\n|[ \t]*\n)/ "\n")

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

(* View: includedir *)
let includedir =
  [ key /#include(dir)?/ . Sep.space . store Rx.fspath . eol ]

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

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

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

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

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

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

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

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

(************************************************************************
 * Group:                          DEFAULTS
 *************************************************************************)

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

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

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

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

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

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

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

let parameter_integer           = parameter_integer_nobool
                                | parameter_integer_bool

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

let parameter_string_nobool    = [ key parameter_string_nobool_kw . sep_eq
                                     . sto_to_com_dquot ]

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

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

let parameter_string           = parameter_string_nobool
                               | parameter_string_bool

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

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

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

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

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

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

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

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

(************************************************************************
 * View: runas_spec
 *   A runas specification for <spec>, using <alias_list> for listing
 *   users and/or groups used to run a command
 *
 *   Definition:
 *     > Runas_Spec ::= '(' Runas_List ')' |
 *     >                '(:' Runas_List ')' |
 *     >                '(' Runas_List ':' Runas_List ')'
 *************************************************************************)
let runas_spec_user       = alias_list "runas_user" sto_to_com
let runas_spec_group      = Util.del_str ":" . indent
                            . alias_list "runas_group" sto_to_com

let runas_spec_usergroup  = runas_spec_user . indent . runas_spec_group

let runas_spec = Util.del_str "("
                 . (runas_spec_user
                    | runas_spec_group
                    | runas_spec_usergroup )
                 . Util.del_str ")" . sep_cont_opt

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

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

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

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

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

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

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

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

let xfm = transform lns filter


Util: add *.bak and *.old to stdexcl, to match files in /etc/sysconfig

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

(* 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: empty_dos *)
  let empty_dos =
    [ del /[ \t]*#?[ \t]*/ "" . del /\r?\n/ "\n" ]

(* 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") .
    (excl "*.bak") .
    (excl "*.old")