pf-tools/pf-tools: 2 new changesets
parmelan-guest at users.alioth.debian.org
parmelan-guest at users.alioth.debian.org
Thu Sep 23 14:39:35 UTC 2010
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/8ea3361dbdd6
changeset: 820:8ea3361dbdd6
user: "Christophe Caillet <quadchris at free.fr>"
date: Thu Sep 23 16:23:52 2010 +0200
description:
Coding style and factorization
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/eca88de2d73a
changeset: 821:eca88de2d73a
user: "Christophe Caillet <quadchris at free.fr>"
date: Thu Sep 23 16:37:30 2010 +0200
description:
Merging
diffstat:
47 files changed, 220 insertions(+), 812 deletions(-)
filters/filter_distrib | 21 ++++-----------------
filters/filter_privateresolve | 24 +++---------------------
filters/filter_vlan2if | 20 +-------------------
lib/PFTools/Bridge.pm | 21 ++-------------------
lib/PFTools/Compat/Parser.pm | 23 ++++-------------------
lib/PFTools/Compat/Translation.pm | 23 ++++-------------------
lib/PFTools/Conf.pm | 18 +++++++++++++-----
lib/PFTools/Conf/Config.pm | 23 +++++------------------
lib/PFTools/Conf/Host.pm | 23 ++++-------------------
lib/PFTools/Conf/Network.pm | 27 +++++----------------------
lib/PFTools/Conf/Syntax.pm | 22 +++++-----------------
lib/PFTools/Disk.pm | 23 ++++-------------------
lib/PFTools/Logger.pm | 24 +++++-------------------
lib/PFTools/Net.pm | 2 +-
lib/PFTools/Packages.pm | 23 ++++++-----------------
lib/PFTools/Packages/DEB.pm | 23 ++++++-----------------
lib/PFTools/Structqueries.pm | 26 ++++----------------------
lib/PFTools/Update.pm | 26 +++-----------------------
lib/PFTools/Update/Addfile.pm | 22 +++-------------------
lib/PFTools/Update/Addlink.pm | 24 +++++-------------------
lib/PFTools/Update/Addmount.pm | 22 +++-------------------
lib/PFTools/Update/Common.pm | 25 ++++++-------------------
lib/PFTools/Update/Createfile.pm | 25 ++++++-------------------
lib/PFTools/Update/Installpkg.pm | 26 +++++++-------------------
lib/PFTools/Update/Mkdir.pm | 25 ++++++-------------------
lib/PFTools/Update/Purgepkg.pm | 25 ++++++-------------------
lib/PFTools/Update/Removedir.pm | 24 +++++-------------------
lib/PFTools/Update/Removefile.pm | 24 +++++-------------------
lib/PFTools/Utils.pm | 21 ++++-----------------
lib/PFTools/VCS.pm | 24 +++++++-----------------
lib/PFTools/VCS/CVS.pm | 24 ++++++------------------
lib/PFTools/VCS/SVN.pm | 24 ++++++------------------
sbin/fix_hosts | 22 ++++------------------
sbin/mk_dhcp | 24 ++++--------------------
sbin/mk_grubopt | 21 ++++-----------------
sbin/mk_interfaces | 24 ++++--------------------
sbin/mk_pxelinuxcfg | 24 ++++--------------------
sbin/mk_resolvconf | 23 ++++-------------------
sbin/mk_sitezone | 22 ++++------------------
sbin/mk_sourceslist | 22 ++++------------------
sbin/update-config | 24 ++++--------------------
t/13.conf.t | 20 ++++++++++++++++++++
tools/Display_IP_config | 19 +------------------
tools/Translate_old_config | 19 -------------------
tools/kvmlaunch | 3 ---
tools/umlaunch | 13 ++-----------
tools/xenlaunch | 25 +++++++------------------
diffs (4212 lines):
diff -r 3fd194956c81 -r eca88de2d73a filters/filter_distrib
--- a/filters/filter_distrib Thu Sep 23 11:37:07 2010 +0200
+++ b/filters/filter_distrib Thu Sep 23 16:37:30 2010 +0200
@@ -1,26 +1,27 @@
#!/usr/bin/perl
-##
-## Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+#
+# Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use Getopt::Long qw( :config ignore_case_always bundling );
use IO::File;
use Sys::Hostname;
@@ -51,9 +52,7 @@
my $PF_CONFIG = {};
my $GLOBAL_STRUCT = {};
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
-
+my $program = basename $PROGRAM_NAME;
###################################
# Funtions
diff -r 3fd194956c81 -r eca88de2d73a filters/filter_privateresolve
--- a/filters/filter_privateresolve Thu Sep 23 11:37:07 2010 +0200
+++ b/filters/filter_privateresolve Thu Sep 23 16:37:30 2010 +0200
@@ -1,30 +1,29 @@
#!/usr/bin/perl
-##
-## $Id$
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
-## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+# Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+# Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use IO::File;
use Getopt::Long qw( :config ignore_case_always bundling );
use Sys::Hostname;
@@ -55,8 +54,7 @@
'type-resolve' => 'cnf',
};
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
+my $program = basename $PROGRAM_NAME;
###################################
# Funtions
diff -r 3fd194956c81 -r eca88de2d73a filters/filter_vlan2if
--- a/filters/filter_vlan2if Thu Sep 23 11:37:07 2010 +0200
+++ b/filters/filter_vlan2if Thu Sep 23 16:37:30 2010 +0200
@@ -1,23 +1,23 @@
#!/usr/bin/perl
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
-## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+# Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+# Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
# eth:vlan -> ethx.y:z
# eth.vlan -> ethx.y
@@ -27,6 +27,7 @@
use warnings;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use Getopt::Long qw( :config ignore_case_always bundling );
use IO::File;
use Sys::Hostname;
@@ -56,8 +57,7 @@
my $PF_CONFIG = {};
my $GLOBAL_STRUCT = {};
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
+my $program = basename $PROGRAM_NAME;
###################################
# Funtions
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Bridge.pm
--- a/lib/PFTools/Bridge.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Bridge.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,27 +1,26 @@
package PFTools::Bridge;
-##
-## $Id$
-##
-## Copyright (C) 2008 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+#
+# Copyright (C) 2008 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
BEGIN {
@@ -33,10 +32,6 @@
die "Sorry, I need vlan, bridge-utils, uml-utilities and iproute2";
}
}
-
-use Exporter;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Get_all_bridges
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Compat/Parser.pm
--- a/lib/PFTools/Compat/Parser.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Compat/Parser.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,33 +1,30 @@
package PFTools::Compat::Parser;
-##
-## $Id$
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use PFTools::Logger;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Subst_vars
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Compat/Translation.pm
--- a/lib/PFTools/Compat/Translation.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Compat/Translation.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,34 +1,30 @@
package PFTools::Compat::Translation;
-##
-## $Id$
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use NetAddr::IP;
use PFTools::Logger;
-
-our @ISA = ('Exporter');
our @EXPORT = qw (
Translate_old2new_host
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Conf.pm
--- a/lib/PFTools/Conf.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Conf.pm Thu Sep 23 16:37:30 2010 +0200
@@ -318,21 +318,47 @@
return $result;
}
+=head2 Load_conf( $file, $hash_subst, $context, $pf_config )
+
+Reads configuration from $file in context $context.
+Returns undef if empty or undefined arguments.
+Croaks on other errors.
+
+FIXME: add more documentation here
+
+=cut
+
sub Load_conf {
my ( $file, $hash_subst, $context, $pf_config ) = @_;
return unless $file and $hash_subst and $context and $pf_config;
- if ( $context !~ m/^$ALLOWED_PARSING_CONTEXT$/ ) {
- Abort(
- $CODE->{'INVALID_CONTEXT'},
- "Context $context for file $file doesn't match $ALLOWED_PARSING_CONTEXT"
- );
+ if ( ref $file ) {
+ croak q{ERROR: Invalid non-scalar $file};
+ }
+ if ( ref $context ) {
+ croak q{ERROR: Invalid non-scalar $context};
+ }
+ if ( ref $hash_subst ne 'HASH' ) {
+ croak q{ERROR: Invalid non-hashref $hash_subst};
+ }
+ if ( ref $pf_config ne 'HASH' ) {
+ croak q{ERROR: Invalid non-hashref $pf_config};
}
+ if ( $context !~ m/^$ALLOWED_PARSING_CONTEXT$/ ) {
+ croak qq{ERROR: Invalid context $context for file $file doesn't match $ALLOWED_PARSING_CONTEXT};
+ }
+
+ # this will croak() on error
my $parsed = Parser_ini($file);
- if ( $context =~ /^(model|host)$/ ) {
+ my $select = $context eq 'config' ? 'action' : 'type'; # compute it only once
+
+ # FIXME: some code factorization seems possible, but
+ # proper tests are needed before changing things here.
+
+ if ( $context eq 'host' or $context eq 'model' ) {
if ( defined $parsed->{'hostgroup'}->{'model'} ) {
$parsed->{'hostgroup'}->{'__model'} = Load_conf(
Get_source(
@@ -346,22 +372,20 @@
}
}
else {
- my $select = ( $context eq 'config' ) ? 'action' : 'type';
foreach my $section ( keys %{$parsed} ) {
- next if ( $section =~ /^__/ );
+ next if $section =~ m{ \A __ }xms; # skip "internal" sections
+
if ( !defined $parsed->{$section}->{$select} ) {
- Abort(
- $CODE->{'UNDEF_KEY'},
- "Key $select on section $section from file $file MUST BE defined"
- );
+ croak qq{Key $select must be defined in section $section from file $file};
}
- my $sect_type = $parsed->{$section}->{$select};
- if ( $sect_type eq 'include' ) {
+
+ my $section_type = $parsed->{$section}->{$select};
+ if ( $section_type eq 'include' ) {
# We need to dive into deep ...
$parsed->{$section}->{'__content'}
= Load_conf(
- Get_source( $section, "", $hash_subst, $pf_config ),
+ Get_source( $section, q{}, $hash_subst, $pf_config ),
$hash_subst, $context, $pf_config
);
}
@@ -373,36 +397,25 @@
# Basic checks
foreach my $section ( keys %{$parsed} ) {
- next if $section =~ /^__/;
- my $sect_type;
- if ( $context =~ /^(host|model)$/ ) {
- $section =~ /^([^:]+)(::(.+))?$/;
- $sect_type = $1;
+ next if $section =~ m{ \A __ }xms; # skip "internal" sections
- # $iface_name = $3;
+ my $section_type;
+ if ( $context eq 'host' or $context eq 'model' ) {
+ unless ( $section =~ m{ \A ([^:]+) (?: :: (.+) )? \z }xms ) {
+ croak qq{ERROR: Unable to compute section type for section $section};
+ }
+ $section_type = $1;
+ # $iface_name = $2;
}
else {
- my $select = ( $context eq 'config' ) ? 'action' : 'type';
if ( !defined $parsed->{$section}->{$select} ) {
- Abort(
- $CODE->{'UNDEF_KEY'},
- "Key $select on section $section from file $file MUST BE defined"
- );
+ croak qq{Key $select must be defined in section $section from file $file};
}
- $sect_type = $parsed->{$section}->{$select};
+ $section_type = $parsed->{$section}->{$select};
}
- my ( $code, $msg )
- = Chk_section_struct(
- $section, $sect_type, $parsed->{$section},
- $context
- );
- if ( $code > 1 ) {
- Warn(
- $code,
- "Errors occur during parsing model from file $file"
- );
- Abort( $code, $msg );
- }
+
+ Chk_section_struct( $section, $section_type, $parsed->{$section},
+ $context );
}
return $parsed;
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Conf/Config.pm
--- a/lib/PFTools/Conf/Config.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Conf/Config.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,32 +1,31 @@
package PFTools::Conf::Config;
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
-## MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+# MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use PFTools::Logger;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Init_CONFIG_STRUCT
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Conf/Host.pm
--- a/lib/PFTools/Conf/Host.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Conf/Host.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,30 +1,29 @@
package PFTools::Conf::Host;
-##
-## $Id: Net.pm 786 2010-07-27 15:16:09Z ccaillet-guest $
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use Carp;
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use Fcntl ':mode';
use POSIX qw(ceil floor);
@@ -32,8 +31,6 @@
use PFTools::Logger;
use PFTools::Net;
use PFTools::Structqueries;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Build_host_from_server
@@ -84,54 +81,54 @@
# Output :
# Returns a list containing last number and last nodes for a hostgroup
#
-sub __Get_host_indexes ($$) {
+sub __Get_host_indexes {
my ( $ref_hostgroup, $hostname_model ) = @_;
my ( $node_last, $num_last, $digits, $nodes );
+ unless( $ref_hostgroup or $hostname_model ) {
+ croak q{ERROR: $ref_hostgroup and $hostname_model MUST BE defined};
+ }
+ unless( ref $ref_hostgroup eq 'HASH' ) {
+ croak q{ERROR: bad ref for $ref_hostgroup};
+ }
+ if( ref $hostname_model ) {
+ croak q{ERROR: $hostname_model MUST BE a string};
+ }
$node_last
= ( $ref_hostgroup->{'nodes'} )
? ( $ref_hostgroup->{'nodes'} - 1 )
: 0;
$num_last = $ref_hostgroup->{'number'} - 1;
- $hostname_model =~ /(%*)(_*)$/;
+ $hostname_model =~ m{(%*)(_*)\Z};
$digits = length($1) || 0;
$nodes = length($2) || 0;
# Checking nodes
if ( $node_last && !$nodes ) {
- Abort( $CODE->{'INVALID_VALUE'},
- "Unable to affect all "
- . $node_last
- . " nodes : no _ defined in key hostname" );
+ croak q{ERROR: Bad definition _ on key hostname};
}
elsif ( $node_last && ceil( log($node_last) / log(26) ) > $nodes ) {
- Warn( $CODE->{'INVALID_VALUE'},
- "Not enough places for indexing nodes definition for host "
- . $hostname_model );
+ carp q{WARN: $node_last exceeds maximum nodes allowed};
}
# Checking hostnum
if ( $num_last && !$digits ) {
- Abort( $CODE->{'INVALID_VALUE'},
- "Unable to affect all host number(s) : no % defined in key hostname "
- . $hostname_model );
+ croak q{ERROR: Bad definition % on key hostname};
}
elsif ( $num_last && $num_last > 10**$digits ) {
- Warn( $CODE->{'INVALID_VALUE'},
- "Not enough places for indexing host number(s) according to hostname "
- . $hostname_model );
+ carp q{WARN: $num_last exceeds maximum host numbers allowed};
}
return ( $num_last, $node_last );
}
-sub __Get_hostnumber_from_model ($$$) {
+sub __Get_hostnumber_from_model {
my ( $model, $num, $node ) = @_;
my ( $digits, $nodes, $index );
- if ( $model !~ /%+/ && $model !~ /_+/ ) {
+ if ( $model !~ m{%+} && $model !~ m{_+} ) {
return "";
}
- $model =~ /(%*)(_*)$/;
+ $model =~ m{(%*)(_*)\Z};
$digits = length($1) || 0;
$nodes = length($2) || 0;
$index = "";
@@ -139,10 +136,7 @@
$index .= "0";
$digits--;
}
- $index
- = ($node)
- ? $index . $num . $node
- : $index . $num;
+ $index = ($node) ? $index . $num . $node : $index . $num;
return $index;
}
@@ -161,7 +155,7 @@
# Output :
# Returns a string containing th hostname
#
-sub __Get_hostname_from_model ($$$$) {
+sub __Get_hostname_from_model {
my ( $hostname_model, $hostnum, $hostnode, $site_prefix, $ref_host ) = @_;
my ( $hostname, $index );
@@ -169,7 +163,7 @@
$index = __Get_hostnumber_from_model(
$hostname_model, $hostnum, $hostnode
);
- $hostname =~ s/(%*)(_*)$/$index/;
+ $hostname =~ s{(%*)(_*)\Z}{$index};
$hostname = $site_prefix . $hostname
if ( $ref_host->{'prefix'} && $ref_host->{'prefix'} eq 'true' );
return $hostname;
@@ -191,47 +185,11 @@
my (@if_list);
foreach my $section ( keys %{$ref_src} ) {
- next if ( $section !~ /^interface/ );
- $section =~ /^interface::(((eth|bond)[\d]+)(\.(TAG[\d]+|\d+))?)$/;
+ next if ( $section !~ /^interface/o );
+ $section =~ /^interface::(((eth|bond)[\d]+)(\.(TAG[\d]+|\d+))?)$/o;
push( @if_list, $1 );
}
return @if_list;
-}
-
-#########################################################################
-#
-# STR Get_ip_from_hostindex ( NetAddr::IP, STR, STR, STR, INT )
-#
-# This function returns the host IP for a given number and node
-# Inputs :
-# - $net_block : NetAddr::IP object containing the subnet of the IP
-# - $ipstart : string containing the pf-tools IP definition
-# - $hostnum : string containing the number of the specified host
-# - $hostnode : string containing the node of the specified host
-# - $nodes : specify here the number of nodes for the specified hostclass
-#
-# Output :
-# Returns a NetAddr::IP object containing the IP
-#
-sub __Get_ip_from_hostindex ($$;$$$) {
- my ( $net_block, $ipstart, $hostnum, $hostnode, $nodes ) = @_;
-
- my $ip = new NetAddr::IP( $net_block->prefix() . $ipstart,
- $net_block->mask() );
- if ( !defined $ip ) {
- Abort( $CODE->{'UNDEF_KEY'},
- "Unable to create IP object from prefix "
- . $net_block->prefix()
- . " and host "
- . $ipstart );
- }
- if ($hostnum) {
- my $add = ($hostnode)
- ? ( $hostnum * $nodes ) + $hostnode
- : $hostnum;
- $ip = $ip + $add;
- }
- return $ip;
}
#########################################################################
@@ -252,27 +210,30 @@
# Output :
# Returns a NetAddr::IP object containing the checked IP
#
-sub __Check_host_ip ($$$$$$$$) {
+sub __Check_host_ip {
my ( $ip_type, $vlan_block, $ipstart, $hostnum, $hostnode, $nodes, $site,
$ref_site )
= @_;
- my $prefix = $vlan_block->prefix();
- my $realip = __Get_ip_from_hostindex(
- $vlan_block, $ipstart, $hostnum,
- $hostnode, $nodes
+ unless( ref( $vlan_block ) eq 'NetAddr::IP' ) {
+ croak q{ERROR: Invalid $vlan_block object};
+ }
+ my $realip = NetAddr::IP->new(
+ $vlan_block->prefix() . $ipstart, $vlan_block->mask()
);
+ unless( $realip ) {
+ croak qq{ERROR: Bad IP with $vlan_block->prefix() and $ipstart};
+ }
+ if( $hostnum ) {
+ my $add = ($hostnode) ? ( $hostnum * $nodes ) + $hostnode : $hostnum;
+ $realip = $realip + $add;
+ }
my $host_addr_site = $ref_site->{'HOST'}->{'BY_ADDR'};
if ( defined $host_addr_site->{ $realip->cidr() } ) {
- Abort( $CODE->{'DUPLICATE_VALUE'},
- "IP $realip->addr() is already in use by host "
- . $host_addr_site->{ $realip->cidr() } . " on site $site"
- );
+ croak qq{ERROR: $realip->addr() already defined on site $site};
}
- if ( !$vlan_block->contains($realip) ) {
- Abort( $CODE->{'INVALID_VALUE'},
- "IP of type $ip_type is out of $vlan_block->cidr() on site $site"
- );
+ unless( $vlan_block->contains( $realip ) ) {
+ croak qq{ERROR: $realip->addr() is out of range $vlan_block->cidr()};
}
return $realip;
}
@@ -288,15 +249,16 @@
# Output :
# Returns an arrayref containing the vlan list
#
-sub __Get_vlan_list_from_server ($) {
+sub __Get_vlan_list_from_server {
my ($ref_srv) = @_;
my $vlan_list = [];
foreach my $key ( keys %{$ref_srv} ) {
- next if ( $key !~ /^ipv/ );
- my ( $type, $vlan, $num ) = split( /\./, $key );
- push( @{$vlan_list}, $vlan )
- if ( !grep ( /^$vlan$/, @{$vlan_list} ) );
+ next if ( $key !~ m{\Aipv}o );
+ my ( $type, $vlan, $num ) = split( m{\.}, $key );
+ push( @{$vlan_list}, $vlan ) if (
+ !grep ( m{\A$vlan\Z}, @{$vlan_list} )
+ );
}
return $vlan_list;
}
@@ -314,48 +276,41 @@
# Output :
# Returns an arrayref containing the alias list
#
-sub __Get_alias_list_from_server ($$;$) {
+sub __Get_alias_list_from_server {
my ( $ref_parsed, $vlan, $host_number ) = @_;
my $alias_list = [];
foreach my $key ( keys %{$ref_parsed} ) {
- next if ( $key !~ /^alias/ );
- my ( $alias, $name, $host_num ) = split( /\./, $key );
+ next if ( $key !~ m{\Aalias}o );
+ my ( $alias, $name, $host_num ) = split( m{\.}, $key );
next if ( $host_number && $host_num && $host_num ne $host_number );
- push( @{$alias_list}, $name )
- if ( $vlan eq $ref_parsed->{$key}
- && !grep ( /^$name$/, @{$alias_list} ) );
+ push( @{$alias_list}, $name ) if (
+ $vlan eq $ref_parsed->{$key}
+ && !grep ( m{\A$name\Z}, @{$alias_list} )
+ );
}
return $alias_list;
}
########################################################################################
#
-# STR __Get_vlan_tag_from_site ( STR, STR, HASHREF )
+# STR __Get_vlan_tag_from_site ( STR, HASHREF )
#
# This function returns the 802.1q tag for a specified vlan and from a site defined into
# global configuration structure
# Inputs :
# - $vlan : specify here the vlan's name as defined into pf-tools configuration
-# - $site : specify here the site's name as defined into pf-tools configuration
-# - $global_config : hashref containing the global configuration parsed
+# - $site_part : specify here the site's part of gloabl hash structure
#
# Output :
# Returns the tag if defined undef undef if not.
#
-sub __Get_vlan_tag_from_site ($$$) {
- my ( $vlan, $site, $global_config ) = @_;
+sub __Get_vlan_tag_from_site {
+ my ( $vlan, $site_part ) = @_;
- foreach my $tag (
- keys %{
- $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'NETWORK'}
- ->{'BY_TAG'}
- }
- )
- {
- return $tag
- if ( $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'NETWORK'}
- ->{'BY_TAG'}->{$tag} eq $vlan );
+ my $net_part = $site_part->{'NETWORK'}->{'BY_TAG'};
+ foreach my $tag ( keys %{ $net_part } ) {
+ return $tag if( $net_part->{$tag} eq $vlan );
}
return;
}
@@ -413,88 +368,62 @@
) = @_;
my ( @if_list, $vlan, $ifraw, $iftag, $add_if, $iface_opt );
- my $network_site = $ref_site->{'NETWORK'};
- my $host_site = $ref_site->{'HOST'};
- my $iface_section = 'interface::' . $iface;
- my $nodes = $ref_host->{'hostgroup'}->{'nodes'} || 0;
- my $host_number = ($hostnode) ? $hostnum . $hostnode : $hostnum;
- $iface =~ /^((eth|bond)[\d]+)(\.(TAG[\d]+))?$/;
+ my $net_site = $ref_site->{'NETWORK'}->{'BY_NAME'};
+ my $host_site = $ref_site->{'HOST'};
+ my $iface_section = 'interface::' . $iface;
+ my $iface_def = $ref_host->{$iface_section};
+ my $nodes = $ref_host->{'hostgroup'}->{'nodes'} || 0;
+ my $host_number = ($hostnode) ? $hostnum . $hostnode : $hostnum;
+ $iface =~ m{\A((eth|bond)[\d]+)(\.(TAG[\d]+))?\Z};
( $ifraw, $iftag ) = ( $1, $4 );
- $vlan = $ref_host->{$iface_section}->{ 'vlan.' . $host_number }
- || $ref_host->{$iface_section}->{'vlan'};
- $iface_opt = $ref_host->{$iface_section}->{ 'iface_opt.' . $host_number }
- || $ref_host->{$iface_section}->{'iface_opt'};
+
+ # Check vlan
+ $vlan = $iface_def->{ 'vlan.' . $host_number } || $iface_def->{'vlan'};
+ unless( $net_site->{$vlan} ) {
+ croak qq{ERROR: Unknown $vlan for $iface on $hostname on site $site};
+ }
$add_if->{'vlan'} = $vlan;
- $add_if->{'iface_opt'} = $iface_opt if ( defined $iface_opt );
+
+ # Iface option(s)
+ $iface_opt = $iface_def->{ 'iface_opt.' . $host_number }
+ || $iface_def->{'iface_opt'};
+ $add_if->{'iface_opt'} = $iface_opt if( defined $iface_opt );
# Check MAC address if defined
- if ( defined $ref_host->{$iface_section}->{ 'mac.' . $host_number } ) {
- my $mac = $ref_host->{$iface_section}->{ 'mac.' . $host_number };
+ my $mac = $iface_def->{ 'mac.' . $host_number } || "";
+ if( $mac ne "" ) {
if ( $host_site->{'BY_MAC'}->{$mac} ) {
- my ( $ifdef, $hostdef, $vlandef )
- = split( /\./, $host_site->{'BY_MAC'}->{$mac} );
- Abort( $CODE->{'DUPLICATE_VALUE'},
- "MAC address "
- . $mac
- . " is already defined for interface "
- . $ifdef
- . " in host "
- . $hostdef
- . " which is on vlan "
- . $vlandef );
+ my ( $macif, $machost, $macvlan ) = split(
+ m{\.},
+ $host_site->{'BY_MAC'}->{$mac}
+ );
+ croak qq{ERROR: $mac already defined for $macif on $machost};
}
$add_if->{'mac'} = $mac;
}
+
+ # Check tag
+ my $net_tag = $net_site->{$vlan}->{'tag'};
+ if ( $iftag && $iftag =~ m{\A\d+\Z} && $net_tag ne $iftag ) {
+ croak qq{ERROR: $iftag for $iface_section differs from $vlan def};
+ }
- # Check tag
- if ( $iftag && $iftag =~ /^\d+$/ ) {
- Abort( $CODE->{'INVALID_VALUE'},
- "Tag "
- . $iftag
- . " defined on section name "
- . $iface_section
- . " differs from "
- . $ref_host->{'vlan'}
- . " network definition" );
- }
if ( $iface =~ /^bond/ && !$iftag ) {
-
# Check if slaves not in use
- my @slaves
- = ( $ref_host->{$iface_section}->{ 'slaves.' . $host_number } )
- ? split( /\s*,\s*/,
- $ref_host->{$iface_section}->{ 'slaves.' . $host_number } )
- : split( /\s*,\s*/, $ref_host->{$iface_section}->{'slaves'} );
+ my @slaves = ( $iface_def->{ 'slaves.' . $host_number } )
+ ? split( m{\s*,\s*}, $iface_def->{ 'slaves.' . $host_number } )
+ : split( m{\s*,\s*}, $iface_def->{'slaves'} );
foreach my $if (@slaves) {
- Abort( $CODE->{'INVALID_VALUE'},
- "Interface "
- . $if
- . " cannot be enslaved by "
- . $iface
- . " : already in use for "
- . $hostname )
- if ( grep ( /$if/, @{$ref_if_list} ) );
+ croak qq{ERROR: $if cannot be enslaved to $iface for $hostname}
+ if ( grep ( m{\A$if\Z}, @{$ref_if_list} ) );
}
$add_if->{'slaves'} = join( " ", @slaves );
- $add_if->{'mode'}
- = $ref_host->{$iface_section}->{ 'mode.' . $host_number }
- || $ref_host->{$iface_section}->{'mode'};
+ $add_if->{'mode'} =
+ $iface_def->{ 'mode.' . $host_number }
+ || $iface_def->{'mode'};
$add_if->{'options'}
- = $ref_host->{$iface_section}->{ 'options.' . $host_number }
- || $ref_host->{$iface_section}->{'options'};
- }
-
- # Check vlan
- if ( !defined $network_site->{'BY_NAME'}->{$vlan} ) {
- Abort( $CODE->{'INVALID_VALUE'},
- "Unknown vlan "
- . $vlan
- . " on site "
- . $site
- . " for interface "
- . $iface
- . " defined on host "
- . $hostname );
+ = $iface_def->{ 'options.' . $host_number }
+ || $iface_def->{'options'};
}
# Check address and route values
@@ -502,142 +431,87 @@
next if ( !$pf_config->{'features'}->{$ip_type} );
my $suffix = ( $ip_type eq 'ipv6' ) ? '6' : '';
my $netblock = Get_netblock_from_vlan(
- $ip_type, $network_site->{'BY_NAME'}->{$vlan} );
+ $ip_type, $net_site->{$vlan}
+ );
unless( $netblock ) {
- Abort( $CODE->{'INVALID_VALUE'},
- "Unable to retrieve network block of type "
- . $ip_type . " for vlan " . $vlan
- . " on site " . $site . " for host " . $hostname );
+ croak qq{ERROR: getting $ip_type subnet for $vlan on $hostname};
}
- my $realip;
- if ( $ref_host->{$iface_section}->{ $ip_type . '.' . $host_number } )
- {
- $realip = __Check_host_ip(
- $ip_type,
- $netblock,
- $ref_host->{$iface_section}
- ->{ $ip_type . '.' . $host_number },
- 0,
- 0,
- 0,
- $site,
- $ref_site
- );
+ my @params = ( $iface_def->{$ip_type . '.' . $host_number} )
+ ? ( $ip_type, $netblock,
+ $iface_def->{$ip_type . '.' . $host_number},
+ 0, 0, 0, $site, $ref_site )
+ : ( $ip_type, $netblock, $iface_def->{$ip_type},
+ $hostnum, $hostnode, $nodes, $site, $ref_site );
+ my $realip = __Check_host_ip @params ;
+ $add_if->{$ip_type} = $realip->cidr();
+
+ my $route_key = '@route'.$suffix;
+ my $gw_key = 'gateway'.$suffix;
+ my @route_list;
+ foreach my $rkey ( keys %{$iface_def} ) {
+ next unless( $rkey =~ m{\A$route_key} );
+ if ( $rkey =~ m{\.(?<number>.+)\Z} ) {
+ push ( @route_list, @{$iface_def->{$rkey}} )
+ if( $+{number} eq $host_number );
+ }
+ push( @route_list, @{$iface_def->{$rkey}} );
}
- else {
- $realip
- = __Check_host_ip( $ip_type, $netblock,
- $ref_host->{$iface_section}->{$ip_type},
- $hostnum, $hostnode, $nodes, $site, $ref_site );
- }
- $add_if->{$ip_type} = $realip->cidr();
- my $route_key = ( $ip_type eq 'ipv6' ) ? '@route6' : '@route';
- $route_key .= $hostnum
- if ( $ref_host->{$iface_section}
- ->{ $route_key . '.' . $host_number } );
- my $gw_key = ( $ip_type eq 'ipv6' ) ? 'gateway6' : 'gateway';
- if ( defined $ref_host->{$iface_section}->{$route_key} ) {
- foreach
- my $route ( @{ $ref_host->{$iface_section}->{$route_key} } )
- {
- $route =~ /^(\S+)\s*(via\s*(\S+))?$/;
- my ( $dest, $via ) = ( $1, $3 );
- my $route2add = '';
- if ( $dest ne 'default' ) {
- my $ip_dest;
- if ( $dest =~ /[g-zG-Z]+/ ) {
- if ( defined $network_site->{'BY_NAME'}->{$dest} ) {
-
- # Dest is a defined network ... translating into IP
- $ip_dest = new NetAddr::IP(
- $network_site->{'BY_NAME'}->{$dest}
- ->{'network'},
- $network_site->{'BY_NAME'}->{$dest}
- ->{'netmask'}
- );
- $route2add .= $ip_dest->cidr() . " via ";
- }
- else {
-
- # Potentially not parsed host on this site
- $route2add .= $dest . " via ";
- }
+ foreach my $route ( @route_list ) {
+ $route =~ m{^(\S+)\s*(via\s*(\S+))?$}o;
+ my ( $dest, $via ) = ( $1, $3 );
+ my $route2add = '';
+ if ( $dest ne 'default' ) {
+ my $ip_dest;
+ if ( $dest =~ m{[g-zG-Z]+} ) {
+ if ( $net_site->{$dest} ) {
+ # Dest is a defined network ... translating into IP
+ $ip_dest = new NetAddr::IP(
+ $net_site->{$dest}->{'network'},
+ $net_site->{$dest}->{'netmask'}
+ );
+ $route2add .= $ip_dest->cidr() . " via ";
}
else {
- $ip_dest = new NetAddr::IP($dest);
- if ( !defined $ip_dest ) {
- Abort( $CODE->{'INVALID_VALUE'},
- "Unable to check dest IP "
- . $dest
- . " of type "
- . $ip_type
- . " on \@route key for interface "
- . $iface
- . " for host "
- . $hostname
- . " on site "
- . $site );
- }
- $route2add .= $ip_dest->cidr() . " via ";
+ # Potentially not parsed host on this site
+ $route2add .= $dest . " via ";
}
}
else {
- $route2add .= "default via ";
+ $ip_dest = new NetAddr::IP($dest);
+ unless( $ip_dest ) {
+ croak qq{ERROR: Bad route $route for $hostname};
+ }
+ $route2add .= $ip_dest->cidr() . " via ";
}
- if ($via) {
- my $ip_via;
- if ( $via eq 'GATEWAY' ) {
- if ( !defined $network_site->{'BY_NAME'}->{$vlan}
- ->{$gw_key} )
- {
- Abort( $CODE->{'INVALID_VALUE'},
- "Unable to define default route by vlan "
- . $vlan
- . " : no gateway defined on this one" );
- }
- $route2add
- .= $network_site->{'BY_NAME'}->{$vlan}->{$gw_key};
+ }
+ else {
+ $route2add .= "default via ";
+ }
+ if ($via) {
+ my $ip_via;
+ if ( $via eq 'GATEWAY' ) {
+ unless( $net_site->{$vlan}->{$gw_key} ) {
+ croak qq{ERROR: Unknown gateway for $vlan};
}
- elsif ( $via =~ /[g-zG-Z]+/ ) {
-
- # Potentially not parsed host ... skipping this case for now
- $route2add .= $via;
+ $route2add .= $net_site->{$vlan}->{$gw_key};
+ }
+ elsif ( $via =~ /[g-zG-Z]+/ ) {
+ # Potentially not parsed host ...
+ # skipping this case for now
+ $route2add .= $via;
+ }
+ else {
+ my $ip_via = new NetAddr::IP($via);
+ unless( $ip_via ) {
+ croak qq{ERROR: Bad gateway for $route on $hostname};
}
- else {
- my $ip_via = new NetAddr::IP($via);
- if ( !defined $ip_via ) {
- Abort( $CODE->{'INVALID_VALUE'},
- "Unable to check IP "
- . $via
- . " of type "
- . $ip_type
- . " as gateway for interface "
- . $iface
- . " for host "
- . $hostname
- . " on site "
- . $site );
- }
- elsif ( !$netblock->contains($ip_via) ) {
- Abort( $CODE->{'INVALID_VALUE'},
- "IP "
- . $ip_via
- . " of type "
- . $ip_type
- . " for gateway on interface "
- . $iface
- . " is out of "
- . $netblock
- . " for host "
- . $hostname
- . " on site "
- . $site );
- }
- $route2add .= $ip_via->addr();
+ unless( $netblock->contains($ip_via) ) {
+ croak qq{ERROR: $ip_via is not on $netblock->cidr()};
}
+ $route2add .= $ip_via->addr();
}
- push( @{ $add_if->{$route_key} }, $route2add );
}
+ push( @{ $add_if->{$route_key} }, $route2add );
}
}
return $add_if;
@@ -806,9 +680,7 @@
$param->{'prefix'}
);
if ( $param->{'host_part'}->{$hostname} ) {
- Warn( $CODE->{'DUPLICATE_VALUE'},
- "Skipping $hostname : already defined"
- );
+ carp qq{WARN: Skipping $hostname : already defined};
next;
}
my $index = __Get_hostnumber_from_model(
@@ -887,10 +759,7 @@
|| $host2add->{'deployment'}->{'dhcpvlan'}
|| $site_part->{'dhcpvlan'};
unless( $site_part->{'NETWORK'}->{'BY_NAME'}->{$dhcpvlan} ) {
- Abort( $CODE->{'INVALID_VALUE'},
- "Unknown vlan " . $dhcpvlan . " on site "
- . $site . " for " . $hostname
- );
+ croak qq{ERROR: Unknown DHCP vlan $dhcpvlan for $hostname};
}
$host_part->{$hostname}->{'deployment'} =
__Add_deployment_on_host_entry (
@@ -913,11 +782,11 @@
$site_part, $pf_config
);
my $iface_name = $iface;
- if ( $iface =~ /^((eth|bond)[\d]+)(\.(TAG[\d]+))$/ ) {
- $iface_name
- = $1 . '.'
- . __Get_vlan_tag_from_site( $if2add->{'vlan'},
- $site, $global_config );
+ if ( $iface =~ m{\A((eth|bond)[\d]+)(\.(TAG[\d]+))\Z} ) {
+ $iface_name =
+ $1 . '.'
+ . __Get_vlan_tag_from_site(
+ $if2add->{'vlan'}, $site_part );
}
# Adding interface and IPs into site's zone
@@ -932,11 +801,7 @@
&& $type eq 'host'
&& !defined $if2add->{'mac'} )
{
- Abort( $CODE->{'UNDEF_KEY'},
- "MAC address MUST BE defined for interface "
- . $iface
- . " which is on dhcpvlan "
- . $dhcpvlan );
+ croak qq{ERROR: MAC MUST BE defined for DHCP on $iface};
}
foreach my $ip_type ( 'ipv4', 'ipv6' ) {
next if ( !$pf_config->{'features'}->{$ip_type} );
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Conf/Network.pm
--- a/lib/PFTools/Conf/Network.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Conf/Network.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,38 +1,35 @@
package PFTools::Conf::Network;
-##
-## $Id$
-##
-## Copyright (C) 2007-2009 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>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2007-2009 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>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use PFTools::Logger;
use PFTools::Net;
use PFTools::Structqueries;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Add_network
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Conf/Syntax.pm
--- a/lib/PFTools/Conf/Syntax.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Conf/Syntax.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,31 +1,30 @@
package PFTools::Conf::Syntax;
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
+use Carp;
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use PFTools::Logger;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
$DEF_SECTIONS
@@ -41,10 +40,31 @@
our @EXPORT_OK = qw();
# Syntax definitions
-our $ALLOWED_PARSING_CONTEXT = '(host|network|config|model)';
+
+# FIXME: factorize the common part of $HOSTTYPE_CONFIG_REGEX,
+# $MODEL_CONFIG_REGEX and $HOST_CONFIG_REGEX
+
+# FIXME: $CONFIG_REGEX->{'foo'} instead of $FOO_CONFIG_REGEX
+
+our $ALLOWED_PARSING_CONTEXT = qr{host|network|config|model};
our $HOSTTYPE_CONFIG_REGEX = qr{
- \A
- (?<HOSTTYPE> # HOSTTYPE
+ \A
+ (?<HOSTTYPE> # HOSTTYPE
+ (
+ (?<POPNAME> # POPNAME (optional)
+ [a-z]{3}\d
+ )
+ -
+ )?
+ (
+ [a-z0-9-]+[a-z-] # host type (without the POP name)
+ )
+ )
+ \z
+}xms;
+our $MODEL_CONFIG_REGEX = qr{
+ \A
+ (?<HOSTTYPE> # HOSTTYPE
(
(?<POPNAME> # POPNAME (optional)
[a-z]{3}\d{1}
@@ -55,14 +75,16 @@
[a-z0-9-]+[a-z-] # host type (without the POP name)
)
)
+ %* # HOSTDIGITS MARK (optional)
+ _* # HOSTNODEINDEX MARK (optional)
\z
}xms;
-our $MODEL_CONFIG_REGEX = qr{
- \A
- (?<HOSTTYPE> # HOSTTYPE
+our $HOST_CONFIG_REGEX = qr{
+ \A
+ (?<HOSTTYPE> # HOSTTYPE
(
- (?<POPNAME> # POPNAME (optional)
- [a-z]{3}\d{1}
+ (?<POPNAME> # POPNAME (optional)
+ [a-z]{3}\d
)
-
)?
@@ -70,30 +92,31 @@
[a-z0-9-]+[a-z-] # host type (without the POP name)
)
)
- %* # HOSTDIGITS MARK (optional)
- _* # HOSTNODEINDEX MARK (optional)
- \z
+ (?<HOSTDIGITS> # HOSTDIGITS (optional)
+ \d*
+ )
+ (?<HOSTNODEINDEX> # HOSTNODEINDEX (optional)
+ [a-z]*
+ )
+ \z
}xms;
-our $HOST_CONFIG_REGEX = qr{
- \A
- (?<HOSTTYPE> # HOSTTYPE
- (
- (?<POPNAME> # POPNAME (optional)
- [a-z]{3}\d{1}
- )
- -
- )?
- (
- [a-z0-9-]+[a-z-] # host type (without the POP name)
- )
- )(?<HOSTDIGITS>\d*) # HOSTDIGITS (optional)
- (?<HOSTNODEINDEX>[a-z]*) # HOSTNODEINDEX (optional)
- \z
+
+# deploy, POPNAME-rdeploy or POPNAME-spawn
+#our $DEPLOY_CONFIG_REGEX = '((?:\w{3}\d-r)?deploy|(\w{3}\d-)?spawn)';
+our $DEPLOY_CONFIG_REGEX = qr{
+ (
+ deploy
+ |
+ [a-z]{3}\d
+ -
+ (?:
+ rdeploy | spawn
+ )
+ )
}xms;
-our $DEPLOY_CONFIG_REGEX = '((?:\w{3}\d-r)?deploy|(\w{3}\d-)?spawn)';
#####################################
-# Sturcture for the hash below :
+# Structure for the hash below :
# {
# <context> = {
# <section> = {
@@ -117,14 +140,14 @@
'ipv6' => 'undefined',
'iface_opt' => 'undefined',
'@route' => 'undefined',
- '@route6' => 'undefined'
+ '@route6' => 'undefined',
},
'deployment' => {
'MANDATORY_KEYS' => [ 'arch', 'mode', 'distrib' ],
'arch' => 'i386|amd64',
'mode' => '(debian|ubuntu)',
'distrib' => '[a-z]+',
- 'dhcpvlan' => '\w+'
+ 'dhcpvlan' => '\w+',
},
'hostgroup' => {
'MANDATORY_KEYS' => [ 'number', 'hostname' ],
@@ -135,7 +158,7 @@
'nodes' => '[\d]+',
'prefix' => '(true|false)',
'hostname' => $MODEL_CONFIG_REGEX,
- 'hosttype' => $HOSTTYPE_CONFIG_REGEX
+ 'hosttype' => $HOSTTYPE_CONFIG_REGEX,
},
'boot' => {
'MANDATORY_KEYS' => ['kernel'],
@@ -143,14 +166,14 @@
'kernel' => 'undefined',
'initrd' => 'undefined',
'cmdline' => 'undefined',
- 'console' => '(default|ttyS0,115200n8)'
+ 'console' => '(default|ttyS0,115200n8)',
},
'dns' => {
'MANDATORY_KEYS' => ['resolver'],
'resolver' => 'undefined',
'shortname' => 'undefined',
- 'alias' => 'undefined'
- }
+ 'alias' => 'undefined',
+ },
},
'network' => {
'zone' => {
@@ -178,34 +201,34 @@
'state' => 'ROOT|EDGE',
'dhcpvlan' => '[\w\-]+',
'prefix' => '\w+',
- 'console' => '(default|ttyS0,115200n8)'
+ 'console' => '(default|ttyS0,115200n8)',
},
'network' => {
'MANDATORY_KEYS' => [ 'network', 'site' ],
'comment' => 'undefined',
'tag' => '\d{1,4}',
- 'network' => '([\d]{1,3}\.){3}[\d]{1,3}\/\d+',
+ 'network' => '([\d]{1,3}\.){3}[\d]{1,3}(\/\d+)?',
'network6' => 'undefined',
'scope' => '(private|public)',
'site' => '(ALL|[\w\-]+(\s*,\s*[\w\-]+)*)',
'gateway' => '([\d]{1,3})((\.[\d]{1,3}){1,3})?',
- 'gateway6' => 'undefined'
+ 'gateway6' => 'undefined',
},
'server' => {
- 'MANDATORY_KEYS' => [ 'site', 'number', ],
- 'comment' => 'undefined',
- 'site' => '(ALL|[\w\-]+(\s*,\s*[\w\-]+)*)',
- 'number' => '\d+',
- 'ipv4' => '([\d]{1,3})((\.[\d]{1,3}){1,3})?',
- 'ipv6' => 'undefined',
- 'alias' => '[a-z][a-z0-9\-]+[a-z0-9]',
- 'shortname' => '[a-z][a-z0-9\-]+[a-z0-9]'
+ 'MANDATORY_KEYS' => [ 'site', 'number', ],
+ 'comment' => 'undefined',
+ 'site' => '(ALL|[\w\-]+(\s*,\s*[\w\-]+)*)',
+ 'number' => '\d+',
+ 'ipv4' => '([\d]{1,3})((\.[\d]{1,3}){1,3})?',
+ 'ipv6' => 'undefined',
+ 'alias' => '[a-z][a-z0-9\-]+[a-z0-9]',
+ 'shortname' => '[a-z][a-z0-9\-]+[a-z0-9]',
},
'service' => {
'MANDATORY_KEYS' => [ 'site', '@host' ],
'comment' => 'undefined',
- '@host' => '[\w\-\:\/]+'
- }
+ '@host' => '[\w\-\:\/]+',
+ },
},
'config' => {
'addfile' => {
@@ -219,7 +242,7 @@
'on_config' => 'undefined',
'before_change' => 'undefined',
'on_noaction' => 'undefined',
- 'after_change' => 'undefined'
+ 'after_change' => 'undefined',
},
'createfile' => {
'depends' => 'undefined',
@@ -231,7 +254,7 @@
'on_config' => 'undefined',
'before_change' => 'undefined',
'on_noaction' => 'undefined',
- 'after_change' => 'undefined'
+ 'after_change' => 'undefined',
},
'removefile' => {},
'mkdir' => {
@@ -241,7 +264,7 @@
'on_config' => 'undefined',
'before_change' => 'undefined',
'on_noaction' => 'undefined',
- 'after_change' => 'undefined'
+ 'after_change' => 'undefined',
},
'addlink' => {
'MANDATORY_KEYS' => ['source'],
@@ -249,7 +272,7 @@
'on_config' => 'undefined',
'before_change' => 'undefined',
'on_noaction' => 'undefined',
- 'after_change' => 'undefined'
+ 'after_change' => 'undefined',
},
'addmount' => {
'MANDATORY_KEYS' => [ 'source', 'fstype', 'options' ],
@@ -257,133 +280,142 @@
'source' => 'undefined',
'fstype' => '(nfs|ext[2-4]|btrfs|cifs)',
'options' => 'undefined',
- 'mode' => '[0-7]?[0-7]{3}'
+ 'mode' => '[0-7]?[0-7]{3}',
},
'installpkg' => {
'version' => 'undefined',
'on_config' => 'undefined',
'before_change' => 'undefined',
'on_noaction' => 'undefined',
- 'after_change' => 'undefined'
+ 'after_change' => 'undefined',
},
'purgepkg' => {
'version' => 'undefined',
'on_config' => 'undefined',
'before_change' => 'undefined',
'on_noaction' => 'undefined',
- 'after_change' => 'undefined'
+ 'after_change' => 'undefined',
},
'filter-model' => {
- 'MANDATORY_KEYS' => ['filter'],
- 'filter' => 'undefined'
+ 'MANDATORY_KEYS' => [ 'filter' ],
+ 'filter' => 'undefined',
},
'actiongroup' => {
'on_config' => 'undefined',
'before_change' => 'undefined',
'on_noaction' => 'undefined',
- 'after_change' => 'undefined'
- }
- }
+ 'after_change' => 'undefined',
+ },
+ },
};
$DEF_SECTIONS->{'config'}->{'apt-get'}
= $DEF_SECTIONS->{'config'}->{'installpkg'};
$DEF_SECTIONS->{'config'}->{'dpkg-purge'}
= $DEF_SECTIONS->{'config'}->{'purgepkg'};
-sub Chk_section_struct ($$$$) {
- my ( $sect_name, $sect_type, $sect_hash, $context ) = @_;
- my ( $iface_type, $definition, $int_context, $sect_tmp );
+=head2
- $int_context = ( $context eq 'model' ) ? 'host' : $context;
+Chk_section_struct( $section_name, $section_type, $section_hash, $context )
- if ( !defined $DEF_SECTIONS->{$int_context}->{$sect_type} ) {
- return ( $CODE->{'INVALID_SECTNAME'},
- "Invalid section type " . $sect_type );
+Check $section_hash validity against $DEF_SECTIONS. Returns a true value on
+success, or croaks on errors.
+
+=cut
+
+sub Chk_section_struct {
+ my ( $section_name, $section_type, $section_hash, $context ) = @_;
+
+ my $int_context = ( $context eq 'model' ) ? 'host' : $context;
+
+ if ( !defined $DEF_SECTIONS->{$int_context}->{$section_type} ) {
+ croak qq{ERROR: Invalid section type $section_type};
}
- if ( $context =~ /^(host|model)$/ ) {
- if ( $sect_name
- =~ /^\Q$sect_type\E(::((eth|bond)[\d]+(\.TAG[\d]+)?))?$/ )
+ my ( $iface_type, $section_tmp);
+ if ( $context eq 'host' or $context eq 'model' ) {
+ unless ($section_name
+ =~ m{
+ \A
+ \Q$section_type\E
+ (?:
+ ::
+ (?: # logical interface name
+ (?:eth|bond) [\d]+ # real interface name
+ (?: # optional 802.1Q tag
+ [.]
+ TAG [\d]+
+ )?
+ )
+ )?
+ \z
+ }xms
+ )
{
- $iface_type = $3;
- }
- else {
- return ( $CODE->{'INVALID_SECTNAME'},
- "Invalid section name " . $sect_name );
+ croak qq{ERROR: Invalid section name $section_name};
}
- # Cleaning key name by removing .default or .%HOSTNUM% suffix
- foreach my $key ( keys %{$sect_hash} ) {
+ # Clean key names by removing .default or .%HOSTNUM% suffix
+ foreach my $key ( keys %{$section_hash} ) {
my $new = $key;
$new =~ s/\..*$//;
- $sect_tmp->{$new}->{'ORIG_NAME'} = $key;
- $sect_tmp->{$new}->{'VALUE'} = $sect_hash->{$key};
+ $section_tmp->{$new}->{'ORIG_NAME'} = $key;
+ $section_tmp->{$new}->{'VALUE'} = $section_hash->{$key};
}
}
else {
- $sect_tmp = $sect_hash;
+ $section_tmp = $section_hash;
}
- $definition = $DEF_SECTIONS->{$int_context}->{$sect_type};
+ my $definition = $DEF_SECTIONS->{$int_context}->{$section_type};
- # Checking mandatory keys
+ # Check mandatory keys
foreach my $key ( @{ $definition->{'MANDATORY_KEYS'} } ) {
- if ( $sect_type eq 'interface' ) {
- next if ( $iface_type eq 'eth' && $key eq 'slaves' );
- next if ( $key =~ /^ipv/ && $context eq 'model' );
+ if ( $section_type eq 'interface' ) {
+ next if $iface_type eq 'eth' and $key eq 'slaves';
+ next if $key =~ m{\A ipv}xms and $context eq 'model';
}
- last if ( $sect_type eq 'hostgroup' && $context eq 'model' );
- return ( $CODE->{'UNDEF_KEY'},
- "Mandatory key "
- . $key
- . " MUST BE defined on section "
- . $sect_name
- . " in context "
- . $context )
- if ( !defined( $sect_tmp->{$key} ) );
+ last if $section_type eq 'hostgroup' and $context eq 'model';
+ if ( !defined $section_tmp->{$key} ) {
+ croak qq{Mandatory key $key must be defined in section $section_name in context $context};
+ }
}
- # Checking all keys defined
+ # Check all keys defined
foreach my $key ( keys %{$definition} ) {
next
- if ( $key eq 'MANDATORY_KEYS'
- || $key =~ /^__/
- || $definition->{$key} eq 'undefined'
- || !defined $sect_tmp->{$key} );
- my $tab_values = [];
- my $key_name;
+ if $key eq 'MANDATORY_KEYS'
+ or $key =~ m{\A __}xms
+ or $definition->{$key} eq 'undefined' # FIXME
+ or !defined $section_tmp->{$key};
+
+ my ( $tab_values, $key_name );
if ( $int_context eq 'host' ) {
$tab_values
= ( $key !~ /^@/ )
- ? [ $sect_tmp->{$key}->{'VALUE'} ]
- : $sect_tmp->{$key}->{'VALUE'};
- $key_name = $sect_tmp->{$key}->{'ORIG_NAME'};
+ ? [ $section_tmp->{$key}->{'VALUE'} ]
+ : $section_tmp->{$key}->{'VALUE'};
+ $key_name = $section_tmp->{$key}->{'ORIG_NAME'};
}
else {
$tab_values
= ( $key !~ /^@/ )
- ? [ $sect_tmp->{$key} ]
- : $sect_tmp->{$key};
+ ? [ $section_tmp->{$key} ]
+ : $section_tmp->{$key};
$key_name = $key;
}
+
foreach my $value ( @{$tab_values} ) {
- # Removing trailing space
- $value =~ s/^\s*//;
- $value =~ s/\s*$//;
- if ( "$value" !~ /^$definition->{$key}$/ ) {
- return ( $CODE->{'INVALID_VALUE'},
- "Value |"
- . $value
- . "| for key "
- . $key_name
- . " on section "
- . $sect_name
- . " doesn't match "
- . $definition->{$key} );
+ # Remove surrounding spaces
+ $value =~ s{\A \s*}{}xms;
+ $value =~ s{\s* \z}{}xms;
+
+ if ( $value !~ m{ \A $definition->{$key} \z }xms ) {
+ croak qq{Value '$value' for key $key_name in section $section_name doesn't match $definition->{$key}};
}
}
}
- return ( $CODE->{'OK'}, "" );
+
+ return 1;
}
1;
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Disk.pm
--- a/lib/PFTools/Disk.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Disk.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,33 +1,30 @@
package PFTools::Disk;
-##
-## $Id$
-##
-## Copyright (C) 2007 Christophe Caillet <christophe.caillet at gmail.com>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2007 Christophe Caillet <christophe.caillet at gmail.com>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use PFTools::Logger;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Build_structure_from_fstab
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Logger.pm
--- a/lib/PFTools/Logger.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Logger.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,35 +1,31 @@
package PFTools::Logger;
-##
-## $Id$
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
+use Carp qw( confess croak );
use File::Basename;
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
- $DEFERREDLOG
$CODE
deferredlogsystem
@@ -47,8 +43,6 @@
);
our @EXPORT_OK = qw();
-
-my $DEFERREDLOG = 0;
# Error code and error messages
our $CODE = {
@@ -69,7 +63,9 @@
'DUPLICATE_VALUE' => 21,
};
-# Vars needed by pf-launch
+my $basename = basename $PROGRAM_NAME;
+my $log_is_deferred = 0;
+
my $sortie;
my $tmpfile = "/tmp/update-config.log"; # FIXME File::Temp
@@ -80,20 +76,18 @@
sub RotateCursor {
print STDERR $rotatecursortemplate[$rotatecursorcount], "\r";
- $rotatecursorcount
- = ( $rotatecursorcount + 1 ) % ( $#rotatecursortemplate + 1 );
+ $rotatecursorcount = ( $rotatecursorcount + 1 ) % @rotatecursortemplate;
}
sub Set_deferredlog {
- $DEFERREDLOG = 1;
+ $log_is_deferred = 1;
}
sub Unset_deferredlog {
- $DEFERREDLOG = 0;
+ $log_is_deferred = 0;
}
sub DeferOutput {
-
local *REAL_STDOUT;
local *REAL_STDERR;
@@ -106,19 +100,19 @@
$sortie->{'_stdout'} = *REAL_STDOUT;
$sortie->{'_stderr'} = *REAL_STDERR;
- open( STDOUT, "+>$tmpfile" ) or warn "Can't open tmp file for stdout";
- open( STDERR, ">&STDOUT" ) or warn "Can't open tmp file for stderr";
+ open( STDOUT, "+>$tmpfile" )
+ or warn qq{Can't open $tmpfile for stdout: $OS_ERROR};
+ open( STDERR, ">&STDOUT" )
+ or warn qq{Can't open $tmpfile for stderr: $OS_ERROR};
unlink $tmpfile;
select STDERR;
$| = 1;
select STDOUT;
$| = 1;
-
}
sub UndeferOutput {
-
seek( STDOUT, 0, 0 );
local $/;
$deferbuffer = <STDOUT>;
@@ -143,7 +137,6 @@
$| = 1;
select STDOUT;
$| = 1;
-
}
sub deferredlogpipe {
@@ -152,11 +145,10 @@
return unless $pipe_cmd;
DeferOutput()
- if $deferredlog or $DEFERREDLOG;
+ if $deferredlog or $log_is_deferred;
unless ( open DEFERREDLOGPIPE, '-|', $pipe_cmd ) {
- Warn( $CODE->{'OPEN'}, "Unable to open pipe $pipe_cmd: $OS_ERROR" );
- return;
+ croak qq{Unable to open pipe $pipe_cmd: $OS_ERROR};
}
my $ret = '';
@@ -167,7 +159,7 @@
close DEFERREDLOGPIPE;
UndeferOutput()
- if $deferredlog or $DEFERREDLOG;
+ if $deferredlog or $log_is_deferred;
if ($deferbuffer) {
$deferredlogbuffer .= $deferbuffer;
@@ -186,12 +178,12 @@
return unless $system_cmd;
DeferOutput()
- if $deferredlog or $DEFERREDLOG;
+ if $deferredlog or $log_is_deferred;
- my $ret = system($system_cmd );
+ my $ret = system($system_cmd);
UndeferOutput()
- if $deferredlog or $DEFERREDLOG;
+ if $deferredlog or $log_is_deferred;
if ($deferbuffer) {
$deferredlogbuffer .= $deferbuffer;
@@ -244,7 +236,7 @@
$deferredlogbuffer .= "\n";
- if ( !$DEFERREDLOG ) {
+ if ( !$log_is_deferred ) {
FlushLog();
}
else {
@@ -255,23 +247,21 @@
sub Debug {
my (@msg) = @_;
- my $basename = basename $0;
Log( "$basename: DEBUG: ", @msg );
}
sub Warn {
my ( $err, @msg ) = @_; # FIXME: $err unused!?
- my $basename = basename $0;
Log( "$basename: WARN: ", @msg );
}
sub Abort {
my ( $err, @msg ) = @_;
- my $basename = basename $0;
Log( "$basename: ERR: ", @msg );
FlushLog();
+ confess q{Please fix the caller by using croak() instead of Abort()};
exit $err;
}
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Net.pm
--- a/lib/PFTools/Net.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Net.pm Thu Sep 23 16:37:30 2010 +0200
@@ -23,16 +23,14 @@
use strict;
use warnings;
+use base qw( Exporter );
use Carp;
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use Net::DNS;
use NetAddr::IP;
use PFTools::Logger;
#use PFTools::Structqueries;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Get_netblock_from_vlan
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Packages.pm
--- a/lib/PFTools/Packages.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Packages.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,33 +1,31 @@
package PFTools::Packages;
-##
-## Copyright (C) 2009-2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+#
+# Copyright (C) 2009-2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use Module::Runtime qw( use_module );
use PFTools::Logger;
use PFTools::Packages::DEB;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Cmp_pkg_version
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Packages/DEB.pm
--- a/lib/PFTools/Packages/DEB.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Packages/DEB.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,32 +1,31 @@
package PFTools::Packages::DEB;
-##
-## Copyright (C) 2009 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2009 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use IO::File;
use PFTools::Logger;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Pkg_status
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Structqueries.pm
--- a/lib/PFTools/Structqueries.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Structqueries.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,36 +1,33 @@
package PFTools::Structqueries;
-##
-## $Id$
-##
-## 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>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# 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>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use PFTools::Logger;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Get_zone_from_hostname
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Update.pm
--- a/lib/PFTools/Update.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Update.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,33 +1,32 @@
package PFTools::Update;
-##
-## $Id$
-##
-## Copyright (C) 2007-2009 Christophe Caillet <quadchris at free.fr>
-## Copyright (C) 2004-2007 Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
-## Copyright (C) 2004 Gonéri Le Bouder <goneri at sitadelle.com>
-## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
-## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2007-2009 Christophe Caillet <quadchris at free.fr>
+# Copyright (C) 2004-2007 Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
+# Copyright (C) 2004 Gonéri Le Bouder <goneri at sitadelle.com>
+# Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+# Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use PFTools::Logger;
use PFTools::Packages;
@@ -41,8 +40,6 @@
use PFTools::Update::Purgepkg;
use PFTools::Update::Removedir;
use PFTools::Update::Removefile;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Get_depends_for_action
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Update/Addfile.pm
--- a/lib/PFTools/Update/Addfile.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Update/Addfile.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,29 +1,28 @@
package PFTools::Update::Addfile;
-##
-## $Id$
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use File::Compare;
use File::Copy;
use Text::Diff;
@@ -31,8 +30,6 @@
use PFTools::Conf;
use PFTools::Logger;
use PFTools::Update::Common;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Addfile_depends
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Update/Addlink.pm
--- a/lib/PFTools/Update/Addlink.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Update/Addlink.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,35 +1,32 @@
package PFTools::Update::Addlink;
-##
-## $Id$
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use PFTools::Conf;
use PFTools::Logger;
use PFTools::Update::Common;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Addlink_depends
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Update/Addmount.pm
--- a/lib/PFTools/Update/Addmount.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Update/Addmount.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,29 +1,28 @@
package PFTools::Update::Addmount;
-##
-## $Id$
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use IO::File;
use File::Copy;
use Text::Diff;
@@ -36,8 +35,6 @@
use PFTools::Structqueries;
use PFTools::Update::Common;
use PFTools::Update::Mkdir;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Addmount_depends
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Update/Common.pm
--- a/lib/PFTools/Update/Common.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Update/Common.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,36 +1,33 @@
package PFTools::Update::Common;
-##
-## $Id$
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use File::Copy;
use File::Path qw( make_path );
use PFTools::Conf;
use PFTools::Logger;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Do_on_config
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Update/Createfile.pm
--- a/lib/PFTools/Update/Createfile.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Update/Createfile.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,36 +1,33 @@
package PFTools::Update::Createfile;
-##
-## $Id$
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use File::Copy;
use PFTools::Conf;
use PFTools::Logger;
use PFTools::Update::Common;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Createfile_depends
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Update/Installpkg.pm
--- a/lib/PFTools/Update/Installpkg.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Update/Installpkg.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,39 +1,36 @@
package PFTools::Update::Installpkg;
-##
-## $Id$
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use Debconf::ConfModule;
use Debconf::Db;
use Debconf::Template;
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use PFTools::Conf;
use PFTools::Logger;
use PFTools::Packages;
use PFTools::Update::Common;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Installpkg_depends
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Update/Mkdir.pm
--- a/lib/PFTools/Update/Mkdir.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Update/Mkdir.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,36 +1,33 @@
package PFTools::Update::Mkdir;
-##
-## $Id$
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use File::Path qw( make_path );
use PFTools::Conf;
use PFTools::Logger;
use PFTools::Update::Common;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Mkdir_depends
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Update/Purgepkg.pm
--- a/lib/PFTools/Update/Purgepkg.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Update/Purgepkg.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,36 +1,33 @@
package PFTools::Update::Purgepkg;
-##
-## $Id$
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use PFTools::Conf;
use PFTools::Logger;
use PFTools::Packages;
use PFTools::Update::Common;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Purgepkg_action
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Update/Removedir.pm
--- a/lib/PFTools/Update/Removedir.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Update/Removedir.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,35 +1,32 @@
package PFTools::Update::Removedir;
-##
-## $Id$
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use PFTools::Conf;
use PFTools::Logger;
use PFTools::Update::Common;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Removedir_action
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Update/Removefile.pm
--- a/lib/PFTools/Update/Removefile.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Update/Removefile.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,35 +1,32 @@
package PFTools::Update::Removefile;
-##
-## $Id$
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use PFTools::Conf;
use PFTools::Logger;
use PFTools::Update::Common;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Removefile_action
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/Utils.pm
--- a/lib/PFTools/Utils.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/Utils.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,28 +1,28 @@
package PFTools::Utils;
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use Digest::MD5;
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use File::Compare;
use File::Copy;
use IO::File;
@@ -34,8 +34,6 @@
use PFTools::Structqueries;
use PFTools::Update;
use PFTools::VCS;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
Init_TOOLS
@@ -58,24 +56,13 @@
our @EXPORT_OK = qw();
#########################################################################
-# Prototypes : needed by recursive calls
-
-sub __Do_updateloop ($$$$$);
-
-#########################################################################
# Functions
sub Init_TOOLS ($;$$$) {
my ( $hostname, $pf_config_file, $global_store_file, $reload ) = @_;
my ( $pf_config, $global_struct );
- if ( $pf_config_file && $pf_config_file ne '' ) {
- if ( !-e $pf_config_file ) {
- Abort( $CODE->{'OPEN'},
- "Unable to open configuration file "
- . $pf_config_file
- . " : no such file or directory" );
- }
+ if ( $pf_config_file ) {
$pf_config = Init_PF_CONFIG($pf_config_file);
}
elsif ( -e '/etc/pf-tools.conf' ) {
@@ -998,7 +985,7 @@
return $interfaces;
}
-sub __Do_updateloop ($$$$$) {
+sub __Do_updateloop {
my ( $host_config, $options, $hash_subst, $global_config, $sortedkeys )
= @_;
my $errorcount = 0;
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/VCS.pm
--- a/lib/PFTools/VCS.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/VCS.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,34 +1,33 @@
package PFTools::VCS;
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use Carp;
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use File::Path qw( make_path remove_tree );
use Module::Runtime qw ( use_module );
use PFTools::Logger;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
VCS_checkout
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/VCS/CVS.pm
--- a/lib/PFTools/VCS/CVS.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/VCS/CVS.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,34 +1,33 @@
package PFTools::VCS::CVS;
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
-## USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+# USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use Carp;
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use File::Path qw( make_path remove_tree );
use PFTools::Logger;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
checkout
diff -r 3fd194956c81 -r eca88de2d73a lib/PFTools/VCS/SVN.pm
--- a/lib/PFTools/VCS/SVN.pm Thu Sep 23 11:37:07 2010 +0200
+++ b/lib/PFTools/VCS/SVN.pm Thu Sep 23 16:37:30 2010 +0200
@@ -1,34 +1,33 @@
package PFTools::VCS::SVN;
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
-## USA
-##
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+# USA
+#
use strict;
use warnings;
+use base qw( Exporter );
use Carp;
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use Exporter;
use File::Path qw( make_path remove_tree );
use PFTools::Logger;
-
-our @ISA = ('Exporter');
our @EXPORT = qw(
checkout
@@ -37,17 +36,23 @@
sub checkout {
my ( $hostname, $pf_config, $options ) = @_;
- unless( $hostname or $pf_config or $options ) {
- carp q{ERROR: $hostname, $pf_config, $options are invalid}
- return;
+ unless ($hostname) {
+ croak q{ERROR: Invalid undefined or empty $hostname};
}
- if( ref $hostname ) {
- carp q{ERROR: $hostname MUST BE a string};
- return;
+ unless ($pf_config) {
+ croak q{ERROR: Invalid undefined or empty $pf_config};
}
- unless( $pf_config eq 'HASH' or $options eq 'HASH' ) {
- carp q{ERROR: non-ref $pf_config and/or $options};
- return;
+ unless ($options) {
+ croak q{ERROR: Invalid undefined or empty $options};
+ }
+ if ( ref $hostname ) {
+ croak q{ERROR: Invalid non-scalar $hostname};
+ }
+ if ( ref $pf_config ne 'HASH' ) {
+ croak q{ERROR: Invalid non-hashref $pf_config};
+ }
+ if ( ref $options ne 'HASH' ) {
+ croak q{ERROR: Invalid non-hashref $options};
}
my $svn_cmd = $pf_config->{'vcs'}->{'command'};
diff -r 3fd194956c81 -r eca88de2d73a sbin/fix_hosts
--- a/sbin/fix_hosts Thu Sep 23 11:37:07 2010 +0200
+++ b/sbin/fix_hosts Thu Sep 23 16:37:30 2010 +0200
@@ -1,27 +1,28 @@
#!/usr/bin/perl
-##
-## Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
-## USA
-##
+#
+# Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+# USA
+#
use strict;
use warnings;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use Getopt::Long qw( :config ignore_case_always bundling );
use IO::File;
use Sys::Hostname;
@@ -56,8 +57,7 @@
my $PF_CONFIG = {};
my $GLOBAL_STRUCT = {};
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
+my $program = basename $PROGRAM_NAME;
###################################
# Funtions
diff -r 3fd194956c81 -r eca88de2d73a sbin/mk_dhcp
--- a/sbin/mk_dhcp Thu Sep 23 11:37:07 2010 +0200
+++ b/sbin/mk_dhcp Thu Sep 23 16:37:30 2010 +0200
@@ -1,29 +1,30 @@
#!/usr/bin/perl
-##
-## Copyright (C) 2007-2008 Christophe Caillet <quadchris at free.fr>
-## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
-## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
-## USA
-##
+#
+# Copyright (C) 2007-2008 Christophe Caillet <quadchris at free.fr>
+# Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+# Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+# USA
+#
use strict;
use warnings;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use Getopt::Long qw( :config ignore_case_always bundling );
use IO::File;
@@ -55,10 +56,7 @@
my $PF_CONFIG = {};
my $GLOBAL_STRUCT = {};
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
-
-#my $version = sprintf( "svn-r%s", q$Revision$ =~ /([\d.]+)/ );
+my $program = basename $PROGRAM_NAME;
#####################################
# Functions
diff -r 3fd194956c81 -r eca88de2d73a sbin/mk_grubopt
--- a/sbin/mk_grubopt Thu Sep 23 11:37:07 2010 +0200
+++ b/sbin/mk_grubopt Thu Sep 23 16:37:30 2010 +0200
@@ -1,26 +1,27 @@
#!/usr/bin/perl
-##
-## Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+#
+# Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use Getopt::Long qw( :config ignore_case_always bundling );
use Sys::Hostname;
@@ -54,8 +55,7 @@
my $PF_CONFIG = {};
my $GLOBAL_STRUCT = {};
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
+my $program = basename $PROGRAM_NAME;
######################################################
# Functions
diff -r 3fd194956c81 -r eca88de2d73a sbin/mk_interfaces
--- a/sbin/mk_interfaces Thu Sep 23 11:37:07 2010 +0200
+++ b/sbin/mk_interfaces Thu Sep 23 16:37:30 2010 +0200
@@ -1,29 +1,30 @@
#!/usr/bin/perl
-##
-## Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
-## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
-## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
-## USA
-##
+#
+# Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
+# Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+# Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+# USA
+#
use strict;
use warnings;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use Getopt::Long qw( :config ignore_case_always bundling );
use IO::File;
use Sys::Hostname;
@@ -59,15 +60,13 @@
"#\n",
);
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
+my $program = basename $PROGRAM_NAME;
###################################
# Funtions
sub Do_help {
print STDERR << "# ENDHELP";
-
Usage: $program [options]
--help : print help and exit
-h --host : hostname for which we want to build interfaces file
diff -r 3fd194956c81 -r eca88de2d73a sbin/mk_pxelinuxcfg
--- a/sbin/mk_pxelinuxcfg Thu Sep 23 11:37:07 2010 +0200
+++ b/sbin/mk_pxelinuxcfg Thu Sep 23 16:37:30 2010 +0200
@@ -1,29 +1,30 @@
#!/usr/bin/perl
-##
-## Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
-## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
-## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
-## USA
-##
+#
+# Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
+# Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+# Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+# USA
+#
use strict;
use warnings;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use Getopt::Long qw( :config ignore_case_always bundling );
use File::Path qw( make_path );
@@ -53,8 +54,7 @@
my $GLOBAL_STRUCT = {};
my $DEFAULT_PRESEED = '';
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
+my $program = basename $PROGRAM_NAME;
############################################
diff -r 3fd194956c81 -r eca88de2d73a sbin/mk_resolvconf
--- a/sbin/mk_resolvconf Thu Sep 23 11:37:07 2010 +0200
+++ b/sbin/mk_resolvconf Thu Sep 23 16:37:30 2010 +0200
@@ -1,28 +1,29 @@
#!/usr/bin/perl
-##
-## Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
-## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
-## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+#
+# Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
+# Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+# Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use Getopt::Long qw( :config ignore_case_always bundling );
use Sys::Hostname;
@@ -51,8 +52,7 @@
my $PF_CONFIG = {};
my $GLOBAL_STRUCT = {};
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
+my $program = basename $PROGRAM_NAME;
###################################
# Funtions
diff -r 3fd194956c81 -r eca88de2d73a sbin/mk_sitezone
--- a/sbin/mk_sitezone Thu Sep 23 11:37:07 2010 +0200
+++ b/sbin/mk_sitezone Thu Sep 23 16:37:30 2010 +0200
@@ -1,27 +1,28 @@
#!/usr/bin/perl
-##
-## Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
-## USA
-##
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+# USA
+#
use strict;
use warnings;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use Getopt::Long qw( :config ignore_case_always bundling );
use IO::File;
@@ -47,8 +48,7 @@
my $PF_CONFIG = {};
my $GLOBAL_STRUCT = {};
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
+my $program = basename $PROGRAM_NAME;
#################################################
# Functions
diff -r 3fd194956c81 -r eca88de2d73a sbin/mk_sourceslist
--- a/sbin/mk_sourceslist Thu Sep 23 11:37:07 2010 +0200
+++ b/sbin/mk_sourceslist Thu Sep 23 16:37:30 2010 +0200
@@ -1,27 +1,28 @@
#!/usr/bin/perl
-##
-## Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
-## USA
-##
+#
+# Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+# USA
+#
use strict;
use warnings;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use Getopt::Long qw( :config ignore_case_always bundling );
use Sys::Hostname;
@@ -56,8 +57,7 @@
my $PF_CONFIG = {};
my $GLOBAL_STRUCT = {};
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
+my $program = basename $PROGRAM_NAME;
############################################
# Functions
diff -r 3fd194956c81 -r eca88de2d73a sbin/update-config
--- a/sbin/update-config Thu Sep 23 11:37:07 2010 +0200
+++ b/sbin/update-config Thu Sep 23 16:37:30 2010 +0200
@@ -1,29 +1,30 @@
#!/usr/bin/perl
-##
-## Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
-## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
-## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
-## USA
-##
+#
+# Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
+# Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+# Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+# USA
+#
use strict;
use warnings;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use Getopt::Long qw( :config ignore_case_always bundling );
use Sys::Hostname;
@@ -37,8 +38,7 @@
my $PF_CONFIG = {};
my $GLOBAL_STRUCT = {};
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
+my $program = basename $PROGRAM_NAME;
###################################
diff -r 3fd194956c81 -r eca88de2d73a t/13.conf.t
--- a/t/13.conf.t Thu Sep 23 11:37:07 2010 +0200
+++ b/t/13.conf.t Thu Sep 23 16:37:30 2010 +0200
@@ -323,3 +323,46 @@
unlink $global_config_file;
remove_tree( qw( /tmp/pftools-conf-test/ ) );
+
+########################################################################
+note('Testing PFTools::Conf::Load_conf');
+can_ok( 'PFTools::Conf', qw( Load_conf ) );
+
+ok !defined Load_conf()
+ => 'Returns undef if no args';
+
+ok !defined Load_conf( 'file' )
+ => 'Returns undef if only one arg';
+
+ok !defined Load_conf( 'file', {} )
+ => 'Returns undef if only two args';
+
+ok !defined Load_conf( 'file', {}, 'context' )
+ => 'Returns undef if only three args';
+
+throws_ok { Load_conf( {}, {}, 'context', {} ) }
+ qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] file }xms
+ => q{Dies if non-scalar $file};
+
+throws_ok { Load_conf( 'file', {}, {}, {} ) }
+ qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] context }xms
+ => q{Dies if non-scalar $context};
+
+throws_ok { Load_conf( 'file', 'subst', 'context', {} ) }
+ qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] [\$] hash_subst }xms
+ => q{Dies if non-hashref $hash_subst};
+
+throws_ok { Load_conf( 'file', {}, 'context', 'pf_config' ) }
+ qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] [\$] pf_config }xms
+ => q{Dies if non-hashref $pf_config};
+
+throws_ok { Load_conf( 'file', {}, 'context', {} ) }
+ qr{ \A ERROR: [ ] Invalid [ ] context [ ] }xms
+ => q{Dies if invalid $context};
+
+throws_ok { Load_conf( 'inexistent file', {}, 'config', {} ) }
+ qr{ \A ERROR: [ ] Unable [ ] to [ ] load [ ] }xms
+ => q{Dies if inexistent $file};
+
+diag( 'FIXME: other tests needed here for Load_conf() with real files and contexts' );
+
diff -r 3fd194956c81 -r eca88de2d73a tools/Display_IP_config
--- a/tools/Display_IP_config Thu Sep 23 11:37:07 2010 +0200
+++ b/tools/Display_IP_config Thu Sep 23 16:37:30 2010 +0200
@@ -1,22 +1,22 @@
#!/usr/bin/perl
-##
-## Copyright (C) 2008-2010 Christophe Caillet <quadchris at free.fr>
-## Copyright (C) 2004 Stephane Pontier <shad at sitadelle.com>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+#
+# Copyright (C) 2008-2010 Christophe Caillet <quadchris at free.fr>
+# Copyright (C) 2004 Stephane Pontier <shad at sitadelle.com>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
# liste toute les adresses ip depuis le fichier private-network
# prend le fichier private-network en argument et un 1 en second
@@ -25,8 +25,8 @@
use strict;
use warnings;
-use Data::Dumper;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use Getopt::Long qw ( :config ignore_case_always bundling );
use NetAddr::IP;
@@ -54,8 +54,7 @@
my $PF_CONFIG = {};
my $GLOBAL_STRUCT = {};
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
+my $program = basename $PROGRAM_NAME;
######################################################
# Functions
diff -r 3fd194956c81 -r eca88de2d73a tools/Translate_old_config
--- a/tools/Translate_old_config Thu Sep 23 11:37:07 2010 +0200
+++ b/tools/Translate_old_config Thu Sep 23 16:37:30 2010 +0200
@@ -1,24 +1,22 @@
#!/usr/bin/perl
-##
-## $Id$
-##
-## Copyright (C) 2008-2010 Christophe Caillet <quadchris at free.fr>
-## Copyright (C) 2004 Stephane Pontier <shad at sitadelle.com>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+#
+# Copyright (C) 2008-2010 Christophe Caillet <quadchris at free.fr>
+# Copyright (C) 2004 Stephane Pontier <shad at sitadelle.com>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
# liste toute les adresses ip depuis le fichier private-network
# prend le fichier private-network en argument et un 1 en second
@@ -28,6 +26,7 @@
use warnings;
use Data::Dumper;
+use File::Basename;
use English qw( -no_match_vars ); # Avoids regex performance penalty
use Getopt::Long qw ( :config ignore_case_always bundling );
@@ -43,18 +42,13 @@
my $TYPE = "config";
my $HELP = 0;
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
-
-my $version = sprintf( "svn-r%s", q$Revision$ =~ /([\d.]+)/ );
+my $program = basename $PROGRAM_NAME;
#################################
# Functions
sub Do_help () {
print STDERR << "# ENDHELP";
- $program - version $version
-
Usage: $program [options]
--help : print help and exit
-t --type : type of configuration file, allowed types are : config, network
diff -r 3fd194956c81 -r eca88de2d73a tools/kvmlaunch
--- a/tools/kvmlaunch Thu Sep 23 11:37:07 2010 +0200
+++ b/tools/kvmlaunch Thu Sep 23 16:37:30 2010 +0200
@@ -1,8 +1,4 @@
#!/usr/bin/perl
-#
-# $Id$
-#
-
#
# Copyright (C) 2009 Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
#
@@ -34,12 +30,15 @@
use Carp;
use Digest::CRC qw( crc32_hex );
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use File::Path;
use Getopt::Long;
use PFTools::Conf;
use PFTools::Net;
use PFTools::Update;
+
+my $program = basename $PROGRAM_NAME;
#$PFTools::Conf::PFTOOLS_VARS->{'UML'} = 1;
@@ -234,7 +233,7 @@
sub usage {
warn <<"EOH";
-Usage: $0 [options] [hostregexp|hostlist] ...
+Usage: $program [options] [hostregexp|hostlist] ...
Options:
--oneeach (-1) Ignore any host arg and launch 1 VM of each existing
host type.
diff -r 3fd194956c81 -r eca88de2d73a tools/umlaunch
--- a/tools/umlaunch Thu Sep 23 11:37:07 2010 +0200
+++ b/tools/umlaunch Thu Sep 23 16:37:30 2010 +0200
@@ -1,27 +1,22 @@
#!/usr/bin/perl
#
-# $Id$
-# $Name$
+# Copyright (C) 2004-2007 Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
+# Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
#
-
-##
-## Copyright (C) 2004-2007 Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
-## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
@@ -35,6 +30,8 @@
use PFTools::Conf;
use PFTools::Net;
use PFTools::Update;
+
+my $program = basename $PROGRAM_NAME;
$PFTools::Conf::PFTOOLS_VARS->{'UML'} = 1;
@@ -77,7 +74,7 @@
) or die "GetOptions error, try --help";
if ( $options->{'help'} ) {
- print STDERR "Usage: $0 [options] [hostregexp] ...\n";
+ print STDERR "Usage: $program [options] [hostregexp] ...\n";
print STDERR "Options:\n";
print STDERR "\t-1 --oneeach 1 machine de chaque\n";
print STDERR "\t --detached deployer en tache de fond\n";
@@ -95,7 +92,7 @@
}
if ( !defined( $ARGV[0] ) ) {
- print STDERR "Usage: " . $0 . " host ...\n";
+ print STDERR "Usage: " . $program . " host ...\n";
exit 1;
}
diff -r 3fd194956c81 -r eca88de2d73a tools/xenlaunch
--- a/tools/xenlaunch Thu Sep 23 11:37:07 2010 +0200
+++ b/tools/xenlaunch Thu Sep 23 16:37:30 2010 +0200
@@ -1,32 +1,34 @@
#!/usr/bin/perl
-
-##
-## Copyright (C) 2005 Gonéri Le Bouder <goneri at sitadelle.com>
-##
-## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version 2
-## of the License, or (at your option) any later version.
-##
-## This program is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with this program; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-##
+#
+# Copyright (C) 2005 Gonéri Le Bouder <goneri at sitadelle.com>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
use strict;
use warnings;
use Data::Dumper;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Basename;
use File::Path qw( make_path );
use Getopt::Long;
use Sitalibs::Config;
+
+my $program = basename $PROGRAM_NAME;
my $XENCFGDIR = "/etc/xen";
my $KERNELDIR = "/distrib/tftpboot";
@@ -179,7 +181,7 @@
) or die "GetOptions error, try --help";
if ( $options->{'help'} ) {
- print STDERR "Usage: $0 [options] [hostregexp] ...\n";
+ print STDERR "Usage: $program [options] [hostregexp] ...\n";
print STDERR "Options:\n";
# print STDERR "\t-1 --oneeach 1 machine de chaque\n";
@@ -197,7 +199,7 @@
}
if ( !defined( $ARGV[0] ) ) {
- print STDERR "Usage: " . $0 . " host ...\n";
+ print STDERR "Usage: " . $program . " host ...\n";
exit 1;
}
More information about the pf-tools-commits
mailing list