pf-tools/pf-tools: 36 new changesets
parmelan-guest at users.alioth.debian.org
parmelan-guest at users.alioth.debian.org
Tue Nov 16 15:32:25 UTC 2010
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/67075db38ac4
changeset: 992:67075db38ac4
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Fri Nov 12 14:35:31 2010 +0100
description:
new __get_route() function, to make __build_iface_entry() more readable
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/636aa558342e
changeset: 993:636aa558342e
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Fri Nov 12 14:50:07 2010 +0100
description:
new __get_host_real_ip() function, to make __build_iface_entry() more readable
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/89feccfd0b25
changeset: 994:89feccfd0b25
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Fri Nov 12 15:09:43 2010 +0100
description:
Style
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/ba0d2babfc95
changeset: 995:ba0d2babfc95
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Fri Nov 12 15:12:36 2010 +0100
description:
perltidy
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/685104667bc5
changeset: 996:685104667bc5
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Fri Nov 12 15:28:34 2010 +0100
description:
Get_kpkg_from_kernel is for internal use only: rename it to __get_kpkg_from_kernel and move it to the end of file. Also add some documentation.
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/c3920a9e6244
changeset: 997:c3920a9e6244
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Fri Nov 12 15:42:58 2010 +0100
description:
__build_preseed_filename()
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/4d4b9c84d869
changeset: 998:4d4b9c84d869
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Fri Nov 12 15:45:11 2010 +0100
description:
Get_MD5SUM_for_preseedfile -> __get_md5sum_for_preseed_file
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/9989b19936c4
changeset: 999:9989b19936c4
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Fri Nov 12 15:48:28 2010 +0100
description:
Style
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/4d843c5008dc
changeset: 1000:4d843c5008dc
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Fri Nov 12 15:50:02 2010 +0100
description:
documentation
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/cff38da011b1
changeset: 1001:cff38da011b1
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Fri Nov 12 15:52:39 2010 +0100
description:
move __Mk_zoneheader to the end of file, rename to __make_zone_header
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/0465d0d6fee5
changeset: 1002:0465d0d6fee5
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Fri Nov 12 16:42:25 2010 +0100
description:
One test for __make_zone_header
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/d7a51512c997
changeset: 1003:d7a51512c997
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sat Nov 13 01:17:05 2010 +0100
description:
More perlcritic-suggested fixes
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/736b3fa9a2ba
changeset: 1004:736b3fa9a2ba
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sat Nov 13 14:02:50 2010 +0100
description:
style and comments
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/67bc1a1c6fd1
changeset: 1005:67bc1a1c6fd1
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sat Nov 13 14:52:41 2010 +0100
description:
Style + new __move_if_needed() function
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/5f853f8eb162
changeset: 1006:5f853f8eb162
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sat Nov 13 15:32:30 2010 +0100
description:
more cleanup
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/e747a9068668
changeset: 1007:e747a9068668
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sat Nov 13 15:43:52 2010 +0100
description:
Change_kopt_for_hostname(): treat the file line-by-line instead of slurping the whole file in an array
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/79b7a4fb2360
changeset: 1008:79b7a4fb2360
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sat Nov 13 15:51:04 2010 +0100
description:
New __read_template_file() function
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/7e65089dbc07
changeset: 1009:7e65089dbc07
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sat Nov 13 16:00:32 2010 +0100
description:
more cleanup
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/3027864cf2d0
changeset: 1010:3027864cf2d0
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sat Nov 13 16:21:15 2010 +0100
description:
Rename __read_template_file() to __read_file_in_scalar() and add __read_file_in_array()
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/43595c5d2e50
changeset: 1011:43595c5d2e50
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sat Nov 13 16:53:55 2010 +0100
description:
More cleanup in PFTools::Utils
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/a191f0d33291
changeset: 1012:a191f0d33291
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sat Nov 13 17:50:31 2010 +0100
description:
More cleanup
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/d1f35033757f
changeset: 1013:d1f35033757f
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sat Nov 13 18:18:08 2010 +0100
description:
__write_scalar_to_filehandle()
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/6eb7b8df8349
changeset: 1014:6eb7b8df8349
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sat Nov 13 18:55:23 2010 +0100
description:
Style
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/47e2fc50b521
changeset: 1015:47e2fc50b521
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sun Nov 14 00:21:09 2010 +0100
description:
Style
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/576fbeb604b1
changeset: 1016:576fbeb604b1
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sun Nov 14 00:25:17 2010 +0100
description:
move all private functions to the end of the file
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/c0e0f77969cc
changeset: 1017:c0e0f77969cc
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sun Nov 14 00:29:22 2010 +0100
description:
Style
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/643094ed7ad8
changeset: 1018:643094ed7ad8
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sun Nov 14 00:37:26 2010 +0100
description:
Style
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/232b4c690e5e
changeset: 1019:232b4c690e5e
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sun Nov 14 12:11:28 2010 +0100
description:
New function: __write_array_to_filehandle()
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/3812ff1c972d
changeset: 1020:3812ff1c972d
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sun Nov 14 19:08:36 2010 +0100
description:
One more use of __read_file_in_array()/__write_array_to_filehandle()
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/0c67772da92b
changeset: 1021:0c67772da92b
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sun Nov 14 19:20:40 2010 +0100
description:
Use 'eq' instead of fixed-pattern regexps
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/86c08d452b7e
changeset: 1022:86c08d452b7e
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sun Nov 14 19:51:17 2010 +0100
description:
Sadly, IO::File does not implement filename() (but File::Temp does).
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/e55e7e6d5b3b
changeset: 1023:e55e7e6d5b3b
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Sun Nov 14 23:26:58 2010 +0100
description:
Style
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/d5292ff22598
changeset: 1024:d5292ff22598
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Mon Nov 15 19:15:53 2010 +0100
description:
Tests for __make_zone_header() and Mk_zone_for_site()
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/78bf77edc1ac
changeset: 1025:78bf77edc1ac
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Mon Nov 15 19:20:09 2010 +0100
description:
comments
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/f7e8cd525a13
changeset: 1026:f7e8cd525a13
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Mon Nov 15 19:26:28 2010 +0100
description:
comments
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/bfbe1ebd6136
changeset: 1027:bfbe1ebd6136
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Tue Nov 16 16:29:30 2010 +0100
description:
More tests and fixes
* Corrected a few error messages and updated the corresponding tests in t/
* get_zone_from_hostname() was not exported due to a typo
* resolve_hostname_from_global_config() was spitting a Perl warning
* Tests and documentation for Mk_resolvconf()
* Mk_resolvconf() now uses IPv4 and IPv6 addresses (if any)
* The test configuration was modified, update the tests accordingly
diffstat:
9 files changed, 174 insertions(+), 5 deletions(-)
lib/PFTools/Conf.pm | 2
lib/PFTools/Conf/Config.pm | 1
lib/PFTools/Conf/Network.pm | 2
lib/PFTools/Conf/Syntax.pm | 1
lib/PFTools/Net.pm | 2
lib/PFTools/Utils.pm | 2
t/13.conf.cfg1/config-export/MODEL/model-rdeploy | 2
t/20.zone.t | 159 ++++++++++++++++++++++
t/99.cleanup.t | 8 +
diffs (3515 lines):
diff -r e756fd4d6365 -r bfbe1ebd6136 lib/PFTools/Conf.pm
--- a/lib/PFTools/Conf.pm Fri Nov 12 13:36:18 2010 +0100
+++ b/lib/PFTools/Conf.pm Tue Nov 16 16:29:30 2010 +0100
@@ -615,14 +615,14 @@
croak q{ERROR: Invalid non-scalar $hostname};
}
if ( not $hostname ) {
- croak q{ERROR: Invalid empty or undefined $hostname};
+ croak q{ERROR: Invalid empty $hostname};
}
if ( ref $site ) {
croak q{ERROR: Invalid non-scalar $site};
}
if ( not $site ) {
- croak q{ERROR: Invalid empty or undefined $site};
+ croak q{ERROR: Invalid empty $site};
}
if ( ref $hash_subst ne 'HASH' ) {
diff -r e756fd4d6365 -r bfbe1ebd6136 lib/PFTools/Conf/Config.pm
--- a/lib/PFTools/Conf/Config.pm Fri Nov 12 13:36:18 2010 +0100
+++ b/lib/PFTools/Conf/Config.pm Tue Nov 16 16:29:30 2010 +0100
@@ -18,6 +18,8 @@
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA 02110-1301, USA
#
+
+# XXX This package is not currently used, but it might be in the future.
use strict;
use warnings;
diff -r e756fd4d6365 -r bfbe1ebd6136 lib/PFTools/Conf/Host.pm
--- a/lib/PFTools/Conf/Host.pm Fri Nov 12 13:36:18 2010 +0100
+++ b/lib/PFTools/Conf/Host.pm Tue Nov 16 16:29:30 2010 +0100
@@ -76,7 +76,7 @@
my ($start_file, $host_type, $host_ref,
$global_config, $pf_config
)
- = @$arguments_ref{
+ = @{$arguments_ref}{
qw( start_file host_type host_ref
global_config pf_config )
};
@@ -317,7 +317,7 @@
my ($start_file, $section_name, $section_ref,
$global_config, $pf_config
)
- = @$arguments_ref{
+ = @{$arguments_ref}{
qw( start_file section_name section_ref global_config pf_config )
};
@@ -563,7 +563,7 @@
my (
$ip_type, $subnet_ref, $ipstart, $hostnum, $hostnode, $nodes,
$site_name, $site_ref
- ) = @$arguments_ref{@argument_names};
+ ) = @{$arguments_ref}{@argument_names};
unless ( ref $subnet_ref eq 'NetAddr::IP' ) {
croak q{ERROR: Invalid $subnet_ref object};
@@ -663,11 +663,10 @@
return $result;
}
-=head2 __build_iface_entry ( FIXME )
+=head2 __build_iface_entry($arguments_ref)
This functions builds the configuration structure for a given host interface.
-
-Arguments:
+I<$arguments_ref> references a hash of named arguments:
=over
@@ -702,7 +701,7 @@
my ($iface_name, $hostname, $hostnum,
$hostnode, $host_ref, $iface_list_ref,
$site_name, $site_ref, $pf_config
- ) = @$arguments_ref{@argument_names};
+ ) = @{$arguments_ref}{@argument_names};
my $net_site_ref = $site_ref->{'NETWORK'}->{'BY_NAME'};
my $host_site_ref = $site_ref->{'HOST'};
@@ -712,15 +711,16 @@
my $host_number = $hostnum . ( $hostnode ? $hostnode : q{} );
# Check vlan
- my $vlan = $iface_section_ref->{"vlan.$host_number"}
+ my $vlan_name = $iface_section_ref->{"vlan.$host_number"}
|| $iface_section_ref->{'vlan'};
- unless ( $net_site_ref->{$vlan} ) {
+ my $vlan_ref = $net_site_ref->{$vlan_name};
+ unless ($vlan_ref) {
croak
- qq{ERROR: site $site_name host $hostname: unknown $vlan for $iface_name};
+ qq{ERROR: site $site_name host $hostname: unknown $vlan_name for $iface_name};
}
my $result = {
- 'vlan' => $vlan,
+ 'vlan' => $vlan_name,
};
# Iface option(s)
@@ -762,11 +762,11 @@
}xms;
if ($iface_tag
and $iface_tag =~ m{\A \d+ \z}xms
- and $iface_tag ne $net_site_ref->{$vlan}->{'tag'}
+ and $iface_tag ne $vlan_ref->{'tag'}
)
{
croak
- qq{ERROR: $iface_tag for $iface_section_name differs from $vlan def};
+ qq{ERROR: $iface_tag for $iface_section_name differs from $vlan_name def};
}
# Bondig "master interface"?
@@ -795,36 +795,22 @@
foreach my $ip_type (qw( ipv4 ipv6 )) {
next unless $pf_config->{'features'}->{$ip_type};
- my $netblock
- = get_netblock_from_vlan( $ip_type, $net_site_ref->{$vlan} );
- unless ($netblock) {
- croak
- qq{ERROR: host $hostname: unknown $ip_type subnet for $vlan};
- }
+ my $subnet_ref
+ = get_subnet_from_vlan( $ip_type, $vlan_ref );
- my $ip_type_dot_host_number = join q{.}, $ip_type, $host_number;
- my $ipstart = $iface_section_ref->{$ip_type_dot_host_number}
- || $iface_section_ref->{$ip_type};
- my $param_hostnum
- = $iface_section_ref->{$ip_type_dot_host_number} ? 0 : $hostnum;
- my $param_hostnode
- = $iface_section_ref->{$ip_type_dot_host_number} ? 0 : $hostnode;
- my $param_nodes
- = $iface_section_ref->{$ip_type_dot_host_number} ? 0 : $nodes;
-
- my $params_ref = {
- ip_type => $ip_type,
- subnet_ref => $netblock,
- ipstart => $ipstart,
- hostnum => $param_hostnum,
- hostnode => $param_hostnode,
- nodes => $param_nodes,
- site_name => $site_name,
- site_ref => $site_ref,
- };
-
- my $realip = __get_host_ip($params_ref);
- $result->{$ip_type} = $realip->cidr();
+ $result->{$ip_type} = __get_host_real_ip(
+ {
+ ip_type => $ip_type,
+ host_number => $host_number,
+ iface_section_ref => $iface_section_ref,
+ hostnum => $hostnum,
+ hostnode => $hostnode,
+ nodes => $nodes,
+ subnet_ref => $subnet_ref,
+ site_name => $site_name,
+ site_ref => $site_ref,
+ }
+ );
my $suffix = $ip_type eq 'ipv6' ? '6' : q{};
my $route_key = '@route' . $suffix;
@@ -838,48 +824,133 @@
}
foreach my $route (@route_list) {
- my ( $destination, $via ) = $route =~ m{
- \A
- (
- \S+ # $destination
- )
- \s*
- (?:
- via
- \s*
- (
- \S+ # $via
- )
- )?
- \z
- }xmso;
- next unless $destination;
+ my $new_route = __get_route(
+ {
+ route => $route,
+ net_site_ref => $net_site_ref,
+ hostname => $hostname,
+ vlan_name => $vlan_name,
+ gw_key => $gw_key,
+ subnet_ref => $subnet_ref,
+ }
+ );
- my $new_route
- = __build_route_destination(
- $destination, $net_site_ref,
- $hostname
- );
-
- if ($via) {
- my $gateway = __build_route_gateway(
- {
- via => $via,
- net_site_ref => $net_site_ref,
- hostname => $hostname,
- vlan => $vlan,
- gw_key => $gw_key,
- netblock => $netblock,
- }
- );
- $new_route .= qq{ via $gateway};
+ if ($new_route) {
+ push @{ $result->{$route_key} }, $new_route;
}
-
- push @{ $result->{$route_key} }, $new_route;
}
}
return $result;
+}
+
+sub __get_host_real_ip {
+ my ($arguments_ref) = @_;
+
+ my @argument_names = qw(
+ ip_type host_number iface_section_ref hostnum hostnode
+ nodes subnet_ref site_name site_ref
+ );
+ my ($ip_type, $host_number, $iface_section_ref, $hostnum, $hostnode,
+ $nodes, $subnet_ref, $site_name, $site_ref
+ ) = @{$arguments_ref}{@argument_names};
+
+ my $ip_type_dot_host_number = join q{.}, $ip_type, $host_number;
+ my $ipstart = $iface_section_ref->{$ip_type_dot_host_number}
+ || $iface_section_ref->{$ip_type};
+ my $param_hostnum
+ = $iface_section_ref->{$ip_type_dot_host_number} ? 0 : $hostnum;
+ my $param_hostnode
+ = $iface_section_ref->{$ip_type_dot_host_number} ? 0 : $hostnode;
+ my $param_nodes
+ = $iface_section_ref->{$ip_type_dot_host_number} ? 0 : $nodes;
+
+ my $params_ref = {
+ ip_type => $ip_type,
+ subnet_ref => $subnet_ref,
+ ipstart => $ipstart,
+ hostnum => $param_hostnum,
+ hostnode => $param_hostnode,
+ nodes => $param_nodes,
+ site_name => $site_name,
+ site_ref => $site_ref,
+ };
+
+ my $real_ip = __get_host_ip($params_ref);
+
+ return $real_ip->cidr();
+}
+
+=head2 __get_route($arguments_ref)
+
+This function builds the translated route string.
+Its named arguments are:
+
+=over
+
+=item I<route> the route as specified in the pf-tools configuration (eg:
+"default GATEWAY", or "vlan-whatever gw-whatever.vlan-whatever.private")
+
+=item I<net_site_ref> reference to the net_site part of the global
+configuration
+
+=item I<hostname> the hostname concerned by this route
+
+=item I<vlan_name> the vlan name to which the interface for which this route
+is constructed is connected. It is needed to compute the gateway when the
+route syntax "... GATEWAY" is used.
+
+=item I<gw_key> gateway or gateway6
+
+=item I<subnet_ref> a NetAddr::IP object representing the IP range associated
+to the I<vlan_name> vlan
+
+=cut
+
+sub __get_route {
+ my ($arguments_ref) = @_;
+
+ my @argument_names = qw(
+ route net_site_ref hostname vlan_name gw_key subnet_ref
+ );
+ my ( $route, $net_site_ref, $hostname, $vlan_name, $gw_key, $subnet_ref )
+ = @{$arguments_ref}{@argument_names};
+
+ my ( $destination, $via ) = $route =~ m{
+ \A
+ (
+ \S+ # $destination
+ )
+ \s*
+ (?:
+ via
+ \s*
+ (
+ \S+ # $via
+ )
+ )?
+ \z
+ }xmso;
+ return unless $destination;
+
+ my $new_route
+ = __build_route_destination( $destination, $net_site_ref, $hostname );
+
+ if ($via) {
+ my $gateway = __build_route_gateway(
+ {
+ via => $via,
+ net_site_ref => $net_site_ref,
+ hostname => $hostname,
+ vlan_name => $vlan_name,
+ gw_key => $gw_key,
+ subnet_ref => $subnet_ref,
+ }
+ );
+ $new_route .= qq{ via $gateway};
+ }
+
+ return $new_route;
}
=head2 __build_route_destination( $destination, $net_site_ref, $hostname )
@@ -923,10 +994,32 @@
return $ip_dest->cidr();
}
-=head2 __build_route_gateway( $via, $net_site_ref, $hostname, $vlan, $gw_key, $netblock )
+=head2 __build_route_gateway($arguments_ref)
This functions verifies the gateway I<$via> and possibly translates it to an
IP address.
+
+The named arguments are:
+
+=over
+
+=item I<via> the gateway name to translate
+
+=item I<net_site_ref> reference to the net_site part of the global
+configuration
+
+=item I<hostname> the hostname concerned by this route
+
+=item I<vlan_name> the vlan name to which the interface for which this route
+is constructed is connected. It is needed to compute the gateway when the
+route syntax "... GATEWAY" is used.
+
+=item I<gw_key> gateway or gateway6
+
+=item I<subnet_ref> a NetAddr::IP object representing the IP range associated
+to the I<vlan_name> vlan
+
+=back
=cut
@@ -934,16 +1027,16 @@
my ($arguments_ref) = @_;
my @argument_names = qw(
- via net_site_ref hostname vlan gw_key netblock
+ via net_site_ref hostname vlan_name gw_key subnet_ref
);
- my ( $via, $net_site_ref, $hostname, $vlan, $gw_key, $netblock )
- = @$arguments_ref{@argument_names};
+ my ( $via, $net_site_ref, $hostname, $vlan_name, $gw_key, $subnet_ref )
+ = @{$arguments_ref}{@argument_names};
# 'GATEWAY' means "the known gateway for this vlan"
if ( $via eq 'GATEWAY' ) {
- my $gateway = $net_site_ref->{$vlan}->{$gw_key};
+ my $gateway = $net_site_ref->{$vlan_name}->{$gw_key};
unless ($gateway) {
- croak qq{ERROR: Host $hostname: unknown gateway for $vlan};
+ croak qq{ERROR: Host $hostname: unknown gateway for $vlan_name};
}
return $gateway;
@@ -959,9 +1052,9 @@
unless ($ip_via) {
croak qq{ERROR: host $hostname: bad route gateway $via};
}
- unless ( $netblock->contains($ip_via) ) {
+ unless ( $subnet_ref->contains($ip_via) ) {
croak
- qq{ERROR: host $hostname: gateway $ip_via is not in $netblock->cidr()};
+ qq{ERROR: host $hostname: gateway $ip_via is not in $subnet_ref->cidr()};
}
return $ip_via->addr();
@@ -984,7 +1077,7 @@
my ($dhcp_part_ref, $dhcp_vlan, $resolver,
$hostname, $hostclass, $ip_type,
$vlan_def_ref, $iface_def_ref, $pxefilename
- ) = @$arguments_ref{@argument_names};
+ ) = @{$arguments_ref}{@argument_names};
my $ip_type_suffix = $ip_type eq 'ipv6' ? 6 : q{};
unless ( $dhcp_part_ref->{$dhcp_vlan} ) {
@@ -1028,7 +1121,7 @@
$zone_name, $shortname, $site, $global_config,
$index
)
- = @$arguments_ref{@argument_names};
+ = @{$arguments_ref}{@argument_names};
unless ($hostname) {
croak q{ERROR: $hostname is mandatory};
@@ -1205,7 +1298,7 @@
my ($last_hostnum, $last_hostnode, $host_part_ref,
$hostname_model, $prefix
)
- = @$arguments_ref{
+ = @{$arguments_ref}{
qw( last_hostnum last_hostnode host_part_ref hostname_model prefix )
};
diff -r e756fd4d6365 -r bfbe1ebd6136 lib/PFTools/Conf/Network.pm
--- a/lib/PFTools/Conf/Network.pm Fri Nov 12 13:36:18 2010 +0100
+++ b/lib/PFTools/Conf/Network.pm Tue Nov 16 16:29:30 2010 +0100
@@ -248,8 +248,9 @@
};
my $site_part = $global_config->{'SITE'};
- my $site_list = get_site_list_from_section( $section_ref, $global_config );
- my $net2add = {
+ my $site_list
+ = get_site_list_from_section( $section_ref, $global_config );
+ my $net2add = {
scope => $section_ref->{'scope'},
};
$net2add->{'comment'} = $section_ref->{'comment'}
@@ -270,25 +271,25 @@
= $ip_type eq 'ipv6'
? '6'
: q{}; # FIXME __get_suffix_from_ip_type ?
- my $net_block = get_netblock_from_vlan( $ip_type, $section_ref );
+ my $subnet_ref = get_subnet_from_vlan( $ip_type, $section_ref );
my $zone_key = qq{ZONE$suffix};
my $dhcp_key = qq{DHCP$suffix};
my $netaddr_key = qq{BY_ADDR$suffix};
my $gw_key = qq{gateway$suffix};
- $net2add->{"network$suffix"} = $net_block->addr();
- $net2add->{"netmask$suffix"} = $net_block->mask();
+ $net2add->{"network$suffix"} = $subnet_ref->addr();
+ $net2add->{"netmask$suffix"} = $subnet_ref->mask();
if ( my $gateway = $section_ref->{$gw_key} ) {
my $ip_gw = NetAddr::IP->new(
- $net_block->prefix() . $gateway,
- $net_block->mask()
+ $subnet_ref->prefix() . $gateway,
+ $subnet_ref->mask()
);
unless ($ip_gw) {
croak
qq{ERROR: Invalid $ip_type gateway $gateway in $section_name};
}
- unless ( $net_block->contains($ip_gw) ) {
- croak qq{ERROR: $ip_gw->addr() is not in $net_block->cidr()};
+ unless ( $subnet_ref->contains($ip_gw) ) {
+ croak qq{ERROR: $ip_gw->addr() is not in $subnet_ref->cidr()};
}
$net2add->{$gw_key} = $ip_gw->addr();
}
@@ -311,7 +312,8 @@
qq{ERROR: File $start_file section $section_name: duplicate tag $tag};
}
- my $network_name = $net_part->{'BY_ADDR'}->{ $net_block->cidr() };
+ my $network_name
+ = $net_part->{'BY_ADDR'}->{ $subnet_ref->cidr() };
if ( $network_name and $network_name ne $section_name ) {
croak
qq{ERROR: File $start_file section $section_name: subnet already in use as $network_name};
@@ -319,7 +321,8 @@
# Adding network to the network part of the global structure
$net_part->{'BY_NAME'}->{$section_name} = $net2add;
- $net_part->{$netaddr_key}->{ $net_block->cidr() } = $section_name;
+ $net_part->{$netaddr_key}->{ $subnet_ref->cidr() }
+ = $section_name;
if ($tag) {
$net_part->{'BY_TAG'}->{$tag} = $section_name;
}
@@ -333,10 +336,10 @@
# Adding IPv4 entries
# FIXME what about IPv6? (see $suffix above?)
- $zone_ref->{'network'} = qq{A\t} . $net_block->addr();
- $zone_ref->{'netmask'} = qq{A\t} . $net_block->mask();
+ $zone_ref->{'network'} = qq{A\t} . $subnet_ref->addr();
+ $zone_ref->{'netmask'} = qq{A\t} . $subnet_ref->mask();
- my $broadcast = $net_block->broadcast();
+ my $broadcast = $subnet_ref->broadcast();
$broadcast =~ s{ [/].* \z }{}xms; # remove /prefix
$zone_ref->{'broadcast'} = qq{A\t} . $broadcast;
@@ -350,8 +353,8 @@
my $dhcp_part = $global_config->{$dhcp_key}->{'BY_SITE'}->{$site}
->{$section_name};
if ($dhcp_part) {
- $dhcp_part->{'subnet'} = $net_block->addr();
- $dhcp_part->{'netmask'} = $net_block->mask();
+ $dhcp_part->{'subnet'} = $subnet_ref->addr();
+ $dhcp_part->{'netmask'} = $subnet_ref->mask();
if ( $net2add->{'gateway'} ) {
$dhcp_part->{'routers'} = $net2add->{'gateway'};
}
diff -r e756fd4d6365 -r bfbe1ebd6136 lib/PFTools/Conf/Syntax.pm
--- a/lib/PFTools/Conf/Syntax.pm Fri Nov 12 13:36:18 2010 +0100
+++ b/lib/PFTools/Conf/Syntax.pm Tue Nov 16 16:29:30 2010 +0100
@@ -333,6 +333,8 @@
croak qq{ERROR: Invalid section type $section_type};
}
+ my $definition = $DEF_SECTIONS->{$int_context}->{$section_type};
+
my ( $iface_type, $section_tmp );
if ( $context eq 'host' or $context eq 'model' ) {
unless (
@@ -356,12 +358,11 @@
{
croak qq{ERROR: Invalid section name $section_name in file $file};
}
- $iface_type = $+{iftype};
+ $iface_type = $LAST_PAREN_MATCH{'iftype'};
# Clean key names by removing .default or .%HOSTNUM% suffix
foreach my $key ( keys %{$section_hash} ) {
- my $new = $key;
- $new =~ s{ [.] .* \z }{}xms;
+ ( my $new = $key ) =~ s{ [.] .* \z }{}xms;
$section_tmp->{$new}->{'ORIG_NAME'} = $key;
$section_tmp->{$new}->{'VALUE'} = $section_hash->{$key};
}
@@ -369,7 +370,6 @@
else {
$section_tmp = $section_hash;
}
- my $definition = $DEF_SECTIONS->{$int_context}->{$section_type};
# Check mandatory keys
foreach my $key ( @{ $definition->{'MANDATORY_KEYS'} } ) {
diff -r e756fd4d6365 -r bfbe1ebd6136 lib/PFTools/Net.pm
--- a/lib/PFTools/Net.pm Fri Nov 12 13:36:18 2010 +0100
+++ b/lib/PFTools/Net.pm Tue Nov 16 16:29:30 2010 +0100
@@ -35,20 +35,20 @@
#use PFTools::Structqueries;
our @EXPORT = qw(
- get_netblock_from_vlan
+ get_subnet_from_vlan
resolve_hostname_from_dns
);
our @EXPORT_OK = qw();
-=head2 Get_netblock_from_vlan ( $type, $net_hash )
+=head2 get_subnet_from_vlan ( $type, $net_hash )
This function builds a NetAddr::IP object, in the same time permits the
control of IP values defined for a given network definition.
=cut
-sub get_netblock_from_vlan {
+sub get_subnet_from_vlan {
my ( $type, $net_hash ) = @_;
if ( ref $type ) {
@@ -61,23 +61,23 @@
my $suffix = $type eq 'ipv6' ? '6' : q{};
my $net_def = $net_hash->{"network$suffix"};
- my $block;
+ my $subnet_ref;
if ( $net_hash->{"network$suffix"} =~ m{ [/] [\d]+ }xms ) {
- $block = NetAddr::IP->new($net_def);
+ $subnet_ref = NetAddr::IP->new($net_def);
}
else {
my $netmask = $net_hash->{'netmask'};
unless ($netmask) {
croak q{ERROR: Unable to retrieve netmask};
}
- $block = NetAddr::IP->new( $net_def, $netmask );
+ $subnet_ref = NetAddr::IP->new( $net_def, $netmask );
}
- unless ($block) {
- croak qq{ERROR: Invalid netblock definition $net_def};
+ unless ($subnet_ref) {
+ croak qq{ERROR: Invalid subnet definition $net_def};
}
- return $block;
+ return $subnet_ref;
}
sub resolve_hostname_from_dns {
diff -r e756fd4d6365 -r bfbe1ebd6136 lib/PFTools/Structqueries.pm
--- a/lib/PFTools/Structqueries.pm Fri Nov 12 13:36:18 2010 +0100
+++ b/lib/PFTools/Structqueries.pm Tue Nov 16 16:29:30 2010 +0100
@@ -32,7 +32,7 @@
#use PFTools::Logger;
our @EXPORT = qw(
- Get_zone_from_hostname
+ get_zone_from_hostname
get_zone_from_site
get_hosttype_from_hostname
get_iface_vlan_from_hostname
@@ -97,14 +97,14 @@
my ( $hostname, $global_config, $site ) = @_;
if ( not $hostname ) {
- croak q{ERROR: Invalid empty or undefined $hostname};
+ croak q{ERROR: Invalid empty $hostname};
}
if ( ref $hostname ) {
croak q{ERROR: Invalid non-scalar $hostname};
}
if ( not $global_config ) {
- croak q{ERROR: Invalid empty or undefined $global_config};
+ croak q{ERROR: Invalid empty $global_config};
}
if ( ref $global_config ne 'HASH' ) {
croak q{ERROR: Invalid non-hashref $global_config};
@@ -131,8 +131,7 @@
}
}
- croak qq{ERROR: Unable to get hosttype from hostname $hostname on site }
- . ( $site ? $site : q{} );
+ croak qq{ERROR: Unknown hostname $hostname} . ( $site ? qq{ on site $site} : q{} );
}
=head2 get_iface_vlan_from_hostname( $vlan, $host_ref )
@@ -213,10 +212,10 @@
return $global_config->{'SITE'}->{'__site_list'};
}
- my @site_list = split m{ \s* [,] \s* }xms, $section_ref->{'site'};
+ my @site_list = split qr{ \s* [,] \s* }xms, $section_ref->{'site'};
# FIXME also permit '@site' notation ?
-# @site_list = ( @$section_ref->{'@site'}, split m{ \s* [,] \s* }xms, $section_ref->{'site'} );
+# @site_list = ( @$section_ref->{'@site'}, split qr{ \s* [,] \s* }xms, $section_ref->{'site'} );
return \@site_list;
}
@@ -265,6 +264,10 @@
my $host_config
= $site_part->{'HOST'}->{'BY_NAME'}->{$hosttype}->{$hostshort};
+ unless ($host_config) {
+ croak qq{ERROR: hostname $hostname: no configuration found};
+ }
+
return $host_config;
}
@@ -298,9 +301,6 @@
my ( $hostname, $global_config, $site_name ) = @_;
my $host_props = get_host_config( $hostname, $global_config, $site_name);
- unless ($host_props) {
- croak qq{ERROR: $hostname: no config found};
- }
my %pkgtype_for = (
debian => q{deb},
@@ -332,7 +332,7 @@
$bond_cmdline
= qq/bonding.mode=$host_ref->{'interfaces'}->{$iface}->{'mode'}/;
- foreach my $opt ( split m{ \s* [,] \s* }xms,
+ foreach my $opt ( split qr{ \s* [,] \s* }xms,
$host_ref->{'interfaces'}->{$iface}->{'options'} )
{
$bond_cmdline .= qq{ bonding.$opt};
@@ -409,7 +409,7 @@
my ($hostname, $ip_type, $global_config,
$site_name, $zone_name, $hosttype
)
- = @$arguments_ref{@argument_names};
+ = @{$arguments_ref}{@argument_names};
my ( $hostshort, $hostvlan )
= $hostname =~ m{
@@ -436,7 +436,7 @@
return;
}
- my ( $type, $field ) = split m{ \s+ }xms,
+ my ( $type, $field ) = split qr{ \s+ }xms,
$zone_part->{$hostvlan}->{$hostshort};
return [$field];
}
@@ -452,7 +452,8 @@
my @result = ();
LINE:
foreach my $line (@fields) {
- my ( $type, $field ) = split m{ \s+ }xms, $line;
+ next unless $line;
+ my ( $type, $field ) = split qr{ \s+ }xms, $line;
if ( $type eq 'A' ) {
push @result, $field;
next LINE;
diff -r e756fd4d6365 -r bfbe1ebd6136 lib/PFTools/Utils.pm
--- a/lib/PFTools/Utils.pm Fri Nov 12 13:36:18 2010 +0100
+++ b/lib/PFTools/Utils.pm Tue Nov 16 16:29:30 2010 +0100
@@ -1,4 +1,7 @@
package PFTools::Utils;
+
+# FIXME: tests and documentation for all functions (at least the public ones)
+
#
# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
#
@@ -26,6 +29,7 @@
use English qw( -no_match_vars ); # Avoids regex performance penalty
use File::Compare;
use File::Copy;
+use File::Temp;
use IO::File;
use Template::Tiny;
@@ -54,525 +58,962 @@
our @EXPORT_OK = qw();
-#########################################################################
-# Functions
+########################################################################
+# Exported functions
+# FIXME documentation + named arguments
sub Init_TOOLS {
my ( $hostname, $pf_config_file, $global_store_file, $reload ) = @_;
- my ( $pf_config, $global_struct );
- if ( $pf_config_file ) {
- $pf_config = Init_PF_CONFIG($pf_config_file);
- }
- elsif ( -e '/etc/pf-tools.conf' ) {
- $pf_config = Init_PF_CONFIG('/etc/pf-tools.conf');
- }
- else {
- $pf_config = Init_PF_CONFIG();
+ my $default_pf_config_file = q{/etc/pf-tools.conf};
+ if (not $pf_config_file and -e $default_pf_config_file) {
+ $pf_config_file = $default_pf_config_file;
}
- unless ( $global_store_file ) {
+ my $pf_config = Init_PF_CONFIG($pf_config_file);
+
+ unless ($global_store_file) {
$global_store_file = $pf_config->{'path'}->{'global_struct'};
}
- if ( !-e $global_store_file || $reload ) {
- my $source
- = Get_source( 'COMMON:/' . $pf_config->{'path'}->{'start_file'},
- $hostname, {}, $pf_config );
- if ( ! VCS_checkout( $hostname, $pf_config, {} ) ) {
+ unless ( -e $global_store_file ) {
+ $reload = 1;
+ }
+
+ my $global_struct;
+ if ($reload) {
+
+ # FIXME VCS_checkout should croak by itself
+ if ( !VCS_checkout( $hostname, $pf_config, {} ) ) {
croak q{ERROR: Unable to checkout configuration from VCS system"};
}
- $global_struct = Init_GLOBAL_NETCONFIG(
- $source, {}, $pf_config
- );
+
+ my $source
+ = Get_source( "COMMON:/$pf_config->{'path'}->{'start_file'}",
+ $hostname, {}, $pf_config );
+
+ $global_struct = Init_GLOBAL_NETCONFIG( $source, {}, $pf_config );
Flush2disk_GLOBAL( $global_struct, $pf_config );
}
else {
$global_struct = Retrieve_GLOBAL($global_store_file);
- if ( !defined $global_struct ) {
- croak qq{ERROR: while retrieving from $global_store_file};
- }
}
+
return ( $pf_config, $global_struct );
}
-sub Get_kpkg_from_kernel {
- my ( $pxefilename, $deploymode ) = @_;
-
- if ( $deploymode =~ m{\A ubuntu}xms ) {
- $pxefilename =~ m{vmlinuz-(.+) \z}xms;
- return "linux-image-" . $1;
- }
- else {
- if ( $pxefilename =~ m{pxe} ) {
- my ( $vm, $type, $pxe, $version, @append )
- = split( m{-}, $pxefilename );
- return
- "linux-image-"
- . $version . "-"
- . $type . "-"
- . join( "-", @append )
- . "-grsec";
- }
- else {
- my ( $vm, $version, $type, $append_version )
- = split( m{-}, $pxefilename );
- return
- "linux-image-"
- . $version . "-"
- . $type . "-"
- . $append_version
- . "-grsec";
- }
- }
-}
-
-sub Build_preseed_filename {
- my ($srv_name, $preseed_tpl, $host_props,
- $default_preseed, $pf_script, $pf_config
- ) = @_;
-
- my $preseed_hl = IO::File->new( $preseed_tpl );
- unless( $preseed_hl ) {
- carp qq{WARN: Unable to get preseed template from $preseed_tpl};
- return $default_preseed;
- }
- my $preseed_content = join '', <$preseed_hl>;
- $preseed_hl->close();
- my $kernel_pkg = Get_kpkg_from_kernel(
- $host_props->{'boot'}->{'kernel'},
- $host_props->{'deployment'}->{'mode'}
- );
- my $tpl = Template::Tiny->new( TRIM => 1 );
- my $preseed_subst = {
- 'kernelpkg' => $kernel_pkg,
- 'mode' => $host_props->{'deployment'}->{'mode'},
- 'distrib' => $host_props->{'deployment'}->{'distrib'},
- 'config_script' => $pf_script
- };
- $tpl->process( \$preseed_content, $preseed_subst, \$preseed_content );
- # FIXME with correct temporary filename handler
- my $src = "/tmp/tmp_preseed";
- my $tmp_hl = IO::File->new( ">" . $src );
- unless( $tmp_hl ) {
- carp qq{WARN: Unable to create preseed file $src};
- return $default_preseed;
- }
- $tmp_hl->print( $preseed_content );
- $tmp_hl->close();
-
- my $dst = $pf_config->{'path'}->{'preseed_dir'} . "/preseed_" . $srv_name;
- if ( compare( $src, $dst ) ) {
- move( $src, $dst );
- }
- else {
- if ( !unlink( $src ) ) {
- carp qq{WARN: Unable to unlink source file $src};
- }
- }
- return "preseed_" . $srv_name;
-}
-
-sub Get_MD5SUM_for_preseedfile {
- my ( $filename, $pf_config ) = @_;
- my ( $md5, $hdl );
-
- $md5 = Digest::MD5->new;
- $hdl = IO::File->new(
- $pf_config->{'path'}->{'preseed_dir'} . "/" . $filename
- );
- unless( $hdl ) {
- carp qq{ERROR: Unable to open preseed $filename};
- return;
- }
- $md5->addfile($hdl);
- my $md5sum = $md5->hexdigest;
- $hdl->close();
- return $md5sum;
-}
-
sub Mk_PXE_bootfile {
- my ( $hostname, $host_props, $pxe_tpl, $preseed_tpl, $default_preseed,
- $pf_script, $pf_config )
+ my ( $hostname, $host_ref, $pxe_template_filename, $preseed_template,
+ $default_preseed, $pf_script, $pf_config )
= @_;
my $iface = get_iface_vlan_from_hostname(
- $host_props->{'deployment'}->{'dhcpvlan'}, $host_props );
- my $mac = $host_props->{'interfaces'}->{$iface}->{'mac'};
- my $pxe_boot_file = $mac;
- $pxe_boot_file =~ s{:}{-}g;
+ $host_ref->{'deployment'}->{'dhcpvlan'}, $host_ref );
+ my $mac = $host_ref->{'interfaces'}->{$iface}->{'mac'};
+ ( my $pxe_boot_file = $mac ) =~ s{ [:] }{-}xmsg;
- if ( !-e $pxe_tpl ) {
- croak qq{ERROR: $pxe_tpl : no such file or directory};
- }
- my $pxetpl_hl = IO::File->new( $pxe_tpl );
- unless( $pxetpl_hl ) {
- croak qq{ERROR: Unable to open PXE template file $pxe_tpl};
- }
- my $content_pxe = join( "", <$pxetpl_hl> );
- $pxetpl_hl->close();
- my $preseed = Build_preseed_filename(
- $hostname, $preseed_tpl, $host_props,
- $default_preseed, $pf_script, $pf_config
+ my $pxe_template_content = __read_file_in_scalar($pxe_template_filename);
+
+ my $preseed_filename = __build_preseed_file(
+ {
+ hostname => $hostname,
+ host_ref => $host_ref,
+ preseed_template => $preseed_template,
+ default_preseed => $default_preseed, # FIXME unused
+ pf_script => $pf_script,
+ pf_config => $pf_config,
+ }
);
- my $preseed_md5 = Get_MD5SUM_for_preseedfile( $preseed, $pf_config );
- my $tpl = Template::Tiny->new( TRIM => 1 );
- my $cmdline = join q{ }, get_cmdline_from_host_ref($host_props);
- $cmdline =~ s{\A \s*}{}xms;
+
+ my $preseed_md5 = __get_md5sum_for_preseedfile( $preseed_filename, $pf_config );
+
+ my $cmdline = join q{ }, get_cmdline_from_host_ref($host_ref);
+ $cmdline =~ s{ \A \s* }{}xms; # Remove leading white space
+
my $pxe_subst = {
- 'iface' => $iface,
- 'mode' => $host_props->{'deployment'}->{'mode'} . '-installer',
- 'arch' => $host_props->{'deployment'}->{'arch'},
- 'distrib' => $host_props->{'deployment'}->{'distrib'},
- 'serial_speed' => '115200',
- 'preseed_url' => $preseed,
- 'preseed_md5' => $preseed_md5,
- 'console' => $host_props->{'boot'}->{'console'},
- 'install_cmdline' => $host_props->{'boot'}->{'cmdline'},
- 'cmdline' => $cmdline,
- 'kernel' => $host_props->{'boot'}->{'kernel'}
+ 'iface' => $iface,
+ 'mode' => $host_ref->{'deployment'}->{'mode'} . '-installer',
+ 'arch' => $host_ref->{'deployment'}->{'arch'},
+ 'distrib' => $host_ref->{'deployment'}->{'distrib'},
+ 'serial_speed' => '115200',
+ 'preseed_url' => $preseed_filename,
+ 'preseed_md5' => $preseed_md5,
+ 'console' => $host_ref->{'boot'}->{'console'},
+ 'install_cmdline' => $host_ref->{'boot'}->{'cmdline'},
+ 'cmdline' => $cmdline,
+ 'kernel' => $host_ref->{'boot'}->{'kernel'}
};
- if ( $host_props->{'boot'}->{'initrd'} ) {
- $pxe_subst->{'initrd'} = $host_props->{'boot'}->{'initrd'};
+
+ if ( $host_ref->{'boot'}->{'initrd'} ) {
+ $pxe_subst->{'initrd'} = $host_ref->{'boot'}->{'initrd'};
}
else {
- $content_pxe =~ s{initrd=(([^/]+/)+)?\[%\s*initrd\s*%\]}{}gs;
+ $pxe_template_content =~ s{
+ initrd=
+ (
+ (
+ [^/]+
+ [/]
+ )+
+ )?
+ \[% \s* initrd \s* %\]
+ }{}xmsg;
}
- $tpl->process( \$content_pxe, $pxe_subst, \$content_pxe );
- # FIXME with correct temporary filename handler
- my $src = "/tmp/tmp_pxe";
- my $dst_hl = IO::File->new ( ">" . $src );
- unless( $dst_hl ) {
- carp qq{ERROR :Unable to open temporary PXE file $src};
- return;
- }
- $dst_hl->print( $content_pxe );
- $dst_hl->close();
- my $dst = $pf_config->{'path'}->{'pxefiles_dir'} . "/" . $pxe_boot_file;
- if ( compare( $src, $dst ) ) {
- move( $src, $dst );
- }
- else {
- if ( !unlink( $src ) ) {
- carp qq{WARN: Unable to unlink source file $src};
- }
- }
+
+ my $tpl = Template::Tiny->new( TRIM => 1 );
+ my $pxe_content = q{};
+ $tpl->process( \$pxe_template_content, $pxe_subst, \$pxe_content );
+
+ my $tmp_fh = File::Temp->new( unlink => 0 );
+ my $tmp_fn = $tmp_fh->filename();
+ __write_scalar_to_filehandle($tmp_fh, $tmp_fn, $pxe_content);
+
+ my $dst = join q{/}, $pf_config->{'path'}->{'pxefiles_dir'}, $pxe_boot_file;
+ __move_if_different( $tmp_fn, $dst );
+
return $pxe_boot_file;
}
-###############################################################
-### Building zone file for IPv4 entries
+=head2 Mk_zone_for_site( $zone_name, $site_name, $global_config )
-sub __Mk_zoneheader {
- my ( $zone_name, $zone_site, $zone_part ) = @_;
- my $zone_result = [];
+This function creates the zone file content for the I<$zone_name> zone on site
+I<$site_name>. I<$global_config> references the global configuration hash. It
+returns a reference to the array of lines.
- # SOA
- push( @{$zone_result}, ";;" );
- push(
- @{$zone_result},
- ";; BIND configuration file for zone : " . $zone_name
- );
- push( @{$zone_result}, ";; Site : " . $zone_site );
- push( @{$zone_result}, ";;" );
- push( @{$zone_result}, ";; " . $zone_part->{'SOA'}->{'comment'} );
- push(
- @{$zone_result},
- ";;============================================================================\n"
- );
- push(
- @{$zone_result},
- sprintf( "\$TTL %s", $zone_part->{'SOA'}->{'ttl'} )
- );
- push(
- @{$zone_result},
- sprintf(
- "%-29s IN SOA\t%s %s (",
- '@', $zone_part->{'SOA'}->{'soa'},
- $zone_part->{'SOA'}->{'mail'}
- )
- );
- my $serial
- = ( $zone_part->{'SOA'}->{'serial'} eq 'AUTO' )
- ? time . "\t; Serial"
- : $zone_part->{'SOA'}->{'serial'};
- push( @{$zone_result}, sprintf( "%-30s%s", '', $serial ) );
+=cut
- foreach my $spec ( 'refresh', 'retry', 'expire', 'negttl' ) {
- push(
- @{$zone_result},
- sprintf( "%-30s%s", '', $zone_part->{'SOA'}->{$spec} )
- );
+sub Mk_zone_for_site {
+ my ( $zone_name, $site_name, $global_config ) = @_;
+
+ if ( not $zone_name ) {
+ croak q{ERROR: Invalid empty $zone_name};
}
- push( @{$zone_result}, sprintf "%-30s%s\n", '', ')' );
+ if ( ref $zone_name ) {
+ croak q{ERROR: Invalid non-scalar $zone_name};
+ }
- # NS fields
- foreach my $nameserver ( @{ $zone_part->{'SOA'}->{'@ns'} } ) {
- push( @{$zone_result},
- sprintf( "%-29s IN NS\t%s", '', $nameserver ) );
+ if ( not $site_name ) {
+ croak q{ERROR: Invalid empty $site_name};
}
- push( @{$zone_result}, "" );
+ if ( ref $site_name ) {
+ croak q{ERROR: Invalid non-scalar $site_name};
+ }
- # MX fields
- foreach my $mx ( @{ $zone_part->{'SOA'}->{'@mx'} } ) {
- push( @{$zone_result}, sprintf( "%-29s IN MX\t%s", '', $mx ) );
+ if ( not $global_config ) {
+ croak q{ERROR: Invalid empty $global_config};
}
- push( @{$zone_result}, "\n" );
+ if ( ref $global_config ne 'HASH' ) {
+ croak q{ERROR: Invalid non-hashref $global_config};
+ }
+
+ # This is not a complete check but it will catch obvious errors,
+ # like $global_config referencing a non-config hash
+ if ( not exists $global_config->{'ZONE'} ) {
+ croak q{ERROR: Invalid $global_config hashref: no 'ZONE' key found};
+ }
+
+ my $zone_ref = $global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name};
+ if ( not $zone_ref ) {
+ croak qq{ERROR: Unknown zone_name: $zone_name};
+ }
+
+ my $zone_part = $zone_ref->{'BY_SITE'}->{$site_name};
+ if ( not $zone_part ) {
+ croak qq{ERROR: Unknown site_name: $zone_name};
+ }
+
+ # Building Header (SOA, NS an MX fields)
+ my $zone_result = __make_zone_header( $zone_name, $site_name, $zone_ref );
+
+ ### Building Networks part
+ push @{$zone_result},
+ q{;;},
+ q{;; Networks},
+ q{;;============================================================================},
+ q{};
+
+ my $network_order_ref
+ = $global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name}
+ ->{'__network_order'}->{$site_name};
+ foreach my $network ( @{$network_order_ref} ) {
+ my $head = qq{; $network};
+ if ( $zone_part->{$network}->{'comment'} ) {
+ $head .= ": $zone_part->{$network}->{'comment'}";
+ }
+
+ push @{$zone_result},
+ $head,
+ q{;----------------------------------------------------------------------------};
+
+ foreach my $spec ( 'network', 'netmask', 'broadcast', 'gateway' ) {
+ my $value = $zone_part->{$network}->{$spec};
+ next unless defined $value;
+ push @{$zone_result},
+ sprintf( q{%-29s IN %s},
+ qq{$spec.$network}, $zone_part->{$network}->{$spec} );
+ }
+
+ push @{$zone_result}, q{};
+ }
+
+ ### Servers
+ push @{$zone_result},
+ q{},
+ q{},
+ q{;;},
+ q{;; Servers},
+ q{;;============================================================================},
+ q{};
+
+ my $hostclass_order_ref
+ = $global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name}
+ ->{'__hostclass_order'}->{$site_name};
+ foreach my $server ( @{$hostclass_order_ref} ) {
+ my $head = qq{; $server};
+
+ if ( $zone_part->{$server}->{'comment'} ) {
+ $head .= ": $zone_part->{$server}->{'comment'}";
+ }
+
+ push @{$zone_result},
+ $head,
+ q{;----------------------------------------------------------------------------};
+
+ foreach my $field ( sort keys %{ $zone_part->{$server} } ) {
+ next if $field eq 'comment';
+
+ if ( ref $zone_part->{$server}->{$field} eq 'ARRAY' ) {
+ foreach my $elt ( @{ $zone_part->{$server}->{$field} } ) {
+ push @{$zone_result},
+ sprintf( q{%-29s IN %s}, $field, $elt );
+ }
+ }
+ else {
+ push @{$zone_result},
+ sprintf( q{%-29s IN %s},
+ $field, $zone_part->{$server}->{$field} );
+ }
+ }
+
+ push @{$zone_result}, q{};
+ }
+
return $zone_result;
}
-sub Mk_zone_for_site ($$$) {
- my ( $zone_name, $zone_site, $global_config ) = @_;
- my $zone_result = [];
+=head2 Mk_resolvconf( $hostname, $global_config, $site_name, $filename );
- # Building Header (SOA, NS an MX fileds)
- $zone_result = __Mk_zoneheader( $zone_name, $zone_site,
- $global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name} );
- my $zone_part
- = $global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name}->{'BY_SITE'}
- ->{$zone_site};
+Writes the I<resolv.conf> configuration for I<$hostname> at I<$site_name> to
+I<$filename>. I<$global_config> is a reference to the global configuration
+hash.
- ### Building Networks part
- push( @{$zone_result}, ";;" );
- push( @{$zone_result}, ";; Networks" );
- push(
- @{$zone_result},
- ";;============================================================================\n"
+=cut
+
+sub Mk_resolvconf {
+ my ( $hostname, $global_config, $site_name, $filename ) = @_;
+
+ if ( not $hostname ) {
+ croak q{ERROR: Invalid empty $hostname};
+ }
+ if ( ref $hostname ) {
+ croak q{ERROR: Invalid non-scalar $hostname};
+ }
+
+ if ( not $global_config ) {
+ croak q{ERROR: Invalid empty $global_config};
+ }
+ if ( ref $global_config ne 'HASH' ) {
+ croak q{ERROR: Invalid non-hashref $global_config};
+ }
+
+ # This is not a complete check but it will catch obvious errors,
+ # like $global_config referencing a non-config hash
+ if ( not exists $global_config->{'ZONE'} ) {
+ croak q{ERROR: Invalid $global_config hashref: no 'ZONE' key found};
+ }
+
+ if ( not $site_name ) {
+ croak q{ERROR: Invalid empty $site_name};
+ }
+ if ( ref $site_name ) {
+ croak q{ERROR: Invalid non-scalar $site_name};
+ }
+
+ if ( not $filename ) {
+ croak q{ERROR: Invalid empty $filename};
+ }
+ if ( ref $filename ) {
+ croak q{ERROR: Invalid non-scalar $filename};
+ }
+
+ my $host_props = get_host_config( $hostname, $global_config, $site_name );
+ my $domain = get_zone_from_hostname( $hostname, $global_config, $site_name );
+
+ my @dns = split qr{ \s* [,] \s* }xms, $host_props->{'dns'}->{'resolver'};
+
+ my $out_fh = IO::File->new( $filename, q{>} );
+ unless ($out_fh) {
+ croak qq{ERROR: open $filename: $OS_ERROR};
+ }
+
+ my @lines = (
+ q{###############################################},
+ q{# This file was auto-genrated by mk_resolvconf},
+ q{},
+ qq{search $domain},
+ q{},
);
- foreach my $network (
- @{ $global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name}
- ->{'__network_order'}->{$zone_site}
+ foreach my $ip_type ( qw( ipv4 ipv6 ) ) {
+ foreach my $dns (@dns) {
+ my $resolved = Resolv( q{cnf}, $ip_type, $dns, $global_config, $site_name );
+ foreach my $ip ( @{$resolved} ) {
+ push @lines, qq{nameserver $ip};
+ }
}
- )
- {
- my $head = $network;
- $head .= " : " . $zone_part->{$network}->{'comment'}
- if ( $zone_part->{$network}->{'comment'} );
- push( @{$zone_result}, "; " . $head );
- push(
- @{$zone_result},
- ";----------------------------------------------------------------------------"
- );
- foreach my $spec ( 'network', 'netmask', 'broadcast', 'gateway' ) {
- next if ( !defined $zone_part->{$network}->{$spec} );
- push(
- @{$zone_result},
- sprintf( "%-29s IN %s",
- $spec . "." . $network,
- $zone_part->{$network}->{$spec} )
- );
- }
- push( @{$zone_result}, "" );
}
- ### Servers
- push( @{$zone_result}, "\n\n;;" );
- push( @{$zone_result}, ";; Servers" );
- push(
- @{$zone_result},
- ";;============================================================================\n"
- );
+ __write_array_to_filehandle( $out_fh, $filename, \@lines, qq{\n} );
- foreach my $server (
- @{ $global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name}
- ->{'__hostclass_order'}->{$zone_site}
- }
- )
- {
- my $head = $server;
- $head .= " : " . $zone_part->{$server}->{'comment'}
- if ( $zone_part->{$server}->{'comment'} );
- push( @{$zone_result}, "; " . $head );
- push(
- @{$zone_result},
- ";----------------------------------------------------------------------------"
- );
- foreach my $field ( sort keys %{ $zone_part->{$server} } ) {
- next if ( $field eq 'comment' );
- if ( ref $zone_part->{$server}->{$field} eq 'ARRAY' ) {
- foreach my $elt ( @{ $zone_part->{$server}->{$field} } ) {
- push(
- @{$zone_result},
- sprintf( "%-29s IN %s", $field, $elt )
- );
- }
- }
- else {
- push(
- @{$zone_result},
- sprintf( "%-29s IN %s",
- $field, $zone_part->{$server}->{$field} )
- );
- }
- }
- push( @{$zone_result}, "" );
- }
- return $zone_result;
-}
-
-sub Mk_resolvconf {
- my ( $hostname, $global_config, $site, $output ) = @_;
-
- my $host_props = get_host_config( $hostname, $global_config, $site );
- unless( $host_props ) {
- carp qq{ERROR: Unknown hostname $hostname on site $site};
- return;
- }
- my $domain = get_zone_from_hostname( $hostname, $global_config, $site );
-
- my @dns = split( m{\s*,\s*}, $host_props->{'dns'}->{'resolver'} );
-
- my $out_hl = IO::File->new( ">" . $output );
- unless( $out_hl ) {
- carp qq{ERROR: Unable to open output file $output};
- return;
- }
- my @header = (
- "###############################################",
- "# This file was auto-genrated by mk_resolvconf",
- "",
- "search " . $domain,
- "",
- );
- $out_hl->print( join( "\n", @header ) );
- foreach my $dns (@dns) {
- my $resolved = Resolv( 'cnf', $dns, $global_config, $site );
- foreach my $ip ( @{$resolved} ) {
- $out_hl->print( "nameserver " . $ip . "\n" );
- }
- }
- $out_hl->close();
return 1;
}
sub Resolv {
- my ( $type_resolve, $ip_type, $hostname, $global_config, $site, $hosttype ) = @_;
+ my ( $type_resolve, $ip_type, $hostname, $global_config, $site_name,
+ $hosttype )
+ = @_;
- unless( $ip_type =~ m{\A ipv(4|6) \z}xms ) {
- carp qq{ERROR: Invalid ip_type $ip_type};
+ if ( $ip_type ne q{ipv4} and $ip_type ne q{ipv6} ) {
+ croak qq{ERROR: Invalid ip_type $ip_type};
+ }
+
+ if ( $type_resolve ne q{cnf} and $type_resolve ne q{dns} ) {
+ croak qq{ERROR: Invalid type_resolve $type_resolve};
+ }
+
+ unless ($hostname) {
+ croak q{ERROR: $hostname is mandatory};
+ }
+
+ if ( $type_resolve eq q{dns} ) {
+ return resolve_hostname_from_dns($hostname);
+ }
+
+ # $type_resolve eq q{cnf}
+ $site_name ||= get_uniq_site_from_hostname( $hostname, $global_config );
+ my $zone = get_zone_from_hostname( $hostname, $global_config, $site_name );
+ $hostname =~ s{ [.] $zone \z}{}xms;
+
+ # FIXME this regexp is also used in
+ # PFTools::Structqueries::resolve_hostname_from_global_config()
+ my ( $hostshort, $hostvlan ) = $hostname =~ m{
+ \A
+ ( # $hostshort
+ [^.]+
+ )
+ (?:
+ [.]
+ ( # $hostvlan
+ [^.]+
+ )
+ )?
+ \z
+ }xms;
+
+ if ( not defined $hosttype
+ and $hostshort
+ !~ m{\A (network|netmask|broadcast|gateway|prefix)}xms )
+ {
+ $hosttype
+ = get_hosttype_from_hostname( $hostshort, $global_config,
+ $site_name );
+ }
+ elsif ( $hostshort eq q{prefix} ) {
+ my $vlan_def = get_vlan_config( $hostvlan, $global_config, $site_name );
+ my $subnet_ref = get_subnet_from_vlan( $ip_type, $vlan_def );
+ my $prefix = $subnet_ref->masklen();
+
+ return [$prefix];
+ }
+
+ return resolve_hostname_from_global_config(
+ {
+ hostname => $hostname,
+ ip_type => $ip_type,
+ global_config => $global_config,
+ site_name => $site_name,
+ zone_name => $zone,
+ hosttype => $hosttype,
+ }
+ );
+}
+
+sub Search_and_replace {
+ my ($hostname, $site_name, $input_file, $type_replace, $pf_config, $separator,
+ $global_config, $type_resolve, $ip_type
+ )
+ = @_;
+
+ if ( $type_resolve && $type_resolve eq 'cnf' && !defined $global_config )
+ {
+ carp q{ERROR: Unable to resolve from configuration};
return;
}
- unless( $type_resolve =~ m{\A (cnf|dns) \z}xms ) {
- carp qq{ERROR: Invalid type_resolv $type_resolve};
- return;
+ my $hosttype
+ = get_hosttype_from_hostname( $hostname, $global_config, $site_name );
+ my $subst = Init_SUBST( $hostname, $hosttype, $pf_config );
+ my $host_props = get_host_config( $hostname, $global_config, $site_name );
+
+ my $src = __read_file_in_array( $input_file, 0 );
+
+ my @result = ();
+ foreach my $line ( @{$src} ) {
+ if ( $type_replace eq 'resolver' ) {
+ $line
+ = __search_and_resolve_ip( $hostname, $ip_type, $site_name, $line,
+ $separator, $type_resolve, $subst, $global_config );
+ }
+ elsif ( $type_replace eq 'iface' ) {
+ $line = __search_and_resolve_iface( $line, $host_props, $subst );
+ }
+ elsif ( $type_replace eq 'distrib' ) {
+ $line
+ =~ s{ %DISTSRC% }{$host_props->{'deployment'}->{'mode'}}xmsg;
+ $line
+ =~ s{ %DISTRIB% }{$host_props->{'deployment'}->{'distrib'}}xmsg;
+ }
+
+ push @result, $line;
}
- unless( $hostname ) {
- carp q{ERROR: $hostname MUST BE specified};
- return;
+
+ return \@result;
+}
+
+sub Fix_hosts {
+ my ( $hostname, $input_file, $site_name, $ip_type, $global_config, $pf_config )
+ = @_;
+
+ if ( $ip_type ne q{ipv4} ) {
+ croak qq{ERROR: $ip_type is not implemented for fixing $input_file};
}
- if ( $type_resolve eq 'cnf' ) {
- $site ||= get_uniq_site_from_hostname( $hostname, $global_config );
- my $zone = get_zone_from_hostname( $hostname, $global_config, $site );
- $hostname =~ s{\.$zone \z}{}xms;
- $hostname =~ m{\A ([^.]+)(\.([^.]+))? \z}xms;
- my ( $hostshort, $hostvlan ) = ( $1, $3 );
- if (!defined $hosttype
- && $hostshort
- !~ m{\A (network|netmask|broadcast|gateway|prefix)}xms
+
+ my $host_ref = get_host_config( $hostname, $global_config, $site_name );
+ my $dhcp_iface = get_iface_vlan_from_hostname(
+ $host_ref->{'deployment'}->{'dhcpvlan'}, $host_ref );
+
+ ( my $ip_deploy = $host_ref->{'interfaces'}->{$dhcp_iface}->{'ipv4'} )
+ =~ s{ [/] [\d]+ \z }{}xms; # remove CIDR prefix size
+
+ my $tmp_hosts = __read_file_in_array( $input_file, 0 );
+
+ foreach my $line ( @{$tmp_hosts} ) {
+ next unless $line =~ m{ $hostname }xms;
+ $line =~ s{ \A 127 [.] 0 [.] [\d]{1,3} [.] [\d]{1,3} }{$ip_deploy}xms;
+ }
+
+ return $tmp_hosts;
+}
+
+sub Mk_dhcp {
+ my ( $header_file, $site_part ) = @_;
+ my @dhcp_hosts = ();
+
+ my $dhcp_headers = $header_file ? __read_file_in_array($header_file, 1) : [];
+
+ my @dhcp_subnets = ();
+ foreach my $vlan ( keys %{$site_part} ) {
+ push @dhcp_subnets,
+ "subnet $site_part->{$vlan}->{'subnet'} netmask $site_part->{$vlan}->{'netmask'} {\n}\n";
+
+ foreach my $hostclass ( keys %{ $site_part->{$vlan} } ) {
+ next
+ if $hostclass eq q{subnet}
+ or $hostclass eq q{netmask}
+ or $hostclass eq q{routers};
+
+ my $host_part = $site_part->{$vlan}->{$hostclass};
+ foreach my $host ( keys %{$host_part} ) {
+ push @dhcp_hosts, "host $host {";
+
+ foreach my $def ( @{ $host_part->{$host} } ) {
+ push @dhcp_hosts, "\t$def";
+ }
+
+ push @dhcp_hosts, "}", q{};
+ }
+ }
+ }
+
+ return [ @{$dhcp_headers}, @dhcp_subnets, @dhcp_hosts ];
+}
+
+sub Mk_sourceslist {
+ my ($hostname, $site_name, $dst, $sections, $template, $backports,
+ $global_config, $pf_config
+ )
+ = @_;
+
+ my $host_ref = get_host_config( $hostname, $global_config, $site_name );
+ my $mode = $host_ref->{'deployment'}->{'mode'};
+
+ $template ||= join q{/}, $pf_config->{'path'}->{'templates_dir'},
+ $pf_config->{$mode}->{'sources_list'};
+
+ my $tpl = Template::Tiny->new( TRIM => 1 );
+ my $sources_template = __read_file_in_scalar($template);
+ my $sources_subst = {
+ 'mode' => $host_ref->{'deployment'}->{'mode'},
+ 'distrib' => $host_ref->{'deployment'}->{'distrib'},
+ 'default_sections' => $pf_config->{$mode}->{'default_sections'},
+ 'custom_sections' => $sections
+ };
+ my $sources_content = q{};
+ $tpl->process( \$sources_template, $sources_subst, \$sources_content );
+
+ if ($backports) {
+ my $back_src = $mode eq 'debian' ? $mode . "-backports" : $mode;
+ $sources_content .= <<"BACKPORTS_TEXT";
+
+deb http://mirrors.private/$back_src $host_ref->{'deployment'}->{'distrib'}-backports $pf_config->{$mode}->{'default_sections'}
+
+BACKPORTS_TEXT
+ }
+
+ $sources_content .= qq{\n};
+
+ my $dst_fh = IO::File->new( $dst, q{>} );
+ unless ($dst_fh) {
+ croak qq{ERROR: open $dst: $OS_ERROR};
+ }
+
+ __write_scalar_to_filehandle($dst_fh, $dst, $sources_content);
+
+ return 1;
+}
+
+sub Change_kopt_for_hostname {
+ my ($hostname, $site_name, $grub_src, $dst, $grub_version, $global_config,
+ $pf_config
+ )
+ = @_;
+
+ my $host_ref = get_host_config( $hostname, $global_config, $site_name );
+ my $mode = $host_ref->{'deployment'}->{'mode'};
+
+ my $cmdline = join q{ }, get_cmdline_from_host_ref($host_ref);
+ $cmdline =~ s{ \A \s* }{}xms; # Remove leading white space
+
+ my $grub_key = $grub_version == 1 ? q{} : $grub_version;
+ $grub_src ||= $pf_config->{$mode}->{"grub$grub_key"};
+
+ my $lines_ref = __read_file_in_array( $grub_src, 1 );
+
+ foreach my $line ( @{$lines_ref} ) {
+ if ( $grub_version == 1
+ and $line =~ m{ \A [#] kopt=.* \z }xms
+ or $grub_version == 2
+ and $line =~ m{ \A GRUB_CMDLINE_LINUX_DEFAULT=".*" \z }xms
)
{
- $hosttype
- = get_hosttype_from_hostname( $hostshort, $global_config,
- $site );
+
+ if ( $cmdline and $line !~ m{ \Q $cmdline \E ["] \z }xms ) {
+ $line =~ s{ ["] \z }{ $cmdline" }xms
+ ; # FIXME really want to add a " if $grub_version == 1 ??
+ }
}
- elsif( $hostshort =~ m{\A prefix \z}xms ) {
- my $vlan_def
- = get_vlan_config( $hostvlan, $global_config, $site );
- my $netblock = get_netblock_from_vlan( $ip_type, $vlan_def );
- my $prefix = $netblock->cidr();
- $prefix =~ s{\A [^/]+\/([\d]+) \z}{$1}xms;
- return [ $prefix ];
+ }
+
+ # Either STDOUT or a tempfile...
+ my ($dst_fh, $dst_fn);
+ if ( $dst eq q{-} ) {
+ $dst_fh = IO::File->new();
+ unless ( $dst_fh->fdopen( fileno(STDOUT), q{>} ) ) {
+ croak qq{ERROR: fdopen STDOUT: $OS_ERROR};
}
- return resolve_hostname_from_global_config(
- {
- hostname => $hostname,
- ip_type => $ip_type,
- global_config => $global_config,
- site_name => $site,
- zone_name => $zone,
- hosttype => $hosttype,
- }
- );
+ $dst_fn = $dst;
}
else {
- return resolve_hostname_from_dns( $hostname );
+ $dst_fh = File::Temp->new( unlink => 0 ); # will croak() on error
+ $dst_fn = $dst_fh->filename();
}
+
+ __write_array_to_filehandle( $dst_fh, $dst_fn, $lines_ref, qq{\n} );
+
+ if ( $dst ne q{-} ) {
+ __move_if_different( $dst_fn, $dst );
+ }
+
+ return 1;
}
-sub __Search_and_resolve_IP {
- my ( $hostname, $ip_type, $site, $line, $separator, $type_resolve, $hash_subst,
- $global_config )
+#
+# VOID Mk_interfaces (STRING $host, STRING $fic_iface, HASHREF $Z)
+#
+# Construit le fichier de declaration d'interfaces $fic_iface pour la
+# machine $host a partir des informations contenues dans la structure $Z
+#
+#======================================================================================
+sub Mk_interfaces {
+ my ( $hostname, $global_config, $pf_config, $site_name ) = @_;
+
+ my $resolve = 0;
+ my $host_ref = get_host_config( $hostname, $global_config, $site_name );
+ my $interfaces = {};
+ my $routes = {};
+
+ foreach my $iface ( 'lo', sort keys %{ $host_ref->{'interfaces'} } ) {
+ push @{ $interfaces->{'__order'} }, $iface;
+
+ my $if_part = $host_ref->{'interfaces'}->{$iface};
+ my $if_method
+ = $if_part->{'method'}
+ ? $if_part->{'method'}
+ : $iface eq 'lo' ? q{loopback}
+ : q{static};
+ push @{ $interfaces->{$iface} },
+ qq{auto $iface},
+ qq{iface $iface inet $if_method};
+
+ if (( $if_part->{'method'} and $if_part->{'method'} eq 'dhcp' )
+ or $iface eq 'lo'
+ )
+ {
+ next;
+ }
+
+ foreach my $ip_type ( 'ipv4', 'ipv6' ) {
+ next if not $pf_config->{'features'}->{$ip_type};
+
+ my $ip = NetAddr::IP->new( $if_part->{$ip_type} );
+ if ( $if_part->{'slaves'} ) {
+ push @{ $interfaces->{$iface} },
+ qq{\tslaves\t\t} . $if_part->{'slaves'};
+ }
+ push @{ $interfaces->{$iface} },
+ qq{\taddress\t\t} . $ip->addr(),
+ qq{\tnetmask\t\t} . $ip->mask(),
+ qq{\tnetwork\t\t} . $ip->network()->addr(),
+ qq{\tbroadcast\t} . $ip->broadcast()->addr();
+
+ # Routes
+ my $suffix = $ip_type eq 'ipv6' ? '6' : q{};
+ foreach my $route ( @{ $if_part->{ '@route' . $suffix } } ) {
+ if ( $route =~ m{ \A (\S+) \s* (?: via (?: \S+ ) )? \z }xms )
+ {
+ my $destination = $1;
+ push @{ $routes->{$destination} }, qq{$iface $route};
+ }
+ }
+
+ # 802.1Q VLAN ID
+ if ( $iface =~ m{ \A ([^.]+) [.] \d+ \z }xms ) {
+ my $raw_device = $1;
+ push @{ $interfaces->{$iface} },
+ qq{\tvlan_raw_device\t$raw_device};
+
+ # Set MTU to 1496 unless told otherwise
+ if ($if_part->{'iface_opt'}
+ and $if_part->{'iface_opt'} !~ m{ mtu }xms
+ )
+ {
+ $if_part->{'iface_opt'} .= q{, mtu 1496};
+ }
+ else {
+ $if_part->{'iface_opt'} = q{mtu 1496};
+ }
+ }
+
+ # Options
+ if ( $if_part->{'iface_opt'} ) {
+ foreach my $option (
+ split qr{ \s* [,] \s* }xms,
+ $if_part->{'iface_opt'}
+ )
+ {
+ push @{ $interfaces->{$iface} },
+ qq{\tup\t\t/sbin/ip link set $iface $option};
+ }
+ }
+ }
+ }
+
+DESTINATION:
+ foreach my $dest ( keys %{$routes} ) {
+
+ # Multiple routes
+ if ( scalar @{ $routes->{$dest} } > 1 ) {
+ foreach my $entry ( @{ $routes->{$dest} } ) {
+ my ( $if, $dst, $via, $gw ) = split qr{ \s+ }xms, $entry;
+ unless ( defined $gw ) {
+ croak
+ qq{ERROR: host $hostname: route to $dest needs a gateway};
+ }
+ push @{ $interfaces->{$if} },
+ qq{\tup\t\t/sbin/ip route add $dst scope global via $gw dev $if};
+ }
+ next DESTINATION;
+ }
+
+ # Only one route
+ my ($entry) = @{ $routes->{$dest} };
+ my ( $if, $dst, $via, $gw ) = split qr{ \s+ }xms, $entry;
+ if ( $dst eq 'default' ) {
+ unless ( defined $gw ) {
+ croak
+ qq{ERROR: host $hostname: default route needs a gateway};
+ }
+ push @{ $interfaces->{$if} }, qq{\tgateway\t\t$gw};
+ next DESTINATION;
+ }
+
+ push @{ $interfaces->{$if} },
+ qq{\tup\t\t/sbin/ip route add $entry dev $if};
+ }
+
+ return $interfaces;
+}
+
+# FIXME documentation
+sub Do_update_from_GLOBAL {
+ my ( $options, $global_config, $pf_config ) = @_;
+
+ my $hostname = $options->{'host'};
+ unless ($hostname) {
+ croak q{ERROR: undefined option host};
+ }
+
+ my $site_name = $options->{'site'};
+ unless ($site_name) {
+ croak q{ERROR: undefined option site};
+ }
+
+ if ( !VCS_checkout( $hostname, $pf_config, $options ) ) {
+ croak q{ERROR: "Unable to checkout configuration from VCS system"};
+ }
+
+ my $hosttype
+ = get_hosttype_from_hostname( $hostname, $global_config, $site_name );
+ my $hash_subst = Init_SUBST( $hostname, $hosttype, $pf_config );
+ my $host_props = get_host_config( $hostname, $global_config, $site_name );
+
+ $hash_subst->{'DISTRIB'} = get_distrib_from_host_ref($host_props);
+ $hash_subst->{'MODE'} = get_mode_from_host_ref($host_props);
+ $options->{'pkg_type'}
+ ||= get_pkgtype_from_hostname( $hostname, $global_config, $site_name );
+
+ my $host_config = Get_config_for_hostname_on_site(
+ $hostname, $site_name, $hash_subst, $global_config, $pf_config
+ );
+ unless ($host_config) {
+ croak qq{ERROR: Problem when parsing config for $hostname on $site_name};
+ }
+
+ if ( !$pf_config->{'features'}->{'update'} ) {
+ croak q{ERROR: update feature is deactivated in config file};
+ }
+
+ my @sortedkeys = sort { Sort_config_sections( $host_config, $a, $b ) }
+ @{ $host_config->{'__sections_order'} };
+
+ $| = 1;
+ my $errorcount = __do_updateloop(
+ $host_config, $options, $hash_subst, $global_config, \@sortedkeys
+ );
+
+ print qq{$errorcount error(s) detected.\n};
+
+ return;
+}
+
+########################################################################
+#
+# Only "private" functions after this line
+#
+
+# FIXME documentation + named arguments
+sub __do_updateloop {
+ my ( $host_config, $options, $hash_subst, $global_config, $sortedkeys )
= @_;
- my $zone = $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'zone'};
+ my $errorcount = 0;
+
+ foreach my $section ( @{$sortedkeys} ) {
+ next if $host_config->{$section}->{'action'} eq 'actiongroup';
+
+ if (not defined $host_config->{$section}->{'doing'}
+ and not defined $host_config->{$section}->{'done'}
+ )
+ {
+ $host_config->{$section}->{'doing'} = 1;
+ Get_depends_for_action(
+ $host_config->{$section}->{'action'},
+ $host_config->{$section},
+ $section, $options
+ );
+ if (defined $host_config->{$section}->{'depends'}
+ and $host_config->{$section}->{'depends'} =~ m{ \S+ }xms
+ )
+ {
+ my @depends = ();
+ my @dependsraw = split qr{ \s+ }xms,
+ $host_config->{$section}->{'depends'};
+ foreach my $depend (@dependsraw) {
+ next if $depend eq q{.};
+ if ( $depend and $host_config->{$depend} ) {
+ if ( $depend eq $section ) {
+ carp qq{WARN: [$section] circular dependancy};
+ next;
+ }
+
+ if ( $host_config->{$depend}->{'action'} eq
+ 'addmount' )
+ {
+ carp
+ qq{WARN: [$section] depends on addmount [$depend], it may not work during install!};
+ }
+
+ push @depends, $depend;
+ }
+ }
+
+ if (@depends) {
+ unless ( $options->{'quiet'} ) {
+ print qq{<$section>} . join q{ }, @depends;
+ }
+ $errorcount += __do_updateloop(
+ $host_config, $options, $hash_subst,
+ $global_config, \@depends
+ );
+ }
+ }
+
+ unless ( $options->{'quiet'} ) {
+ print qq{[$section]\n};
+ }
+
+ if (!Exec_action(
+ $host_config->{$section}->{'action'},
+ $host_config->{$section},
+ $section,
+ $options,
+ $hash_subst,
+ $global_config
+ )
+ )
+ {
+ $errorcount++;
+ }
+
+ $host_config->{$section}->{'done'} = 1;
+ }
+ }
+
+ return $errorcount;
+}
+
+sub __search_and_resolve_ip {
+ my ($hostname, $ip_type, $site_name, $line, $separator, $type_resolve,
+ $hash_subst, $global_config
+ )
+ = @_;
+
+ my $zone = $global_config->{'SITE'}->{'BY_NAME'}->{$site_name}->{'zone'};
my $pos = length $line;
+
while (
substr( $line, 0, $pos )
- =~ m{\A
- (.*[^A-Za-z0-9.-])?
- ([A-Za-z0-9.-]+)
- (\\?)
- (\.$zone)
- ([^A-Za-z0-9.-].*)?
- \z}xmso
- ) {
+ =~ m{
+ \A
+ ( # -> $before
+ .*
+ [^A-Za-z0-9.-]
+ )?
+ ( # $2
+ [A-Za-z0-9.-]+
+ )
+ ( # $3
+ [\]?
+ )
+ ( # $4
+ [.]
+ $zone
+ )
+ ( # -> $after
+ [^A-Za-z0-9.-]
+ .*
+ )?
+ \z
+ }xmso
+ )
+ {
my $before = $1;
my $back = $3;
my $match = $2 . $3 . $4;
my $matchback = $2 . $4;
my $after = $5;
+
my $lengthbefore = defined $before ? length $before : 0;
- if( $back ne "\\\\" ) {
- my $match2 = $match;
- $match2 =~ s{HOSTNAME}{$hostname};
- $match2 =~ s{POPNAME}{$hash_subst->{'POPNAME'}}xmsg;
- my $resolved = Resolv(
- $type_resolve, $ip_type, $match2, $global_config, $site
- );
- if( scalar @{$resolved} ) {
- if( $separator eq "DUPLICATE" ) {
- my $templine = "";
- my $templine2;
- foreach my $res ( @{$resolved} ) {
- $templine2 = $line;
- substr( $templine2, $lengthbefore, length $match )
- = $res;
- $templine .= $templine2;
- }
- $line = $templine;
+
+ if ( $back eq "\\\\" ) {
+ substr( $line, $lengthbefore, length $match, $matchback );
+ $pos = $lengthbefore;
+ next;
+ }
+
+ my $match2 = $match;
+ $match2 =~ s{ HOSTNAME }{$hostname}xmsg;
+ $match2 =~ s{ POPNAME }{$hash_subst->{'POPNAME'}}xmsg;
+
+ my $resolved = Resolv( $type_resolve, $ip_type, $match2, $global_config, $site_name);
+ if ( @{$resolved} ) {
+ if ( $separator eq q{DUPLICATE} ) {
+ my $templine = q{};
+ foreach my $res ( @{$resolved} ) {
+ my $templine2 = $line;
+ substr( $templine2, $lengthbefore, length $match, $res );
+ $templine .= $templine2;
}
- else {
- substr( $line, $lengthbefore, length $match )
- = join( $separator, @{$resolved} );
- }
- $pos = $lengthbefore;
+
+ $line = $templine;
}
else {
- $pos = $lengthbefore;
+ my $replacement = join $separator, @{$resolved};
+ substr( $line, $lengthbefore, length $match, $replacement);
}
}
- else {
- substr( $line, $lengthbefore, length $match ) = $matchback;
- $pos = $lengthbefore;
- }
+
+ $pos = $lengthbefore;
}
+
return $line;
}
-sub __Search_and_resolve_IFACE {
+sub __search_and_resolve_iface {
my ( $line, $host_props, $hash_subst ) = @_;
my $pos = length $line;
while (
substr( $line, 0, $pos )
- =~ m{\A
- (.*[^A-Za-z0-9.-])?
- (eth
- ([-.:])
- ([A-Za-z0-9-]+)
+ =~ m{
+ \A
+ ( # -> $before
+ .*
+ [^A-Za-z0-9.-]
+ )?
+ ( # -> $match
+ eth
+ ( # -> $type
+ [-.:]
)
- ([^A-Za-z0-9.-].*)?
- \z}xmso
+ (
+ [A-Za-z0-9-]+ # -> $vlan
+ )
+ )
+ ( # -> $after
+ [^A-Za-z0-9.-]
+ .*
+ )?
+ \z
+ }xmso
)
{
my $before = $1;
@@ -583,538 +1024,374 @@
my $lengthbefore = defined $before ? length $before : 0;
- my $vlan2 = $vlan;
- $vlan2 =~ s{POPNAME}{$hash_subst->{'POPNAME'}};
+ ( my $real_vlan = $vlan ) =~ s{ POPNAME }{$hash_subst->{'POPNAME'}}xms;
- my $eth = get_iface_vlan_from_hostname( $vlan2, $host_props );
+ my $eth = get_iface_vlan_from_hostname( $real_vlan, $host_props );
+ if ( defined $eth ) {
+ my $neweth = $eth;
+ if ( $type eq q{.} ) {
+ $neweth =~ s{ [:] .* \z }{}xms;
+ }
+ elsif ( $type eq q{-} ) {
+ $neweth =~ s{ [.:] .* \z }{}xms;
+ }
- if( defined $eth ) {
- my $neweth = $eth;
- if( $type eq "." ) {
- $neweth =~ s{:.*\z}{};
- }
- elsif( $type eq "-" ) {
- $neweth =~ s{[.:].*\z}{};
- }
- substr( $line, $lengthbefore, length $match ) = $neweth;
+ substr( $line, $lengthbefore, length $match, $neweth );
$pos = $lengthbefore;
}
else {
$pos = $lengthbefore;
}
}
+
return $line;
}
-sub Search_and_replace {
- my ( $hostname, $site, $input_file, $type_replace, $pf_config, $separator,
- $global_config, $type_resolve, $ip_type )
- = @_;
- my $result = [];
+=head2 __build_preseed_file($arguments_ref)
- if ( $type_resolve && $type_resolve eq 'cnf' && !defined $global_config )
- {
- carp q{ERROR: Unable to resolve from configuration};
- return;
- }
- my $hosttype
- = get_hosttype_from_hostname( $hostname, $global_config, $site );
- my $subst = Init_SUBST( $hostname, $hosttype, $pf_config );
- my $host_props = get_host_config( $hostname, $global_config, $site );
+Builds the preseed file for a host, returns the filename.
+I<$arguments_ref> is a reference to a hash of named parameters:
- my $input_hl = IO::File->new( $input_file );
- unless( $input_hl ) {
- carp qq{ERROR: Unable to open file $input_file : $OS_ERROR};
- return;
- }
- my @src = <$input_hl>;
- $input_hl->close();
+=over
- foreach my $line ( @src ) {
- if( $type_replace eq 'resolver' ) {
- $line = __Search_and_resolve_IP(
- $hostname, $ip_type, $site, $line, $separator,
- $type_resolve, $subst, $global_config
- );
- }
- elsif( $type_replace eq 'iface' ) {
- $line = __Search_and_resolve_IFACE( $line, $host_props, $subst );
- }
- elsif( $type_replace eq 'distrib' ) {
- $line =~ s{%DISTSRC%}{$host_props->{'deployment'}->{'mode'}}gs;
- $line =~ s{%DISTRIB%}{$host_props->{'deployment'}->{'distrib'}}gs;
- }
- push( @{$result}, $line );
- }
- return $result;
+=item I<hostname> the host name
+
+=item I<host_ref> a reference to the host configuration hash
+
+=item I<preseed_template> the template file name
+
+=item I<default_preseed> FIXME unused?
+
+=item I<pf_script> FIXME ???
+
+=item I<pf_config> a reference to the pf-tools configuration hash
+
+=back
+
+=cut
+
+sub __build_preseed_file {
+ my ($arguments_ref) = @_;
+
+ my ($hostname, $host_ref, $preseed_template,
+ $default_preseed, $pf_script, $pf_config
+ ) = @{$arguments_ref}{
+ qw(
+ hostname host_ref preseed_template
+ default_preseed pf_script pf_config
+ )
+ };
+
+ my $preseed_template_content = __read_file_in_scalar($preseed_template);
+
+ my $kernel_pkg = __get_kpkg_from_kernel(
+ $host_ref->{'boot'}->{'kernel'},
+ $host_ref->{'deployment'}->{'mode'},
+ );
+
+ my $preseed_subst = {
+ 'kernelpkg' => $kernel_pkg,
+ 'mode' => $host_ref->{'deployment'}->{'mode'},
+ 'distrib' => $host_ref->{'deployment'}->{'distrib'},
+ 'config_script' => $pf_script,
+ };
+ my $preseed_content = q{};
+ my $tpl = Template::Tiny->new( TRIM => 1 );
+ $tpl->process( \$preseed_template_content, $preseed_subst, \$preseed_content );
+
+ my $tmp_fh = File::Temp->new( unlink => 0 );
+ my $tmp_fn = $tmp_fh->filename();
+ __write_scalar_to_filehandle($tmp_fh, $tmp_fn, $preseed_content);
+
+ my $preseed_filename = qq{preseed_$hostname};
+ my $dst = join q{/}, $pf_config->{'path'}->{'preseed_dir'}, $preseed_filename;
+ __move_if_different( $tmp_fn, $dst );
+
+ return $preseed_filename;
}
-sub Fix_hosts {
- my ( $hostname, $input_file, $site, $ip_type, $global_config, $pf_config )
- = @_;
- my $tmp_hosts = [];
+=head2 __get_kpkg_from_kernel( $pxefilename, $deploymode )
- if ( $ip_type !~ m{\A ipv4 \z}xms ) {
- carp qq{ERROR: $ip_type is not implemented for fixing $input_file};
- return;
+This functions computes the name of the kernel package to install, base on the
+I<$pxefilename> and I<$deploymode> values.
+
+FIXME: the -grsec thing should be moved out of the pf-tools source code, to
+keep it generic.
+
+=cut
+
+sub __get_kpkg_from_kernel {
+ my ( $pxefilename, $deploymode ) = @_;
+
+ # FIXME why special-case this to Ubuntu!?
+ if ( $deploymode =~ m{ \A ubuntu }xms ) {
+ my ($version) = $pxefilename =~ m{ vmlinuz-(.+) \z }xms;
+ return "linux-image-$version";
}
- my $input_hl = IO::File->new( $input_file );
- unless( $input_file ) {
- carp qq{ERROR: Unable top open $input_file};
- return;
+
+ # FIXME I think this special case should be moved out of the pf-tools
+ # source code to keep it generic
+ if ( $pxefilename =~ m{ pxe }xms ) {
+ my ( $vm, $type, $pxe, $version, @append )
+ = split qr{ [-] }xms, $pxefilename;
+ return
+ qq{linux-image-$version-$type-}
+ . join( q{-}, @append )
+ . q{-grsec};
}
- @{$tmp_hosts} = <$input_hl>;
- $input_hl->close();
+ else {
+ my ( $vm, $version, $type, $append_version )
+ = split qr{ [-] }xms, $pxefilename;
+ return
+ qq{linux-image-$version-$type-}
+ . $append_version
+ . q{-grsec};
+ }
- my $host_props = get_host_config( $hostname, $global_config, $site );
- unless( $host_props ) {
- carp qq{ERROR: Unknown hostname $hostname};
- return;
- }
- my $iface_dhcpvlan = get_iface_vlan_from_hostname(
- $host_props->{'deployment'}->{'dhcpvlan'}, $host_props
- );
- my $ip_deploy = $host_props->{'interfaces'}->{$iface_dhcpvlan}->{'ipv4'};
- $ip_deploy =~ s{\/[\d]+\z}{};
- foreach ( @{$tmp_hosts} ) {
- next if ( !m{$hostname} );
- s{\A 127.0.([\d]{1,3}\.[\d]{1,3})}{$ip_deploy}xms;
- }
- return $tmp_hosts;
+ return;
}
-sub Mk_dhcp {
- my ( $header_file, $site_part ) = @_;
- my $dhcp_header = [];
- my $dhcp_hosts = [];
- my $dhcp_subnet = [];
+=head2 __get_md5sum_for_preseedfile( $filename, $pf_config )
- if ( $header_file ne '' ) {
- unless( -e $header_file ) {
- croak qq{ERROR: $header_file no such file or directory};
- }
- my $header_hl = IO::File->new( $header_file );
- unless( $header_hl ) {
- croak qq{ERROR: Unable to open header $header_file : $OS_ERROR};
- }
- foreach (<$header_hl>) {
- chomp;
- push( @{$dhcp_header}, $_ );
- }
- $header_hl->close();
+This function computes and returns the MD5 digest for the preseedfile named
+I<$filename>.
+
+=cut
+
+sub __get_md5sum_for_preseedfile {
+ my ( $filename, $pf_config ) = @_;
+
+ my $file_path = join q{/}, $pf_config->{'path'}->{'preseed_dir'},
+ $filename;
+
+ my $fh = IO::File->new( $file_path, q{<} );
+ unless ($fh) {
+ croak qq{ERROR: $file_path: $OS_ERROR};
}
- foreach my $vlan ( keys %{$site_part} ) {
- push(
- @{$dhcp_subnet},
- "subnet " . $site_part->{$vlan}->{'subnet'}
- . " netmask " . $site_part->{$vlan}->{'netmask'} . " {\n}\n"
- );
- foreach my $hostclass ( keys %{ $site_part->{$vlan} } ) {
- next if ( $hostclass =~ m{\A (subnet|netmask|routers) \z}xmso );
- my $host_part = $site_part->{$vlan}->{$hostclass};
- foreach my $host ( keys %{$host_part} ) {
- push( @{$dhcp_hosts}, "host " . $host . " {" );
- foreach my $def ( @{ $host_part->{$host} } ) {
- push( @{$dhcp_hosts}, "\t" . $def );
- }
- push( @{$dhcp_hosts}, "}", "" );
- }
- }
- }
- return [ @{$dhcp_header}, @{$dhcp_subnet}, @{$dhcp_hosts} ];
+ # Digest::MD5 will properly croak() on errors
+ my $md5sum = Digest::MD5->new()->addfile($fh)->hexdigest();
+
+ $fh->close();
+
+ return $md5sum;
}
-sub Mk_sourceslist {
- my ( $hostname, $site, $dst, $sections, $template, $backports,
- $global_config, $pf_config )
- = @_;
+=head2 __make_zone_header( $zone_name, $site_name, $zone_part )
- my $host_props = get_host_config( $hostname, $global_config, $site );
- unless( $host_props ) {
- croak qq{ERROR: Unknown $hostname on $site};
+This function creates the header lines for the I<$zone_name> zone file on site
+I<$site_name>. I<$zone_ref> references the hash describing I<$zone_name>. It
+returns a reference to the array of generated lines.
+
+=cut
+
+sub __make_zone_header {
+ my ( $zone_name, $site_name, $zone_ref ) = @_;
+
+ if ( not $zone_name ) {
+ croak q{ERROR: Invalid empty $zone_name};
}
- my $tpl = Template::Tiny->new( TRIM => 1 );
- my $mode = $host_props->{'deployment'}->{'mode'};
- unless( $template ) {
- $template = $pf_config->{'path'}->{'templates_dir'} . '/'
- . $pf_config->{$mode}->{'sources_list'};
+ if ( ref $zone_name ) {
+ croak q{ERROR: Invalid non-scalar $zone_name};
}
- my $tpl_hl = IO::File->new( $template );
- unless( $tpl_hl ) {
- croak qq{ERROR: Unable to open template $template};
+ if ( not $site_name ) {
+ croak q{ERROR: Invalid empty $site_name};
}
- my $sources_content = join '', <$tpl_hl>;
- $tpl_hl->close();
-
- my $sources_subst = {
- 'mode' => $host_props->{'deployment'}->{'mode'},
- 'distrib' => $host_props->{'deployment'}->{'distrib'},
- 'default_sections' => $pf_config->{$mode}->{'default_sections'},
- 'custom_sections' => $sections
- };
- $tpl->process( \$sources_content, $sources_subst, \$sources_content );
-
- if( $backports ) {
- my $back_src = ( $mode eq 'debian' )
- ? $mode . "-backports"
- : $mode;
- $sources_content
- .= "\ndeb http://mirrors.private/"
- . $back_src . " "
- . $host_props->{'deployment'}->{'distrib'}
- . "-backports "
- . $pf_config->{$mode}->{'default_sections'} . "\n";
+ if ( ref $site_name ) {
+ croak q{ERROR: Invalid non-scalar $site_name};
}
- my $dst_hl = IO::File->new( ">".$dst );
- unless( $dst_hl ) {
- croak qq{ERROR: Unable to open $dst : $OS_ERROR};
+ if ( not $zone_ref ) {
+ croak q{ERROR: Invalid empty $zone_ref};
}
- $dst_hl->print( $sources_content."\n" );
- $dst_hl->close();
+ if ( ref $zone_ref ne 'HASH' ) {
+ croak q{ERROR: Invalid non-hashref $zone_ref};
+ }
+
+ # This is not a complete check but it will catch obvious errors,
+ # like $zone_ref referencing a non-zone hash
+ if ( not exists $zone_ref->{'SOA'} ) {
+ croak q{ERROR: Invalid $zone_ref hashref: no 'SOA' key found};
+ }
+
+ my $serial
+ = $zone_ref->{'SOA'}->{'serial'} eq 'AUTO'
+ ? time
+ : $zone_ref->{'SOA'}->{'serial'};
+
+ # SOA
+ my @result = (
+ q{;;},
+ qq{;; BIND configuration file for zone: $zone_name},
+ qq{;; Site: $site_name},
+ q{;;},
+ qq/;; $zone_ref->{'SOA'}->{'comment'}/,
+ q{;;============================================================================},
+ q{},
+ sprintf( q{$TTL %s}, $zone_ref->{'SOA'}->{'ttl'} ),
+ sprintf(
+ qq{%-29s IN SOA\t%s %s (},
+ q{@}, $zone_ref->{'SOA'}->{'soa'},
+ $zone_ref->{'SOA'}->{'mail'},
+ ),
+ sprintf( "%-30s%s\t; Serial", q{}, $serial ),
+ );
+
+ foreach my $spec ( 'refresh', 'retry', 'expire', 'negttl' ) {
+ push @result, sprintf( q{%-30s%s}, q{}, $zone_ref->{'SOA'}->{$spec} );
+ }
+ push @result, sprintf( qq{%-30s%s}, q{}, q{)} ), q{};
+
+ # NS fields
+ foreach my $nameserver ( @{ $zone_ref->{'SOA'}->{'@ns'} } ) {
+ push @result, sprintf( qq{%-29s IN NS\t%s}, q{}, $nameserver );
+ }
+ push @result, q{};
+
+ # MX fields
+ foreach my $mx ( @{ $zone_ref->{'SOA'}->{'@mx'} } ) {
+ push @result, sprintf( qq{%-29s IN MX\t%s}, q{}, $mx );
+ }
+ push @result, q{}, q{};
+
+ return \@result;
+}
+
+=head2 __move_if_different( $source, $destination )
+
+Compares I<$source> and I<$destination>. If they differ, moves I<$source> to
+I<$destination>. If they are equal, unlink I<$source>.
+
+=cut
+
+sub __move_if_different {
+ my ($source, $destination) = @_;
+
+ if ( compare( $source, $destination ) ) {
+ unless ( move( $source, $destination ) ) {
+ croak qq{ERROR: move( $source, $destination ): $OS_ERROR};
+ }
+
+ return 1;
+ }
+
+ unless ( unlink($source) ) {
+ carp qq{WARNING: unlink $source: $OS_ERROR};
+ }
+
return 1;
}
-sub Change_kopt_for_hostname {
- my ( $hostname, $site, $grub_src, $dst, $grub_version, $global_config,
- $pf_config )
- = @_;
- my $tmp_grub = [];
+=head2 __read_file_in_scalar($filename)
- my $host_props = get_host_config( $hostname, $global_config, $site );
- unless( $host_props ) {
- croak qq{ERROR: Unknown $hostname on $site};
+Read the whole content of I<$filename> as a scalar (string).
+Return the content.
+
+=cut
+
+sub __read_file_in_scalar {
+ my ($filename) = @_;
+
+ my $fh = IO::File->new( $filename, q{<} );
+ unless ($fh) {
+ croak qq{ERROR: open $filename: $OS_ERROR};
}
- my $mode = $host_props->{'deployment'}->{'mode'};
- my $cmdline = join q{ }, get_cmdline_from_host_ref($host_props);
- $cmdline =~ s{\A\s*}{}; # Removing trailing space
- $grub_version = "" if ( $grub_version == 1 );
- $grub_src = $pf_config->{$mode}->{ 'grub' . $grub_version }
- if ( $grub_src eq '' );
- my $src_hdl = IO::File->new( $grub_src );
- unless( $src_hdl ) {
- Warn( $CODE->{'OPEN'},
- "Unable to open GRUB source $grub_src : $OS_ERROR" );
- return;
+ # FIXME use File::Slurp instead?
+ my $content = do { local $INPUT_RECORD_SEPARATOR = undef; <$fh> };
+
+ unless ( $fh->close() ) {
+ croak qq{ERROR: close $filename: $OS_ERROR};
}
- @{$tmp_grub} = <$src_hdl>;
- $src_hdl->close();
- foreach ( @{$tmp_grub} ) {
- chomp;
- next
- if ( $grub_version == 2 && !/^GRUB_CMDLINE_LINUX_DEFAULT=".*"$/ );
- next if ( $grub_version == 1 && !/^\# kopt=.*$/ );
- s/\"$/ $cmdline\"/ if ( $cmdline && !/\Q$cmdline\E\"$/ );
+ return $content;
+}
+
+=head2 __read_file_in_array( $filename, $chomp_wanted )
+
+Reads I<$filename> as an array of lines. Each line is chomped unless
+I<$chomp_wanted> is 0 (the default is 1). Returns a reference to the array of
+lines.
+
+=cut
+
+sub __read_file_in_array {
+ my ($filename, $chomp_wanted) = @_;
+
+ $chomp_wanted = 1 unless defined $chomp_wanted;
+
+ my $fh = IO::File->new( $filename, q{<} );
+ unless ($fh) {
+ croak qq{ERROR: open $filename: $OS_ERROR};
}
- my $tmp_dst = ( $dst eq "-" ) ? $dst : "/tmp/menulst";
- my $dst_hdl = IO::File->new( ">$tmp_dst" );
- unless( $dst_hdl ) {
- Warn( $CODE->{'OPEN'},
- "Unable to open tmp destination $tmp_dst : $OS_ERROR" );
- return;
+
+ my @lines = ();
+ while ( defined ( my $line = $fh->getline() ) ) {
+ if ($chomp_wanted) {
+ chomp $line;
+ }
+
+ push @lines, $line;
}
- unless( $dst_hdl->print( join( "\n", @{$tmp_grub} ) ) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to write on tmp destination $tmp_dst : $OS_ERROR" );
+
+ unless ( $fh->close() ) {
+ croak qq{ERROR: close $filename: $OS_ERROR};
}
- $dst_hdl->close();
- if ( $tmp_dst ne "-" ) {
- if ( compare( $tmp_dst, $dst ) ) {
- return move( $tmp_dst, $dst );
- }
- else {
- if ( !unlink($tmp_dst) ) {
- Warn( $CODE->{'UNLINK'},
- "Unable to unlink tmp destination $tmp_dst : $OS_ERROR" );
- }
- }
+
+ return \@lines;
+}
+
+=head2 __write_scalar_to_filehandle( $fh, $filename, $scalar )
+
+This functions writes I<$scalar> to the I<$fh> filehandle, then closes it.
+
+=cut
+
+sub __write_scalar_to_filehandle {
+ my ($fh, $filename, $scalar) = @_;
+
+ # IO::File does not implement filename()
+ #my $filename = $fh->filename();
+
+ unless ( $fh->print($scalar) ) {
+ croak qq{ERROR: write $filename: $OS_ERROR};
}
+
+ unless ( $fh->close() ) {
+ croak qq{ERROR: close $filename: $OS_ERROR};
+ }
+
return 1;
}
-#
-# VOID Mk_interfaces (STRING $host, STRING $fic_iface, HASHREF $Z)
-#
-# Construit le fichier de declaration d'interfaces $fic_iface pour la
-# machine $host a partir des informations contenues dans la structure $Z
-#
-#======================================================================================
-sub Mk_interfaces ($$$;$) {
- my ( $hostname, $global_config, $pf_config, $site ) = @_;
+=head2 __write_array_to_filehandle( $fh, $filename, $array_ref, $line_separator )
- my $resolve = 0;
- my $properties = get_host_config( $hostname, $global_config, $site );
- unless( $properties ) {
- carp qq{ERROR: Unknown $hostname on $site};
- return;
+This functions writes the list of lines referenced by I<$array_ref> to the
+I<$fh> filehandle, then closes it. I<$line_separator> is written between each
+line (the default is the empty string, but a useful value is qq{\n}).
+
+=cut
+
+sub __write_array_to_filehandle {
+ my ( $fh, $filename, $array_ref, $line_separator ) = @_;
+
+ # $line_separator //= q{};
+ unless ( defined $line_separator ) {
+ $line_separator = q{};
}
- my $hostclass = $properties->{'deployment'}->{'hosttype'};
- my $interfaces = {};
- my $routes = {};
- foreach my $iface ( 'lo', sort keys %{ $properties->{'interfaces'} } ) {
- push( @{ $interfaces->{'__order'} }, $iface );
- my $if_part = $properties->{'interfaces'}->{$iface}
- if ( defined $properties->{'interfaces'}->{$iface} );
- push( @{ $interfaces->{$iface} }, "auto " . $iface );
- if ( $if_part->{'method'} ) {
- push(
- @{ $interfaces->{$iface} },
- "iface " . $iface . " inet " . $if_part->{'method'}
- );
- }
- elsif ( $iface eq 'lo' ) {
- push(
- @{ $interfaces->{$iface} },
- "iface " . $iface . " inet loopback"
- );
- }
- else {
- push(
- @{ $interfaces->{$iface} },
- "iface " . $iface . " inet static"
- );
- }
- next
- if ( ( $if_part->{'method'} && $if_part->{'method'} eq 'dhcp' )
- || $iface eq 'lo' );
- foreach my $ip_type ( 'ipv4', 'ipv6' ) {
- next if ( !$pf_config->{'features'}->{$ip_type} );
- my $suffix = ( $ip_type eq 'ipv6' ) ? '6' : '';
- my $ip = new NetAddr::IP( $if_part->{$ip_type} );
- push(
- @{ $interfaces->{$iface} },
- "\tslaves\t\t" . $if_part->{'slaves'}
- ) if ( $if_part->{'slaves'} );
- push( @{ $interfaces->{$iface} }, "\taddress\t\t" . $ip->addr() );
- push( @{ $interfaces->{$iface} }, "\tnetmask\t\t" . $ip->mask() );
- my $net = $ip->network();
- push( @{ $interfaces->{$iface} },
- "\tnetwork\t\t" . $net->addr() );
- my $broad = $ip->broadcast();
- push(
- @{ $interfaces->{$iface} },
- "\tbroadcast\t" . $broad->addr()
- );
+ # IO::File does not implement filename()
+ #my $filename = $fh->filename();
- foreach my $route ( @{ $if_part->{ '@route' . $suffix } } ) {
- $route =~ /^([^\s]+)\s*(via ([^\s]+))?$/;
- push( @{ $routes->{$1} }, $iface . " " . $route );
- }
- if ( $iface =~ /^([^\.]+)\.\d+$/ ) {
- push( @{ $interfaces->{$iface} },
- "\tvlan_raw_device\t" . $1 );
- if ( $if_part->{'iface_opt'}
- && $if_part->{'iface_opt'} !~ /mtu/ )
- {
- $if_part->{'iface_opt'} .= ",mtu 1496";
- }
- else {
- $if_part->{'iface_opt'} = "mtu 1496";
- }
- }
- if ( defined $if_part->{'iface_opt'} ) {
- foreach
- my $option ( split( /\s*,\s*/, $if_part->{'iface_opt'} ) )
- {
- push(
- @{ $interfaces->{$iface} },
- "\tup\t\t/sbin/ip link set " . $iface . " " . $option
- );
- }
- }
+ unless ( $fh->print( join $line_separator, @{$array_ref} ) ) {
+ croak qq{ERROR: print $filename: $OS_ERROR};
+ }
- }
+ unless ( $fh->close() ) {
+ croak qq{ERROR: close $filename: $OS_ERROR};
}
- foreach my $dest ( keys %{$routes} ) {
- if ( scalar @{ $routes->{$dest} } > 1 ) {
- foreach my $entry ( @{ $routes->{$dest} } ) {
- my ( $if, $dst, $via, $gw ) = split( /\s+/, $entry );
- if ( !defined $gw ) {
- Warn( $CODE->{'UNDEF_KEY'},
- "Unable to add a route for destination "
- . $dst
- . " with multiple gateway without gateway definition"
- . " on hostname "
- . $hostname );
- last;
- }
- push(
- @{ $interfaces->{$if} },
- "\tup\t\t/sbin/ip route add "
- . $dst
- . " scope global via "
- . $gw . " dev "
- . $if
- );
- }
- }
- else {
- my ($entry) = @{ $routes->{$dest} };
- my ( $if, $dst, $via, $gw ) = split( /\s+/, $entry );
- if ( $dst eq 'default' ) {
- if ( !defined $gw ) {
- Abort( $CODE->{'UNDEF_KEY'},
- "Unable to define default route without gateway defined for interface "
- . $if
- . " on hostname "
- . $hostname );
- }
- push( @{ $interfaces->{$if} }, "\tgateway\t\t$gw" );
- }
- else {
- push(
- @{ $interfaces->{$if} },
- "\tup\t\t/sbin/ip route add " . $entry . " dev " . $if
- );
- }
- }
- }
- return $interfaces;
}
-sub __Do_updateloop {
- my ( $host_config, $options, $hash_subst, $global_config, $sortedkeys )
- = @_;
- my $errorcount = 0;
+1; # Magic true value required at end of module
- foreach my $section ( @{$sortedkeys} ) {
- next if ( $host_config->{$section}->{'action'} eq 'actiongroup' );
-
-# if (
-# $host_config->{$section}->{'actiongroup'}
-# && ! defined $host_config->{$host_config->{$section}->{'actiongroup'}}
-# ) {
-# Abort ( $CODE->{'UNDEF_KEY'},
-# "Unable to trigger an actiongroup which is not defined into configuration" );
-# }
- if ( !defined( $host_config->{$section}->{'doing'} )
- && !defined( $host_config->{$section}->{'done'} ) )
- {
- $host_config->{$section}->{'doing'} = 1;
- Get_depends_for_action(
- $host_config->{$section}->{'action'},
- $host_config->{$section},
- $section, $options
- );
- if ( defined( $host_config->{$section}->{'depends'} )
- && $host_config->{$section}->{'depends'} =~ m{\S+} )
- {
- my $depends = [];
- my @dependsraw
- = split( m{\s+}, $host_config->{$section}->{'depends'} );
- foreach my $depend (@dependsraw) {
- next if ( $depend eq "." );
- if ( defined($depend)
- && $depend ne ""
- && defined( $host_config->{$depend} ) )
- {
- if ( $depend eq $section ) {
- carp qq{WARN: [$section] circular dependancy};
-# FlushLog();
- next;
- }
- push @{$depends}, $depend;
- if ( $host_config->{$depend}->{'action'} eq
- 'addmount' )
- {
- carp qq{
- WARN:[$section] depends on addmount [$depend],
- it may not work during install!
- };
-# FlushLog();
- }
- }
-
- # else {
- # Abort ( $CODE->{'UNDEF_KEY'},
- # "[".$section."] depends on [".$depend."] which is not defined" );
- # }
- }
- if ( scalar @{$depends} ) {
- print "<" . $section . "> " . join( ' ', @{$depends} )
- if( ! $options->{'quiet'} );
- $errorcount += __Do_updateloop( $host_config, $options,
- $hash_subst, $global_config, $depends );
- }
- }
- print "[" . $section . "]\n" if ( ! $options->{'quiet'} );
- $errorcount++ if( ! Exec_action(
- $host_config->{$section}->{'action'},
- $host_config->{$section},
- $section,
- $options,
- $hash_subst,
- $global_config
- )
- );
-# {
-# FlushLog();
-# $errorcount++;
-# }
-# else {
-# DelLog();
-# }
- $host_config->{$section}->{'done'} = 1;
- }
- }
- return $errorcount;
-}
-
-sub Do_update_from_GLOBAL {
- my ( $options, $global_config, $pf_config ) = @_;
- my $errorcount = 0;
-
- my $hostname = $options->{'host'};
- unless( $hostname ) {
- croak q{ERROR: undefined option host};
- }
- my $site = $options->{'site'};
- unless( $site ) {
- croak q{ERROR: undefined option site};
- }
-# Set_deferredlog();
- if ( !VCS_checkout( $hostname, $pf_config, $options ) ) {
- croak q{ERROR: "Unable to checkout configuration from VCS system"};
- }
-# Unset_deferredlog();
- my $hosttype
- = get_hosttype_from_hostname( $hostname, $global_config, $site );
- my $hash_subst = Init_SUBST( $hostname, $hosttype, $pf_config );
- my $host_props = get_host_config( $hostname, $global_config, $site );
- unless( $host_props ) {
- croak qq{ERROR: Unknown hostname $hostname};
- }
- $hash_subst->{'DISTRIB'} = get_distrib_from_host_ref($host_props);
- $hash_subst->{'MODE'} = get_mode_from_host_ref($host_props);
- $options->{'pkg_type'}
- ||= get_pkgtype_from_hostname( $hostname, $global_config, $site );
- my $host_config = Get_config_for_hostname_on_site(
- $hostname, $site, $hash_subst, $global_config, $pf_config
- );
- unless( $host_config ) {
- croak qq{ERROR: Problem when parsing config for $hostname on $site};
- }
-
- if ( !$pf_config->{'features'}->{'update'} ) {
- croak q{ERROR: update feature is deactivated in config file};
- }
-
- my $sortedkeys;
- @{$sortedkeys} = sort { Sort_config_sections( $host_config, $a, $b ) }
- @{ $host_config->{'__sections_order'} };
-
- $| = 1;
- $errorcount = __Do_updateloop(
- $host_config, $options, $hash_subst, $global_config, $sortedkeys
- );
-
- print $errorcount . " error(s) detected.\n";
-# FlushLog();
-}
-
-1;
diff -r e756fd4d6365 -r bfbe1ebd6136 t/13.conf.cfg1/config-export/MODEL/model-rdeploy
--- a/t/13.conf.cfg1/config-export/MODEL/model-rdeploy Fri Nov 12 13:36:18 2010 +0100
+++ b/t/13.conf.cfg1/config-export/MODEL/model-rdeploy Tue Nov 16 16:29:30 2010 +0100
@@ -11,7 +11,9 @@
[dns]
shortname = vlan-systeme
- resolver = nsprivate.private,spawn.private
+ resolver = nsprivate.private
+ alias.nsprivate = vlan-systeme
+ alias.spawn = vlan-systeme
[interface::eth0]
vlan = vlan-systeme
diff -r e756fd4d6365 -r bfbe1ebd6136 t/13.conf.t
--- a/t/13.conf.t Fri Nov 12 13:36:18 2010 +0100
+++ b/t/13.conf.t Tue Nov 16 16:29:30 2010 +0100
@@ -245,7 +245,7 @@
throws_ok { Get_source() }
qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] source }xms
- => 'Dies if empty/undef $source';
+ => 'Dies if empty $source';
throws_ok { Get_source( q{foo bar baz}, undef, q{non-hashref $hash_subst} ) }
qr{ \A ERROR: [ ] Invalid [ ] non-href [ ] [\$] hash_subst }xms
@@ -805,13 +805,13 @@
'hardware ethernet 00:1e:c9:ff:42:0b;',
'fixed-address 10.1.167.1;',
'filename pxelinux.0;',
- 'option domain-name-servers nsprivate.private,spawn.private;'
+ 'option domain-name-servers nsprivate.private;'
],
'cbv4-rdeploy00' => [
'hardware ethernet 00:1e:c9:ff:08:e4;',
'fixed-address 10.1.167.0;',
'filename pxelinux.0;',
- 'option domain-name-servers nsprivate.private,spawn.private;'
+ 'option domain-name-servers nsprivate.private;'
],
},
},
@@ -1092,7 +1092,7 @@
'cbv4-rdeploy01' => {
'dns' => {
'resolver' =>
- 'nsprivate.private,spawn.private'
+ 'nsprivate.private',
},
'boot' => {
'kernel' =>
@@ -1120,7 +1120,7 @@
'cbv4-rdeploy00' => {
'dns' => {
'resolver' =>
- 'nsprivate.private,spawn.private'
+ 'nsprivate.private',
},
'boot' => {
'kernel' =>
@@ -1149,6 +1149,12 @@
'filer01' => 'cbv4-rdeploy01',
'filer00' => 'cbv4-rdeploy00',
'filer' => 'cbv4-rdeploy',
+ 'nsprivate01' => 'cbv4-rdeploy01',
+ 'nsprivate00' => 'cbv4-rdeploy00',
+ 'nsprivate' => 'cbv4-rdeploy',
+ 'spawn01' => 'cbv4-rdeploy01',
+ 'spawn00' => 'cbv4-rdeploy00',
+ 'spawn' => 'cbv4-rdeploy',
},
},
'__hostclass_pxe' => [
@@ -1282,6 +1288,12 @@
'filer' => 'CNAME cbv4-rdeploy.vlan-systeme',
'filer00' => 'CNAME cbv4-rdeploy00.vlan-systeme',
'filer01' => 'CNAME cbv4-rdeploy01.vlan-systeme',
+ 'nsprivate' => 'CNAME cbv4-rdeploy.vlan-systeme',
+ 'nsprivate00' => 'CNAME cbv4-rdeploy00.vlan-systeme',
+ 'nsprivate01' => 'CNAME cbv4-rdeploy01.vlan-systeme',
+ 'spawn' => 'CNAME cbv4-rdeploy.vlan-systeme',
+ 'spawn00' => 'CNAME cbv4-rdeploy00.vlan-systeme',
+ 'spawn01' => 'CNAME cbv4-rdeploy01.vlan-systeme',
'cbv4-rdeploy00.vlan-systeme' => 'A 10.1.167.0',
'cbv4-rdeploy' =>
'CNAME cbv4-rdeploy.vlan-systeme',
@@ -1369,7 +1381,7 @@
my $global_config = $parsed_configuration;
throws_ok { get_hosttype_from_hostname() }
-qr{ \A ERROR: [ ] Invalid [ ] empty [ ] or [ ] undefined [ ] [\$] hostname }xms
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] hostname }xms
=> 'Dies if no hostname';
throws_ok { get_hosttype_from_hostname( {} ) }
@@ -1377,7 +1389,7 @@
=> q{Dies if non-scalar $hostname};
throws_ok { get_hosttype_from_hostname('hostname') }
-qr{ \A ERROR: [ ] Invalid [ ] empty [ ] or [ ] undefined [ ] [\$] global_config }xms
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] global_config }xms
=> 'Dies if no global_config';
throws_ok { get_hosttype_from_hostname( 'hostname', 'global_config' ) }
@@ -1389,7 +1401,7 @@
=> q{Dies if non-scalar $site};
throws_ok { get_hosttype_from_hostname( 'hostname', {} ) }
-qr{ \A ERROR: [ ] Unable [ ] to [ ] get [ ] hosttype [ ] from [ ] hostname }xms
+qr{ \A ERROR: [ ] Unknown [ ] hostname }xms
=> q{Dies if unknown hostname};
$parsed_configuration = get_hosttype_from_hostname(
@@ -1410,7 +1422,7 @@
can_ok( 'PFTools::Conf', qw( Get_config_for_hostname_on_site ) );
throws_ok { Get_config_for_hostname_on_site() }
-qr{ \A ERROR: [ ] Invalid [ ] empty [ ] or [ ] undefined [ ] [\$] hostname }xms
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] hostname }xms
=> 'Dies if no hostname';
throws_ok { Get_config_for_hostname_on_site( {} ) }
@@ -1418,7 +1430,7 @@
=> q{Dies if non-scalar $hostname};
throws_ok { Get_config_for_hostname_on_site('hostname') }
-qr{ \A ERROR: [ ] Invalid [ ] empty [ ] or [ ] undefined [ ] [\$] site }xms
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] site }xms
=> 'Dies if no site';
throws_ok { Get_config_for_hostname_on_site( 'hostname', {} ) }
@@ -1597,7 +1609,7 @@
my $expected_result = [ q{10.1.167.0} ];
is_deeply $result, $expected_result
=> q{Returns the expected result for one A value}
- or note explain $expected_result;
+ or note explain $result;
$result = resolve_hostname_from_global_config(
{
@@ -1612,7 +1624,7 @@
$expected_result = [ q{10.1.167.0}, q{10.1.167.1} ];
is_deeply $result, $expected_result
=> q{Returns the expected result for two A values}
- or note explain $expected_result;
+ or note explain $result;
$result = resolve_hostname_from_global_config(
{
@@ -1627,7 +1639,7 @@
$expected_result = [ q{10.1.167.0}, q{10.1.167.1} ];
is_deeply $result, $expected_result
=> q{Returns the expected result for a CNAME resolving to two A values}
- or note explain $expected_result;
+ or note explain $result;
$result = resolve_hostname_from_global_config(
{
@@ -1642,7 +1654,7 @@
$expected_result = undef;
is_deeply $result, $expected_result
=> q{Returns the expected result for an unknown vlan}
- or note explain $expected_result;
+ or note explain $result;
$result = resolve_hostname_from_global_config(
{
@@ -1657,14 +1669,12 @@
$expected_result = [ q{10.1.0.0} ];
is_deeply $result, $expected_result
=> q{Returns the expected result for a known vlan}
- or note explain $expected_result;
+ or note explain $result;
#TODO: {
# local $TODO = 'Depends on other, still failing, tests';
#} # END TODO
-
-remove_tree(q{/tmp/pf-test});
__END__
diff -r e756fd4d6365 -r bfbe1ebd6136 t/20.zone.t
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/t/20.zone.t Tue Nov 16 16:29:30 2010 +0100
@@ -0,0 +1,319 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Cwd;
+use English qw( -no_match_vars ); # Avoids regex performance penalty
+use Sys::Hostname;
+use Test::Exception;
+use Test::More qw( no_plan );
+
+use PFTools::Conf;
+use PFTools::Utils;
+
+# Let's go back to our test configuration
+# FIXME: this depends on t/13.conf.t, but it probably should not.
+my $config_file = 't/13.conf.cfg1/etc/pf-tools.1.conf';
+my $pf_config = Init_PF_CONFIG($config_file); # already tested OK in 13.conf.t
+
+my $hostname = hostname;
+my $hash_subst = Init_SUBST( $hostname, undef, $pf_config, 'private' );
+
+my $global_config = Init_GLOBAL_NETCONFIG( q{COMMON:private-network}, $hash_subst );
+
+########################################################################
+note('Testing PFTools::Utils::__make_zone_header');
+can_ok( 'PFTools::Utils', qw( __make_zone_header ) );
+
+throws_ok { PFTools::Utils::__make_zone_header(); }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] zone_name }xms
+ => q{Dies if empty $zone_name};
+
+throws_ok { PFTools::Utils::__make_zone_header( {} ); }
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] zone_name }xms
+ => q{Dies if non-scalar $zone_name};
+
+throws_ok { PFTools::Utils::__make_zone_header( q{name} ); }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] site_name }xms
+ => q{Dies if empty $site_name};
+
+throws_ok { PFTools::Utils::__make_zone_header( q{name}, {} ); }
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] site_name }xms
+ => q{Dies if non-scalar $site_name};
+
+throws_ok { PFTools::Utils::__make_zone_header( q{name}, q{site} ); }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] zone_ref }xms
+ => q{Dies if empty $zone_ref};
+
+throws_ok { PFTools::Utils::__make_zone_header( q{name}, q{site}, q{ref} ); }
+qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] [\$] zone_ref }xms
+ => q{Dies if non-hashref $zone_ref};
+
+throws_ok { PFTools::Utils::__make_zone_header( q{name}, q{site}, {} ); }
+qr{ \A ERROR: [ ] Invalid [ ] [\$] zone_ref [ ] hashref:
+ [ ] no [ ] 'SOA' [ ] key [ ] found }xms
+ => q{Dies if non-zone hashref $zone_ref};
+
+
+my $zone_ref = $global_config->{'ZONE'}->{'BY_NAME'}->{'private'};
+$zone_ref->{'SOA'}->{'serial'} = '1289575205';
+my $result = PFTools::Utils::__make_zone_header( 'private', 'cbv4-pfds', $zone_ref );
+my $expected_result = [
+ ';;',
+ ';; BIND configuration file for zone: private',
+ ';; Site: cbv4-pfds',
+ ';;',
+ ';; Internal management zone',
+ ';;============================================================================',
+ '',
+ '$TTL 1D ; TTL (1 day)',
+ '@ IN SOA' . qq{\t} . 'Deploy00.private. dnsmaster at private (',
+ ' 1289575205' . qq{\t} . '; Serial',
+ ' 6H ; Refresh (6 hours)',
+ ' 1H ; Retry (1 hour)',
+ ' 7D ; Expire (7 days)',
+ ' 1H ; Negative TTL (1 hours)',
+ ' )',
+ '',
+ ' IN NS' . qq{\t} . 'deploy00.vlan-systeme.private.',
+ ' IN NS' . qq{\t} . 'deploy01.vlan-systeme.private.',
+ '',
+ ' IN MX' . qq{\t} . '1 mf.private.',
+ ' IN MX' . qq{\t} . '2 mf00.private.',
+ ' IN MX' . qq{\t} . '2 mf01.private.',
+ '',
+ '',
+];
+
+is_deeply $result, $expected_result
+ => q{Returns the expected result for zone 'private'}
+ or note explain $result;
+
+
+########################################################################
+note('Testing PFTools::Utils::Mk_zone_for_site');
+can_ok( 'PFTools::Utils', qw( Mk_zone_for_site ) );
+
+throws_ok { Mk_zone_for_site(); }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] zone_name }xms
+ => q{Dies if empty $zone_name};
+
+throws_ok { Mk_zone_for_site( {} ); }
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] zone_name }xms
+ => q{Dies if non-scalar $zone_name};
+
+throws_ok { Mk_zone_for_site( q{name} ); }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] site_name }xms
+ => q{Dies if empty $site_name};
+
+throws_ok { Mk_zone_for_site( q{name}, {} ); }
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] site_name }xms
+ => q{Dies if non-scalar $site_name};
+
+throws_ok { Mk_zone_for_site( q{name}, q{site} ); }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] global_config }xms
+ => q{Dies if empty $global_config};
+
+throws_ok { Mk_zone_for_site( q{name}, q{site}, q{ref} ); }
+qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] [\$] global_config }xms
+ => q{Dies if non-hashref $global_config};
+
+throws_ok { Mk_zone_for_site( q{name}, q{site}, {} ); }
+qr{ \A ERROR: [ ] Invalid [ ] [\$] global_config [ ] hashref:
+ [ ] no [ ] 'ZONE' [ ] key [ ] found }xms
+ => q{Dies if non-config hashref $global_config};
+
+throws_ok { Mk_zone_for_site( q{name}, q{site}, $global_config ); }
+qr{ \A ERROR: [ ] Unknown [ ] zone_name: [ ] }xms
+ => q{Dies if unknown zone_name};
+
+throws_ok { Mk_zone_for_site( q{private}, q{site}, $global_config ); }
+qr{ \A ERROR: [ ] Unknown [ ] site_name: [ ] }xms
+ => q{Dies if unknown site_name};
+
+$result = Mk_zone_for_site( q{private}, q{cbv4-pfds}, $global_config );
+$expected_result = [
+ ';;',
+ ';; BIND configuration file for zone: private',
+ ';; Site: cbv4-pfds',
+ ';;',
+ ';; Internal management zone',
+ ';;============================================================================',
+ '',
+ '$TTL 1D ; TTL (1 day)',
+ '@ IN SOA Deploy00.private. dnsmaster at private (',
+ ' 1289575205 ; Serial',
+ ' 6H ; Refresh (6 hours)',
+ ' 1H ; Retry (1 hour)',
+ ' 7D ; Expire (7 days)',
+ ' 1H ; Negative TTL (1 hours)',
+ ' )',
+ '',
+ ' IN NS deploy00.vlan-systeme.private.',
+ ' IN NS deploy01.vlan-systeme.private.',
+ '',
+ ' IN MX 1 mf.private.',
+ ' IN MX 2 mf00.private.',
+ ' IN MX 2 mf01.private.',
+ '',
+ '',
+ ';;',
+ ';; Networks',
+ ';;============================================================================',
+ '',
+ '; vlan-systeme',
+ ';----------------------------------------------------------------------------',
+ 'network.vlan-systeme IN A 10.1.0.0',
+ 'netmask.vlan-systeme IN A 255.255.0.0',
+ 'broadcast.vlan-systeme IN A 10.1.255.255',
+ '',
+ '; vlan-pfds-int',
+ ';----------------------------------------------------------------------------',
+ 'network.vlan-pfds-int IN A 10.2.0.0',
+ 'netmask.vlan-pfds-int IN A 255.255.0.0',
+ 'broadcast.vlan-pfds-int IN A 10.2.255.255',
+ '',
+ '; vlan-pfds-ext',
+ ';----------------------------------------------------------------------------',
+ 'network.vlan-pfds-ext IN A 192.168.1.0',
+ 'netmask.vlan-pfds-ext IN A 255.255.255.0',
+ 'broadcast.vlan-pfds-ext IN A 192.168.1.255',
+ 'gateway.vlan-pfds-ext IN A 192.168.1.254',
+ '',
+ '; vlan-admindsi',
+ ';----------------------------------------------------------------------------',
+ 'network.vlan-admindsi IN A 10.3.1.0',
+ 'netmask.vlan-admindsi IN A 255.255.255.0',
+ 'broadcast.vlan-admindsi IN A 10.3.1.255',
+ 'gateway.vlan-admindsi IN A 10.3.1.254',
+ '',
+ '; vlan-middledsi',
+ ';----------------------------------------------------------------------------',
+ 'network.vlan-middledsi IN A 10.3.2.0',
+ 'netmask.vlan-middledsi IN A 255.255.255.0',
+ 'broadcast.vlan-middledsi IN A 10.3.2.255',
+ 'gateway.vlan-middledsi IN A 10.3.2.254',
+ '',
+ '',
+ '',
+ ';;',
+ ';; Servers',
+ ';;============================================================================',
+ '',
+ '; vip-spawn',
+ ';----------------------------------------------------------------------------',
+ 'cvs IN CNAME vip-spawn.vlan-systeme',
+ 'mf IN CNAME vip-spawn.vlan-systeme',
+ 'mirrors IN CNAME vip-spawn.vlan-systeme',
+ 'nscache IN CNAME vip-spawn.vlan-systeme',
+ 'nsprivate IN CNAME vip-spawn.vlan-systeme',
+ 'vip-deploy IN CNAME vip-spawn.vlan-systeme',
+ 'vip-spawn.vlan-pfds-ext IN A 192.168.1.99',
+ 'vip-spawn.vlan-systeme IN A 10.1.1.254',
+ '',
+ '; cbv4-pfds-filer',
+ ';----------------------------------------------------------------------------',
+ 'cbv4-pfds-filer00.vlan-systeme IN A 10.1.2.0',
+ 'cbv4-pfds-filer01.vlan-systeme IN A 10.1.2.1',
+ '',
+ '; cbv4-spawn',
+ ';----------------------------------------------------------------------------',
+ 'cbv4-spawn IN CNAME cbv4-spawn.vlan-systeme',
+ 'cbv4-spawn.vlan-systeme IN A 10.1.167.0',
+ 'cbv4-spawn.vlan-systeme IN A 10.1.167.1',
+ 'cbv4-spawn00.vlan-admindsi IN A 10.3.1.41',
+ 'cbv4-spawn00.vlan-middledsi IN A 10.3.2.41',
+ 'cbv4-spawn00.vlan-pfds-ext IN A 192.168.1.97',
+ 'cbv4-spawn00.vlan-pfds-int IN A 10.2.167.0',
+ 'cbv4-spawn00.vlan-systeme IN A 10.1.167.0',
+ 'cbv4-spawn01.vlan-admindsi IN A 10.3.1.42',
+ 'cbv4-spawn01.vlan-middledsi IN A 10.3.2.42',
+ 'cbv4-spawn01.vlan-pfds-ext IN A 192.168.1.98',
+ 'cbv4-spawn01.vlan-pfds-int IN A 10.2.167.1',
+ 'cbv4-spawn01.vlan-systeme IN A 10.1.167.1',
+ 'ntp IN CNAME cbv4-spawn.vlan-systeme',
+ 'ntp00 IN CNAME cbv4-spawn00.vlan-systeme',
+ 'ntp01 IN CNAME cbv4-spawn01.vlan-systeme',
+ 'spawn IN CNAME cbv4-spawn.vlan-systeme',
+ 'spawn00 IN CNAME cbv4-spawn00.vlan-systeme',
+ 'spawn01 IN CNAME cbv4-spawn01.vlan-systeme',
+ ''
+];
+
+is_deeply $result, $expected_result
+ => q{Returns the expected result for zone 'private'}
+ or note explain $result;
+
+
+########################################################################
+note('Testing PFTools::Utils::Mk_resolvconf');
+can_ok( 'PFTools::Utils', qw( Mk_resolvconf ) );
+
+throws_ok { Mk_resolvconf(); }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] hostname }xms
+ => q{Dies if empty $hostname};
+
+throws_ok { Mk_resolvconf( {} ); }
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] hostname }xms
+ => q{Dies if non-scalar $hostname};
+
+throws_ok { Mk_resolvconf( q{hostname} ); }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] global_config }xms
+ => q{Dies if empty $global_config};
+
+throws_ok { Mk_resolvconf( q{hostname}, q{global_config} ); }
+qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] [\$] global_config }xms
+ => q{Dies if non-hashref $global_config};
+
+throws_ok { Mk_resolvconf( q{name}, {} ); }
+qr{ \A ERROR: [ ] Invalid [ ] [\$] global_config [ ] hashref:
+ [ ] no [ ] 'ZONE' [ ] key [ ] found }xms
+ => q{Dies if non-config hashref $global_config};
+
+throws_ok { Mk_resolvconf( q{hostname}, $global_config ); }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] site_name }xms
+ => q{Dies if empty $site_name};
+
+throws_ok { Mk_resolvconf( q{hostname}, $global_config, {} ); }
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] site_name }xms
+ => q{Dies if non-scalar $site_name};
+
+throws_ok { Mk_resolvconf( q{hostname}, $global_config, q{site_name} ); }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] filename }xms
+ => q{Dies if empty $filename};
+
+throws_ok { Mk_resolvconf( q{hostname}, $global_config, q{site_name}, {} ); }
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] filename }xms
+ => q{Dies if non-scalar $filename};
+
+throws_ok { Mk_resolvconf( q{hostname}, $global_config, q{cbv4}, q{filename} ); }
+qr{ \A ERROR: [ ] Unknown [ ] hostname [ ] }xms
+ => q{Dies if unknown $hostname};
+
+throws_ok { Mk_resolvconf( q{cbv4-spawn00}, $global_config, q{cbv4}, q{filename} ); }
+qr{ \A ERROR: [ ] Unknown [ ] hostname [ ] }xms
+ => q{Dies if unknown $hostname};
+
+my $test_resolv_conf_file = q{test.resolv.conf};
+$result = Mk_resolvconf( q{cbv4-rdeploy01}, $global_config, q{cbv4}, $test_resolv_conf_file );
+ok $result => q{Returns true on success};
+
+$result = PFTools::Utils::__read_file_in_array( $test_resolv_conf_file, 1 );
+$expected_result = [
+ q{###############################################},
+ q{# This file was auto-genrated by mk_resolvconf},
+ q{},
+ q{search private},
+ q{},
+ q{nameserver 10.1.167.0},
+ q{nameserver 10.1.167.1},
+];
+
+
+is_deeply $result, $expected_result
+ => q{Returns the expected result for host cbv4-rdeploy01 site cbv4'}
+ or note explain $result;
+
+ok unlink($test_resolv_conf_file) => q{Removed the test-generated resolv.conf}
+
diff -r e756fd4d6365 -r bfbe1ebd6136 t/99.cleanup.t
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/t/99.cleanup.t Tue Nov 16 16:29:30 2010 +0100
@@ -0,0 +1,16 @@
+#!perl
+
+use strict;
+use warnings;
+
+use File::Path qw( remove_tree );
+use Test::Exception;
+use Test::More qw( no_plan );
+
+note('Cleaning up the test area');
+
+# Not really a test, but t/*.t need to run at least one test,
+# so we just run what we need inside lives_ok ;)
+lives_ok { remove_tree(q{/tmp/pf-test}); };
+
+
More information about the pf-tools-commits
mailing list