pf-tools/pf-tools: 3 new changesets

parmelan-guest at users.alioth.debian.org parmelan-guest at users.alioth.debian.org
Wed Sep 22 14:51:51 UTC 2010


details:   http://hg.debian.org/hg/pf-tools/pf-tools/rev/2e55e00e83bc
changeset: 804:2e55e00e83bc
user:      "Christophe Caillet <quadchris at free.fr>"
date:      Wed Sep 22 07:48:27 2010 +0200
description:
UPD: adding tests for params in functions

details:   http://hg.debian.org/hg/pf-tools/pf-tools/rev/b7b894febdeb
changeset: 805:b7b894febdeb
user:      "Christophe Caillet <quadchris at free.fr>"
date:      Wed Sep 22 08:12:44 2010 +0200
description:
Coding style
Params checks

details:   http://hg.debian.org/hg/pf-tools/pf-tools/rev/192bbd15991e
changeset: 806:192bbd15991e
user:      "Christophe Caillet <quadchris at free.fr>"
date:      Wed Sep 22 08:40:40 2010 +0200
description:
Coding style, now we need to debug Display_IP_config

diffstat:

2 files changed, 4 deletions(-)
lib/PFTools/Net.pm      |    2 --
tools/Display_IP_config |    2 --

diffs (438 lines):

diff -r 291abd3f33a1 -r 192bbd15991e lib/PFTools/Net.pm
--- a/lib/PFTools/Net.pm	Tue Sep 21 09:09:28 2010 +0200
+++ b/lib/PFTools/Net.pm	Wed Sep 22 08:40:40 2010 +0200
@@ -1,8 +1,6 @@
 package PFTools::Net;
 ##
-##  $Id$
-##
-##  Copyright (C) 2007-2009 Christophe Caillet <quadchris at free.fr>
+##  Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
 ##  Copyright (C) 2005-2007 Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
 ##  Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
 ##  Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
