[augeas-devel] Review of dhcpd lens
Francis Giraldeau
francis.giraldeau at usherbrooke.ca
Tue Jul 13 15:31:58 UTC 2010
Hi,
I send dhcpd.conf lens for review, since it's an early version. Feel
free to provide comments on it.
I tried to follow most of dhclient lens tree structure, both are almost
identical. There is a difference in handling new lines, because I wanted
to allow many statements ont the same line.
BTW, Util.empty creates an empty tree "{ }". We can't select it in the
XPath interface, and don't even know if we can create such node. In this
case, what is the real purpose of it?
Thanks and have a nice day,
Francis
-------------- next part --------------
(* BIND dhcp 3 server configuration module for Augeas
Author: Francis Giraldeau <francis.giraldeau at rlnx.com>
Reference: man dhcpd.conf
Follow dhclient module for tree structure
*)
module Dhcpd =
autoload xfm
(************************************************************************
* USEFUL PRIMITIVES
*************************************************************************)
let eol = Util.eol
let comment = Util.comment
let empty = Util.empty
let indent = Util.indent
let eos = comment?
(* Define separators *)
let sep_spc = del /[ \t]+/ " "
let sep_scl = del /[ \t]*;/ ";"
let sep_obr = del /[ \t]*\{/ " {"
let sep_cbr = del /[ \t]*\}([ \t]*\n)*/ " }\n"
let sep_com = del /[ \t\n]*,[ \t\n]*/ ","
let sep_slh = del "\/" "/"
let sep_col = del ":" ":"
let sep_eq = del /[ \t]*=[ \t]*/ "="
let scl = del ";" ";"
(* Define basic types *)
let word = /[A-Za-z0-9_.-]+(\[[0-9]+\])?/
let ip = Rx.ipv4
(* Define fields *)
(* TODO: there could be a " " in the middle of a value ... *)
let sto_to_spc = store /[^\\#,;\{\}" \t\n]+|"[^\\#"\n]+"/
let sto_to_scl = store /[^ \t;][^;\n=]+[^ \t;]|[^ \t;=]+/
let rfc_code = [ key "code" . sep_spc . store word ]
. sep_eq
. [ label "value" . sto_to_scl ]
let sto_number = store /[0-9][0-9]*/
(************************************************************************
* NO ARG STATEMENTS
*************************************************************************)
let stmt_noarg_re = "authoritative"
let stmt_noarg = [ indent
. key stmt_noarg_re
. sep_scl
. eos ]
(************************************************************************
* INT ARG STATEMENTS
*************************************************************************)
let stmt_integer_re = "default-lease-time"
| "max-lease-time"
| "min-lease-time"
| "lease limit"
let stmt_integer = [ indent
. key stmt_integer_re
. sep_spc
. sto_number
. sep_scl
. eos ]
(************************************************************************
* STRING ARG STATEMENTS
*************************************************************************)
let stmt_string_re = "ddns-update-style"
| "ddns-updates"
| "log-facility"
| "filename"
| "server-name"
| "fixed-address"
| "failover peer"
| "use-host-decl-names"
let stmt_string = [ indent
. key stmt_string_re
. sep_spc
. sto_to_spc
. sep_scl
. eos ]
(************************************************************************
* RANGE STATEMENTS
*************************************************************************)
let stmt_range = [ indent
. key "range"
. sep_spc
. [ label "flag" . store /dynamic-bootp/ . sep_spc ]?
. [ label "from" . store ip . sep_spc ]?
. [ label "to" . store ip ]
. sep_scl
. eos ]
(************************************************************************
* HARDWARE STATEMENTS
*************************************************************************)
let stmt_hardware = [ indent
. key "hardware"
. sep_spc
. [ label "type" . store /ethernet|tokenring/ ]
. sep_spc
. [ label "address" . store /[a-fA-F0-9:-]+/ ]
. sep_scl
. eos ]
(************************************************************************
* OPTION STATEMENTS
*************************************************************************)
(* We do not parse further the option's value, because custom format can
be defined at runtime *)
(* FIXME: handle multi value ---> remove "=" in sto_to_spc *)
let stmt_option_re = "option"
let stmt_option = [ indent
. key stmt_option_re
. sep_spc
(* . [ key word . sep_spc . (sto_to_scl|rfc_code) ] *)
. [ key word . sep_spc . (sto_to_scl|rfc_code) ]
. sep_scl
. eos ]
(************************************************************************
* ALLOW/DENY STATEMENTS
*************************************************************************)
(* We have to use special key for allow/deny members of
to avoid ambiguity in the put direction *)
let allow_deny_re = "unknown-clients"
| "dynamic bootp clients"
| "authenticated clients"
| "unauthenticated clients"
let stmt_secu_re = "allow"
| "deny"
let stmt_secu = [ indent
. key stmt_secu_re
. sep_spc
. store allow_deny_re
. sep_scl
. eos ]
| [ indent
. del /allow[ \t]+members[ \t]+of/ "allow members of"
. sep_spc
. label "allow-members-of"
. sto_to_spc
. sep_scl
. eos ]
| [ indent
. del /deny[ \t]+members[ \t]+of/ "deny members of"
. sep_spc
. label "deny-members-of"
. sto_to_spc
. sep_scl
. eos ]
(************************************************************************
* BLOCK STATEMENTS
*************************************************************************)
(* Blocks doesn't support comments at the end of the closing bracket *)
let stmt_entry = stmt_secu
| stmt_option
| stmt_hardware
| stmt_range
| stmt_string
| stmt_integer
| stmt_noarg
| empty
| comment
let stmt_block_noarg_re = "pool"
| "group"
let stmt_block_noarg (body:lens)
= [ indent
. key stmt_block_noarg_re
. sep_obr
. body*
. sep_cbr ]
let stmt_block_arg_re = "host"
| "class"
| "shared-network"
let stmt_block_arg (body:lens)
= [ indent
. key stmt_block_arg_re
. sep_spc
. sto_to_spc
. sep_obr
. body*
. sep_cbr ]
let stmt_block_subnet (body:lens)
= [ indent
. key "subnet"
. sep_spc
. [ label "network" . store ip ]
. sep_spc
. [ key "netmask" . sep_spc . store ip ]
. sep_obr
. body*
. sep_cbr ]
let all_block (body:lens) =
let lns1 = stmt_block_subnet body in
let lns2 = stmt_block_arg body in
let lns3 = stmt_block_noarg body in
(lns1 | lns2 | lns3 | stmt_entry)
let rec lns_staging = stmt_entry|all_block lns_staging
let lns = (lns_staging)*
let xfm = transform lns (incl "/etc/dhcp3/dhcpd.conf")
-------------- next part --------------
module Test_dhcpd =
let lns = Dhcpd.lns
let conf = "#
# Sample configuration file for ISC dhcpd for Debian
#
# Attention: If /etc/ltsp/dhcpd.conf exists, that will be used as
# configuration file instead of this file.
#
# $Id: dhcpd.conf,v 1.1.1.1 2002/05/21 00:07:44 peloy Exp $
#
# The ddns-updates-style parameter controls whether or not the server will
# attempt to do a DNS update when a lease is confirmed. We default to the
# behavior of the version 2 packages ('none', since DHCP v2 didn't
# have support for DDNS.)
ddns-update-style none;
# option definitions common to all supported networks...
option domain-name \"example.org\";
option domain-name-servers ns1.example.org, ns2.example.org;
default-lease-time 600;
max-lease-time 7200;
# If this DHCP server is the official DHCP server for the local
# network, the authoritative directive should be uncommented.
authoritative;
# Use this to send dhcp log messages to a different log file (you also
# have to hack syslog.conf to complete the redirection).
log-facility local7;
# No service will be given on this subnet, but declaring it helps the
# DHCP server to understand the network topology.
subnet 10.152.187.0 netmask 255.255.255.0 {
}
# This is a very basic subnet declaration.
subnet 10.254.239.0 netmask 255.255.255.224 {
range 10.254.239.10 10.254.239.20;
option routers rtr-239-0-1.example.org, rtr-239-0-2.example.org;
}
# This declaration allows BOOTP clients to get dynamic addresses,
# which we don't really recommend.
subnet 10.254.239.32 netmask 255.255.255.224 {
range dynamic-bootp 10.254.239.40 10.254.239.60;
option broadcast-address 10.254.239.31;
option routers rtr-239-32-1.example.org;
}
# A slightly different configuration for an internal subnet.
subnet 10.5.5.0 netmask 255.255.255.224 {
range 10.5.5.26 10.5.5.30;
option domain-name-servers ns1.internal.example.org;
option domain-name \"internal.example.org\";
option routers 10.5.5.1;
option broadcast-address 10.5.5.31;
default-lease-time 600;
max-lease-time 7200;
}
# Hosts which require special configuration options can be listed in
# host statements. If no address is specified, the address will be
# allocated dynamically (if possible), but the host-specific information
# will still come from the host declaration.
host passacaglia {
hardware ethernet 0:0:c0:5d:bd:95;
filename \"vmunix.passacaglia\";
server-name \"toccata.fugue.com\";
}
# Fixed IP addresses can also be specified for hosts. These addresses
# should not also be listed as being available for dynamic assignment.
# Hosts for which fixed IP addresses have been specified can boot using
# BOOTP or DHCP. Hosts for which no fixed address is specified can only
# be booted with DHCP, unless there is an address range on the subnet
# to which a BOOTP client is connected which has the dynamic-bootp flag
# set.
host fantasia {
hardware ethernet 08:00:07:26:c0:a5;
fixed-address fantasia.fugue.com;
}
# You can declare a class of clients and then do address allocation
# based on that. The example below shows a case where all clients
# in a certain class get addresses on the 10.17.224/24 subnet, and all
# other clients get addresses on the 10.0.29/24 subnet.
#class \"foo\" {
# match if substring (option vendor-class-identifier, 0, 4) = \"SUNW\";
#}
shared-network 224-29 {
subnet 10.17.224.0 netmask 255.255.255.0 {
option routers rtr-224.example.org;
}
subnet 10.0.29.0 netmask 255.255.255.0 {
option routers rtr-29.example.org;
}
pool {
allow members of \"foo\";
range 10.17.224.10 10.17.224.250;
}
pool {
deny members of \"foo\";
range 10.0.29.10 10.0.29.230;
}
}
"
test lns get "authoritative;" = { "authoritative" }
test lns get "ddns-update-style none;" = { "ddns-update-style" = "none" }
test lns get "option domain-name \"example.org\";" =
{ "option"
{ "domain-name" = "\"example.org\"" }
}
test lns get "option domain-name-servers ns1.example.org, ns2.example.org;" =
{ "option"
{ "domain-name-servers" = "ns1.example.org, ns2.example.org" }
}
test lns get "default-lease-time 600;" = { "default-lease-time" = "600" }
test lns get "range 10.254.239.60;" =
{ "range"
{ "to" = "10.254.239.60" }
}
test lns get "range dynamic-bootp 10.254.239.60;" =
{ "range"
{ "flag" = "dynamic-bootp" }
{ "to" = "10.254.239.60" }
}
test lns get "range dynamic-bootp 10.254.239.40 10.254.239.60;" =
{ "range"
{ "flag" = "dynamic-bootp" }
{ "from" = "10.254.239.40" }
{ "to" = "10.254.239.60" }
}
test lns get "subnet 10.152.187.0 netmask 255.255.255.0 {}\n" =
{ "subnet"
{ "network" = "10.152.187.0" }
{ "netmask" = "255.255.255.0" }
}
test lns get " pool {
pool {
}
}
" =
{ "pool"
{ }
{ "pool"
{ }
{ }
}
}
test lns get "group { host Sentier-Xerox-WC5655-1 {hardware ethernet 00:00:aa:cf:47:e2; fixed-address 10.106.64.20;}}" =
{ "group"
{ "host" = "Sentier-Xerox-WC5655-1"
{ "hardware"
{ "type" = "ethernet" }
{ "address" = "00:00:aa:cf:47:e2" }
}
{ "fixed-address" = "10.106.64.20" }
}
}
let _ = print_regexp(lens_ctype(Dhcpd.stmt_secu))
let _ = print_endline ""
(* FIXME: client shouldn't have to know if quotes are necessary *)
test Dhcpd.stmt_secu get "allow members of \"foo\";" = { "allow-members-of" = "\"foo\"" }
test lns get conf = ?
More information about the augeas-devel
mailing list