openvpn: simple ipv6 regex to save memory for tests

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

 Reference: http://openvpn.net/index.php/documentation/howto.html
 Reference: https://community.openvpn.net/openvpn/wiki/Openvpn23ManPage

 TODO: Inline file support
*)

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.
   Custom simplified ipv6 used instead of Rx.ipv6 as the augeas Travis instances
   are limited to 2GB of memory. Using 'ipv6_re = Rx.ipv6' consumes an extra
   2GB of memory and thus the test is OOM-killed.
*)
let ipv6_re = /[0-9A-Fa-f:]+/
let ipv4_re = Rx.ipv4
let ip_re  = ipv4_re|ipv6_re
let num_re = Rx.integer
let fn_re  = /[^#; \t\n][^#;\n]*[^#; \t\n]|[^#; \t\n]/
let fn_safe_re = /[^#; \t\r\n]+/
let an_re  = /[a-z][a-z0-9_-]*/
let hn_re  = Rx.hostname
let port_re = /[0-9]+/
let host_re = ip_re|hn_re
let proto_re = /(tcp|udp)/
let proto_ext_re = /(udp|tcp-client|tcp-server)/
let alg_re = /(none|[A-Za-z][A-Za-z0-9-]+)/
let ipv6_bits_re = ipv6_re . /\/[0-9]+/

(* Define store aliases *)
let ip     = store ip_re
let num    = store num_re
let filename = store fn_re
let filename_safe = store fn_safe_re
let hostname = store hn_re
let sto_to_dquote = store /[^"\n]+/   (* " Emacs, relax *)
let port = store port_re
let host = store host_re
let proto = store proto_re
let proto_ext = store proto_ext_re

(* 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|hostname
 *   - port  => num
 *   - proto => udp|tcp-client|tcp-server
 *   - proto-force => udp|tcp
 *   - mode  => p2p|server
 *   - dev   => (tun|tap)\d*
 *   - dev-node => filename
 *   - ca    => filename
 *   - config => 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
 *   - client-config-dir => filename
 *   - verb => num
 *   - mute => num
 *   - fragment => num
 *   - mssfix   => num
 *   - connect-retry num
 *   - connect-retry-max num
 *   - connect-timeout num
 *   - http-proxy-timeout num
 *   - max-routes num
 *   - ns-cert-type => "server"
 *   - resolv-retry => "infinite"
 *   - script-security => [0-3] (execve|system)?
 *   - ipchange => command
 *   - topology => type
 *************************************************************************)

let single_host = "local" | "tls-remote"
let single_ip   = "lladdr"
let single_ipv6_bits = "iroute-ipv6"
                     | "server-ipv6"
                     | "ifconfig-ipv6-pool"
let single_num = "port"
               | "max-clients"
               | "verb"
               | "mute"
               | "fragment"
               | "mssfix"
               | "connect-retry"
               | "connect-retry-max"
               | "connect-timeout"
               | "http-proxy-timeout"
               | "resolv-retry"
               | "lport"
               | "rport"
               | "max-routes"
               | "max-routes-per-client"
               | "route-metric"
               | "tun-mtu"
               | "tun-mtu-extra"
               | "shaper"
               | "ping"
               | "ping-exit"
               | "ping-restart"
               | "sndbuf"
               | "rcvbuf"
               | "txqueuelen"
               | "link-mtu"
               | "nice"
               | "management-log-cache"
               | "bcast-buffers"
               | "tcp-queue-limit"
               | "server-poll-timeout"
               | "keysize"
               | "pkcs11-pin-cache"
               | "tls-timeout"
               | "reneg-bytes"
               | "reneg-pkts"
               | "reneg-sec"
               | "hand-window"
               | "tran-window"
let single_fn   = "ca"
                | "cert"
                | "extra-certs"
                | "config"
                | "key"
                | "dh"
                | "log"
                | "log-append"
                | "client-config-dir"
                | "dev-node"
                | "cd"
                | "chroot"
                | "writepid"
                | "client-config-dir"
                | "tmp-dir"
                | "replay-persist"
                | "ca"
                | "capath"
                | "pkcs12"
                | "pkcs11-id"
                | "askpass"
                | "tls-export-cert"
                | "x509-track"
let single_an  = "user"
               | "group"
               | "management-client-user"
               | "management-client-group"
let single_cmd = "ipchange"
                | "iproute"
                | "route-up"
                | "route-pre-down"
                | "mark"
                | "up"
                | "down"
                | "setcon"
                | "echo"
                | "client-connect"
                | "client-disconnect"
                | "learn-address"
                | "tls-verify"

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

let single_opt_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 single_host host_re
	       | single_entry single_ip ip_re
           | single_entry single_ipv6_bits ipv6_bits_re
           | single_entry single_cmd fn_re
	       | single_entry "proto"    proto_ext_re
	       | single_entry "proto-force"    proto_re
	       | single_entry "mode"    /(p2p|server)/
               | single_entry "dev"      /(tun|tap)[0-9]*|null/
	       | single_entry "dev-type"      /(tun|tap)/
	       | single_entry "topology"      /(net30|p2p|subnet)/
	       | single_entry "cipher" alg_re
	       | single_entry "auth" alg_re
	       | single_entry "resolv-retry" "infinite"
	       | single_entry "script-security" /[0-3]( execve| system)?/
	       | single_entry "route-gateway" (host_re|/dhcp/)
	       | single_entry "mtu-disc" /(no|maybe|yes)/
	       | single_entry "remap-usr1" /SIG(HUP|TERM)/
	       | single_entry "socket-flags" /(TCP_NODELAY)/
           | single_entry "auth-retry" /(none|nointeract|interact)/
           | single_entry "tls-version-max" Rx.decimal
           | single_entry "verify-hash" /([A-Za-z0-9]{2}:)+[A-Za-z0-9]{2}/
           | single_entry "pkcs11-cert-private" /[01]/
           | single_entry "pkcs11-protected-authentication" /[01]/
           | single_entry "pkcs11-private-mode" /[A-Za-z0-9]+/
           | single_entry "key-method" /[12]/
           | single_entry "ns-cert-type" /(client|server)/
           | single_entry "remote-cert-tls" /(client|server)/

let single_opt  = single_opt_entry "comp-lzo" /(yes|no|adaptive)/
                | single_opt_entry "syslog" fn_re
                | single_opt_entry "daemon" fn_re
                | single_opt_entry "auth-user-pass" fn_re
                | single_opt_entry "explicit-exit-notify" num_re
                | single_opt_entry "engine" fn_re

(************************************************************************
 *                               DOUBLE VALUES
 *************************************************************************)

let double_entry (kw:regexp) (a:string) (aval:regexp) (b:string) (bval:regexp)
    = [ key kw
      . sep . [ label a . store aval ]
      . sep . [ label b . store bval ]
      . comment_or_eol
      ]

let double_secopt_entry (kw:regexp) (a:string) (aval:regexp) (b:string) (bval:regexp)
    = [ key kw
      . sep . [ label a . store aval ]
      . (sep . [ label b . store bval ])?
      . comment_or_eol
      ]

let double  = double_entry "keepalive" "ping" num_re "timeout" num_re
            | double_entry "hash-size" "real" num_re "virtual" num_re
            | double_entry "ifconfig" "local" ip_re "remote" ip_re
            | double_entry "connect-freq" "num" num_re "sec" num_re
            | double_entry "verify-x509-name" "name" hn_re "type"
                /(subject|name|name-prefix)/
            | double_entry "ifconfig-ipv6" "address" ipv6_bits_re "remote" ipv6_re
            | double_entry "ifconfig-ipv6-push" "address" ipv6_bits_re "remote" ipv6_re
            | double_secopt_entry "iroute" "local" ip_re "netmask" ip_re
            | double_secopt_entry "stale-routes-check" "age" num_re "interval" num_re
            | double_secopt_entry "ifconfig-pool-persist"
                "file" fn_safe_re "seconds" num_re
            | double_secopt_entry "secret" "file" fn_safe_re "direction" /[01]/
            | double_secopt_entry "prng" "algorithm" alg_re "nsl" num_re
            | double_secopt_entry "replay-window" "window-size" num_re "seconds" num_re

(************************************************************************
 *                               FLAGS
 *************************************************************************)

let flag_words = "client-to-client"
               | "duplicate-cn"
	       | "persist-key"
	       | "persist-tun"
	       | "client"
	       | "remote-random"
	       | "nobind"
	       | "mute-replay-warnings"
	       | "http-proxy-retry"
	       | "socks-proxy-retry"
           | "remote-random-hostname"
           | "show-proxy-settings"
           | "float"
           | "bind"
           | "nobind"
           | "tun-ipv6"
           | "ifconfig-noexec"
           | "ifconfig-nowarn"
           | "route-noexec"
           | "route-nopull"
           | "allow-pull-fqdn"
           | "mtu-test"
           | "ping-timer-rem"
           | "persist-tun"
           | "persist-local-ip"
           | "persist-remote-ip"
           | "mlock"
           | "up-delay"
           | "down-pre"
           | "up-restart"
           | "disable-occ"
           | "errors-to-stderr"
           | "passtos"
           | "suppress-timestamps"
           | "fast-io"
           | "multihome"
           | "comp-noadapt"
           | "management-client"
           | "management-query-passwords"
           | "management-query-proxy"
           | "management-query-remote"
           | "management-forget-disconnect"
           | "management-hold"
           | "management-signal"
           | "management-up-down"
           | "management-client-auth"
           | "management-client-pf"
           | "push-reset"
           | "push-peer-info"
           | "disable"
           | "ifconfig-pool-linear"
           | "client-to-client"
           | "duplicate-cn"
           | "ccd-exclusive"
           | "tcp-nodelay"
           | "opt-verify"
           | "auth-user-pass-optional"
           | "client-cert-not-required"
           | "username-as-common-name"
           | "pull"
           | "key-direction"
           | "no-replay"
           | "mute-replay-warnings"
           | "no-iv"
           | "use-prediction-resistance"
           | "test-crypto"
           | "tls-server"
           | "tls-client"
           | "pkcs11-id-management"
           | "single-session"
           | "tls-exit"
           | "auth-nocache"
           | "show-ciphers"
           | "show-digests"
           | "show-tls"
           | "show-engines"
           | "genkey"
           | "mktun"
           | "rmtun"

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

let flag       = flag_entry flag_words

(************************************************************************
 *                               OTHER FIELDS
 *
 *   - server        => IP IP [nopool]
 *   - server-bridge => IP IP IP IP
 *   - route	     => host host [host [num]]
 *   - push          => "string"
 *   - tls-auth      => filename [01]
 *   - remote        => hostname/IP [num] [(tcp|udp)]
 *   - management    => IP num filename
 *   - http-proxy    => host port [filename|keyword] [method]
 *   - http-proxy-option => (VERSION decimal|AGENT string)
 *   ...
 *   and many others
 *
 *************************************************************************)

let server          = [ key "server"
                      . sep . [ label "address" . ip ]
                      . sep . [ label "netmask" . ip ]
                      . (sep . [ key "nopool" ]) ?
                      . comment_or_eol
                      ]

let server_bridge =
    let ip_params = [ label "address" . ip ] . sep
        . [ label "netmask" . ip ] . sep
        . [ label "start"   . ip ] . sep
        . [ label "end"     . ip ] in
            [ key "server-bridge"
            . sep . (ip_params|store /(nogw)/)
            . comment_or_eol
            ]

let route =
    let route_net_kw   = store (/(vpn_gateway|net_gateway|remote_host)/|host_re) in
        [ key "route" . sep
        . [ label "address" . route_net_kw ]
        . (sep . [ label "netmask" . store (ip_re|/default/) ]
            . (sep . [ label "gateway" . route_net_kw ]
                . (sep . [ label "metric" . store (/default/|num_re)] )?
            )?
        )?
        . comment_or_eol
        ]

let route_ipv6 =
    let route_net_re = /(vpn_gateway|net_gateway|remote_host)/ in
        [ key "route-ipv6" . sep
        . [ label "network" . store (route_net_re|ipv6_bits_re) ]
        . (sep . [ label "gateway" . store (route_net_re|ipv6_re) ]
            . (sep . [ label "metric" . store (/default/|num_re)] )?
        )?
        . comment_or_eol
        ]

let push          = [ key "push" . sep
                    . Quote.do_dquote sto_to_dquote
		    . 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" . host ]
		            . (sep . [label "port" . port]
                        . (sep . [label "proto" . proto]) ? ) ?
                    . comment_or_eol
		    ]

let http_proxy =
    let auth_method_re = /(none|basic|ntlm)/ in
        let auth_method = store auth_method_re in
            [ key "http-proxy"
            . sep . [ label "server" . host ]
            . sep . [ label "port"   . port ]
            . (sep . [ label "auth" .  filename_safe ]
                . (sep . [ label "auth-method" . auth_method ]) ? )?
            . comment_or_eol
            ]

let http_proxy_option = [ key "http-proxy-option"
                        . sep . [ label "option" . store /(VERSION|AGENT)/ ]
                        . sep . [ label "value" . filename ]
                        . comment_or_eol
                        ]

let socks_proxy     = [ key "socks-proxy"
                      . sep . [ label "server" . host ]
                      . (sep . [ label "port"   . port ]
                        . (sep . [ label "auth" .  filename_safe ])? )?
                      . comment_or_eol
                      ]

let port_share      = [ key "port-share"
                      . sep . [ label "host" . host ]
                      . sep . [ label "port" . port ]
                      . (sep . [ label "dir" . filename ])?
                      . comment_or_eol
                      ]

let route_delay     = [ key "route-delay"
                    . (sep . [ label "seconds" . num ]
                        . (sep . [ label "win-seconds" . num ] ) ?
                    )?
                    . comment_or_eol
                    ]

let inetd           = [ key "inetd"
                    . (sep . [label "mode" . store /(wait|nowait)/ ]
                        . (sep . [ label "progname" . filename ] ) ?
                    )?
                    . comment_or_eol
                    ]

let inactive        = [ key "inactive"
                    . sep . [ label "seconds" . num ]
                    . (sep . [ label "bytes" . num ] ) ?
                    . comment_or_eol
                    ]

let client_nat      = [ key "client-nat"
                    . sep . [ label "type" . store /(snat|dnat)/ ]
                    . sep . [ label "network" . ip ]
                    . sep . [ label "netmask" . ip ]
                    . sep . [ label "alias" . ip ]
                    . comment_or_eol
                    ]

let status          = [ key "status"
                    . sep . [ label "file" . filename_safe ]
                    . (sep . [ label "repeat-seconds" . num ]) ?
                    . comment_or_eol
                    ]

let plugin          = [ key "plugin"
                    . sep . [ label "file" . filename_safe ]
                    . (sep . [ label "init-string" . filename ]) ?
                    . comment_or_eol
                    ]

let management    = [ key "management" . sep
                    . [ label "server" . ip ]
                    . sep . [ label "port" . port ]
                    . (sep . [ label "pwfile" . filename ] ) ?
                    . comment_or_eol
                    ]

let auth_user_pass_verify   = [ key "auth-user-pass-verify"
                              . sep . [ Quote.quote_spaces (label "command") ]
                              . sep . [ label "method" . store /via-(env|file)/ ]
                              . comment_or_eol
                              ]

let static_challenge    = [ key "static-challenge"
                          . sep . [ Quote.quote_spaces (label "text") ]
                          . sep . [ label "echo" . store /[01]/ ]
                          . comment_or_eol
                          ]

let cryptoapicert        = [ key "cryptoapicert" . sep . Quote.dquote
                          . [ key /[A-Z]+/ . Sep.colon . store /[A-Za-z _-]+/ ]
                          . Quote.dquote . comment_or_eol
                          ]

let setenv =
    let envvar = /[^#;\/ \t\n][A-Za-z0-9_-]+/ in
        [ key ("setenv"|"setenv-safe")
        . sep . [ key envvar . sep . store fn_re ]
        . comment_or_eol
        ]

let redirect =
    let redirect_flag   = /(local|autolocal|def1|bypass-dhcp|bypass-dns|block-local)/ in
        let redirect_key    = "redirect-gateway" | "redirect-private" in
            [ key redirect_key
            . (sep . [ label "flag" . store redirect_flag ] ) +
            . comment_or_eol
            ]

let tls_cipher =
    let ciphername = /[A-Za-z0-9!_-]+/ in
        [ key "tls-cipher" . sep
        . [label "cipher" . store ciphername]
        . (Sep.colon . [label "cipher" . store ciphername])*
        . comment_or_eol
        ]

let remote_cert_ku =
    let usage = [label "usage" . store /[A-Za-z0-9]{1,2}/] in
        [ key "remote-cert-ku" . sep . usage . (sep . usage)* . comment_or_eol ]

(* FIXME: Surely there's a nicer way to do this *)
let remote_cert_eku =
    let oid = [label "oid" . store /[0-9]+\.([0-9]+\.)*[0-9]+/] in
        let symbolic = [Quote.do_quote_opt
            (label "symbol" . store /[A-Za-z0-9][A-Za-z0-9 _-]*[A-Za-z0-9]/)] in
            [ key "remote-cert-eku" . sep . (oid|symbolic) . comment_or_eol ]

let status_version          = [ key "status-version"
                              . (sep . num) ?
                              . comment_or_eol
                              ]

let ifconfig_pool           = [ key "ifconfig-pool"
                              . sep . [ label "start" . ip ]
                              . sep . [ label "end" . ip ]
                              . (sep . [ label "netmask" . ip ])?
                              . comment_or_eol
                              ]

let ifconfig_push           = [ key "ifconfig-push"
                              . sep . [ label "local" . ip ]
                              . sep . [ label "remote-netmask" . ip ]
                              . (sep . [ label "alias" . store /[A-Za-z0-9_-]+/ ] )?
                              . comment_or_eol
                              ]

let ignore_unknown_option   = [ key "ignore-unknown-option"
                              . (sep . [ label "opt" . store /[A-Za-z0-9_-]+/ ] ) +
                              . comment_or_eol
                              ]

let tls_version_min         = [ key "tls-version-min"
                              . sep . store Rx.decimal
                              . (sep . [ key "or-highest" ]) ?
                              . comment_or_eol
                              ]

let crl_verify              = [ key "crl-verify"
                              . sep . filename_safe
                              . (sep . [ key "dir" ]) ?
                              . comment_or_eol
                              ]

let x509_username_field =
    let fieldname = /[A-Za-z0-9_-]+/ in
        let extfield = ([key /ext/ . Sep.colon . store fieldname]) in
            let subjfield = ([label "subj" . store fieldname]) in
                [ key "x509-username-field"
                . sep . (extfield|subjfield)
                . comment_or_eol
                ]

let other   = server
            | server_bridge
            | route
            | push
            | tls_auth
            | remote
            | http_proxy
            | http_proxy_option
            | socks_proxy
            | management
            | route_delay
            | client_nat
            | redirect
            | inactive
            | setenv
            | inetd
            | status
            | status_version
            | plugin
            | ifconfig_pool
            | ifconfig_push
            | ignore_unknown_option
            | auth_user_pass_verify
            | port_share
            | static_challenge
            | tls_version_min
            | tls_cipher
            | cryptoapicert
            | x509_username_field
            | remote_cert_ku
            | remote_cert_eku
            | crl_verify
            | route_ipv6

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

let lns    = ( comment | empty | single | single_opt | double | 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>
 Author: Justin Akers <dafugg@gmail.com>

 Reference: http://openvpn.net/index.php/documentation/howto.html
 Reference: https://community.openvpn.net/openvpn/wiki/Openvpn23ManPage

 TODO: Inline file support
*)

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.ip
let num_re = Rx.integer
let fn_re  = /[^#; \t\n][^#;\n]*[^#; \t\n]|[^#; \t\n]/
let fn_safe_re = /[^#; \t\r\n]+/
let an_re  = /[a-z][a-z0-9_-]*/
let hn_re  = Rx.hostname
let port_re = /[0-9]+/
let host_re = ip_re|hn_re
let proto_re = /(tcp|udp)/
let proto_ext_re = /(udp|tcp-client|tcp-server)/
let alg_re = /(none|[A-Za-z][A-Za-z0-9-]+)/
let ipv6_bits_re = Rx.ipv6 . /\/[0-9]+/

(* Define store aliases *)
let ip     = store ip_re
let num    = store num_re
let filename = store fn_re
let filename_safe = store fn_safe_re
let hostname = store hn_re
let sto_to_dquote = store /[^"\n]+/   (* " Emacs, relax *)
let port = store port_re
let host = store host_re
let proto = store proto_re
let proto_ext = store proto_ext_re

(* 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|hostname
 *   - port  => num
 *   - proto => udp|tcp-client|tcp-server
 *   - proto-force => udp|tcp
 *   - mode  => p2p|server
 *   - dev   => (tun|tap)\d*
 *   - dev-node => filename
 *   - ca    => filename
 *   - config => 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
 *   - client-config-dir => filename
 *   - verb => num
 *   - mute => num
 *   - fragment => num
 *   - mssfix   => num
 *   - connect-retry num
 *   - connect-retry-max num
 *   - connect-timeout num
 *   - http-proxy-timeout num
 *   - max-routes num
 *   - ns-cert-type => "server"
 *   - resolv-retry => "infinite"
 *   - script-security => [0-3] (execve|system)?
 *   - ipchange => command
 *   - topology => type
 *************************************************************************)

let single_host = "local" | "tls-remote"
let single_ip   = "lladdr"
let single_ipv6_bits = "iroute-ipv6"
                     | "server-ipv6"
                     | "ifconfig-ipv6-pool"
let single_num = "port"
               | "max-clients"
               | "verb"
               | "mute"
               | "fragment"
               | "mssfix"
               | "connect-retry"
               | "connect-retry-max"
               | "connect-timeout"
               | "http-proxy-timeout"
               | "resolv-retry"
               | "lport"
               | "rport"
               | "max-routes"
               | "max-routes-per-client"
               | "route-metric"
               | "tun-mtu"
               | "tun-mtu-extra"
               | "shaper"
               | "ping"
               | "ping-exit"
               | "ping-restart"
               | "sndbuf"
               | "rcvbuf"
               | "txqueuelen"
               | "link-mtu"
               | "nice"
               | "management-log-cache"
               | "bcast-buffers"
               | "tcp-queue-limit"
               | "server-poll-timeout"
               | "keysize"
               | "pkcs11-pin-cache"
               | "tls-timeout"
               | "reneg-bytes"
               | "reneg-pkts"
               | "reneg-sec"
               | "hand-window"
               | "tran-window"
let single_fn   = "ca"
                | "cert"
                | "extra-certs"
                | "config"
                | "key"
                | "dh"
                | "log"
                | "log-append"
                | "client-config-dir"
                | "dev-node"
                | "cd"
                | "chroot"
                | "writepid"
                | "client-config-dir"
                | "tmp-dir"
                | "replay-persist"
                | "ca"
                | "capath"
                | "pkcs12"
                | "pkcs11-id"
                | "askpass"
                | "tls-export-cert"
                | "x509-track"
let single_an  = "user"
               | "group"
               | "management-client-user"
               | "management-client-group"
let single_cmd = "ipchange"
                | "iproute"
                | "route-up"
                | "route-pre-down"
                | "mark"
                | "up"
                | "down"
                | "setcon"
                | "echo"
                | "client-connect"
                | "client-disconnect"
                | "learn-address"
                | "tls-verify"

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

let single_opt_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 single_host host_re
	       | single_entry single_ip ip_re
           | single_entry single_ipv6_bits ipv6_bits_re
           | single_entry single_cmd fn_re
	       | single_entry "proto"    proto_ext_re
	       | single_entry "proto-force"    proto_re
	       | single_entry "mode"    /(p2p|server)/
               | single_entry "dev"      /(tun|tap)[0-9]*|null/
	       | single_entry "dev-type"      /(tun|tap)/
	       | single_entry "topology"      /(net30|p2p|subnet)/
	       | single_entry "cipher" alg_re
	       | single_entry "auth" alg_re
	       | single_entry "resolv-retry" "infinite"
	       | single_entry "script-security" /[0-3]( execve| system)?/
	       | single_entry "route-gateway" (host_re|/dhcp/)
	       | single_entry "mtu-disc" /(no|maybe|yes)/
	       | single_entry "remap-usr1" /SIG(HUP|TERM)/
	       | single_entry "socket-flags" /(TCP_NODELAY)/
           | single_entry "auth-retry" /(none|nointeract|interact)/
           | single_entry "tls-version-max" Rx.decimal
           | single_entry "verify-hash" /([A-Za-z0-9]{2}:)+[A-Za-z0-9]{2}/
           | single_entry "pkcs11-cert-private" /[01]/
           | single_entry "pkcs11-protected-authentication" /[01]/
           | single_entry "pkcs11-private-mode" /[A-Za-z0-9]+/
           | single_entry "key-method" /[12]/
           | single_entry "ns-cert-type" /(client|server)/
           | single_entry "remote-cert-tls" /(client|server)/

let single_opt  = single_opt_entry "comp-lzo" /(yes|no|adaptive)/
                | single_opt_entry "syslog" fn_re
                | single_opt_entry "daemon" fn_re
                | single_opt_entry "auth-user-pass" fn_re
                | single_opt_entry "explicit-exit-notify" num_re
                | single_opt_entry "engine" fn_re

(************************************************************************
 *                               DOUBLE VALUES
 *************************************************************************)

let double_entry (kw:regexp) (a:string) (aval:regexp) (b:string) (bval:regexp)
    = [ key kw
      . sep . [ label a . store aval ]
      . sep . [ label b . store bval ]
      . comment_or_eol
      ]

let double_secopt_entry (kw:regexp) (a:string) (aval:regexp) (b:string) (bval:regexp)
    = [ key kw
      . sep . [ label a . store aval ]
      . (sep . [ label b . store bval ])?
      . comment_or_eol
      ]

let double  = double_entry "keepalive" "ping" num_re "timeout" num_re
            | double_entry "hash-size" "real" num_re "virtual" num_re
            | double_entry "ifconfig" "local" ip_re "remote" ip_re
            | double_entry "connect-freq" "num" num_re "sec" num_re
            | double_entry "verify-x509-name" "name" hn_re "type"
                /(subject|name|name-prefix)/
            | double_entry "ifconfig-ipv6" "address" ipv6_bits_re "remote" Rx.ipv6
            | double_entry "ifconfig-ipv6-push" "address" ipv6_bits_re "remote" Rx.ipv6
            | double_secopt_entry "iroute" "local" ip_re "netmask" ip_re
            | double_secopt_entry "stale-routes-check" "age" num_re "interval" num_re
            | double_secopt_entry "ifconfig-pool-persist"
                "file" fn_safe_re "seconds" num_re
            | double_secopt_entry "secret" "file" fn_safe_re "direction" /[01]/
            | double_secopt_entry "prng" "algorithm" alg_re "nsl" num_re
            | double_secopt_entry "replay-window" "window-size" num_re "seconds" num_re

(************************************************************************
 *                               FLAGS
 *************************************************************************)

let flag_words = "client-to-client"
               | "duplicate-cn"
	       | "persist-key"
	       | "persist-tun"
	       | "client"
	       | "remote-random"
	       | "nobind"
	       | "mute-replay-warnings"
	       | "http-proxy-retry"
	       | "socks-proxy-retry"
           | "remote-random-hostname"
           | "show-proxy-settings"
           | "float"
           | "bind"
           | "nobind"
           | "tun-ipv6"
           | "ifconfig-noexec"
           | "ifconfig-nowarn"
           | "route-noexec"
           | "route-nopull"
           | "allow-pull-fqdn"
           | "mtu-test"
           | "ping-timer-rem"
           | "persist-tun"
           | "persist-local-ip"
           | "persist-remote-ip"
           | "mlock"
           | "up-delay"
           | "down-pre"
           | "up-restart"
           | "disable-occ"
           | "errors-to-stderr"
           | "passtos"
           | "suppress-timestamps"
           | "fast-io"
           | "multihome"
           | "comp-noadapt"
           | "management-client"
           | "management-query-passwords"
           | "management-query-proxy"
           | "management-query-remote"
           | "management-forget-disconnect"
           | "management-hold"
           | "management-signal"
           | "management-up-down"
           | "management-client-auth"
           | "management-client-pf"
           | "push-reset"
           | "push-peer-info"
           | "disable"
           | "ifconfig-pool-linear"
           | "client-to-client"
           | "duplicate-cn"
           | "ccd-exclusive"
           | "tcp-nodelay"
           | "opt-verify"
           | "auth-user-pass-optional"
           | "client-cert-not-required"
           | "username-as-common-name"
           | "pull"
           | "key-direction"
           | "no-replay"
           | "mute-replay-warnings"
           | "no-iv"
           | "use-prediction-resistance"
           | "test-crypto"
           | "tls-server"
           | "tls-client"
           | "pkcs11-id-management"
           | "single-session"
           | "tls-exit"
           | "auth-nocache"
           | "show-ciphers"
           | "show-digests"
           | "show-tls"
           | "show-engines"
           | "genkey"
           | "mktun"
           | "rmtun"

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

let flag       = flag_entry flag_words

(************************************************************************
 *                               OTHER FIELDS
 *
 *   - server        => IP IP [nopool]
 *   - server-bridge => IP IP IP IP
 *   - route	     => host host [host [num]]
 *   - push          => "string"
 *   - tls-auth      => filename [01]
 *   - remote        => hostname/IP [num] [(tcp|udp)]
 *   - management    => IP num filename
 *   - http-proxy    => host port [filename|keyword] [method]
 *   - http-proxy-option => (VERSION decimal|AGENT string)
 *   ...
 *   and many others
 *
 *************************************************************************)

let server          = [ key "server"
                      . sep . [ label "address" . ip ]
                      . sep . [ label "netmask" . ip ]
                      . (sep . [ key "nopool" ]) ?
                      . comment_or_eol
                      ]

let server_bridge =
    let ip_params = [ label "address" . ip ] . sep
        . [ label "netmask" . ip ] . sep
        . [ label "start"   . ip ] . sep
        . [ label "end"     . ip ] in
            [ key "server-bridge"
            . sep . (ip_params|store /(nogw)/)
            . comment_or_eol
            ]

let route =
    let route_net_kw   = store (/(vpn_gateway|net_gateway|remote_host)/|host_re) in
        [ key "route" . sep
        . [ label "address" . route_net_kw ]
        . (sep . [ label "netmask" . store (ip_re|/default/) ]
            . (sep . [ label "gateway" . route_net_kw ]
                . (sep . [ label "metric" . store (/default/|num_re)] )?
            )?
        )?
        . comment_or_eol
        ]

let route_ipv6 =
    let route_net_re = /(vpn_gateway|net_gateway|remote_host)/ in
        [ key "route-ipv6" . sep
        . [ label "network" . store (route_net_re|ipv6_bits_re) ]
        . (sep . [ label "gateway" . store (route_net_re|Rx.ipv6) ]
            . (sep . [ label "metric" . store (/default/|num_re)] )?
        )?
        . comment_or_eol
        ]

let push          = [ key "push" . sep
                    . Quote.do_dquote sto_to_dquote
		    . 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" . host ]
		            . (sep . [label "port" . port]
                        . (sep . [label "proto" . proto]) ? ) ?
                    . comment_or_eol
		    ]

let http_proxy =
    let auth_method_re = /(none|basic|ntlm)/ in
        let auth_method = store auth_method_re in
            [ key "http-proxy"
            . sep . [ label "server" . host ]
            . sep . [ label "port"   . port ]
            . (sep . [ label "auth" .  filename_safe ]
                . (sep . [ label "auth-method" . auth_method ]) ? )?
            . comment_or_eol
            ]

let http_proxy_option = [ key "http-proxy-option"
                        . sep . [ label "option" . store /(VERSION|AGENT)/ ]
                        . sep . [ label "value" . filename ]
                        . comment_or_eol
                        ]

let socks_proxy     = [ key "socks-proxy"
                      . sep . [ label "server" . host ]
                      . (sep . [ label "port"   . port ]
                        . (sep . [ label "auth" .  filename_safe ])? )?
                      . comment_or_eol
                      ]

let port_share      = [ key "port-share"
                      . sep . [ label "host" . host ]
                      . sep . [ label "port" . port ]
                      . (sep . [ label "dir" . filename ])?
                      . comment_or_eol
                      ]

let route_delay     = [ key "route-delay"
                    . (sep . [ label "seconds" . num ]
                        . (sep . [ label "win-seconds" . num ] ) ?
                    )?
                    . comment_or_eol
                    ]

let inetd           = [ key "inetd"
                    . (sep . [label "mode" . store /(wait|nowait)/ ]
                        . (sep . [ label "progname" . filename ] ) ?
                    )?
                    . comment_or_eol
                    ]

let inactive        = [ key "inactive"
                    . sep . [ label "seconds" . num ]
                    . (sep . [ label "bytes" . num ] ) ?
                    . comment_or_eol
                    ]

let client_nat      = [ key "client-nat"
                    . sep . [ label "type" . store /(snat|dnat)/ ]
                    . sep . [ label "network" . ip ]
                    . sep . [ label "netmask" . ip ]
                    . sep . [ label "alias" . ip ]
                    . comment_or_eol
                    ]

let status          = [ key "status"
                    . sep . [ label "file" . filename_safe ]
                    . (sep . [ label "repeat-seconds" . num ]) ?
                    . comment_or_eol
                    ]

let plugin          = [ key "plugin"
                    . sep . [ label "file" . filename_safe ]
                    . (sep . [ label "init-string" . filename ]) ?
                    . comment_or_eol
                    ]

let management    = [ key "management" . sep
                    . [ label "server" . ip ]
                    . sep . [ label "port" . port ]
                    . (sep . [ label "pwfile" . filename ] ) ?
                    . comment_or_eol
                    ]

let auth_user_pass_verify   = [ key "auth-user-pass-verify"
                              . sep . [ Quote.quote_spaces (label "command") ]
                              . sep . [ label "method" . store /via-(env|file)/ ]
                              . comment_or_eol
                              ]

let static_challenge    = [ key "static-challenge"
                          . sep . [ Quote.quote_spaces (label "text") ]
                          . sep . [ label "echo" . store /[01]/ ]
                          . comment_or_eol
                          ]

let cryptoapicert        = [ key "cryptoapicert" . sep . Quote.dquote
                          . [ key /[A-Z]+/ . Sep.colon . store /[A-Za-z _-]+/ ]
                          . Quote.dquote . comment_or_eol
                          ]

let setenv =
    let envvar = /[^#;\/ \t\n][A-Za-z0-9_-]+/ in
        [ key ("setenv"|"setenv-safe")
        . sep . [ key envvar . sep . store fn_re ]
        . comment_or_eol
        ]

let redirect =
    let redirect_flag   = /(local|autolocal|def1|bypass-dhcp|bypass-dns|block-local)/ in
        let redirect_key    = "redirect-gateway" | "redirect-private" in
            [ key redirect_key
            . (sep . [ label "flag" . store redirect_flag ] ) +
            . comment_or_eol
            ]

let tls_cipher =
    let ciphername = /[A-Za-z0-9!_-]+/ in
        [ key "tls-cipher" . sep
        . [label "cipher" . store ciphername]
        . (Sep.colon . [label "cipher" . store ciphername])*
        . comment_or_eol
        ]

let remote_cert_ku =
    let usage = [label "usage" . store /[A-Za-z0-9]{1,2}/] in
        [ key "remote-cert-ku" . sep . usage . (sep . usage)* . comment_or_eol ]

(* FIXME: Surely there's a nicer way to do this *)
let remote_cert_eku =
    let oid = [label "oid" . store /[0-9]+\.([0-9]+\.)*[0-9]+/] in
        let symbolic = [Quote.do_quote_opt
            (label "symbol" . store /[A-Za-z0-9][A-Za-z0-9 _-]*[A-Za-z0-9]/)] in
            [ key "remote-cert-eku" . sep . (oid|symbolic) . comment_or_eol ]

let status_version          = [ key "status-version"
                              . (sep . num) ?
                              . comment_or_eol
                              ]

let ifconfig_pool           = [ key "ifconfig-pool"
                              . sep . [ label "start" . ip ]
                              . sep . [ label "end" . ip ]
                              . (sep . [ label "netmask" . ip ])?
                              . comment_or_eol
                              ]

let ifconfig_push           = [ key "ifconfig-push"
                              . sep . [ label "local" . ip ]
                              . sep . [ label "remote-netmask" . ip ]
                              . (sep . [ label "alias" . store /[A-Za-z0-9_-]+/ ] )?
                              . comment_or_eol
                              ]

let ignore_unknown_option   = [ key "ignore-unknown-option"
                              . (sep . [ label "opt" . store /[A-Za-z0-9_-]+/ ] ) +
                              . comment_or_eol
                              ]

let tls_version_min         = [ key "tls-version-min"
                              . sep . store Rx.decimal
                              . (sep . [ key "or-highest" ]) ?
                              . comment_or_eol
                              ]

let crl_verify              = [ key "crl-verify"
                              . sep . filename_safe
                              . (sep . [ key "dir" ]) ?
                              . comment_or_eol
                              ]

let x509_username_field =
    let fieldname = /[A-Za-z0-9_-]+/ in
        let extfield = ([key /ext/ . Sep.colon . store fieldname]) in
            let subjfield = ([label "subj" . store fieldname]) in
                [ key "x509-username-field"
                . sep . (extfield|subjfield)
                . comment_or_eol
                ]

let other   = server
            | server_bridge
            | route
            | push
            | tls_auth
            | remote
            | http_proxy
            | http_proxy_option
            | socks_proxy
            | management
            | route_delay
            | client_nat
            | redirect
            | inactive
            | setenv
            | inetd
            | status
            | status_version
            | plugin
            | ifconfig_pool
            | ifconfig_push
            | ignore_unknown_option
            | auth_user_pass_verify
            | port_share
            | static_challenge
            | tls_version_min
            | tls_cipher
            | cryptoapicert
            | x509_username_field
            | remote_cert_ku
            | remote_cert_eku
            | crl_verify
            | route_ipv6

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

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

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

let xfm = transform lns filter


Adapt comments for NaturalDocs parsing

Adapt comments for NaturalDocs parsing

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

module Xinetd =
  autoload xfm

  let comment = [ del /[ \t]*(#.*|[ \t]*)\n/ "#\n" ]

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

  let eq = opt_spc . Util.del_str "="

  let op = opt_spc . ([ label "add" . Util.del_str "+=" ]
                 |[ label "del" . Util.del_str "-=" ]
                 |Util.del_str "=")

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

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

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

  let attr_lst_eq (n:regexp) = attr_lst n eq

  let attr_lst_op (n:regexp) = attr_lst n op

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

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

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

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

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

  let service =
     let key_re = /[^ \t\n\/]+/ - /include|includedir|defaults/ in
     [ del /service[ \t]+/ "service " . key key_re . body service_attr ]

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

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

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

  let xfm = transform lns filter

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

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

  let comment = [ del /[ \t]*(#.*|[ \t]*)\n/ "#\n" ]

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

  let eq = opt_spc . Util.del_str "="

  let op = opt_spc . ([ label "add" . Util.del_str "+=" ]
                 |[ label "del" . Util.del_str "-=" ]
                 |Util.del_str "=")

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

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

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

  let attr_lst_eq (n:regexp) = attr_lst n eq

  let attr_lst_op (n:regexp) = attr_lst n op

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

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

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

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

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

  let service =
     let key_re = /[^ \t\n\/]+/ - /include|includedir|defaults/ in
     [ del /service[ \t]+/ "service " . key key_re . body service_attr ]

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

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

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

  let xfm = transform lns filter

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


Json: parse verbatim escaped spaces and newlines in quotes

module Json =

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

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

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

let str_store = Quote.dquote . store /([^\\\\"]|\\\\("|n|r|t|\\\\))*/ . Quote.dquote  (* " Emacs, relax *)

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

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

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

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

let lns = comments . rlns

module Json =

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

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

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

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

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

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

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

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

let lns = comments . rlns


Interfaces: fix documentation typos

Interfaces: fix documentation typos

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

 Reference: man interfaces

*)

module Interfaces =
   autoload xfm

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

let eol        = Util.eol

(* Define separators *)

(* a line can be extended across multiple lines by making the last  *)
(*  character a backslash *)
let sep_spc    =  del /([ \t]+|[ \t]*\\\\\n[ \t]*)/ " "

(* Define fields *)
let sto_to_eol = store /([^\\ \t\n].*[^\\ \t\n]|[^\\ \t\n])/ . eol
let sto_to_spc = store /[^\\ \t\n]+/

(* Define comments and empty lines *)

(* note that the comment definition from Util does not support *)
(* splitting lines with a backlash                             *)
let comment    = Util.comment

let empty      = Util.empty

(* Define tree stanza_ids *)
let stanza_id    (t:string) = key t . sep_spc . sto_to_spc
let stanza_param (l:string) = [ sep_spc . label l . sto_to_spc ]

(* Define reserved words and multi-value options *)
let stanza_word =
   /(source(-directory)?|iface|auto|allow-[a-z-]+|mapping|bond-slaves|bridge-ports)/

(* Define stanza option indentation *)
let stanza_indent = del /[ \t]*/ "   "

(* Define additional lines for multi-line stanzas *)
let stanza_option = [  stanza_indent
                     . key  ( /[a-z0-9_-]+/ - stanza_word )
                     . sep_spc
                     . sto_to_eol ]

(* Define space-separated array *)
let array (r:regexp) (t:string) =  del r t . label t . counter t
   . [ sep_spc . seq t . sto_to_spc ]+

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

let auto = [ array /(allow-)?auto/ "auto" . eol ]

(************************************************************************
 *                              GENERIC ALLOW
 *************************************************************************)

let allow = [ key ( /allow-[a-z-]+/ - "allow-auto" )
             . counter "allow_seq"
             . [ sep_spc . seq "allow_seq" . sto_to_spc ]+
             . eol ]

(************************************************************************
 *                              MAPPING
 *************************************************************************)

let mapping = [ stanza_id "mapping"
               . eol
               . (stanza_option|comment|empty)+ ]

(************************************************************************
 *                              IFACE
 *************************************************************************)

let multi_option (t:string) = [ stanza_indent . array t t . eol ]

let iface   = [ Util.indent
              . stanza_id    "iface"
              . stanza_param "family"
              . stanza_param "method"
              . eol
              . ( stanza_option
                | multi_option "bond-slaves"
                | multi_option "bridge-ports"
                | comment
                | empty )* ]

(************************************************************************
 *                              SOURCE
 *************************************************************************)

let source = [ key "source" . sep_spc . sto_to_eol ]

(************************************************************************
 *                              SOURCE-DIRECTORY
 *************************************************************************)

let source_directory = [ key "source-directory" . sep_spc . sto_to_eol ]

(************************************************************************
 *                              STANZAS
 *************************************************************************)

(* The auto and hotplug stanzas always consist of one line only, while
   iface and mapping can spand along more lines. Comment nodes are
   inserted in the tree as direct children of the root node only when they
   come after an auto or hotplug stanza, otherwise they are considered part
   of an iface or mapping block *)

let stanza_single = (auto|allow|source|source_directory) . (comment|empty)*
let stanza_multi  = iface|mapping

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

   let lns = (comment|empty)* . (stanza_multi | stanza_single)*

   let filter = (incl "/etc/network/interfaces")
                . (incl "/etc/network/interfaces.d/*")
                . Util.stdexcl

   let xfm = transform lns filter

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

 Reference: man interfaces

*)

module Interfaces =
   autoload xfm

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

let eol        = Util.eol

(* Define separators *)

(* a line can be extended across multiple lines by making the last  *)
(*  character a backslash *)
let sep_spc    =  del /([ \t]+|[ \t]*\\\\\n[ \t]*)/ " "

(* Define fields *)
let sto_to_eol = store /([^\\ \t\n].*[^\\ \t\n]|[^\\ \t\n])/ . eol
let sto_to_spc = store /[^\\ \t\n]+/

(* Define comments and empty lines *)

(* note that the comment definition from Util does not support *)
(* splitting lines with a backlash                             *)
let comment    = Util.comment

let empty      = Util.empty

(* Define tree stanza_ids *)
let stanza_id    (t:string) = key t . sep_spc . sto_to_spc
let stanza_param (l:string) = [ sep_spc . label l . sto_to_spc ]

(* Define reseverved words and multi-value options*)
let stanza_word =
   /(source(-directory)?|iface|auto|allow-[a-z-]+|mapping|bond-slaves|bridge-ports)/

(* Define stanza option indentation *)
let stanza_indent = del /[ \t]*/ "   "

(* Define additional lines for multi-line stanzas *)
let stanza_option = [  stanza_indent
                     . key  ( /[a-z0-9_-]+/ - stanza_word )
                     . sep_spc
                     . sto_to_eol ]

(* Define space-separated array *)
let array (r:regexp) (t:string) =  del r t . label t . counter t
   . [ sep_spc . seq t . sto_to_spc ]+

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

let auto = [ array /(allow-)?auto/ "auto" . eol ]

(************************************************************************
 *                              GENERIC ALLOW
 *************************************************************************)

let allow = [ key ( /allow-[a-z-]+/ - "allow-auto" )
             . counter "allow_seq"
             . [ sep_spc . seq "allow_seq" . sto_to_spc ]+
             . eol ]

(************************************************************************
 *                              MAPPING
 *************************************************************************)

let mapping = [ stanza_id "mapping"
               . eol
               . (stanza_option|comment|empty)+ ]

(************************************************************************
 *                              IFACE
 *************************************************************************)

let multi_option (t:string) = [ stanza_indent . array t t . eol ]

let iface   = [ Util.indent
              . stanza_id    "iface"
              . stanza_param "family"
              . stanza_param "method"
              . eol
              . ( stanza_option
                | multi_option "bond-slaves"
                | multi_option "bridge-ports"
                | comment
                | empty )* ]

(************************************************************************
 *                              SOURCE
 *************************************************************************)

let source = [ key "source" . sep_spc . sto_to_eol ]

(************************************************************************
 *                              SOURCE-DIRECTORY
 *************************************************************************)

let source_directory = [ key "source-directory" . sep_spc . sto_to_eol ]

(************************************************************************
 *                              STANZAS
 *************************************************************************)

(* The auto and hotplug stanzas always consist of one line only, while
   iface and mapping can spand along more lines. Comment nodes are
   inserted in the tree as direct children of the root node only when they
   come after an auto or hotplug stanza, otherwise they are considered part
   of a iface or mapping block *)

let stanza_single = (auto|allow|source|source_directory) . (comment|empty)*
let stanza_multi  = iface|mapping

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

   let lns = (comment|empty)* . (stanza_multi | stanza_single)*

   let filter = (incl "/etc/network/interfaces")
                . (incl "/etc/network/interfaces.d/*")
                . Util.stdexcl

   let xfm = transform lns filter


Permit ! in block titles, which is permitted in modern versions of Dovecot m Please enter the commit message for your changes. Lines starting

(*
Module: Dovecot
  Parses dovecot configuration files.

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

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

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

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

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

module Dovecot =

  autoload xfm

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Based off Quote.dquote_spaces

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

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

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

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

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

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

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

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

let xfm = transform lns filter

(*
Module: Dovecot
  Parses dovecot configuration files.

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

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

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

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

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

module Dovecot =

  autoload xfm

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Based off Quote.dquote_spaces

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

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

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

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

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

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

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

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

let xfm = transform lns filter


graphviz.aug: space is optional before options

(*
Module: Graphviz
  Parses graphviz files.

Author: Raphael Pinson <raphink@gmail.com>

About: Reference

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

About: Lens Usage
   To be documented

About: Configuration files
   This lens applies to graphviz files.

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

module Graphviz =

(* View: name *)
let name =
   let reserved = "node" | "graph"
   in  store ( ("\"" . /[^"]*/ . "\"")
               | (/[A-Za-z0-9_.]+/ - reserved) )

(* View: eol
     Special eol using semicolons and/or newlines *)
let eol = del /[ \t]*((;\n?)|\n)/ ";\n"

(* View: block
     A block construct, using Build.block_generic
     in order to pass our special definition of <eol> *)
let block (kw:regexp) (entry:lens) =
   [ key kw
   . Sep.space . name
   . Build.block_generic  (* Use our definition of eol *)
        (Util.indent . entry . eol)
        (entry . eol) (Util.indent . entry) entry
        Util.comment Util.comment_noindent
        Build.block_ldelim_re /;?[ \t\n]*\}/ (* Allow semicol *)
        Build.block_ldelim_default Build.block_rdelim_default ]

(* View: variable_generic
     A generic way of parsing variables
     with or without double quotes *)
let variable_generic (reserved:regexp) =
   Build.key_value (Rx.word - reserved) Sep.space_equal name

(* View: variable *)
let variable =
   let reserved = "subgraph" | "node"
   in variable_generic reserved

(* View: options
     A list of options for <nodes> or <links> *)
let options =
      let reserved = "node" | "link_type"
   in let option = variable_generic reserved
   in let comma = del /,[ \t\n]*/ ","
   in Sep.opt_space . del /\[[ \t]*/ "["
                . Build.opt_list option comma
                . del /[ \t]*\]/ "]"

(* View: link *)
let link =
      let link_node = [ label "node" . name ]
   in let link_type = [ label "link_type" . Sep.opt_space
                      . store /\<?\-\-?\>?/ . Sep.opt_space ]
   in [ label "link"
      . Build.list link_node link_type
      . options? ]

(* View: node *)
let node = [ label "node" . name . options? ]

(* View: nodelist
     Several <nodes> can be declared at once in a nodelist.
     This cannot be declared as simply a list of <nodes>,
     since it would be ambiguous in the put direction. *)
let nodelist = [ label "nodelist" . Build.list node Sep.space ]

(* View: default_node
     General settings for <nodes> *)
let default_node = [ Build.xchgs "node" "@node" . options ]

(* View: default_graph
     General settings for <graphs> *)
let default_graph = [ Build.xchgs "graph" "@graph" . options ]

(* View: entry
     A general entry *)
let entry = (link | variable | node | nodelist
           | default_node | default_graph)

(* View: subgraph
     Recursive *)
let rec subgraph = block "subgraph" (subgraph | entry)

(* View: graph
     The top-level graph *)
let graph = block /(di)?graph/ (subgraph | entry) . Util.eol

(* View: lns
     The graphviz lens *)
let lns = (Util.comment | Util.empty)* . graph

(*
Module: Graphviz
  Parses graphviz files.

Author: Raphael Pinson <raphink@gmail.com>

About: Reference

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

About: Lens Usage
   To be documented

About: Configuration files
   This lens applies to graphviz files.

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

module Graphviz =

(* View: name *)
let name =
   let reserved = "node" | "graph"
   in  store ( ("\"" . /[^"]*/ . "\"")
               | (/[A-Za-z0-9_.]+/ - reserved) )

(* View: eol
     Special eol using semicolons and/or newlines *)
let eol = del /[ \t]*((;\n?)|\n)/ ";\n"

(* View: block
     A block construct, using Build.block_generic
     in order to pass our special definition of <eol> *)
let block (kw:regexp) (entry:lens) =
   [ key kw
   . Sep.space . name
   . Build.block_generic  (* Use our definition of eol *)
        (Util.indent . entry . eol)
        (entry . eol) (Util.indent . entry) entry
        Util.comment Util.comment_noindent
        Build.block_ldelim_re /;?[ \t\n]*\}/ (* Allow semicol *)
        Build.block_ldelim_default Build.block_rdelim_default ]

(* View: variable_generic
     A generic way of parsing variables
     with or without double quotes *)
let variable_generic (reserved:regexp) =
   Build.key_value (Rx.word - reserved) Sep.space_equal name

(* View: variable *)
let variable =
   let reserved = "subgraph" | "node"
   in variable_generic reserved

(* View: options
     A list of options for <nodes> or <links> *)
let options =
      let reserved = "node" | "link_type"
   in let option = variable_generic reserved
   in let comma = del /,[ \t\n]*/ ","
   in Sep.space . del /\[[ \t]*/ "["
                . Build.opt_list option comma
                . del /[ \t]*\]/ "]"

(* View: link *)
let link =
      let link_node = [ label "node" . name ]
   in let link_type = [ label "link_type" . Sep.opt_space
                      . store /\<?\-\-?\>?/ . Sep.opt_space ]
   in [ label "link"
      . Build.list link_node link_type
      . options? ]

(* View: node *)
let node = [ label "node" . name . options? ]

(* View: nodelist
     Several <nodes> can be declared at once in a nodelist.
     This cannot be declared as simply a list of <nodes>,
     since it would be ambiguous in the put direction. *)
let nodelist = [ label "nodelist" . Build.list node Sep.space ]

(* View: default_node
     General settings for <nodes> *)
let default_node = [ Build.xchgs "node" "@node" . options ]

(* View: default_graph
     General settings for <graphs> *)
let default_graph = [ Build.xchgs "graph" "@graph" . options ]

(* View: entry
     A general entry *)
let entry = (link | variable | node | nodelist
           | default_node | default_graph)

(* View: subgraph
     Recursive *)
let rec subgraph = block "subgraph" (subgraph | entry)

(* View: graph
     The top-level graph *)
let graph = block /(di)?graph/ (subgraph | entry) . Util.eol

(* View: lns
     The graphviz lens *)
let lns = (Util.comment | Util.empty)* . graph


Logrotate: no functional change; remove tabs

(* Logrotate module for Augeas                *)
(* Author: Raphael Pinson <raphink@gmail.com> *)
(* Patches from:                              *)
(*   Sean Millichamp <sean@bruenor.org>       *)
(*                                            *)
(* Supported :                                *)
(*   - defaults                               *)
(*   - rules                                  *)
(*   - (pre|post)rotate entries               *)
(*                                            *)
(* Todo :                                     *)
(*                                            *)

module Logrotate =
   autoload xfm

   let sep_spc = Sep.space
   let sep_val = del /[ \t]*=[ \t]*|[ \t]+/ " "
   let eol = Util.eol
   let num = Rx.relinteger
   let word = /[^,#= \n\t{}]+/
   let filename = /\/[^,#= \n\t{}]+/
   let size = num . /[kMG]?/

   let indent = del Rx.opt_space "\t"

   (* define omments and empty lines *)
   let comment = Util.comment
   let empty   = Util.empty

   (* Useful functions *)

   let list_item = [ sep_spc . key /[^\/+,# \n\t{}]+/ ]
   let select_to_eol (kw:string) (select:regexp) = [ label kw . store select ]
   let value_to_eol (kw:string) (value:regexp)  = Build.key_value kw sep_val (store value)
   let flag_to_eol (kw:string) = Build.flag kw
   let list_to_eol (kw:string) = [ key kw . list_item+ ]

   (* Defaults *)

   let create =
     let mode = sep_spc . [ label "mode" . store num ] in
     let owner = sep_spc . [ label "owner" . store word ] in
     let group = sep_spc . [ label "group" . store word ] in
     [ key "create" .
         ( mode | mode . owner | mode . owner . group )? ]

   let su =
     let owner = sep_spc . [ label "owner" . store word ] in
     let group = sep_spc . [ label "group" . store word ] in
     [ key "su" .
         ( owner | owner . group )? ]

   let tabooext = [ key "tabooext" . ( sep_spc . store /\+/ )? . list_item+ ]

   let attrs = select_to_eol "schedule" /(daily|weekly|monthly|yearly)/
                | value_to_eol "rotate" num
        | create
        | flag_to_eol "nocreate"
        | su
        | value_to_eol "include" word
        | select_to_eol "missingok" /(no)?missingok/
        | select_to_eol "compress" /(no)?compress/
        | select_to_eol "delaycompress" /(no)?delaycompress/
        | select_to_eol "ifempty" /(not)?ifempty/
        | select_to_eol "sharedscripts" /(no)?sharedscripts/
        | value_to_eol "size" size
        | tabooext
        | value_to_eol "olddir" word
        | flag_to_eol "noolddir"
        | value_to_eol "mail" word
        | flag_to_eol "mailfirst"
        | flag_to_eol "maillast"
        | flag_to_eol "nomail"
        | value_to_eol "errors" word
        | value_to_eol "extension" word
        | select_to_eol "dateext" /(no)?dateext/
        | value_to_eol "dateformat" word
        | value_to_eol "compresscmd" word
        | value_to_eol "uncompresscmd" word
        | value_to_eol "compressext" word
        | list_to_eol "compressoptions"
        | select_to_eol "copy" /(no)?copy/
        | select_to_eol "copytruncate" /(no)?copytruncate/
        | value_to_eol "maxage" num
        | value_to_eol "minsize" size
        | select_to_eol "shred" /(no)?shred/
        | value_to_eol "shredcycles" num
        | value_to_eol "start" num

   (* Define hooks *)

   let hook_lines =
     let line_re = /.*/ - /[ \t]*endscript[ \t]*/ in
       store ( line_re . ("\n" . line_re)* )? . Util.del_str "\n"

   let hooks =
     let hook_names = /(pre|post)rotate|(first|last)action/ in
     [ key hook_names . eol .
       hook_lines? .
       del /[ \t]*endscript/ "\tendscript" ]

   (* Define rule *)

   let body = Build.block_newlines
                 (indent . (attrs | hooks) . eol)
                 Util.comment

   let rule =
     let filename_entry = [ label "file" . store filename ] in
     let filename_sep = del /[ \t\n]+/ " " in
     let filenames = Build.opt_list filename_entry filename_sep in
     [ label "rule" . Util.indent . filenames . body . eol ]

   let lns = ( comment | empty | (attrs . eol) | rule )*

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

   let xfm = transform lns filter


Multipath: updated for multipath-0.4.9-99.el7

(* Process /etc/multipath.conf                             *)
(* The lens is based on the multipath.conf(5) man page     *)
module Multipath =

autoload xfm

let comment = Util.comment
let empty = Util.empty
let dels = Util.del_str
let eol = Util.eol

let ws = del /[ \t]+/ " "
let indent = del /[ \t]*/ ""
(* We require that braces are always followed by a newline *)
let obr = del /\{([ \t]*)\n/ "{\n"
let cbr = del /[ \t]*}[ \t]*\n/ "}\n"

let ikey (k:regexp) = indent . key k

let section (n:regexp) (b:lens) =
  [ ikey n . ws . obr . (b|empty|comment)* . cbr ]

let kv (k:regexp) (v:regexp) =
  [ ikey k . ws . store v . eol ]

(* FIXME: it would be much more concise to write                       *)
(* [ key k . ws . (bare | quoted) ]                                    *)
(* but the typechecker trips over that                                 *)
let qstr (k:regexp) =
  let delq = del /['"]/ "\"" in
  let bare = del /["']?/ "" . store /[^"' \t\n]+/ . del /["']?/ "" in
  let quoted = delq . store /.*[ \t].*/ . delq in
  [ ikey k . ws . bare . eol ]
 |[ ikey k . ws . quoted . eol ]

let wwid = kv "wwid" (Rx.word|"*")

(* Settings that can be changed in various places *)
let common_setting =
   qstr "path_selector"
  |kv "path_grouping_policy" /failover|multibus|group_by_(serial|prio|node_name)/
  |kv "path_checker" /tur|emc_clariion|hp_sw|rdac|directio|rdb|readsector0/
  |kv "prio" /const|emc|alua|ontap|rdac|hp_sw|hds|random|weightedpath/
  |qstr "prio_args"
  |kv "failback" (Rx.integer | /immediate|manual|followover/)
  |kv "rr_weight" /priorities|uniform/
  |kv "flush_on_last_del" /yes|no/
  |kv "user_friendly_names" /yes|no/
  |kv "no_path_retry" (Rx.integer | /fail|queue/)
  |kv /rr_min_io(_q)?/ Rx.integer
  |qstr "features"
  |kv "reservation_key" Rx.word
  |kv "deferred_remove" /yes|no/
  |kv "delay_watch_checks" (Rx.integer | "no")
  |kv "delay_wait_checks" (Rx.integer | "no")
  |kv "skip_kpartx" /yes|no/
  (* Deprecated settings for backwards compatibility *)
  |qstr /(getuid|prio)_callout/
  (* Settings not documented in `man multipath.conf` *)
  |kv /rr_min_io_rq/ Rx.integer
  |kv "udev_dir" Rx.fspath
  |qstr "selector"
  |kv "async_timeout" Rx.integer
  |kv "pg_timeout" Rx.word
  |kv "h_on_last_deleassign_maps" /yes|no/
  |qstr "uid_attribute"
  |kv "hwtable_regex_match" /yes|no|on|off/
  |kv "reload_readwrite" /yes|no/

let default_setting =
   common_setting
  |kv "polling_interval" Rx.integer
  |kv "max_polling_interval" Rx.integer
  |kv "multipath_dir" Rx.fspath
  |kv "find_multipaths" /yes|no/
  |kv "verbosity" /[0-6]/
  |kv "reassign_maps" /yes|no/
  |kv "uid_attrribute" Rx.word
  |kv "max_fds" (Rx.integer|"max")
  |kv "checker_timeout" Rx.integer
  |kv "fast_io_fail_tmo" (Rx.integer|"off")
  |kv "dev_loss_tmo" (Rx.integer|"infinity")
  |kv "queue_without_daemon" /yes|no/
  |kv "bindings_file" Rx.fspath
  |kv "wwids_file" Rx.fspath
  |kv "log_checker_err" /once|always/
  |kv "retain_attached_hw_handler" /yes|no/
  |kv "detect_prio" /yes|no/
  |kv "hw_str_match" /yes|no/
  |kv "force_sync" /yes|no/
  |kv "config_dir" Rx.fspath
  |kv "missing_uev_wait_timeout" Rx.integer
  |kv "ignore_new_boot_devs" /yes|no/
  |kv "retrigger_tries" Rx.integer
  |kv "retrigger_delay" Rx.integer
  |kv "new_bindings_in_boot" /yes|no/

(* A device subsection *)
let device =
  let setting =
    qstr /vendor|product|product_blacklist|hardware_handler|alias_prefix/
   |default_setting in
  section "device" setting

(* The defaults section *)
let defaults =
  section "defaults" default_setting

(* The blacklist and blacklist_exceptions sections *)
let blacklist =
  let setting =
    wwid
   |qstr "devnode"
   |device in
  section /blacklist(_exceptions)?/ setting

(* A multipath subsection *)
let multipath =
  let setting =
    wwid
   |qstr "alias"
   |common_setting in
  section "multipath" setting

(* The multipaths section *)
let multipaths =
  section "multipaths" multipath

(* The devices section *)
let devices =
  section "devices" device

let lns = (comment|empty|defaults|blacklist|devices|multipaths)*

let xfm = transform lns (incl "/etc/multipath.conf" .
                         incl "/etc/multipath/conf.d/*.conf")

(* Process /etc/multipath.conf                             *)
(* The lens is based on the multipath.conf(5) man page     *)
module Multipath =

autoload xfm

let comment = Util.comment
let empty = Util.empty
let dels = Util.del_str
let eol = Util.eol

let ws = del /[ \t]+/ " "
let indent = del /[ \t]*/ ""
(* We require that braces are always followed by a newline *)
let obr = del /\{([ \t]*)\n/ "{\n"
let cbr = del /[ \t]*}[ \t]*\n/ "}\n"

let ikey (k:regexp) = indent . key k

let section (n:regexp) (b:lens) =
  [ ikey n . ws . obr . (b|empty|comment)* . cbr ]

let kv (k:regexp) (v:regexp) =
  [ ikey k . ws . store v . eol ]

(* FIXME: it would be much more concise to write                       *)
(* [ key k . ws . (bare | quoted) ]                                    *)
(* but the typechecker trips over that                                 *)
let qstr (k:regexp) =
  let delq = del /['"]/ "\"" in
  let bare = del /["']?/ "" . store /[^"' \t\n]+/ . del /["']?/ "" in
  let quoted = delq . store /.*[ \t].*/ . delq in
  [ ikey k . ws . bare . eol ]
 |[ ikey k . ws . quoted . eol ]

let wwid = kv "wwid" (Rx.word|"*")

(* Settings that can be changed in various places *)
let common_setting =
  kv "path_grouping_policy"
    /failover|multibus|group_by_(serial|prio|node_name)/
 |qstr /(getuid|prio)_callout/
 |qstr /path_(selector|checker)|features/
 |kv "failback" (Rx.integer | /immediate|manual/)
 |kv "rr_weight" /priorities|uniform/
 |kv "no_path_retry" (Rx.integer | /fail|queue/)
 |kv /rr_min_io(_rq)?/ Rx.integer
 |kv "flush_on_last_del" /yes|no/
 |kv "reservation_key" Rx.word
 |kv "delay_watch_checks" (Rx.integer|"no")
 |kv "delay_wait_checks" (Rx.integer|"no")

let default_setting =
  kv "polling_interval" Rx.integer
  |kv "udev_dir" Rx.fspath
  |qstr "selector"
  |kv "user_friendly_names" /yes|no/
  |kv "dev_loss_tmo" Rx.integer
  |kv "fast_io_fail_tmo" Rx.integer
  |kv "verbosity" /[0-6]/
  |kv "reassign_maps" /yes|no/
  |kv "prio" Rx.word
  |kv "max_fds" Rx.integer
  |kv "find_multipaths" /yes|no/
  |kv "checker_timeout" Rx.integer
  |kv "hwtable_regex_match" /yes|no/
  |kv "reload_readwrite" /yes|no/
  |kv "replace_wwid_whitespace" /yes|no/
  |kv "force_sync" /yes|no/
  |kv "config_dir" Rx.fspath
  (* SUSE extensions *)
  |kv "async_timeout" Rx.integer
  |kv "max_polling_interval" Rx.integer
  |kv "pg_timeout" Rx.word
  |kv "bindings_file" Rx.fspath
  |kv "multipath_dir" Rx.fspath
  |kv "alias_prefix" Rx.word
  |kv "queue_without_daemon" /yes|no/
  |kv "h_on_last_deleassign_maps" /yes|no/
  |qstr "prio_args"
  (* SUSE extensions SP3 *)
  |qstr "uid_attribute"
  |kv "wwids_file" Rx.fspath
  |kv "log_checker_err" Rx.word
  |kv "retain_attached_hw_handler" /yes|no/
  |kv "detect_prio" /yes|no/

(* A device subsection *)
let device =
  let setting =
    qstr /vendor|product|product_blacklist|hardware_handler/
   |common_setting
   |default_setting in
  section "device" setting

(* The defaults section *)
let defaults =
  let setting =
    common_setting
   |default_setting
  in section "defaults" setting

(* The blacklist and blacklist_exceptions sections *)
let blacklist =
  let setting =
    wwid
   |qstr "devnode"
   |device in
  section /blacklist(_exceptions)?/ setting

(* A multipath subsection *)
let multipath =
  let setting =
    wwid
   |qstr "alias"
   |common_setting in
  section "multipath" setting

(* The multipaths section *)
let multipaths =
  section "multipaths" multipath

(* The devices section *)
let devices =
  section "devices" device

let lns = (comment|empty|defaults|blacklist|devices|multipaths)*

let xfm = transform lns (incl "/etc/multipath.conf" .
                         incl "/etc/multipath/conf.d/*.conf")