@@ -59,6 +57,15 @@
 sub Get_netblock_from_vlan ($$) {
     my ( $type, $net_hash ) = @_;
 
+    if( ref $type ) {
+        carp q{ERROR: $type parameter MUST BE a string};
+        return;
+    }
+    if( ref $net_hash ne 'HASH' ) {
+        carp q{ERROR: non-ref $net-hash paramter};
+        return;
+    }
+    return unless( ref $net_hash eq 'HASH' );
     my $suffix = ( $type eq 'ipv6' ) ? '6' : '';
     my $net_def = ( $net_hash->{ 'network' . $suffix } );
     my $block;
diff -r 291abd3f33a1 -r 192bbd15991e lib/PFTools/VCS.pm
--- a/lib/PFTools/VCS.pm	Tue Sep 21 09:09:28 2010 +0200
+++ b/lib/PFTools/VCS.pm	Wed Sep 22 08:40:40 2010 +0200
@@ -20,6 +20,7 @@
 use strict;
 use warnings;
 
+use Carp;
 use English qw( -no_match_vars );    # Avoids regex performance penalty
 use Exporter;
 use File::Path qw( make_path remove_tree );
@@ -37,8 +38,7 @@
     my ( $hostname, $pf_config, $options ) = @_;
 
     unless( $pf_config ) {
-        Warn ( $CODE->{'UNDEF_KEY'},
-            "Unable to access to pf-tools configuration for VCS checkout" );
+        carp q{ERROR: $pf_config is invalid};
         return;
     }
     my $module_name = 'PFTools::VCS::'.uc($pf_config->{'vcs'}->{'type'});
@@ -48,7 +48,7 @@
     
     $module->import();
     
-    if ( checkout( $hostname, $pf_config, $options ) ) {
+    if ( !checkout( $hostname, $pf_config, $options ) ) {
         return 0
     }
     return 1;
diff -r 291abd3f33a1 -r 192bbd15991e lib/PFTools/VCS/CVS.pm
--- a/lib/PFTools/VCS/CVS.pm	Tue Sep 21 09:09:28 2010 +0200
+++ b/lib/PFTools/VCS/CVS.pm	Wed Sep 22 08:40:40 2010 +0200
@@ -21,6 +21,7 @@
 use strict;
 use warnings;
 
+use Carp;
 use English qw( -no_match_vars );    # Avoids regex performance penalty
 use Exporter;
 use File::Path qw( make_path remove_tree );
@@ -37,13 +38,22 @@
     my ( $hostname, $pf_config, $options ) = @_;
     my $cvs_cmd = $pf_config->{'vcs'}->{'command'};
 
+    if( ref $hostname ) {
+        carp q{ERROR: $hostname MUST BE a string};
+        return;
+    }
+    unless( $pf_config or $options ) {
+        carp q{ERROR: invalid parameter};
+        return;
+    }
+    unless( ref $pf_config eq 'HASH' || ref $options eq 'HASH' ) {
+        carp q{ERROR: non-ref $pf_config and/or $options};
+        return;
+    }
+
     if ( defined $options->{'branch'} && $options->{'branch'} ne '' ) {
         if ( $cvs_cmd ne '' ) {
-            Warn( $CODE->{'DUPLICATE_VALUE'},
-                      "Ignoring CVS command " 
-                    . $cvs_cmd
-                    . " for using branche "
-                    . $options->{'branch'} );
+            carp qq{WARN: ingnoring $cvs_cmd with branch $options->{'branch'}};
         }
     }
     elsif ( $pf_config->{'vcs'}->{'branch'} ) {
@@ -83,12 +93,10 @@
     my $co_dir = $pf_config->{'path'}->{'checkout_dir'};
     if ( -e $co_dir ) {
         remove_tree $co_dir
-            or Abort ( $CODE->{'OPEN'},
-                "Unable to remove the content of $co_dir before checking out" );
+            or croak qq{ERROR: Unable to remove $co_dir : $OS_ERROR};
     }
     make_path $co_dir
-        or Abort( $CODE->{'OPEN'},
-            "Unable to create path $co_dir for checking out" );
+        or croak qq{ERROR: Unable to create $co_dir : $OS_ERROR};
 
     $ret = deferredlogsystem( "cd '" . $co_dir . "';" . $cvs_cmd );
     if ($ret) {
@@ -98,7 +106,8 @@
         DelLog();
     }
     umask($umask);
-    return $ret;
+    # Shell return 0 with success
+    return !$ret;
 }
 
 1;
diff -r 291abd3f33a1 -r 192bbd15991e lib/PFTools/VCS/SVN.pm
--- a/lib/PFTools/VCS/SVN.pm	Tue Sep 21 09:09:28 2010 +0200
+++ b/lib/PFTools/VCS/SVN.pm	Wed Sep 22 08:40:40 2010 +0200
@@ -21,6 +21,7 @@
 use strict;
 use warnings;
 
+use Carp;
 use English qw( -no_match_vars );    # Avoids regex performance penalty
 use Exporter;
 use File::Path qw( make_path remove_tree );
@@ -36,17 +37,24 @@
 sub checkout {
     my ( $hostname, $pf_config, $options ) = @_;
     
-    return unless $hostname or $pf_config or $options;
+    unless( $hostname or $pf_config or $options ) {
+        carp q{ERROR: $hostname, $pf_config, $options are invalid}
+        return;
+    }
+    if( ref $hostname ) {
+        carp q{ERROR: $hostname MUST BE a string};
+        return;
+    }
+    unless( $pf_config eq 'HASH' or $options eq 'HASH' ) {
+        carp q{ERROR: non-ref $pf_config and/or $options};
+        return;
+    }
     
     my $svn_cmd = $pf_config->{'vcs'}->{'command'};
 
     if ( defined $options->{'branch'} && $options->{'branch'} ne '' ) {
         if ( $svn_cmd ne '' ) {
-            Warn( $CODE->{'DUPLICATE_VALUE'},
-                      "Ignoring SVN command " 
-                    . $svn_cmd
-                    . " for using branche "
-                    . $options->{'branch'} );
+            carp qq{WARN: Ignoring $svn_cmd with branch $options->{'branch'}};
         }
     }
     elsif ( $pf_config->{'vcs'}->{'branch'} ) {
@@ -75,12 +83,10 @@
     my $co_dir = $pf_config->{'path'}->{'checkout_dir'};
     if ( -e $co_dir ) {
         remove_tree $co_dir
-            or Abort ( $CODE->{'OPEN'},
-                "Unable to remove the content of $co_dir before checking out" );
+            or croak qq{ERROR: Unable to remove $co_dir : $OS_ERROR};
     }
     make_path $co_dir
-        or Abort( $CODE->{'OPEN'},
-            "Unable to create path $co_dir for checking out" );
+        or croak qq{ERROR: Unable to create $co_dir : $OS_ERROR};
     
     $ret = deferredlogsystem( "cd '" . $co_dir . "';" . $svn_cmd );
     if ($ret) {
@@ -90,7 +96,7 @@
         DelLog();
     }
     umask($umask);
-    return $ret;
+    return !$ret;
 }
 
 1;
diff -r 291abd3f33a1 -r 192bbd15991e tools/Display_IP_config
--- a/tools/Display_IP_config	Tue Sep 21 09:09:28 2010 +0200
+++ b/tools/Display_IP_config	Wed Sep 22 08:40:40 2010 +0200
@@ -1,6 +1,4 @@
 #!/usr/bin/perl
-##
-##  $Id$
 ##
 ##  Copyright (C) 2008-2010 Christophe Caillet <quadchris at free.fr>
 ##  Copyright (C) 2004 Stephane Pontier <shad at sitadelle.com>
@@ -36,34 +34,40 @@
 ####################################################
 # Vars
 
-my $HOSTCLASS         = "";
-my $SITE              = "";
-my $OUTPUT            = "";
-my $IP_TYPE           = 'ipv4';
-my $HELP              = 0;
-my $GLOBAL_STORE_FILE = '';
-my $PF_CONFIG_FILE    = '';
+my @options_specs = (
+    'help',
+    'read',
+    'host|h=s',
+    'type|t=s',
+    'config|c=s',
+    'store=s',
+    'output|o=s',
+);
+
+my $options = {
+    'type'      => 'ipv4',
+    'output'    => '-',
+};
+
 my $PF_CONFIG         = {};
 my $GLOBAL_STRUCT     = {};
 
 my $program = $0;
 $program =~ s%.*/%%;    # cheap basename
 
-my $version = sprintf( "svn-r%s", q$Revision$ =~ /([\d.]+)/ );
-
 ######################################################
 # Functions
 
 sub Do_help () {
     print STDERR << "# ENDHELP";
-    $program - version $version
 
 Usage:	$program [options]
 	--help	: print help and exit
-	-h --host	: the hostclass for which you want to display configuration
+	-h --host	: the hostclass or hostname for which you want to display configuration
 	-s --site	: the site where the hostname is defined
 	-t --type	: IP type (ipv4 or ipv6)
-	-o --output	: destination for modified GRUB configuration
+	-o --output	: destination
+    --read      : display result in "human readable" format
 	--store		: path for accessing storable file containing the global configuration
 	-c --config	: path for accessing pf-tools.conf file
 # ENDHELP
@@ -84,9 +88,9 @@
     return 0;
 }
 
-sub order_servers ($) {
+sub order_servers {
     my ($host_part) = @_;
-
+    my $order;
     foreach my $hostclass ( keys %{$host_part} ) {
         foreach my $hostname ( keys %{ $host_part->{$hostclass} } ) {
             my $srv_order
@@ -99,16 +103,16 @@
     return $order;
 }
 
-sub get_srv_iface ($$$$) {
+sub get_srv_iface {
     my ( $ip_type, $srv_name, $global_config, $site ) = @_;
     my $result = {};
 
-    return undef if ( !$pf_config->{'features'}->{$ip_type} );
-    my $host_props
-        = Get_host_config_from_CONFIG( $srv_name, $global_config, $site );
-    if ( !defined $host_props ) {
-        Abort( $CODE->{'UNDEF_KEY'},
-            "Unknown hostname " . $hostname . " in global configuration" );
+    return undef if ( !$PF_CONFIG->{'features'}->{$ip_type} );
+    my $host_props = Get_host_config_from_CONFIG(
+        $srv_name, $global_config, $site
+    );
+    unless( $host_props ) {
+        die "Unknown hostname " . $srv_name . " in global configuration";
     }
     foreach my $iface ( keys %{ $host_props->{'interfaces'} } ) {
         $result->{$iface}->{'addr'}
@@ -119,7 +123,7 @@
     return $result;
 }
 
-sub get_srv_ip ($$$$) {
+sub get_srv_ip {
     my ( $ip_type, $hostclass, $host_part, $pf_config ) = @_;
     my $result = {};
 
@@ -135,13 +139,13 @@
     return $result;
 }
 
-sub get_all_ip ($$) {
+sub get_all_ip {
     my ( $ip_type, $host_part, $pf_config ) = @_;
     my $result = {};
 
     return undef if ( !$pf_config->{'features'}->{$ip_type} );
     foreach my $hostclass ( keys %{$host_part} ) {
-        foreach my $hostname ( keys %{ $host_part->{$hostclass} } ) {
+        foreach my $srv ( keys %{ $host_part->{$hostclass} } ) {
             my $ref_srv = $host_part->{$hostclass}->{$srv};
             foreach my $iface ( keys %{ $ref_srv->{'interfaces'} } ) {
                 my $entry = {
@@ -164,62 +168,49 @@
 #######################################################""
 ### MAIN
 
-GetOptions(
-    'help'       => \$HELP,
-    'h|host=s'   => \$HOSTCLASS,
-    'site|s=s'   => \$SITE,
-    't|type=s'   => \$IP_TYPE,
-    'o|output=s' => \$OUTPUT,
-    'config|c=s' => \$PF_CONFIG_FILE,
-    'store=s'    => \$GLOBAL_STORE_FILE,
-) or die "Didn't grok options (see --help).\n";
+GetOptions( $options, @options_specs )
+    or die "Didn't grok options (see --help).\n";
 
-if ($HELP) {
+if ($options->{'help'}) {
     Do_help();
     exit 0;
 }
 
-( $PF_CONFIG, $GLOBAL_STRUCT )
-    = Init_TOOLS( "", $PF_CONFIG_FILE, $GLOBAL_STORE_FILE );
+( $PF_CONFIG, $GLOBAL_STRUCT ) = Init_TOOLS(
+    "",
+    $options->{'config'},
+    $options->{'store'}
+);
 
-if ( $SITE eq '' && !defined $PF_CONFIG->{'location'}->{'site'} ) {
-    my $site_list = Get_site_from_hostname( $HOSTNAME, $GLOBAL_STRUCT );
-    if ( !defined $site_list ) {
-        Abort( $CODE->{'UNDEF_KEY'},
-                  "Unable to retrieve site for hostname "
-                . $HOSTNAME
-                . " : hostname not defined" );
+unless( $options->{'site'} ) {
+    unless( $PF_CONFIG->{'location'}->{'site'} ) {
+        my $site_list = Get_site_from_hostname(
+            $options->{'host'}, $GLOBAL_STRUCT
+        );
+        unless( $site_list ) {
+            die qq{ERROR: Unknown hostclass $options->{'host'}};
+        }
+        if ( scalar @{$site_list} > 1 ) {
+            die qq{ERROR: Multiple sites for hostclass $options->{'host'}};
+        }
+        ($options->{'site'}) = @{$site_list};
     }
-    elsif ( scalar @{$site_list} > 1 ) {
-        Abort( $CODE->{'DUPLICATE_VALUE'},
-                  "Unable to retrieve site for hostname "
-                . $HOSTNAME
-                . " : hostname appeared in multiple sites : "
-                . join( ",", @{$site_list} ) . ".\n"
-                . "Please relaunch this command with the right site" );
-    }
-    else {
-        ($SITE) = @{$site_list};
-    }
+    $options->{'site'} = $PF_CONFIG->{'location'}->{'site'};
 }
 
 my $host_part
-    = $GLOBAL_STRUCT->{'SITE'}->{'BY_NAME'}->{$SITE}->{'HOST'}->{'BY_NAME'};
-if ( $HOSTCLASS ne "" && !defined $$host_part->{$HOSTCLASS} ) {
-    Abort( $CODE->{'UNDEF_KEY'},
-        "Unexistant hostclass in global configuration" );
+    = $GLOBAL_STRUCT->{'SITE'}->{'BY_NAME'}->{$options->{'site'}}->{'HOST'}->{'BY_NAME'};
+if ( $options->{'host'} ne "" && !defined $$host_part->{$options->{'host'}} ) {
+    die "Unexistant hostclass in global configuration";
 }
-if ($HOSTCLASS) {
-    if ($read) {
-        foreach my $hostname ( sort keys %{ $host_part->{$HOSTCLASS} } ) {
-            print "\t" . $srv . "\n";
-            my $srv_net = get_srv_iface( $IP_TYPE, $hostname,
-                $host_part->{$HOSTCLASS}->{$srv} );
+if ($options->{'host'}) {
+    if ($options->{'read'}) {
+        foreach my $hostname ( sort keys %{ $host_part->{$options->{'host'}} } ) {
+            print "\t" . $hostname . "\n";
+            my $srv_net = get_srv_iface( $options->{'type'}, $hostname,
+                $host_part->{$options->{'host'}}->{$hostname} );
             if ( !defined $srv_net ) {
-                Abort( $CODE->{'UNDEF_KEY'},
-                          "IP feature " 
-                        . $IP_TYPE
-                        . " is deactivated in pf-tools configuration file" );
+                die "IP feature $options->{'type'} is deactivated";
             }
             foreach my $iface ( sort keys %{$srv_net} ) {
                 print "\t\t" 
@@ -230,8 +221,10 @@
         }
     }
     else {
-        my $srv_ip
-            = get_srv_ip( $IP_TYPE, $HOSTCLASS, $host_part->{$HOSTCLASS} );
+        my $srv_ip = get_srv_ip(
+            $options->{'type'}, $options->{'host'},
+            $host_part->{$options->{'host'}}, $PF_CONFIG
+        );
         foreach my $ip ( sort { _ipcomp( $a, $b ) } keys %{$srv_ip} ) {
             print $ip. "\t"
                 . $srv_ip->{$ip}->{'hostname'} . "("
@@ -240,7 +233,7 @@
     }
 }
 else {
-    if ($read) {
+    if ($options->{'read'}) {
         my $srv_type_list = order_servers($host_part);
         foreach my $prio ( sort keys %{$srv_type_list} ) {
             print "Server with deployment priority : " . $prio . "\n";
@@ -262,7 +255,7 @@
         }
     }
     else {
-        my $ip_list = get_all_ip($host_part);
+        my $ip_list = get_all_ip( $options->{'type'}, $host_part, $PF_CONFIG );
         foreach my $ip ( sort { _ipcomp( $a, $b ) } keys %{$ip_list} ) {
             print "$ip\t"
                 . join( ' ',



More information about the pf-tools-commits mailing list