pf-tools/pf-tools: 11 new changesets
parmelan-guest at users.alioth.debian.org
parmelan-guest at users.alioth.debian.org
Thu Sep 16 14:32:42 UTC 2010
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/1edb695d6c49
changeset: 771:1edb695d6c49
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Tue Sep 14 16:14:48 2010 +0200
description:
Tests for __Sort_net_section (and __Sort_net_prio not needed anymore)
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/3fca89040985
changeset: 772:3fca89040985
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Tue Sep 14 16:19:37 2010 +0200
description:
comments + perltidy
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/14f6914d876d
changeset: 773:14f6914d876d
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Tue Sep 14 16:47:46 2010 +0200
description:
Subst_vars: suppress a warning
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/0773e3860626
changeset: 774:0773e3860626
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Tue Sep 14 23:16:43 2010 +0200
description:
Parser.pm: croak()
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/15622e818ae2
changeset: 775:15622e818ae2
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Wed Sep 15 09:12:23 2010 +0200
description:
Tests for Init_PF_CONFIG()
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/304e3732748b
changeset: 776:304e3732748b
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Wed Sep 15 16:18:38 2010 +0200
description:
Better corner cases in Subst_vars()
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/7c643563095b
changeset: 777:7c643563095b
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Wed Sep 15 19:26:36 2010 +0200
description:
Tests for Init_SUBST()
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/c260c0785cc3
changeset: 778:c260c0785cc3
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Thu Sep 16 10:00:38 2010 +0200
description:
fix comment
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/a87dd5b2ce2c
changeset: 779:a87dd5b2ce2c
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Thu Sep 16 14:17:27 2010 +0200
description:
Get_source() calls Subst_vars() + tests for Get_source()
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/705cc3717f46
changeset: 780:705cc3717f46
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Thu Sep 16 14:20:27 2010 +0200
description:
Simplify "make test" by calling "prove -lr"
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/d008affda437
changeset: 781:d008affda437
user: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
date: Thu Sep 16 14:22:21 2010 +0200
description:
Suppress a warning in make test
diffstat:
6 files changed, 126 insertions(+), 6 deletions(-)
lib/PFTools/Conf.pm | 1
lib/PFTools/Parser.pm | 3
lib/PFTools/Update/Addfile.pm | 1
lib/PFTools/Update/Createfile.pm | 1
t/11.vars.t | 4 -
t/13.conf.t | 122 ++++++++++++++++++++++++++++++++++++++
diffs (956 lines):
diff -r 2dbf713e764a -r d008affda437 Makefile
--- a/Makefile Wed Sep 15 15:50:24 2010 +0200
+++ b/Makefile Thu Sep 16 14:22:21 2010 +0200
@@ -33,7 +33,7 @@
# rien pour l'instant
test:
- perl -I./lib -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=1; runtests @ARGV;' t/*.t 2>/dev/null
+ prove -lr
install: install_tools install_host
diff -r 2dbf713e764a -r d008affda437 debian/control
--- a/debian/control Wed Sep 15 15:50:24 2010 +0200
+++ b/debian/control Thu Sep 16 14:22:21 2010 +0200
@@ -3,7 +3,7 @@
Priority: optional
Maintainer: Christophe Caillet <quadchris at free.fr>
Uploaders: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>, Christophe Caillet <quadchris at free.fr>
-Build-Depends-Indep: perl, libtest-exception-perl, libtest-more-perl
+Build-Depends-Indep: perl, libhash-merge-simple-perl, libtest-exception-perl, libtest-more-perl
Standards-Version: 3.0.1
Package: pf-tools
diff -r 2dbf713e764a -r d008affda437 lib/PFTools/Conf.pm
--- a/lib/PFTools/Conf.pm Wed Sep 15 15:50:24 2010 +0200
+++ b/lib/PFTools/Conf.pm Thu Sep 16 14:22:21 2010 +0200
@@ -1,4 +1,5 @@
package PFTools::Conf;
+
#
# Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
# Copyright (C) 2005-2007 Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
@@ -27,8 +28,8 @@
use Carp;
use English qw( -no_match_vars ); # Avoids regex performance penalty
use Fcntl ':mode';
+use Net::Domain qw( hostname hostdomain );
use Storable;
-use Sys::Hostname;
use PFTools::Conf::Host;
use PFTools::Conf::Network;
@@ -117,119 +118,150 @@
},
};
-# Subst_vars( $test, $variables_ref)
-# returns $text after replacing %FOO% by the value of $variables_ref->{'FOO'}
+=head2 Subst_vars( $text, $variables_ref)
+
+If $text is empty or undefined, just return it.
+If $variables_ref is not a valid hash reference, just return $text.
+Otherwise, replace %FOO% in $text by the value of $variables_ref->{'FOO'}.
+
+=cut
+
sub Subst_vars {
my ( $text, $variables_ref ) = @_;
- return unless $text and $variables_ref;
+ return unless defined $text;
+ return $text unless $text;
+ return $text unless ref $variables_ref eq 'HASH';
- $text =~ s{ % ([^%]+) % }{$variables_ref->{$1}}xmsg;
+ $text =~ s{ % ([^%]+) % }{ $variables_ref->{$1} || '' }xmsge;
return $text;
}
+
+=head2 Init_PF_CONFIG( $filename )
+
+Parses $filename and merges known sections/keys with the default
+configuration as found in $PF_CONFIG.
+Returns $PF_CONFIG if no $filename specified.
+Returns the result of the merge if $filename parses correctly.
+croak() on fatal error.
+
+=cut
sub Init_PF_CONFIG {
my ($config_file) = @_;
return $PF_CONFIG unless $config_file;
- if ( !-e $config_file ) {
- Abort( $CODE->{'UNDEF_KEY'},
- "Unable to proceed with configuration file "
- . $config_file
- . " : no such file or directory" );
+ unless ( -e $config_file ) {
+ croak qq{ERROR: $config_file: no such file};
}
+
+ # FIXME use File::stat ?
+ # FIXME stat or lstat ?
my ( $dev, $ino, $mode, $nlink, $uid, $gid, @lstat_vars )
= lstat($config_file);
-# unless ( $uid == 0 && $gid == 0 && S_IMODE($mode) == 0600 && S_ISREG($mode) ) {
+ # FIXME: also check that $uid == 0 && $gid == 0 ?
unless ( S_IMODE($mode) == 0600 && S_ISREG($mode) ) {
- Abort( $CODE->{'RIGHTS'},
- "Ignoring weak rights for configuration file "
- . $config_file
- . " (check owner/group/mode)" );
+ croak
+ qq{ERROR: weak rights for $config_file (check owner/group/mode)};
}
my $conf_parsed = Parser_ini($config_file);
- Abort( $CODE->{'SYNTAX'},
- "Unable to parse configuration file " . $config_file )
- if ( !defined $conf_parsed );
+
+ # FIXME use Hash::Merge::Simple instead ?
+ # (it would allow unknown sections/keys, is that a problem ?)
+ # (would also need to separate $DEFAULT_PF_CONFIG and $PF_CONFIG)
foreach my $section ( keys %{$PF_CONFIG} ) {
- next if ( !defined $conf_parsed->{$section} );
+ next if !defined $conf_parsed->{$section};
foreach my $key ( keys %{ $PF_CONFIG->{$section} } ) {
- if ( defined $conf_parsed->{$section}->{$key} ) {
- $PF_CONFIG->{$section}->{$key}
- = $conf_parsed->{$section}->{$key};
- }
+ next if !defined $conf_parsed->{$section}->{$key};
+ $PF_CONFIG->{$section}->{$key} = $conf_parsed->{$section}->{$key};
}
}
+
return $PF_CONFIG;
}
+=head2 Init_SUBST( $hostname, $host_type, $pf_config, $domainname )
+
+Initialize a hash structure with all the substitution variables needed
+to handle $hostname (default: the local host).
+
+FIXME: The variables are NOT documented.
+
+=cut
+
sub Init_SUBST {
- my ( $host, $hosttype, $pf_config, $domain ) = @_;
+ my ( $hostname, $hosttype, $pf_config, $domainname ) = @_;
- unless ($host) {
- Abort( $CODE->{'UNDEF_KEY'},
- "Unable to init substitution hash (undefined hostname)." );
+ $hostname ||= hostname;
+
+ if ( $pf_config and ref $pf_config ne 'HASH' ) {
+ croak q{ERROR: Invalid non-href $pf_config};
}
- unless (ref $hosttype ne 'SCALAR') {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Hosttype parameter must be a string" );
+ $pf_config ||= Init_PF_CONFIG();
+
+ $domainname ||= $pf_config->{'location'}->{'zone'} || hostdomain || q{};
+
+ if ( $hosttype and ref $hosttype ne 'SCALAR' ) {
+ croak q{ERROR: Hosttype parameter must be a string};
}
- unless ($pf_config) {
- $pf_config = Init_PF_CONFIG();
- }
-
- my $ref_subst = {};
- $ref_subst->{'HOSTNAME'} = ( $host ne "" ) ? $host : hostname;
- $ref_subst->{'DOMAINNAME'}
- = $domain
- || $pf_config->{'location'}->{'zone'}
- || "";
- if ( $ref_subst->{'DOMAINNAME'} eq "" ) {
- if ( -x "/bin/domainname" ) {
- chomp( $ref_subst->{'DOMAINNAME'}
- = `/bin/domainname 2>>/dev/null` );
- }
- elsif ( -x "/bin/dnsdomainname" ) {
- chomp( $ref_subst->{'DOMAINNAME'}
- = `/bin/dnsdomainname 2>>/dev/null` );
- }
- }
- chomp( $ref_subst->{'OS_RELEASE'} = `/bin/uname -r` );
my $host_regex = $pf_config->{'regex'}->{'hostname'}
|| $HOST_CONFIG_REGEX;
- unless ( $ref_subst->{'HOSTNAME'} =~ m/$host_regex/ ) {
- Abort( $CODE->{'OPEN'},
- "Init_SUBST failed: invalid hostname $ref_subst->{'HOSTNAME'}" );
+ unless ( $hostname =~ m/$host_regex/ ) {
+ croak qq{ERROR: Invalid hostname $hostname};
}
- $ref_subst->{'HOSTTYPE'} = $hosttype || $+{HOSTTYPE};
- $ref_subst->{'HOSTDIGITS'} = $+{HOSTDIGITS};
- $ref_subst->{'HOSTCLUSTER'} = $+{HOSTDIGITS} . $+{HOSTNODEINDEX}
- if defined $+{HOSTDIGITS} and defined $+{HOSTNODEINDEX};
- $ref_subst->{'HOSTNODEINDEX'} = $+{HOSTNODEINDEX} || '';
- $ref_subst->{'POPNAME'} = $+{POPNAME} || '';
- $ref_subst->{'HOSTNUM'} = $ref_subst->{'HOSTDIGITS'};
- $ref_subst->{'HOSTNUM'} =~ s/^0*//;
+ chomp( my $os_release = qx{ /bin/uname -r } );
- if ( $ref_subst->{'HOSTNUM'} eq '' ) {
- $ref_subst->{'HOSTNUM'} = 0;
- }
- $ref_subst->{'HOSTMINUTE'} = $ref_subst->{'HOSTNUM'} % 60;
- $ref_subst->{'HOSTHOUR'} = $ref_subst->{'HOSTNUM'} % 24;
+ my $hostnum = sprintf '%d', $+{HOSTDIGITS} || 0;
+
+ my $ref_subst = {
+ HOSTNAME => $hostname,
+ DOMAINNAME => $domainname,
+ HOSTTYPE => $hosttype || $+{HOSTTYPE},
+ HOSTDIGITS => $+{HOSTDIGITS},
+ HOSTNUM => $hostnum,
+ HOSTNODEINDEX => $+{HOSTNODEINDEX} || q{},
+ HOSTCLUSTER => $+{HOSTDIGITS} . $+{HOSTNODEINDEX},
+ POPNAME => $+{POPNAME} || q{},
+ OS_RELEASE => $os_release,
+ HOSTMINUTE => $hostnum % 60,
+ HOSTHOUR => $hostnum % 24,
+ };
+
return $ref_subst;
}
+
+=head2 Get_source( $source, $hostname, $hash_subst, $pf_config )
+
+If $source is defined, resolve macros and variables found in $source and return
+the result.
+
+Optional parameters $hostname, $hash_subst and $pf_config will be computed if
+not specified.
+
+FIXME: The macros are NOT documented.
+
+The variables are defined by $hash_subst (defaults to the result of
+Init_SUBST()). See also Subst_vars().
+
+=cut
sub Get_source {
my ( $source, $hostname, $hash_subst, $pf_config ) = @_;
- return unless $source;
+ return unless defined $source;
+ return $source unless $source;
+
+ if ( $hash_subst and ref $hash_subst ne 'HASH' ) {
+ croak q{ERROR: Invalid non-href $hash_subst};
+ }
unless ($hash_subst) {
- $hash_subst = Init_SUBST( $hostname, $pf_config );
+ $hash_subst = Init_SUBST( $hostname, undef, $pf_config );
}
unless ($pf_config) {
$pf_config = $PF_CONFIG;
@@ -237,20 +269,31 @@
my $vcs_work_dir = $pf_config->{'path'}->{'checkout_dir'};
my $module = $pf_config->{'vcs'}->{'module'};
- $source =~ s!^MODSITE_([^:]+):!$vcs_work_dir/$module/SITE/$1/MODEL!;
- $source =~ s!^MOD:!$vcs_work_dir/$module/MODEL!;
- $source =~ s!^CONFSITE_([^:]+):!$vcs_work_dir/$module/SITE/$1/CONFIG!;
- $source =~ s!^CONF:!$vcs_work_dir/$module/CONFIG!;
- $source =~ s!^SITE_([^:]+):!$vcs_work_dir/$module/SITE/$1!;
- $source =~ s!^SITE:!$vcs_work_dir/$module/SITE!;
- $source
- =~ s!^HOSTSITE_([^:]+):!$vcs_work_dir/$module/SITE/$1/$hash_subst->{'HOSTTYPE'}!;
- $source =~ s!^HOST:!$vcs_work_dir/$module/$hash_subst->{'HOSTTYPE'}!;
- $source =~ s!^COMMON:!$vcs_work_dir/$module/COMMON!;
- $source =~ s!^CONFIG:!$vcs_work_dir/$module/!;
- $source =~ s!^CVS:!$vcs_work_dir/!;
- $source =~ s!^GLOBAL:!$vcs_work_dir/$module/GLOBAL!;
- return $source;
+
+ my $result = $source;
+
+ $result
+ =~ s{ \A MODSITE_([^:]+) [:] }{$vcs_work_dir/$module/SITE/$1/MODEL}xms;
+ $result =~ s{ \A MOD [:] }{$vcs_work_dir/$module/MODEL}xms;
+ $result
+ =~ s{ \A CONFSITE_([^:]+) [:] }{$vcs_work_dir/$module/SITE/$1/CONFIG}xms;
+ $result =~ s{ \A CONF [:] }{$vcs_work_dir/$module/CONFIG}xms;
+ $result =~ s{ \A SITE_([^:]+) [:] }{$vcs_work_dir/$module/SITE/$1}xms;
+ $result =~ s{ \A SITE [:] }{$vcs_work_dir/$module/SITE}xms;
+ $result
+ =~ s{ \A HOSTSITE_([^:]+) [:] }{$vcs_work_dir/$module/SITE/$1/%HOSTTYPE%}xms;
+ $result
+ =~ s{ \A HOST [:] }{$vcs_work_dir/$module/%HOSTTYPE%}xms;
+ $result =~ s{ \A COMMON [:] }{$vcs_work_dir/$module/COMMON}xms;
+ $result =~ s{ \A CONFIG [:] }{$vcs_work_dir/$module/}xms;
+ $result =~ s{ \A CVS [:] }{$vcs_work_dir/}xms;
+ $result =~ s{ \A GLOBAL [:] }{$vcs_work_dir/$module/GLOBAL}xms;
+
+ $result = Subst_vars( $result, $hash_subst );
+
+ $result =~ s{ [/]+ }{/}xmsg; # fix multiple slashes
+
+ return $result;
}
sub __Get_config_path {
@@ -258,14 +301,18 @@
return unless $hostvalue and $pf_config and $site;
- my $site_conf_file = Get_source( "CONFSITE_${site}:/update-${hostvalue}",
- $hostvalue, {}, $pf_config );
+ my $site_conf_file = Get_source(
+ "CONFSITE_${site}:/update-${hostvalue}",
+ $hostvalue, {}, $pf_config
+ );
return $site_conf_file
if -e $site_conf_file;
my $default_conf_file
- = Get_source( "CONFIG:/update-${hostvalue}", $hostvalue, {},
- $pf_config );
+ = Get_source(
+ "CONFIG:/update-${hostvalue}", $hostvalue, {},
+ $pf_config
+ );
return $default_conf_file
if -e $default_conf_file;
@@ -329,21 +376,25 @@
my $tmp_merged
= __Merge_conf_includes(
$hash_to_merge->{$section}->{'__content'},
- $hash_subst, $context );
+ $hash_subst, $context
+ );
foreach my $tomerge_section ( @{ $tmp_merged->{'__sections_order'} } )
{
if ( defined $global_parsed->{$tomerge_section} ) {
- if ( !defined $tmp_merged->{$tomerge_section}->{'override'}
+ if (!defined $tmp_merged->{$tomerge_section}->{'override'}
|| $tmp_merged->{$tomerge_section}->{'override'} ne
- 'replace' )
+ 'replace'
+ )
{
- Warn( $CODE->{'WARNING'},
+ Warn(
+ $CODE->{'WARNING'},
"Section $tomerge_section from file $section already defined ... skipping it\n"
);
next;
}
else {
- Warn( $CODE->{'WARNING'},
+ Warn(
+ $CODE->{'WARNING'},
"Section $tomerge_section already defined but override is set to replace ... overriding it\n"
);
@@ -369,15 +420,13 @@
return unless $file and $hash_subst and $context and $pf_config;
if ( $context !~ m/^$ALLOWED_PARSING_CONTEXT$/ ) {
- Abort( $CODE->{'INVALID_CONTEXT'},
+ Abort(
+ $CODE->{'INVALID_CONTEXT'},
"Context $context for file $file doesn't match $ALLOWED_PARSING_CONTEXT"
);
}
my $parsed = Parser_ini($file);
- if ( !defined $parsed ) {
- Abort( $CODE->{'PARSING'}, "Parsing error for file $file" );
- }
if ( $context =~ /^(model|host)$/ ) {
if ( defined $parsed->{'hostgroup'}->{'model'} ) {
@@ -397,17 +446,20 @@
foreach my $section ( keys %{$parsed} ) {
next if ( $section =~ /^__/ );
if ( !defined $parsed->{$section}->{$select} ) {
- Abort( $CODE->{'UNDEF_KEY'},
+ Abort(
+ $CODE->{'UNDEF_KEY'},
"Key $select on section $section from file $file MUST BE defined"
);
}
my $sect_type = $parsed->{$section}->{$select};
if ( $sect_type eq 'include' ) {
+
# We need to dive into deep ...
$parsed->{$section}->{'__content'}
= Load_conf(
Get_source( $section, "", $hash_subst, $pf_config ),
- $hash_subst, $context, $pf_config );
+ $hash_subst, $context, $pf_config
+ );
}
}
}
@@ -428,18 +480,23 @@
else {
my $select = ( $context eq 'config' ) ? 'action' : 'type';
if ( !defined $parsed->{$section}->{$select} ) {
- Abort( $CODE->{'UNDEF_KEY'},
+ Abort(
+ $CODE->{'UNDEF_KEY'},
"Key $select on section $section from file $file MUST BE defined"
);
}
$sect_type = $parsed->{$section}->{$select};
}
my ( $code, $msg )
- = Chk_section_struct( $section, $sect_type, $parsed->{$section},
- $context );
+ = Chk_section_struct(
+ $section, $sect_type, $parsed->{$section},
+ $context
+ );
if ( $code > 1 ) {
- Warn( $code,
- "Errors occur during parsing model from file $file" );
+ Warn(
+ $code,
+ "Errors occur during parsing model from file $file"
+ );
Abort( $code, $msg );
}
}
@@ -447,27 +504,31 @@
return $parsed;
}
-### Like old Init_lib_net
-sub __Sort_net_prio {
+=head2 __Sort_net_section( $net, $a, $b )
- #my ( $type, $section ) = @_;
- my ($type) = @_;
+This function is used to sort the network configuration sections by section
+type. It always returns -1, 0 or 1, as every sort subroutine.
- my $prio = 0;
-
- foreach my $prio_type ( 'zone', 'site', 'network', 'server', 'service' ) {
- return $prio if $type eq $prio_type;
- $prio++;
- }
-
- return $prio;
-}
+=cut
sub __Sort_net_section {
my ( $net_parsed, $a, $b ) = @_;
- return __Sort_net_prio( $net_parsed->{$a}->{'type'}, $a )
- <=> __Sort_net_prio( $net_parsed->{$b}->{'type'}, $b );
+ return -1 unless defined $a and defined $b; # => no warnings
+
+ my %net_prio_for = (
+ 'zone' => 0,
+ 'site' => 1,
+ 'network' => 2,
+ 'server' => 3,
+ 'service' => 4,
+ 'unknown' => 100,
+ );
+
+ my $a_type = $net_parsed->{$a}->{'type'} || 'unknown';
+ my $b_type = $net_parsed->{$b}->{'type'} || 'unknown';
+
+ return $net_prio_for{$a_type} <=> $net_prio_for{$b_type};
}
sub Init_GLOBAL_NETCONFIG {
@@ -497,20 +558,28 @@
@{ $net_parsed->{'__sections_order'} };
foreach my $section (@sortnetkeys) {
if ( $net_parsed->{$section}->{'type'} eq 'zone' ) {
- Add_zone( $start_file, $section, $net_parsed->{$section},
- $GLOBAL, $pf_config );
+ Add_zone(
+ $start_file, $section, $net_parsed->{$section},
+ $GLOBAL, $pf_config
+ );
}
elsif ( $net_parsed->{$section}->{'type'} eq 'site' ) {
- Add_site( $start_file, $section, $net_parsed->{$section},
- $GLOBAL, $pf_config );
+ Add_site(
+ $start_file, $section, $net_parsed->{$section},
+ $GLOBAL, $pf_config
+ );
}
elsif ( $net_parsed->{$section}->{'type'} eq 'network' ) {
- Add_network( $start_file, $section, $net_parsed->{$section},
- $GLOBAL, $pf_config );
+ Add_network(
+ $start_file, $section, $net_parsed->{$section},
+ $GLOBAL, $pf_config
+ );
}
elsif ( $net_parsed->{$section}->{'type'} eq 'server' ) {
- Add_server( $start_file, $section, $net_parsed->{$section},
- $GLOBAL, $pf_config );
+ Add_server(
+ $start_file, $section, $net_parsed->{$section},
+ $GLOBAL, $pf_config
+ );
}
elsif ( $net_parsed->{$section}->{'type'} eq 'service' ) {
my $site_list = Get_site_list( $net_parsed->{$section}, $GLOBAL );
@@ -522,8 +591,10 @@
my $hostfile
= Get_source( $host, "", $hash_subst, $pf_config );
my $host_parsed
- = Load_conf( $hostfile, $hash_subst, 'host',
- $pf_config );
+ = Load_conf(
+ $hostfile, $hash_subst, 'host',
+ $pf_config
+ );
Add_host( $hostfile, $host_parsed, $GLOBAL, $pf_config );
push @{ $service_part->{$section} }, $host;
}
@@ -534,6 +605,8 @@
return $GLOBAL;
}
+# store $global_config in $flush_file
+# $flush_file defaults to $pf_config->{'path'}->{'global_struct'}
sub Flush2disk_GLOBAL {
my ( $global_config, $pf_config, $flush_file ) = @_;
@@ -552,6 +625,7 @@
return 1;
}
+# retrieve and return $global_config from $path_global_file
sub Retrieve_GLOBAL {
my ($path_global_file) = @_;
@@ -562,7 +636,8 @@
croak "ERROR: $EVAL_ERROR";
}
if ( !$ret ) {
- croak "ERROR: unable to retrieve global structure from $path_global_file";
+ croak
+ "ERROR: unable to retrieve global structure from $path_global_file";
}
return $ret;
@@ -584,7 +659,8 @@
my $hosttype
= Get_hosttype_from_hostname( $hostname, $global_config, $site );
if ( !defined $hosttype ) {
- Abort( $CODE->{'UNDEF_KEY'},
+ Abort(
+ $CODE->{'UNDEF_KEY'},
"Unable to get hosttype from hostname $hostname for getting hosttype configuration file"
);
}
@@ -610,4 +686,5 @@
return $global_host_conf;
}
-1;
+1; # Magic true value required at end of module
+
diff -r 2dbf713e764a -r d008affda437 lib/PFTools/Parser.pm
--- a/lib/PFTools/Parser.pm Wed Sep 15 15:50:24 2010 +0200
+++ b/lib/PFTools/Parser.pm Thu Sep 16 14:22:21 2010 +0200
@@ -40,13 +40,11 @@
# @Config::IniFiles::errors is only used for parse errors
if (@Config::IniFiles::errors) {
- carp "Unable to parse $file: ",
+ croak "ERROR: Unable to parse $file: ",
join( "\n", @Config::IniFiles::errors );
- return; # FIXME should just croak()
}
- unless ($parse) {
- carp "Unable to load $file";
- return; # FIXME should just croak()
+ if ( !$parse ) {
+ croak "ERROR: Unable to load $file";
}
my $refined = $parse->{'v'};
diff -r 2dbf713e764a -r d008affda437 lib/PFTools/Update/Addfile.pm
--- a/lib/PFTools/Update/Addfile.pm Wed Sep 15 15:50:24 2010 +0200
+++ b/lib/PFTools/Update/Addfile.pm Thu Sep 16 14:22:21 2010 +0200
@@ -64,8 +64,7 @@
my $splitsource;
foreach $splitsource ( split( ' ', $ref_section->{'source'} ) ) {
$splitsource
- = Get_source( Subst_vars( $splitsource, $hash_subst ),
- $options->{'host'}, $hash_subst );
+ = Get_source( $splitsource, $options->{'host'}, $hash_subst );
if ( !-f $splitsource ) {
Warn( $CODE->{'OPEN'}, "Unable to open " . $splitsource );
return 1;
@@ -82,8 +81,7 @@
}
}
else {
- $source
- = Get_source( Subst_vars( $ref_section->{'source'}, $hash_subst ),
+ $source = Get_source( $ref_section->{'source'},
$options->{'host'}, $hash_subst );
}
diff -r 2dbf713e764a -r d008affda437 lib/PFTools/Update/Createfile.pm
--- a/lib/PFTools/Update/Createfile.pm Wed Sep 15 15:50:24 2010 +0200
+++ b/lib/PFTools/Update/Createfile.pm Thu Sep 16 14:22:21 2010 +0200
@@ -72,8 +72,7 @@
}
}
else {
- my $source
- = Get_source( Subst_vars( $ref_section->{'source'}, $hash_subst ),
+ my $source = Get_source( $ref_section->{'source'},
$hash_subst->{'HOSTNAME'}, $hash_subst );
$hash_subst->{'SOURCE'} = $source;
my $tmp = Get_tmp_dest($dest);
diff -r 2dbf713e764a -r d008affda437 lib/PFTools/VCS/CVS.pm
--- a/lib/PFTools/VCS/CVS.pm Wed Sep 15 15:50:24 2010 +0200
+++ b/lib/PFTools/VCS/CVS.pm Thu Sep 16 14:22:21 2010 +0200
@@ -33,7 +33,7 @@
checkout
);
-sub checkout ($$$) {
+sub checkout {
my ( $hostname, $pf_config, $options ) = @_;
my $cvs_cmd = $pf_config->{'vcs'}->{'command'};
diff -r 2dbf713e764a -r d008affda437 t/10.parse.t
--- a/t/10.parse.t Wed Sep 15 15:50:24 2010 +0200
+++ b/t/10.parse.t Thu Sep 16 14:22:21 2010 +0200
@@ -3,6 +3,7 @@
use strict;
use warnings;
+use Test::Exception;
use Test::More qw( no_plan );
use PFTools::Parser qw( Parser_ini );
@@ -14,15 +15,18 @@
ok !defined( Parser_ini() )
=> 'Returns undef if no file specified';
-ok !defined( Parser_ini('/dev/null'))
- => 'Returns undef on empty file';
+throws_ok { Parser_ini('/dev/null') }
+ qr{\A ERROR: }xms
+ => 'Dies on empty file';
-ok !defined( Parser_ini('/nonexistent.ini') )
- => 'Returns undef on nonexistent file';
+throws_ok { Parser_ini('/nonexistent.ini') }
+ qr{\A ERROR: }xms
+ => 'Dies on nonexistent file';
-my $cfg = Parser_ini('t/10.parse.cfg1');
-ok !defined($cfg)
- => 'Returns undef on non-ini file';
+my $cfg;
+throws_ok { Parser_ini('t/10.parse.cfg1') }
+ qr{\A ERROR: }xms
+ => 'Dies on non-ini file';
$cfg = Parser_ini('t/10.parse.cfg2');
ok defined($cfg)
diff -r 2dbf713e764a -r d008affda437 t/11.vars.t
--- a/t/11.vars.t Wed Sep 15 15:50:24 2010 +0200
+++ b/t/11.vars.t Thu Sep 16 14:22:21 2010 +0200
@@ -14,8 +14,12 @@
ok !defined( Subst_vars() )
=> 'Returns undef if no args';
-ok !defined( Subst_vars(undef, undef) )
- => 'Returns undef if undef args';
+ok !defined( Subst_vars(undef) )
+ => 'Returns undef if undef string';
+
+is Subst_vars( q{}, {} ),
+ q{}
+ => 'Returns empty string if $text is empty';
my %variables = (
VAR1 => "var1",
@@ -23,6 +27,10 @@
VAR10 => "var10",
);
my $template_string = q{Some %VAR1% text %VAR10% %UNKNOWN_VAR% %%VAR2%%.};
+
+is Subst_vars( $template_string, 'foo' ),
+ $template_string
+ => 'Returns $text if $variables_ref is not a hashref';
my $result = Subst_vars($template_string, \%variables);
ok defined($result)
diff -r 2dbf713e764a -r d008affda437 t/13.conf.t
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/t/13.conf.t Thu Sep 16 14:22:21 2010 +0200
@@ -0,0 +1,245 @@
+#!perl
+
+use strict;
+use warnings;
+
+use English qw( -no_match_vars ); # Avoids regex performance penalty
+use Test::Exception;
+use Test::More qw( no_plan );
+
+use PFTools::Conf;
+
+########################################################################
+note('Testing PFTools::Conf::__Sort_net_section');
+
+is PFTools::Conf::__Sort_net_section(), -1
+ => 'Returns -1 if no arg';
+
+is PFTools::Conf::__Sort_net_section( {}, 'foo', 'bar' ), 0
+ => 'Returns 0 if invalid parsed_net arg';
+
+# FIXME add a more complex/complete test
+my $parsed_net = {
+ foo => {
+ type => 'server',
+ },
+ bar => {
+ type => 'network',
+ },
+};
+
+is PFTools::Conf::__Sort_net_section( $parsed_net, 'foo', 'foo' ), 0
+ => 'Returns 0 if same order';
+
+is PFTools::Conf::__Sort_net_section( $parsed_net, 'foo', 'bar' ), 1
+ => 'Returns 1 if inversed order';
+
+my @ordered = sort { PFTools::Conf::__Sort_net_section( $parsed_net, $a, $b ) } qw( foo bar baz );
+my @expected_order = qw( bar foo baz );
+is_deeply \@ordered, \@expected_order
+ => 'Sorts correctly';
+
+########################################################################
+note('Testing PFTools::Conf::Init_PF_CONFIG');
+can_ok( 'PFTools::Conf', qw( Init_PF_CONFIG ) );
+
+my $default_pf_config = $PFTools::Conf::PF_CONFIG;
+ok defined $default_pf_config
+ => '$PF_CONFIG defined';
+ok ref $default_pf_config eq 'HASH'
+ => '$PF_CONFIG is a hashref';
+ok keys %{$default_pf_config}
+ => '$PF_CONFIG is a non-empty hashref';
+
+is_deeply Init_PF_CONFIG(), $default_pf_config
+ => 'Returns the default config';
+
+throws_ok { Init_PF_CONFIG( '/non-existent-file' ) }
+ qr{\A ERROR: }xms
+ => 'Dies with error message if non-existent configuration file';
+
+my $test_config_file = '/tmp/test_configuration';
+unlink $test_config_file;
+my $fh = IO::File->new( $test_config_file, '>', 0666 )
+ or die "open $test_config_file: $OS_ERROR";
+$fh->print( <<'EOT' )
+[debian]
+fake = value
+preseed = mypreseed
+EOT
+ or die "print $test_config_file: $OS_ERROR";
+$fh->close
+ or die "close $test_config_file: $OS_ERROR";
+
+my $test_configuration = {
+ debian => {
+ # fake => 'value', # this one ignored: unknown key
+ preseed => 'mypreseed',
+ },
+};
+
+throws_ok { Init_PF_CONFIG($test_config_file) }
+ qr{\A ERROR: }xms
+ => 'Dies with error message if configuration file has bad permissions';
+
+chmod 0600, $test_config_file
+ or die "chmod: $OS_ERROR";
+
+my $parsed_configuration = Init_PF_CONFIG( $test_config_file );
+ok ref $parsed_configuration eq 'HASH' && keys %{$parsed_configuration}
+ => 'Returns a non-empty hashref';
+
+use Hash::Merge::Simple qw( merge );
+my $expected_configuration = merge( $default_pf_config, $test_configuration );
+is_deeply $parsed_configuration, $expected_configuration
+ => 'Correctly merges with the default configuration'
+ or note explain $parsed_configuration;
+
+unlink $test_config_file
+ or die "unlink $test_config_file: $OS_ERROR";
+
+########################################################################
+note('Testing PFTools::Conf::Init_SUBST');
+can_ok( 'PFTools::Conf', qw( Init_SUBST ) );
+
+throws_ok { Init_SUBST( undef, { foo => 1 } ) }
+ qr{\A ERROR: [ ] Hosttype [ ] parameter [ ] must [ ] be [ ] a [ ] string }xms
+ => 'Dies if $hosttype specified but not a scalar';
+
+throws_ok { Init_SUBST( '1nvalid_hostname!' ) }
+ qr{\A ERROR: [ ] Invalid [ ] hostname }xms
+ => 'Dies if invalid $hostname';
+
+# OS_RELEASE is always taken from the local host
+chomp( my $os_release = qx{ /bin/uname -r } );
+
+# FIXME: add real tests for HOSTCLUSTER et HOSTNODEINDEX
+my $expected_subst_for = {
+ 'abv1-ncdn-lvs00' => {
+ 'HOSTMINUTE' => 0,
+ 'HOSTDIGITS' => '00',
+ 'HOSTNUM' => 0,
+ 'HOSTNAME' => 'abv1-ncdn-lvs00',
+ 'HOSTNODEINDEX' => '',
+ 'DOMAINNAME' => 'private',
+ 'OS_RELEASE' => $os_release,
+ 'HOSTHOUR' => 0,
+ 'HOSTTYPE' => 'abv1-ncdn-lvs',
+ 'HOSTCLUSTER' => '00',
+ 'POPNAME' => 'abv1'
+ },
+ 'cor1-spawn00' => {
+ 'HOSTMINUTE' => 0,
+ 'HOSTDIGITS' => '00',
+ 'HOSTNUM' => 0,
+ 'HOSTNAME' => 'cor1-spawn00',
+ 'HOSTNODEINDEX' => '',
+ 'DOMAINNAME' => 'private',
+ 'OS_RELEASE' => $os_release,
+ 'HOSTHOUR' => 0,
+ 'HOSTTYPE' => 'cor1-spawn',
+ 'HOSTCLUSTER' => '00',
+ 'POPNAME' => 'cor1'
+ },
+ 'cor1-spawn01' => {
+ 'HOSTMINUTE' => 1,
+ 'HOSTDIGITS' => '01',
+ 'HOSTNUM' => 1,
+ 'HOSTNAME' => 'cor1-spawn01',
+ 'HOSTNODEINDEX' => '',
+ 'DOMAINNAME' => 'private',
+ 'OS_RELEASE' => $os_release,
+ 'HOSTHOUR' => 1,
+ 'HOSTTYPE' => 'cor1-spawn',
+ 'HOSTCLUSTER' => '01',
+ 'POPNAME' => 'cor1'
+ },
+};
+
+foreach my $hostname ( keys %{ $expected_subst_for } ) {
+ # we must fake the 'private' domainname
+ my $got = Init_SUBST($hostname, undef, undef, 'private');
+ is_deeply $got, $expected_subst_for->{$hostname}
+ => qq{Returns the correct information for host $hostname}
+ or note explain $got;
+}
+
+########################################################################
+note('Testing PFTools::Conf::Get_source');
+can_ok( 'PFTools::Conf', qw( Get_source ) );
+
+ok !defined( Get_source() )
+ => 'Returns undef if no args';
+
+ok !defined( Get_source(undef) )
+ => 'Returns undef if undef string';
+
+is Get_source( q{}, {} ),
+ q{}
+ => 'Returns empty string if $text is empty';
+
+throws_ok { Get_source( q{foo bar baz}, undef, q{non-hashref $hash_subst} ) }
+ qr{ \A ERROR: [ ] Invalid [ ] non-href [ ] [\$] hash_subst }xms
+ => q{Dies on non-hashref $hash_subst};
+
+throws_ok { Get_source( q{foo bar baz}, undef, undef, q{non-hashref $pf_config} ) }
+ qr{ \A ERROR: [ ] Invalid [ ] non-href [ ] [\$] pf_config }xms
+ => q{Dies on non-hashref $pf_config};
+
+is Get_source( q{MODSITE_FOOBAR:/my/path/to/file} ),
+ q{/var/lib/cvsguest/config/SITE/FOOBAR/MODEL/my/path/to/file}
+ => q{Good result for MODSITE_*:};
+
+is Get_source( q{MOD:/my/path/to/file} ),
+ q{/var/lib/cvsguest/config/MODEL/my/path/to/file}
+ => q{Good result for MOD:};
+
+is Get_source( q{CONFSITE_FOOBAR:/my/path/to/file} ),
+ q{/var/lib/cvsguest/config/SITE/FOOBAR/CONFIG/my/path/to/file}
+ => q{Good result for CONFSITE_*:};
+
+is Get_source( q{CONF:/my/path/to/file} ),
+ q{/var/lib/cvsguest/config/CONFIG/my/path/to/file}
+ => q{Good result for CONF:};
+
+is Get_source( q{SITE_FOOBAR:/my/path/to/file} ),
+ q{/var/lib/cvsguest/config/SITE/FOOBAR/my/path/to/file}
+ => q{Good result for SITE_*:};
+
+is Get_source( q{SITE:/my/path/to/file} ),
+ q{/var/lib/cvsguest/config/SITE/my/path/to/file}
+ => q{Good result for SITE:};
+
+is Get_source( q{HOSTSITE_FOOBAR:/my/path/to/file}, q{myhost00} ),
+ q{/var/lib/cvsguest/config/SITE/FOOBAR/myhost/my/path/to/file}
+ => q{Good result for HOSTSITE_*:};
+
+is Get_source( q{HOST:/my/path/to/file}, q{myhost00} ),
+ q{/var/lib/cvsguest/config/myhost/my/path/to/file}
+ => q{Good result for HOST:};
+
+is Get_source( q{HOST:/my/path/to/file.%HOSTDIGITS%}, q{myhost00} ),
+ q{/var/lib/cvsguest/config/myhost/my/path/to/file.00}
+ => q{Good result for HOST: and %HOSTDIGITS%};
+
+is Get_source( q{COMMON:/my/path/to/file} ),
+ q{/var/lib/cvsguest/config/COMMON/my/path/to/file}
+ => q{Good result for COMMON:};
+
+is Get_source( q{CONFIG:/my/path/to/file} ),
+ q{/var/lib/cvsguest/config/my/path/to/file}
+ => q{Good result for CONFIG:/};
+
+is Get_source( q{CONFIG:my/path/to/file} ),
+ q{/var/lib/cvsguest/config/my/path/to/file}
+ => q{Good result for CONFIG:};
+
+is Get_source( q{CVS:config/my/path/to/file} ),
+ q{/var/lib/cvsguest/config/my/path/to/file}
+ => q{Good result for CVS:};
+
+is Get_source( q{GLOBAL:/my/path/to/file} ),
+ q{/var/lib/cvsguest/config/GLOBAL/my/path/to/file}
+ => q{Good result for CONFIG:};
+
+
More information about the pf-tools-commits
mailing list