pf-tools/pf-tools: 2 new changesets
parmelan-guest at users.alioth.debian.org
parmelan-guest at users.alioth.debian.org
Fri Aug 8 16:02:17 UTC 2014
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/b945cc2d5657
changeset: 1306:b945cc2d5657
user: shad
date: Fri Aug 08 16:16:51 2014 +0200
description:
critic + error messages + comments
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/ef9e72e07750
changeset: 1307:ef9e72e07750
user: shad
date: Fri Aug 08 18:02:12 2014 +0200
description:
more critic
diffstat:
doc/networkfile-syntax | 2 +-
lib/PFTools.pm | 4 +-
lib/PFTools/Conf.pm | 203 ++++----
lib/PFTools/Conf/Config.pm | 138 ++---
lib/PFTools/Conf/Host.pm | 10 +-
lib/PFTools/Conf/Syntax.pm | 2 +-
lib/PFTools/Disk.pm | 918 +++-----------------------------------
lib/PFTools/Net.pm | 88 ++-
lib/PFTools/Packages.pm | 60 +-
lib/PFTools/Packages/DEB.pm | 28 +-
lib/PFTools/Parser.pm | 2 +-
lib/PFTools/Raid.pm | 837 +++++++++++++++++++++++++++++++++++
lib/PFTools/Structqueries.pm | 26 +-
lib/PFTools/Update.pm | 32 +-
lib/PFTools/Update/ADDFILE.pm | 6 +-
lib/PFTools/Update/ADDLINK.pm | 2 +-
lib/PFTools/Update/ADDMOUNT.pm | 10 +-
lib/PFTools/Update/CREATEFILE.pm | 4 +-
lib/PFTools/Update/Common.pm | 12 +-
lib/PFTools/Update/INSTALLPKG.pm | 12 +-
lib/PFTools/Update/PURGEPKG.pm | 6 +-
lib/PFTools/Utils.pm | 26 +-
lib/PFTools/VCS.pm | 63 +-
lib/PFTools/VCS/CVS.pm | 12 +-
lib/PFTools/VCS/HG.pm | 12 +-
lib/PFTools/VCS/SVN.pm | 12 +-
sbin/update-config | 2 +-
t/11.vars.t | 16 +-
t/12.storable.t | 10 +-
t/13.conf.t | 220 ++++----
t/20.files.t | 6 +-
tools/kvmlaunch | 2 +-
tools/umlaunch | 2 +-
33 files changed, 1450 insertions(+), 1335 deletions(-)
diffs (4594 lines):
diff -r fc33cd0e9c62 -r ef9e72e07750 doc/networkfile-syntax
--- a/doc/networkfile-syntax Thu Aug 07 18:31:27 2014 +0200
+++ b/doc/networkfile-syntax Fri Aug 08 18:02:12 2014 +0200
@@ -20,7 +20,7 @@
? location ::= <STR>
? room ::= <STR>
? alias ::= [a-z]{3}\d
- ? confdir ::= <PATH> define here the directory for configuration access refined by Get_source
+ ? confdir ::= <PATH> define here the directory for configuration access refined by get_source
! dhcpvlan ::= <NETWORK_NAME>
! console ::= (default|ttyS0,115200n8)
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools.pm
--- a/lib/PFTools.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools.pm Fri Aug 08 18:02:12 2014 +0200
@@ -226,9 +226,9 @@
my ( $args_ref, @keys ) = @_;
check_args {
- my ( $args_ref, $key ) = @_;
+ my ( $args_ref2, $key ) = @_;
- if ( not $args_ref->{$key} ) {
+ if ( not $args_ref2->{$key} ) {
croak qq{ERROR: Invalid empty $key};
}
}
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Conf.pm
--- a/lib/PFTools/Conf.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Conf.pm Fri Aug 08 18:02:12 2014 +0200
@@ -54,15 +54,15 @@
use PFTools::Structqueries;
our @EXPORT = qw(
- Subst_vars
- Init_SUBST
- Init_PF_CONFIG
- Init_GLOBAL_NETCONFIG
- Load_conf
+ subst_vars
+ init_subst
+ init_pf_config
+ init_global_netconfig
+ load_conf
store_global_config
retrieve_global_config
- Get_source
- Get_config_for_hostname_on_site
+ get_source
+ get_config_for_hostname_on_site
get_default_pf_config
get_current_pf_config
reset_pf_config
@@ -160,7 +160,7 @@
Returns the current (and writable) pf_config (internally stored in
$PF_CONFIG). This hash is initialized from the default configuration and
-further modified by Load_conf().
+further modified by load_conf().
=cut
@@ -181,7 +181,7 @@
return;
}
-=head2 Subst_vars( $text, $variables_ref )
+=head2 subst_vars( $text, $variables_ref )
If $text is empty or undefined, just return it.
If $variables_ref is not a valid hash reference, just return $text.
@@ -189,18 +189,18 @@
=cut
-sub Subst_vars {
+sub subst_vars {
my ( $text, $variables_ref ) = @_;
- return unless defined $text;
- return $text unless $text;
- return $text unless ref $variables_ref eq 'HASH';
+ return if !defined $text;
+ return $text if !$text;
+ return $text if ref $variables_ref ne 'HASH';
$text =~ s{ % ([^%]+) % }{ $variables_ref->{$1} || q{} }xmsge;
return $text;
}
-=head2 Init_PF_CONFIG( $filename )
+=head2 init_pf_config( $filename )
Parses $filename and merges known sections/keys with the default
configuration as found in $DEFAULT_PF_CONFIG, and stores the result
@@ -211,29 +211,29 @@
=cut
-sub Init_PF_CONFIG {
+sub init_pf_config {
my ($config_file) = @_;
# Initialize $PF_CONFIG with the default configuration if it is empty
# (that means it had not been initialized yet)
- unless ( keys %{$PF_CONFIG} ) {
+ if ( !keys %{$PF_CONFIG} ) {
$PF_CONFIG = clone($DEFAULT_PF_CONFIG);
}
# Return the current (possibly default) configuration if no config_file
# was specified
- unless ($config_file) {
+ if ( !$config_file ) {
return $PF_CONFIG;
}
- unless ( -e $config_file ) {
+ if ( !-e $config_file ) {
croak qq{ERROR: $config_file: no such file};
}
my $st = stat $config_file;
# FIXME also check that $uid == 0 && $gid == 0 ?
- unless ( S_IMODE( $st->mode ) == oct('0600') and S_ISREG( $st->mode ) ) {
+ if ( ( S_IMODE( $st->mode ) != oct('0600') ) || !S_ISREG( $st->mode ) ) {
croak
qq{ERROR: weak rights for $config_file (check owner/group/mode)};
}
@@ -257,7 +257,7 @@
return $PF_CONFIG;
}
-=head2 Init_SUBST( $hostname, $host_type, $pf_config, $domainname )
+=head2 init_subst( $hostname, $host_type, $pf_config, $domainname )
Initializes a hash structure with all the substitution variables needed to
handle $hostname (default: the local host).
@@ -266,25 +266,25 @@
=cut
-sub Init_SUBST {
+sub init_subst {
my ( $hostname, $hosttype, $pf_config, $domainname ) = @_;
$hostname ||= lc hostname;
if ( $pf_config and ref $pf_config ne 'HASH' ) {
- croak q{ERROR: Invalid non-href $pf_config};
+ croak q{ERROR: Invalid non-href 'pf_config'};
}
- $pf_config ||= Init_PF_CONFIG();
+ $pf_config ||= init_pf_config();
$domainname ||= $pf_config->{'location'}->{'zone'} || hostdomain || q{};
if ( ref $hosttype ) {
- croak q{ERROR: Hosttype parameter must be a string};
+ croak q{ERROR: 'hosttype' parameter must be a string};
}
my $host_regex = $pf_config->{'regex'}->{'hostname'}
|| $HOST_CONFIG_REGEX;
- unless ( $hostname =~ m{ $host_regex }xms ) {
+ if ( $hostname !~ m{ $host_regex }xms ) {
croak qq{ERROR: Invalid hostname $hostname};
}
@@ -310,7 +310,7 @@
return $ref_subst;
}
-=head2 Get_source( $source, $hostname, $hash_subst, $pf_config )
+=head2 get_source( $source, $hostname, $hash_subst, $pf_config )
If $source is defined, resolves macros and variables found in $source and
returns the result.
@@ -321,28 +321,28 @@
FIXME document the available macros
The variables are defined by $hash_subst (defaults to the result of
-Init_SUBST()). See also Subst_vars().
+init_subst()). See also subst_vars().
=cut
-sub Get_source {
+sub get_source {
my ( $source, $hostname, $hash_subst, $pf_config ) = @_;
if ( ref $source ) {
- croak q{ERROR: Invalid non-scalar $source};
+ croak q{ERROR: Invalid non-scalar 'source'};
}
if ( not $source ) {
- croak q{ERROR: Invalid empty $source};
+ croak q{ERROR: Invalid empty 'source'};
}
if ( $hash_subst and ref $hash_subst ne 'HASH' ) {
- croak q{ERROR: Invalid non-href $hash_subst};
+ croak q{ERROR: Invalid non-href 'hash_subst'};
}
- unless ($hash_subst) {
- $hash_subst = Init_SUBST( $hostname, undef, $pf_config );
+ if ( !$hash_subst ) {
+ $hash_subst = init_subst( $hostname, undef, $pf_config );
}
- unless ($pf_config) {
+ if ( !$pf_config ) {
$pf_config = $PF_CONFIG;
}
@@ -370,14 +370,14 @@
$result =~ s{ \A CVS [:] }{$vcs_work_dir/}xms;
$result =~ s{ \A GLOBAL [:] }{$vcs_work_dir/$module/GLOBAL/}xms;
- $result = Subst_vars( $result, $hash_subst );
+ $result = subst_vars( $result, $hash_subst );
$result =~ s{ [/]+ }{/}xmsg; # fix multiple slashes
return $result;
}
-=head2 Load_conf( $file, $hash_subst, $context, $pf_config )
+=head2 load_conf( $file, $hash_subst, $context, $pf_config )
Reads configuration from $file in context $context.
@@ -385,29 +385,29 @@
=cut
-sub Load_conf {
+sub load_conf {
my ( $file, $hash_subst, $context, $pf_config ) = @_;
if ( ref $file ) {
- croak q{ERROR: Invalid non-scalar $file};
+ croak q{ERROR: Invalid non-scalar 'file'};
}
if ( not $file ) {
- croak q{ERROR: Invalid empty $file};
+ croak q{ERROR: Invalid empty 'file'};
}
if ( ref $hash_subst ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $hash_subst};
+ croak q{ERROR: Invalid non-hashref 'hash_subst'};
}
if ( ref $context ) {
- croak q{ERROR: Invalid non-scalar $context};
+ croak q{ERROR: Invalid non-scalar 'context'};
}
if ( not $context ) {
- croak q{ERROR: Invalid empty $context};
+ croak q{ERROR: Invalid empty 'context'};
}
if ( ref $pf_config ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $pf_config};
+ croak q{ERROR: Invalid non-hashref 'pf_config'};
}
if ( $context !~ m{ \A $ALLOWED_PARSING_CONTEXT \z }xms ) {
@@ -415,11 +415,11 @@
qq{ERROR: Invalid context $context for file $file: doesn't match $ALLOWED_PARSING_CONTEXT};
}
- # Automagically resolve $file with Get_source()
- # NOTE: $hostname will default to localhost in Init_SUBST(), so there's no
+ # Automagically resolve $file with get_source()
+ # NOTE: $hostname will default to localhost in init_subst(), so there's no
# need to err if it is not defined here
my $hostname = $hash_subst->{'HOSTNAME'};
- my $real_file = Get_source( $file, $hostname, $hash_subst, $pf_config );
+ my $real_file = get_source( $file, $hostname, $hash_subst, $pf_config );
# This will properly croak() on error
my $parsed = parse_ini($real_file);
@@ -431,7 +431,7 @@
my $model = $parsed->{'hostgroup'}->{'model'};
if ($model) {
$parsed->{'hostgroup'}->{'__model'}
- = Load_conf( $model, $hash_subst, 'model', $pf_config );
+ = load_conf( $model, $hash_subst, 'model', $pf_config );
}
}
else {
@@ -441,21 +441,21 @@
next if $section =~ m{ \A __ }xms;
my $section_type = $parsed->{$section}->{$action_or_type};
- unless ($section_type) {
+ if ( !$section_type ) {
croak
qq{ERROR: Key '$action_or_type' must be defined in file '$file' section [$section]};
}
if ( $section_type eq 'include' ) {
$parsed->{$section}->{'__content'}
- = Load_conf( $section, $hash_subst, $context,
+ = load_conf( $section, $hash_subst, $context,
$pf_config );
}
}
}
# Merging if needed
- $parsed = __Merge_conf_includes( $parsed, $hash_subst, $context );
+ $parsed = __merge_conf_includes( $parsed, $hash_subst, $context );
# This will croak on check failures
__check_sections( $parsed, $context, $action_or_type, $file );
@@ -463,34 +463,34 @@
return $parsed;
}
-=head2 Init_GLOBAL_NETCONFIG( $start_file, $hash_subst, $pf_config )
+=head2 init_global_netconfig( $start_file, $hash_subst, $pf_config )
Loads $start_file and returns the corresponding structure.
=cut
-sub Init_GLOBAL_NETCONFIG {
+sub init_global_netconfig {
my ( $start_file, $hash_subst, $pf_config ) = @_;
if ( ref $start_file ) {
- croak q{ERROR: Invalid non-scalar $start_file};
+ croak q{ERROR: Invalid non-scalar 'start_file'};
}
if ( not $start_file ) {
- croak q{ERROR: Invalid empty $start_file};
+ croak q{ERROR: Invalid empty 'start_file'};
}
if ( ref $hash_subst ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $hash_subst};
+ croak q{ERROR: Invalid non-hashref 'hash_subst'};
}
$pf_config ||= $PF_CONFIG; # default
if ( ref $pf_config ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $pf_config};
+ croak q{ERROR: Invalid non-hashref 'pf_config'};
}
my $GLOBAL = { 'SITE' => { 'BY_NAME' => {}, } };
foreach my $ip_type ( 'ipv4', 'ipv6' ) {
- next unless $pf_config->{'features'}->{$ip_type};
+ next if !$pf_config->{'features'}->{$ip_type};
my $zone_key = $ip_type eq 'ipv6' ? 'ZONE6' : 'ZONE';
my $dhcp_key = $ip_type eq 'ipv6' ? 'DHCP6' : 'DHCP';
@@ -502,7 +502,7 @@
}
my $net_parsed
- = Load_conf( $start_file, $hash_subst, 'network', $pf_config );
+ = load_conf( $start_file, $hash_subst, 'network', $pf_config );
my @sortnetkeys = sort { __sort_net_section( $net_parsed, $a, $b ) }
@{ $net_parsed->{'__sections_order'} };
@@ -517,7 +517,7 @@
foreach my $section (@sortnetkeys) {
my $section_type = $net_parsed->{$section}->{'type'};
- unless ( exists $add_function_for{$section_type} ) {
+ if ( !exists $add_function_for{$section_type} ) {
croak qq{ERROR: Unknown section type $section_type};
}
@@ -549,16 +549,16 @@
my ( $global_config, $pf_config, $flush_file ) = @_;
if ( ref $global_config ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $global_config};
+ croak q{ERROR: Invalid non-hashref 'global_config'};
}
if ( ref $pf_config ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $pf_config};
+ croak q{ERROR: Invalid non-hashref 'pf_config'};
}
$flush_file ||= $pf_config->{'path'}->{'global_struct'};
if ( ref $flush_file ) {
- croak q{ERROR: Invalid non-scalar $flush_file};
+ croak q{ERROR: Invalid non-scalar 'flush_file'};
}
my $ret = eval { store( $global_config, $flush_file ); };
@@ -582,10 +582,10 @@
my ($path_global_file) = @_;
if ( ref $path_global_file ) {
- croak q{ERROR: Invalid non-scalar $path_global_file};
+ croak q{ERROR: Invalid non-scalar 'path_global_file'};
}
if ( not $path_global_file ) {
- croak q{ERROR: Invalid empty $path_global_file};
+ croak q{ERROR: Invalid empty 'path_global_file'};
}
my $ret = eval { retrieve($path_global_file); };
@@ -600,44 +600,44 @@
return $ret;
}
-=head2 Get_config_for_hostname_on_site( $hostname, $site, $hash_subst, $global_config, $pf_config )
+=head2 get_config_for_hostname_on_site( $hostname, $site, $hash_subst, $global_config, $pf_config )
Returns the parsed configuration for $hostname on $site.
=cut
-sub Get_config_for_hostname_on_site {
+sub get_config_for_hostname_on_site {
my ( $hostname, $site, $hash_subst, $global_config, $pf_config ) = @_;
if ( ref $hostname ) {
- croak q{ERROR: Invalid non-scalar $hostname};
+ croak q{ERROR: Invalid non-scalar 'hostname'};
}
if ( not $hostname ) {
- croak q{ERROR: Invalid empty $hostname};
+ croak q{ERROR: Invalid empty 'hostname'};
}
if ( ref $site ) {
- croak q{ERROR: Invalid non-scalar $site};
+ croak q{ERROR: Invalid non-scalar 'site'};
}
if ( not $site ) {
- croak q{ERROR: Invalid empty $site};
+ croak q{ERROR: Invalid empty 'site'};
}
if ( ref $hash_subst ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $hash_subst};
+ croak q{ERROR: Invalid non-hashref 'hash_subst'};
}
if ( ref $global_config ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $global_config};
+ croak q{ERROR: Invalid non-hashref 'global_config'};
}
if ( ref $pf_config ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $pf_config};
+ croak q{ERROR: Invalid non-hashref 'pf_config'};
}
# Common configuration file e.g. update-common
my $global_host_conf
- = Load_conf( 'COMMON:/' . $pf_config->{'path'}->{'common_config'},
+ = load_conf( 'COMMON:/' . $pf_config->{'path'}->{'common_config'},
$hash_subst, 'config', $pf_config );
my $hosttype
= get_hosttype_from_hostname( $hostname, $global_config, $site );
@@ -649,11 +649,11 @@
my $hostname_file = __get_config_path( $hostname, $pf_config, $site );
foreach my $file ( $hosttype_file, $hostname_file ) {
- next unless $file;
+ next if !$file;
- my $config = Load_conf( $file, $hash_subst, 'config', $pf_config );
+ my $config = load_conf( $file, $hash_subst, 'config', $pf_config );
foreach my $section ( @{ $config->{'__sections_order'} } ) {
- unless ( $global_host_conf->{$section} ) {
+ if ( !$global_host_conf->{$section} ) {
push @{ $global_host_conf->{'__sections_order'} }, $section;
}
$global_host_conf->{$section} = $config->{$section};
@@ -683,12 +683,12 @@
sub __get_config_path {
my ( $host_value, $pf_config, $site ) = @_;
- return unless $host_value and $pf_config and $site;
+ return if !$host_value || !$pf_config || !$site;
if ( ref $host_value or ref $site ) {
- croak q{ERROR: Invalid non-scalar value for $host_value or $site};
+ croak q{ERROR: Invalid non-scalar value for 'host_value' or 'site'};
}
if ( ref $pf_config ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref value for $pf_config};
+ croak q{ERROR: Invalid non-hashref value for 'pf_config'};
}
my @sources = (
@@ -697,7 +697,7 @@
);
foreach my $source (@sources) {
- my $file = Get_source( $source, $host_value, {}, $pf_config );
+ my $file = get_source( $source, $host_value, {}, $pf_config );
return $file
if -e $file;
}
@@ -705,21 +705,21 @@
return;
}
-=head2 __Merge_host_config( $hash_to_merge, $hash_subst )
+=head2 __merge_host_config( $hash_to_merge, $hash_subst )
FIXME doc and tests
=cut
-sub __Merge_host_config {
+sub __merge_host_config {
my ( $hash_to_merge, $hash_subst ) = @_;
if ( ref $hash_to_merge ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $hash_to_merge};
+ croak q{ERROR: Invalid non-hashref 'hash_to_merge'};
}
if ( ref $hash_subst ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $hash_subst};
+ croak q{ERROR: Invalid non-hashref 'hash_subst'};
}
my $merge = {};
@@ -754,32 +754,32 @@
return $merge;
}
-=head2 __Merge_conf_includes( $hash_to_merge, $hash_subst, $context )
+=head2 __merge_conf_includes( $hash_to_merge, $hash_subst, $context )
FIXME doc and tests
=cut
-sub __Merge_conf_includes {
+sub __merge_conf_includes {
my ( $hash_to_merge, $hash_subst, $context ) = @_;
if ( ref $hash_to_merge ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $hash_to_merge};
+ croak q{ERROR: Invalid non-hashref 'hash_to_merge'};
}
if ( ref $hash_subst ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $hash_subst};
+ croak q{ERROR: Invalid non-hashref 'hash_subst'};
}
if ( ref $context ) {
- croak q{ERROR: Invalid non-scalar $context};
+ croak q{ERROR: Invalid non-scalar 'context'};
}
if ( not $context ) {
- croak q{ERROR: Invalid empty $context};
+ croak q{ERROR: Invalid empty 'context'};
}
if ( $context eq q{host} or $context eq q{model} ) {
- return __Merge_host_config( $hash_to_merge, $hash_subst );
+ return __merge_host_config( $hash_to_merge, $hash_subst );
}
my $global_parsed = {};
@@ -792,7 +792,7 @@
next;
}
my $tmp_merged
- = __Merge_conf_includes(
+ = __merge_conf_includes(
$hash_to_merge->{$section}->{'__content'},
$hash_subst, $context );
foreach my $tomerge_section ( @{ $tmp_merged->{'__sections_order'} } )
@@ -838,7 +838,7 @@
sub __sort_net_section {
my ( $net_parsed, $a, $b ) = @_;
- return -1 unless defined $a and defined $b; # => no warnings
+ return -1 if !defined $a || !defined $b; # => no warnings
my %net_prio_for = (
'zone' => 0,
@@ -857,9 +857,9 @@
=head2 __add_service($args)
-This function does the necessary magic (including calling L<add_host()>) for each
-host composing a service. I<$args> is a reference to a hash containing the
-following named parameters :
+This function does the necessary magic (including calling L<PFTools::Conf/add_host()>)
+for each host composing a service.
+I<$args> is a reference to a hash containing the following named parameters :
=over
@@ -904,9 +904,9 @@
my $service_part = $site_ref->{'SERVICE'}->{'BY_NAME'};
foreach my $host ( @{ $section_ref->{'@host'} } ) {
- my $hostfile = Get_source( $host, q{}, $hash_subst, $pf_config );
+ my $hostfile = get_source( $host, q{}, $hash_subst, $pf_config );
my $host_parsed
- = Load_conf( $hostfile, $hash_subst, q{host}, $pf_config );
+ = load_conf( $hostfile, $hash_subst, q{host}, $pf_config );
add_host(
{ start_file => $hostfile,
host_type => q{host},
@@ -940,14 +940,14 @@
my $section_type;
if ( $context eq 'host' or $context eq 'model' ) {
($section_type) = $section =~ m{ \A ([^:]+) (?: :: .+ )? \z }xms;
- unless ($section_type) {
+ if ( !$section_type ) {
croak
qq{ERROR: Unable to compute section type for section $section};
}
}
else {
$section_type = $parsed->{$section}->{$action_or_type};
- unless ($section_type) {
+ if ( !$section_type ) {
croak
qq{ERROR: Key '$action_or_type' must be defined in file '$file' section [$section]};
}
@@ -962,4 +962,3 @@
}
1; # Magic true value required at end of module
-
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Conf/Config.pm
--- a/lib/PFTools/Conf/Config.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Conf/Config.pm Fri Aug 08 18:02:12 2014 +0200
@@ -15,7 +15,7 @@
#
# 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,
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA 02110-1301, USA
#
@@ -44,13 +44,9 @@
my $CONFIG_STRUCT = {
'__sections_order' => [],
- 'ACTIONGROUP' => {
- '__actiongroups_order' => [
- 'NONE'
- ],
- 'NONE' => {
- 'priority' => 100,
- },
+ 'ACTIONGROUP' => {
+ '__actiongroups_order' => ['NONE'],
+ 'NONE' => { 'priority' => 100, },
},
'DEPENDS' => {},
};
@@ -64,18 +60,18 @@
# Functions
sub Init_CONFIG_STRUCT {
- my ( $param ) = @_;
-
+ my ($param) = @_;
+
my $struct = $CONFIG_STRUCT;
- $struct->{'__sections_order'} = $param->{'parsed'}->{'__sections_order'};
- $struct->{'__hash_subst'} = $param->{'hash_subst'};
+ $struct->{'__sections_order'} = $param->{'parsed'}->{'__sections_order'};
+ $struct->{'__hash_subst'} = $param->{'hash_subst'};
return $struct;
}
sub __Exists_deps {
my ( $dep, $parsed ) = @_;
-
- return if not ( $dep or $parsed );
+
+ return if not( $dep or $parsed );
print "checking if dep exists\n";
return $parsed->{$dep};
@@ -83,32 +79,27 @@
sub __Same_actiongroup {
my ( $section1, $section2, $parsed ) = @_;
-
- return if not ( $section1 or $section2 or $parsed );
+
+ return if not( $section1 or $section2 or $parsed );
my $actiongrp1 = $parsed->{$section1}->{'actiongroup'} || 'NONE';
my $actiongrp2 = $parsed->{$section2}->{'actiongroup'} || 'NONE';
- my $same = 0;
+ my $same = 0;
if ( $actiongrp1 eq $actiongrp2 ) {
$same++;
}
- if (
- (
- $parsed->{$section1}->{'action'} eq 'actiongroup'
+ if (( $parsed->{$section1}->{'action'} eq 'actiongroup'
and $actiongrp2 eq 'NONE'
)
- or
- (
- $parsed->{$section2}->{'action'} eq 'actiongroup'
- and $parsed->{$section1}->{'action'} eq 'actiongroup'
+ or ( $parsed->{$section2}->{'action'} eq 'actiongroup'
+ and $parsed->{$section1}->{'action'} eq 'actiongroup' )
+ or ( $parsed->{$section2}->{'action'} eq 'actiongroup'
+ and $actiongrp1 eq 'NONE' )
)
- or
- (
- $parsed->{$section2}->{'action'} eq 'actiongroup'
- and $actiongrp1 eq 'NONE'
- )
- ) { $same++; }
-
-# $same++ if ( $parsed->{$section}->{'actiongroup'})
+ {
+ $same++;
+ }
+
+ # $same++ if ( $parsed->{$section}->{'actiongroup'})
return $same;
}
@@ -121,71 +112,68 @@
}
sub Add_config {
- my ( $param ) = @_;
-
+ my ($param) = @_;
+
# Checking mandatory parameter
- foreach my $par ('config','sect_name','ref_sect', 'parsed') {
+ foreach my $par ( 'config', 'sect_name', 'ref_sect', 'parsed' ) {
return if not $param->{$par};
}
-
- my $glob_cnf = $param->{'config'};
- my $name = $param->{'sect_name'};
-
+
+ my $glob_cnf = $param->{'config'};
+ my $name = $param->{'sect_name'};
+
my $actiongrp = $param->{'ref_sect'}->{'actiongroup'} || 'NONE';
if ( not defined $glob_cnf->{'ACTIONGROUP'}->{$actiongrp} ) {
$glob_cnf->{'ACTIONGROUP'}->{$actiongrp} = {};
}
my $action_entry = $glob_cnf->{'ACTIONGROUP'}->{$actiongrp};
if ( $param->{'ref_sect'}->{'depends'} ) {
- foreach my $dep (
- split m{ \s }xms, $param->{'ref_sect'}->{'depends'}
- ) {
+ foreach
+ my $dep ( split m{ \s }xms, $param->{'ref_sect'}->{'depends'} )
+ {
croak qq{ERROR: Undefined $dep in section $name}
- if not __Exists_deps ($dep, $param->{'parsed'}) ;
+ if not __Exists_deps( $dep, $param->{'parsed'} );
croak qq{ERROR: $dep and $name not on actiongroup $actiongrp}
- if not __Same_actiongroup(
- $actiongrp, $dep, $param->{'parsed'}
- );
-
+ if not __Same_actiongroup( $actiongrp, $dep,
+ $param->{'parsed'} );
+
}
}
- if ($param->{'ref_sect'}->{'action'} eq 'actiongroup') {
- my $exist =
- grep
- { m{ \A $name }xms }
- @{$glob_cnf->{'ACTIONGROUP'}->{'__actiongroups_order'}};
+ if ( $param->{'ref_sect'}->{'action'} eq 'actiongroup' ) {
+ my $exist = grep {m{ \A $name }xms}
+ @{ $glob_cnf->{'ACTIONGROUP'}->{'__actiongroups_order'} };
if ( not $exist ) {
- push
- @{$glob_cnf->{'ACTIONGROUP'}->{'__actiongroups_order'}},
+ push @{ $glob_cnf->{'ACTIONGROUP'}->{'__actiongroups_order'} },
$name;
}
- $glob_cnf->{'ACTIONGROUP'}->{$name}->{'priority'} =
- $param->{'ref_sect'}->{'priority'} || $DEFAULT_AG_PRIO;
- $glob_cnf->{'ACTIONGROUP'}->{$name}->{'__config'} =
- $param->{'ref_sect'};
+ $glob_cnf->{'ACTIONGROUP'}->{$name}->{'priority'}
+ = $param->{'ref_sect'}->{'priority'} || $DEFAULT_AG_PRIO;
+ $glob_cnf->{'ACTIONGROUP'}->{$name}->{'__config'}
+ = $param->{'ref_sect'};
}
else {
- push @{$action_entry->{'__order'}}, $name;
+ push @{ $action_entry->{'__order'} }, $name;
$action_entry->{$name} = $param->{'ref_sect'};
$action_entry->{$name}->{'__subst'}->{'DESTINATION'} = $name;
}
-
+
return $glob_cnf;
}
-sub __Sort_depends_prio {
+# FIXME Duplicate code with lib/PFTools/Update.pm ... why?
+sub __sort_depends_prio {
my ( $action, $section ) = @_;
my $prio = 0;
# First : authentication parts
- return $prio if ( $section eq "/etc/passwd" );
+ return $prio if ( $section eq q{/etc/passwd} );
$prio++;
- return $prio if ( $section eq "/etc/group" );
+ return $prio if ( $section eq q{/etc/group} );
$prio++;
- return $prio if ( $section eq "/etc/shadow" );
+ return $prio if ( $section eq q{/etc/shadow} );
$prio++;
- return $prio if ( $section eq "/etc/gshadow" );
+ return $prio if ( $section eq q{/etc/gshadow} );
$prio++;
# Second : directory and mount points
@@ -195,13 +183,13 @@
$prio++;
# Third : Packaging infra and packages
- return $prio if ( $section =~ m{ \A /etc/apt/ }xms );
+ return $prio if ( $section =~ m{\A /etc/apt/ }xms );
$prio++;
- return $prio if ( $section eq "pf-tools" );
+ return $prio if ( $section eq q{pf-tools} );
$prio++;
- return $prio if ( $action eq "dpkg-purge" || $action eq "purgepkg" );
+ return $prio if ( $action eq q{dpkg-purge} || $action eq q{purgepkg} );
$prio++;
- return $prio if ( $action eq "apt-get" || $action eq "installpkg" );
+ return $prio if ( $action eq q{apt-get} || $action eq q{installpkg} );
$prio++;
# Fourth : creations and adds for files and links
@@ -213,20 +201,20 @@
$prio++;
# Fifth : removing files and dirs
- return $prio if ( $action =~ m{ \A remove }xms );
+ return $prio if ( $action =~ m{\A remove }xms );
$prio++;
# Last : other elements
return $prio;
}
-sub Sort_config_sections {
+sub sort_config_sections {
my ( $host_config, $a, $b ) = @_;
- my $prioa = $host_config->{$a}->{'priority'} ||
- __Sort_depends_prio( $host_config->{$a}->{'action'}, $a );
- my $priob = $host_config->{$a}->{'priority'} ||
- __Sort_depends_prio( $host_config->{$b}->{'action'}, $b );
+ my $prioa = $host_config->{$a}->{'priority'}
+ || __sort_depends_prio( $host_config->{$a}->{'action'}, $a );
+ my $priob = $host_config->{$a}->{'priority'}
+ || __sort_depends_prio( $host_config->{$b}->{'action'}, $b );
if ( $prioa != $priob ) {
return $prioa <=> $priob;
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Conf/Host.pm
--- a/lib/PFTools/Conf/Host.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Conf/Host.pm Fri Aug 08 18:02:12 2014 +0200
@@ -402,13 +402,13 @@
my ( $hostgroup_ref, $hostname_model ) = @_;
if ( !$hostgroup_ref || !$hostname_model ) {
- croak q{ERROR: $hostgroup_ref and $hostname_model are mandatory};
+ croak q{ERROR: 'hostgroup_ref' and 'hostname_model' are mandatory};
}
if ( ref $hostgroup_ref ne 'HASH' ) {
- croak q{ERROR: Invalid non-hash reference $hostgroup_ref};
+ croak q{ERROR: Invalid non-hash reference 'hostgroup_ref'};
}
if ( ref $hostname_model ) {
- croak q{ERROR: Invalid non-scalar $hostname_model};
+ croak q{ERROR: Invalid non-scalar 'hostname_model'};
}
my $last_num = $hostgroup_ref->{'number'} - 1;
@@ -1437,10 +1437,10 @@
croak q{ERROR: one or more parameter is not defined};
}
if ( ref $type or ref $hostclass ) {
- croak q{ERROR: $type and/or $hostclass MUST BE a string};
+ croak q{ERROR: 'type' and/or 'hostclass' MUST BE a string};
}
if ( ref $host_part_ref ne 'HASH' ) {
- croak q{ERROR: non-hashref $host_part_ref};
+ croak q{ERROR: non-hashref 'host_part_ref'};
}
my $dep_def = $DEF_SECTIONS->{'host'}->{'deployment'};
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Conf/Syntax.pm
--- a/lib/PFTools/Conf/Syntax.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Conf/Syntax.pm Fri Aug 08 18:02:12 2014 +0200
@@ -277,7 +277,7 @@
'after_change' => 'undefined',
},
'removefile' => {},
- 'removedir' => {},
+ 'removedir' => {},
'ignore' => {},
'mkdir' => {
'depends' => 'undefined',
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Disk.pm
--- a/lib/PFTools/Disk.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Disk.pm Fri Aug 08 18:02:12 2014 +0200
@@ -1,113 +1,85 @@
package PFTools::Disk;
-#
-# 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
-#
+=head1 NAME
+
+PFTools::Disk - PF-Tools Mountpoint configuration handling
+
+=head1 DESCRIPTION
+
+This module exports functions handling the reading and parsing of the
+fstab files.
+
+=head1 LICENSE AND COPYRIGHT
+
+ Copyright (C) 2007 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
+
+=cut
use strict;
use warnings;
use base qw( Exporter );
+use Carp;
use English qw( -no_match_vars ); # Avoids regex performance penalty
-use PFTools::Logger;
-
our @EXPORT = qw(
- Build_structure_from_fstab
- Build_fstab_from_structure
+ build_structure_from_fstab
+ build_fstab_from_structure
);
our @EXPORT_OK = qw();
-######################################
-### Constants
+=head1 SUBROUTINES/METHODS
-my @FSTAB_FIELDS_ORDER
- = ( 'source', 'dest', 'fstype', 'options', 'dump', 'pass' );
+This module defines the following functions:
-#
-# Global(s) var(s)
-#
+=cut
-### Command vars
-my $MDADM = '/sbin/mdadm';
-my $DRBDADM = '/sbin/drbdadm';
-my $MKFS = '/sbin/mkfs.';
-my $FSCK = '/sbin/fsck.';
-my $SFDISK = '/sbin/sfdisk';
-my $FDISK = '/sbin/fdisk';
-my $HALT = '/sbin/halt';
-my $ECHO = '/bin/echo';
+my @FSTAB_FIELDS_ORDER = qw( source dest fstype options dump pass );
-### Env vars
-our $DEBUG = 0;
-my $VERBOSE = 0;
-my $FOLLOW = '';
-my $SIZE = '';
+=head2 build_structure_from_fstab($fstab_file)
-if ($DEBUG) { $VERBOSE = 1; }
+Returns a hash representing the content of fstab
+It takes the following arguments:
-# Checking if all commands vars exists
-# foreach my $cmd ( $MDADM, $MKFS, $SFDISK, $FDISK, $HALT, $ECHO ) {
-# if ( ! -e $cmd ) {
-# warn "Command ".$cmd." doesn't exist\n" if ( $VERBOSE ) ;
-# exit 1 ;
-# }
-# }
+=over
-### /proc definitions for different files
-my $PROC_PART = '/proc/partitions';
-my $PROC_RAID = '/proc/mdstat';
-my $PROC_SCSI = '/proc/scsi/scsi';
-my $PROC_DRBD = '/proc/drbd';
+=item I<fstab_file> the fstab file we want to parse
-### Pattern(s) for misc checks
-# FIXME qr{} + hash
-my $DISK_DEV_PATTERN = '\/dev\/(h|s)d[a-z]([\d]+)?';
-my $RAID_DEV_PATTERN = '\/dev\/md([\d]+)';
-my $RAID_DEV = 'md0';
-my $RAID_DEV_STATUS = '(active sync|removed|faulty)';
-my $RAID_DEV_PART = '\/dev\/(h|s)d[a-z]4';
-my $RAID_PART_NUM = '4';
-my $RAID_PART_TYPE = 'fd';
-my $RAID_FS = 'ext3';
-my $DRBD_DEV_PATTERN = '\/dev\/drbd';
-my $DRBD_DEV = 'drbd0';
+=back
-### Misc files
-my $DUMP_PART_FILE = '/tmp/device_part.dmp'; # FIXME File::Temp ?
-my $TPL_SPARC_PART = '';
+=cut
-#
-# Misc functions
-#
-
-sub Build_structure_from_fstab {
+sub build_structure_from_fstab {
my ($fstab_file) = @_;
- return unless $fstab_file;
+ return if !$fstab_file;
# FIXME IO::File or File::Slurp or Perl6::Slurp
- if ( !open( FSTAB, $fstab_file ) ) {
- Warn( $CODE->{'OPEN'}, "Unable to open $fstab_file: $OS_ERROR" );
+ my $FSTAB;
+ if ( !open $FSTAB, q{<}, $fstab_file ) {
+ carp "Unable to open $fstab_file: $OS_ERROR";
return;
}
- my @current_fstab = <FSTAB>;
- close(FSTAB);
+ my @current_fstab = <$FSTAB>;
+ if ( !close $FSTAB ) {
+ carp "Unable to close $fstab_file: $OS_ERROR";
+ return;
+ }
print join @current_fstab;
@@ -115,16 +87,17 @@
foreach my $line (@current_fstab) {
# Skip comments
- next if $line =~ m/^#/;
+ next if $line =~ m/\A [#]/xms;
# Removing trailing spaces
- $line =~ s/^\s*//;
- $line =~ s/\s*$//;
+ $line =~ s/\A \s*//xms;
+ $line =~ s/\s* \z//xms;
# Skipping empty lines
- next if $line =~ m/^$/;
+ next if $line =~ m/\A\z/xms;
my ( $src_mnt, $mnt_pt, $type, $opt_mnt, $dump, $pass )
- = split /\s+/, $line;
+ = split /\s+/xms,
+ $line;
# Linux >= 2.6.39 (or around) adds a slash at the end of an NFS
# mount source in /proc/mounts, we need to remove it.
@@ -135,7 +108,7 @@
'source' => $src_mnt,
'dest' => $mnt_pt,
'fstype' => $type,
- 'options' => join( ',', sort split ',', $opt_mnt ),
+ 'options' => join( q{,}, sort split /,/xms, $opt_mnt ),
'dump' => $dump,
'pass' => $pass,
};
@@ -144,776 +117,39 @@
return $struct;
}
-sub Build_fstab_from_structure {
+=head2 build_fstab_from_structure($struct)
+
+Return an array containing lines of fstab file using the hash passed as argument
+It takes the following arguments:
+
+=over
+
+=item I<fstab_file> the fstab file we want to parse
+
+=back
+
+=cut
+
+sub build_fstab_from_structure {
my ($struct) = @_;
- return unless $struct;
+ return if !$struct;
my @fstab = ();
push @fstab, '###################################################';
- push @fstab, '# Fstab generated by Build_fstab_from_structure';
+ push @fstab, '# Fstab generated by build_fstab_from_structure';
push @fstab, "#\n";
foreach my $entry ( @{ $struct->{'__mnt_order'} } ) {
my @line;
foreach my $field (@FSTAB_FIELDS_ORDER) {
push @line, $struct->{$entry}->{$field};
}
- push @fstab, join( "\t", @line );
+ push @fstab, join "\t", @line;
}
- push @fstab, '';
+ push @fstab, q{};
return \@fstab;
}
-# FIXME: duplicate code?
-sub Exec_cmd {
- my ( $cmd, $msg ) = @_;
-
- return unless $cmd;
- $msg = "Problem when executing command $cmd:\n"
- unless $msg;
-
- if ($DEBUG) {
- print 'Exec :' . $cmd . "\n";
- return 1;
- }
-
- system($cmd);
- if ($CHILD_ERROR) {
- warn $msg if $VERBOSE;
- if ( $CHILD_ERROR == -1 ) {
- warn "failed to execute: $OS_ERROR\n"
- if $VERBOSE; # FIXME carp or Warn
- }
- elsif ( $CHILD_ERROR & 127 ) {
- warn "child died with signal %d, %s coredump\n"
- , # FIXME carp or Warn
- ( $CHILD_ERROR & 127 ),
- ( $CHILD_ERROR & 128 ) ? 'with' : 'without'
- if $VERBOSE;
- }
- else {
- warn "child exited with value %d\n", # FIXME carp or Warn
- $CHILD_ERROR >> 8
- if $VERBOSE;
- }
-
- return;
- }
-
- return 1;
-}
-
-#
-# System check and analysis ...
-#
-
-sub GetDiskDevice {
-
- my $part;
-
- # FIXME IO::File
- if ( !open( $part, $PROC_PART ) ) {
- warn "GetDiskDevice -- Unable to parse "
- . $PROC_PART
- . " for analysing disk structures\n"
- if $VERBOSE;
- return;
- }
-
- # Parsing /proc/partitions file
- my $result = {};
- while (<$part>) {
- next if /^$/;
- next unless /^\s*([\d]+)\s+([\d]+)\s+([\d]+)\s+([^\s]+)$/;
-
- my ( $major, $minor, $block_size, $name ) = ( $1, $2, $3, $4 );
- if ( $name =~ /^$DISK_DEV_PATTERN$/ ) {
- push @{ $result->{'disk'} }, $name;
- $result->{$name} = 0
- unless defined $result->{$name};
- }
- if ( $name =~ /^$DISK_DEV_PATTERN$/ ) {
- $result->{$name} += 1;
- }
- if ( $name =~ /^$RAID_DEV_PATTERN$/ ) {
- push @{ $result->{'raid'} }, $name;
- }
- if ( $name =~ /^$DRBD_DEV_PATTERN$/ ) {
- push @{ $result->{'drbd'} }, $name;
- }
- }
- close($part);
-
- return $result;
-}
-
-sub GetDiskGeometry {
- my ( $device, $arch ) = @_;
-
- return unless $device;
- $arch = 'i386' unless $arch; # default
-
- if ( $device !~ /^$DISK_DEV_PATTERN$/ ) {
- warn
- "GetDiskGeometry -- device name $device doesn't match $DISK_DEV_PATTERN\n" # FIXME carp or Warn
- if $VERBOSE;
- return;
- }
-
- # Local(s) var(s)
- my $geo = { name => $device };
- my ( $pad, $cyls, $heads, $sectors );
-
- if ( $arch eq 'i386' ) {
-
- # Retrieving geometry by sfdisk command
- my $cmd = $SFDISK . ' -f -g ' . $device;
- ( $pad, $cyls, $pad, $heads, $pad, $sectors )
- = split( /\s+/, `$cmd` ); # FIXME no `` ever!
- if ( $cyls == 0 || $heads == 0 || $sectors == 0 ) {
- warn
- "GetDiskGeometry -- Invalid values retriveved by sfdisk for device $device\n"
- if $VERBOSE;
- return;
- }
- $geo->{'cyls'} = $cyls;
- $geo->{'heads'} = $heads;
- $geo->{'sectors'} = $sectors;
-
- return $geo;
- }
-
- if ( $arch eq 'sparc' ) {
- my $cmd = $FDISK . ' -l /dev/' . $device;
-
- # Disk /dev/sda: 160.0 GB, 160041885696 bytes
- # 255 heads, 63 sectors/track, 19457 cylinders
- # Units = cylinders of 16065 * 512 = 8225280 bytes
- # Disk identifier: 0xf98d6e74
-
- if ( !open( FDL, $cmd ) ) {
- warn "GetDiskGeometry -- Unable to get geometry with command "
- . $cmd . "\n"
- if ($VERBOSE);
- return undef;
- }
- while (<FDL>) {
- if (/^([\d]+) heads, ([\d]+) sectors\/track, ([\d]+) cylinders$/)
- {
- $geo->{'cyls'} = $3;
- $geo->{'heads'} = $1;
- $geo->{'sectors'} = $2;
- }
- }
- close(FDL);
-
- return $geo;
- }
-
- warn
- "GetDiskGeometry -- Unsupported architecture $arch: unable to get geometry\n"
- if $VERBOSE;
- return;
-}
-
-sub GetAllGeometry {
- my ( $dev_list, $arch ) = @_;
-
- my $geo = {};
- foreach my $disk ( @{ $dev_list->{'disk'} } ) {
- $geo->{$disk} = GetDiskGeometry( $disk, $arch );
- if ( !defined( $geo->{$disk} ) ) {
- warn
- "GetAllGeometry -- Cannot retrieve geometry for all disks: see message below\n"
- if $VERBOSE;
- return;
- }
- }
- return $geo;
-}
-
-sub CheckDiskGeometry {
- my ( $device, $ref_wanted, $arch ) = @_;
-
- # Local(s) var(s)
- my $ref_geo_device = {};
- my ( $check_name, $wanted_name );
-
- $ref_geo_device
- = ref($device) eq 'HASH'
- ? $device
- : GetDiskGeometry( $device, $arch );
- if ( !defined($ref_geo_device) ) {
- warn "CheckDiskGeometry -- Unable to retrive geometry for device "
- . $device . "\n"
- if $VERBOSE;
- return;
- }
-
- $check_name = $ref_geo_device->{'name'};
- $wanted_name = $ref_wanted->{'name'};
- foreach my $char ( keys %{$ref_wanted} ) {
- if ( $ref_geo_device->{$char} != $ref_wanted->{$char} ) {
- warn "CheckDiskGeometry -- Device "
- . $check_name
- . " and reference device "
- . $wanted_name
- . " have not the same geometry\n"
- if $VERBOSE;
- return;
- }
- }
-
- return 1;
-}
-
-sub CheckAllGeometry {
- my ( $ref_wanted, $arch ) = @_;
-
- my $dev_list = GetDiskDevice();
- if ( !defined($dev_list) ) {
- warn "CheckAllGeometry -- Unable to get devices list on host\n"
- if $VERBOSE;
- return;
- }
-
- my $all_geo_dev = GetAllGeometry( $dev_list, $arch );
- if ( !defined($all_geo_dev) ) {
- warn
- "CheckAllGeometry -- Unable to retrieve one ore more geometry : see error bellow\n"
- if $VERBOSE;
- return;
- }
-
- foreach my $disk ( keys %{$all_geo_dev} ) {
- if ( !CheckDiskGeometry( $disk, $ref_wanted, $arch ) ) {
- warn
- "CheckAllGeometry -- One ore more disk(s) has not the same geometry see error bellow\n"
- if $VERBOSE;
- return;
- }
- }
-
- return 1;
-}
-
-sub CheckRaidArray {
- my ($raid_dev) = @_;
-
- my $part;
- if ( !open( $part, $MDADM . ' -D ' . $raid_dev ) ) {
- warn "Unable to analyse raid status for RAID array "
- . $raid_dev . "\n";
- return;
- }
-
- my $stat = { failed => 0 };
- while (<$part>) {
- if ( /^\s*Failed Devices : ([\d]+)$/ && $1 > 0 ) {
- $stat->{'failed'} = $1;
- }
- elsif ( $stat->{'failed'} ) {
- if (/^\s*([\d]+)\s([\d]+)\s*([\d]+)\s*([\d]+)\s*([$RAID_DEV_STATUS])\s*(\Q$RAID_DEV_PART\E)$/
- )
- {
- my ( $number, $major, $minor, $raid_num, $status, $device )
- = ( $1, $2, $3, $4, $5, $6 );
- if ( $status !~ /^fault|failed$/ ) {
- next;
- }
- else {
- $device =~ s/[\d]$//;
- push( @{ $stat->{'failed_dev'} }, $device );
- }
- }
- elsif (/^\s*UUID : ([^\s]+)$/) {
- $stat->{'uid'} = $1;
- }
- }
- }
- close($part);
-
- return $stat;
-}
-
-sub CheckArrayRecovery {
- my ($raid_dev) = @_;
-
- my ( $active, $check, $fail, $last_size ) = ( 0, 0, 0, 0 );
- my $build = 1;
- my $proc;
- while ( !$active ) {
- if ( !open( $proc, $PROC_RAID ) ) {
- warn "Unable to open proc file "
- . $PROC_RAID
- . " for checking Raid ARRAY status\n";
- return;
- }
-
-# [>....................] recovery = 0.1% (90880/56998528) finish=93.9min speed=10097K/sec
- while (<$proc>) {
- if (/^$raid_dev : .*$/) { $check = 1; }
- if (/^\s*(\[[^\]]+\])\s*recovery =\s*([\d]+.[\d+]%) \(([\d]+)\/[\d]+\).+$/
- && $check
- )
- {
- if ( !$last_size ) {
- $last_size = $3;
- }
- elsif ( $last_size == $3 ) {
- if ( $fail == 3 ) {
- warn "Failure during array RAID operation\n";
- return;
- }
- else {
- $fail += 1;
- }
- }
- else {
- $fail = 0;
- }
- print $1. ' ' . $2 . "\r";
- sleep 1;
- $build = 1;
- }
- if ( /^unused devices: .*$/ && $build ) {
- $build = 0;
- }
- else {
- $active = 1;
- }
- }
- }
-
- return 1;
-}
-
-sub CheckDrbdSyncer {
- my ($drbd_dev) = @_;
-
- unless ( $drbd_dev =~ /^$DRBD_DEV_PATTERN([\d])$/ ) {
- warn "Unsupported drbd device name $drbd_dev\n";
- return;
- }
- my $num_drbd = $1;
-
- my ( $proc, $build, $active, $check, $fail, $last_size );
- $active = $fail = $last_size = $check = 0;
- $build = 1;
- while ( !$active ) {
- if ( !open( $proc, $PROC_DRBD ) ) {
- warn "Unable to open file "
- . $PROC_DRBD
- . " for checking DRBD syncer status\n";
- return;
- }
-
- # 0: cs:SyncSource st:Primary/Secondary ld:Consistent
- # ns:38460 nr:0 dw:0 dr:38460 al:0 bm:10431 lo:0 pe:18 ua:0 ap:0
- # [>...................] sync'ed: 0.1% (166822/166859)M
- # finish: 4:56:34 speed: 9,596 (9,596) K/sec
- while (<$proc>) {
- if (/^\s([\d]): cs:([^\s]+) st:([^\/]+)\/([^\s]+) ld:([^\s]+)$/) {
- next if ( $1 != $num_drbd );
- if ( $2 eq 'SyncSource' ) {
- $check = 1;
- }
- elsif ( $2 eq 'Connected' ) {
- $active = 1;
- }
- }
- elsif (
- /^\s*(\[[^\]]+\]) sync'ed: ([\d]+\.[\d]+\%) \(([\d]+)\/[\d]+\)+$/
- && $check
- )
- {
- if ( !$last_size ) {
- $last_size = $3;
- }
- elsif ( $last_size == $3 ) {
- if ( $fail == 3 ) {
- warn "Failure during array RAID operation\n";
- return;
- }
- else {
- $fail += 1;
- }
- }
- else {
- $fail = 0;
- }
- print $1. ' ' . $2 . "\r";
- $check = 0;
- sleep 1;
- }
- }
- }
-
- return 1;
-}
-
-#
-# Managing scsi disk(s) (add, remove)
-#
-
-sub ManageScsiDevice {
- my ( $ref_device, $action ) = @_;
-
- unless ( $ref_device and $action ) {
-
- #FIXME confess "BUG: invalid arguments";
- return;
- }
-
- my $cmd;
-
- if ( ref($ref_device) ne 'ARRAY' ) {
- warn
- "ManageScsiDevice -- Wrong device definition for managing SCSI channel(s)\n"
- if $VERBOSE;
- return;
- }
- if ( $action eq 'add' ) {
- $cmd
- = $ECHO
- . ' "scsi add-single-device '
- . join( " ", @{$ref_device} ) . '" > '
- . $PROC_SCSI;
- }
- elsif ( $action eq 'mod' ) {
- $cmd
- = $ECHO
- . ' "scsi remove-single-device '
- . join( " ", @{$ref_device} ) . '" > '
- . $PROC_SCSI;
- }
- else {
- warn "ManageScsiDevice -- Wrong action parameter " . $action . "\n"
- if $VERBOSE;
- return;
- }
-
- return Exec_cmd(
- $cmd,
- "Problem when managing SCSI device with command "
- . $cmd
- . " and with the following error(s)\n"
- );
-}
-
-#
-# Managing partitions (dump, restore, ...)
-#
-
-sub AddRaidPartition {
- my ( $device, $arch ) = @_;
-
- return unless $device;
- $arch = 'i386' unless $arch;
-
- my $cmd;
-
- if ( $arch eq 'i386' ) {
- $cmd
- = $SFDISK . ' -f '
- . $device
- . ' << EOF '
- . $FOLLOW . ','
- . $SIZE . ','
- . $RAID_PART_TYPE . ' EOF';
- return Exec_cmd(
- $cmd,
- "Unable to add raid partition on device "
- . $device
- . " with command "
- . $cmd
- . " and with the following error(s)\n"
- );
- }
- elsif ( $arch eq 'sparc' ) {
- if ( !open( CMD, "| " . $FDISK . " " . $device ) ) {
- warn "Unable to add raid partition on device "
- . $device
- . " with fdisk command\n"
- if $VERBOSE;
- return;
- }
- print CMD "n\n4\n\n\nt\n4\n$RAID_PART_TYPE\nw\n";
- close(CMD);
-
-# $cmd = "echo \"n\\n4t\\n4\\n$RAID_PART_TYPE\\nw\\n\" | ".$FDISK." ".$device. ;
- }
- else {
- warn
- "Unsupported architecture $arch: unable to add raid partition on device $device\n"
- if $VERBOSE;
- return;
- }
-
- # FIXME: notreached?
- return Exec_cmd(
- $cmd,
- "Unable to add raid partition on device "
- . $device
- . " with command "
- . $cmd
- . " and with the following error(s)\n"
- );
-}
-
-# This function must be used with sparc architecture
-sub EraseAllpartitions {
- my ( $device, $arch ) = @_;
-
- return unless $device;
-
- my $disk_list = GetDiskDevice();
- if ( !defined($disk_list) ) {
- warn "Unable to retrieve partitions for device $device\n"
- if $VERBOSE;
- return;
- }
-
- my @actions = ();
- foreach my $part ( @{ $disk_list->{'disk'} } ) {
- next if $part !~ /^\Q$device\E[\d]+$/;
- $part =~ /^\Q$device\E([\d]+)$/;
- push @actions, "d\n$1\n";
- }
- push @actions, "w\n";
-
- if ( !open( ERASE, "|" . $FDISK . " " . $device ) ) {
- warn "Unable to erase partition table for device $device\n"
- if $VERBOSE;
- return;
- }
- foreach my $action (@actions) {
- print ERASE $action;
- }
- close(ERASE);
-
- return 1;
-}
-
-sub DumpAllPartitions {
- my ( $device, $arch ) = @_;
-
- return unless $device;
- $arch = 'i386' unless $arch;
-
- my $cmd;
- if ( $arch eq 'i386' ) {
- $cmd = $SFDISK . ' -d ' . $device . ' > ' . $DUMP_PART_FILE;
- return Exec_cmd(
- $cmd,
- "Unable to dump partiotion table from device "
- . $device
- . " with command "
- . $cmd
- . " and with the following error(s)\n"
- );
- }
- elsif ( $arch eq 'sparc' ) {
- my @actions = ();
-
- # Dumping partition via command $cmd
- $cmd = $FDISK . ' -l ' . $device;
-
-# Device Boot Start End Blocks Id System
-# /dev/sda1 1 893 7168000 1c Hidden W95 FAT32 (LBA)
-# Partition 1 does not end on cylinder boundary.
-# /dev/sda2 * 894 4717 30716280 7 HPFS/NTFS
-# /dev/sda3 4718 7149 19535040 83 Linux
-# /dev/sda4 7150 19457 98864010 5 Extended
-# /dev/sda5 7150 7392 1951866 82 Linux swap / Solaris
-# /dev/sda6 7393 19457 96912081 83 Linux
- if ( !open( DUMP, $cmd . "|" ) ) {
- warn "Unable to dump partitions table for device $device\n"
- if $VERBOSE;
- return;
- }
- push @actions, "n\n3\n\nt\n3\n5\n";
- while (<DUMP>) {
- my ( $part, $bootable, $first, $last, $type, $type_name );
- next if /\Q$device\E\3.*Whole disk.*$/;
-
- # Fetching partition description line(s)
- if (/^$device([\d]+)\s*(\*)?\s*([\d]+)\s*([\d+])\s*[\d]+([^\s]+)\s*(.)*$/
- )
- {
- ( $part, $bootable, $first, $last, $type, $type_name )
- = ( $1, $2, $3, $4, $5, $6 );
- }
-
-# Create the actions to do with fdisk command for creating partition which is parsed on this line
- push @actions, "n\n$part\n$first\n$last\nt\n$part\n$type\n";
- }
- close(DUMP);
-
- # Command for writing changes to disk and exit
- push @actions, "w\n";
-
- # Initialize dumpfile with sparc template ;
- if ( !open( TPL, $TPL_SPARC_PART ) ) {
- warn "Unable to initialize dump file for sparc device $device\n"
- if $VERBOSE;
- return;
- }
- @actions = <TPL>;
- close(TPL);
-
- # Adding partitions retrieved by command $cmd
- if ( !open( DUMP, ">" . $DUMP_PART_FILE ) ) {
- warn
- "Unable to write dump partition for device $device on file $DUMP_PART_FILE\n"
- if $VERBOSE;
- return;
- }
- foreach my $action (@actions) {
- print DUMP $action;
- }
- close(DUMP);
- }
- else {
- warn
- "Unsupported architecture $arch: unable to dump partition table for device $device\n"
- if $VERBOSE;
- return;
- }
-
- return 1;
-}
-
-sub RestoreAllPartitions {
- my ( $device, $dumpfile, $arch ) = @_;
-
- return unless $device;
- $dumpfile = $DUMP_PART_FILE unless $dumpfile;
- $arch = 'i386' unless $arch;
-
- # Local(s) var(s)
- my $cmd;
-
- if ( !-e $dumpfile ) {
- warn "Dump file for partition table $dumpfile doesn't exist\n"
- if $VERBOSE;
- return;
- }
- elsif ( -z $dumpfile ) {
- warn "Dump file for partition table $dumpfile is empty\n"
- if $VERBOSE;
- return;
- }
-
- if ( $arch eq 'i386' ) {
- $cmd = $SFDISK . ' ' . $device . ' < ' . $dumpfile;
- }
- elsif ( $arch eq 'sparc' ) {
- if ( !Erase_disk_partition($device) ) {
- warn
- "Unable to erase partition table before restoring from dump file $dumpfile\n"
- if $VERBOSE;
- return;
- }
- $cmd = $FDISK . ' ' . $device . ' < ' . $dumpfile;
- }
- else {
- warn
- "Unsupported architecture $arch: unable to restore partition table for device $device\n"
- if $VERBOSE;
- return;
- }
- return Exec_cmd(
- $cmd,
- "Unable to restore partition table for "
- . $device
- . " with command "
- . $cmd
- . " and with the following error(s)\n"
- );
-}
-
-#
-# Managing RAID array(s) (create, add a disk ...)
-#
-
-sub MakeRaidArray {
- my ( $raid_dev, $raid_level, $dev_list ) = @_;
-
- return unless $raid_dev and $raid_level;
-
- my $cmd
- = $MDADM . ' -C '
- . $raid_dev . ' -l '
- . $raid_level . ' -n '
- . scalar( @{$dev_list} ) . ' '
- . join( ' ', @{$dev_list} );
-
- return
- unless Exec_cmd(
- $cmd,
- "Unable to create RAID array level $raid_level with command $cmd and with the following error(s)\n"
- );
-
- return CheckArrayRecovery($raid_dev);
-}
-
-sub AddDeviceOnArray {
- my ( $raid_dev, $device ) = @_;
-
- return unless $raid_dev and $device;
-
- my $cmd = "$MDADM $raid_dev -a $device";
- return unless Exec_cmd(
- $cmd,
- "Problem when adding device $device on ARRAY $raid_dev with command $cmd and with the following error(s)\n"
- );
-
- return CheckArrayRecovery($raid_dev);
-}
-
-sub DelDeviceOnArray {
- my ( $raid_dev, $device ) = @_;
-
- return unless $raid_dev and $device;
-
- my $cmd = "$MDADM $raid_dev -r $device";
- return Exec_cmd(
- $cmd,
- "Problem when deleting device $device on ARRAY $raid_dev with command $cmd and with the following error(s)\n"
- );
-}
-
-#
-# Managing DRBD cluster(s)
-#
-
-#
-# Managing filesystems ( formatting, checking ...)
-#
-
-sub ManageFilesystem {
- my ( $device, $fs_type, $action ) = @_;
-
- return unless $device and $fs_type and $action;
-
- my $cmd;
- if ( $action eq 'make' ) {
- $cmd = $MKFS . $fs_type . ' ' . $device;
- }
- elsif ( $action eq 'check' ) {
- $cmd = $FSCK . $fs_type . ' -y ' . $device;
- }
- else {
- warn "ManageFilesystem -- Unknown action " . $action
- . " : allowed actions are make and check\n";
- return;
- }
- return Exec_cmd( $cmd,
- "Unable to manage filesystem with command $cmd and with the following error(s)\n"
- );
-}
-
1;
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Net.pm
--- a/lib/PFTools/Net.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Net.pm Fri Aug 08 18:02:12 2014 +0200
@@ -1,25 +1,33 @@
package PFTools::Net;
-#
-# 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
-#
+=head1 NAME
+
+PFTools::Net - Net module for PFTools
+
+=head1 LICENSE AND COPYRIGHT
+
+ 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
+
+=head1 SUBROUTINES/METHODS
+
+=cut
use strict;
use warnings;
@@ -39,10 +47,19 @@
our @EXPORT_OK = qw();
-=head2 get_subnet_from_vlan ( $type, $net_hash )
+=head2 get_subnet_from_vlan($type,$net_hash)
This function builds a NetAddr::IP object, in the same time permits the
control of IP values defined for a given network definition.
+It takes the following arguments:
+
+=over
+
+=item I<type> FIXME
+
+=item I<net_hash> FIXME
+
+=back
=cut
@@ -50,13 +67,13 @@
my ( $type, $net_hash ) = @_;
if ( ref $type ) {
- croak q{ERROR: $type parameter MUST BE a string};
+ croak q{ERROR: 'type' parameter MUST BE a string};
}
if ( ref $net_hash ne 'HASH' ) {
- croak q{ERROR: non-ref $net-hash paramter};
+ croak q{ERROR: non-ref 'net-hash' parameter};
}
- my $suffix = get_suffix_from_ip_type( $type );
+ my $suffix = get_suffix_from_ip_type($type);
my $net_def = $net_hash->{"network$suffix"};
my $subnet_ref;
@@ -65,38 +82,51 @@
}
else {
my $netmask = $net_hash->{'netmask'};
- unless ($netmask) {
+ if ( !$netmask ) {
croak q{ERROR: Unable to retrieve netmask};
}
$subnet_ref = NetAddr::IP->new( $net_def, $netmask );
}
- unless ($subnet_ref) {
+ if ( !$subnet_ref ) {
croak qq{ERROR: Invalid subnet definition $net_def};
}
return $subnet_ref;
}
+=head2 resolve_hostname_from_dns($hostname)
+
+FIXME
+
+=over
+
+=item I<type> FIXME
+
+=item I<net_hash> FIXME
+
+=back
+
+=cut
+
sub resolve_hostname_from_dns {
my ($hostname) = @_;
my $res = Net::DNS::Resolver->new();
my $query = $res->search($hostname);
- unless ($query) {
+ if ( !$query ) {
croak qq{ERROR: Query failed: $res->errorstring};
}
my @resolved = ();
foreach my $rr ( $query->answer ) {
- next unless $rr->type eq q{A};
+ next if $rr->type ne q{A};
push @resolved, $rr->address;
}
return \@resolved;
}
-
1; # Magic true value required at end of module
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Packages.pm
--- a/lib/PFTools/Packages.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Packages.pm Fri Aug 08 18:02:12 2014 +0200
@@ -27,25 +27,25 @@
use Module::Runtime qw( use_module );
our @EXPORT = qw(
- Cmp_pkg_version
- Get_pkg_depends
- Get_pkg_policy
- Get_pkg_status
- Install_pkg
- Purge_pkg
- Update_pkg_repository
+ cmp_pkg_version
+ get_pkg_depends
+ get_pkg_policy
+ get_pkg_status
+ install_pkg
+ purge_pkg
+ update_pkg_repository
);
our @EXPORT_OK = qw();
my $VERBOSE = 0;
-sub Init_pkgtype_module {
+sub init_pkgtype_module {
my ( $pkg_type, $pf_config ) = @_;
return if not $pkg_type;
- my $module_name = "PFTools::Packages::" . uc($pkg_type);
+ my $module_name = q{PFTools::Packages::} . uc $pkg_type;
my $module;
eval { $module = use_module($module_name); };
if ($EVAL_ERROR) {
@@ -55,89 +55,89 @@
return 1;
}
-sub Get_pkg_status {
+sub get_pkg_status {
my ( $pkg_type, $pkg_name ) = @_;
return if not( $pkg_type or $pkg_name );
my $result = {};
- if ( not Init_pkgtype_module($pkg_type) ) {
+ if ( not init_pkgtype_module($pkg_type) ) {
carp qq{ERROR: Unable to init package engine $pkg_type};
return;
}
- return Pkg_status($pkg_name);
+ return pkg_status($pkg_name);
}
-sub Update_pkg_repository {
+sub update_pkg_repository {
my ($pkg_type) = @_;
return if not $pkg_type;
- if ( not Init_pkgtype_module($pkg_type) ) {
+ if ( not init_pkgtype_module($pkg_type) ) {
carp qq{ERROR: Unable to init package engine $pkg_type};
return;
}
- return Pkg_update_repository();
+ return pkg_update_repository();
}
-sub Purge_pkg {
+sub purge_pkg {
my ( $pkg_type, $pkg_name ) = @_;
return if not( $pkg_type or $pkg_name );
- if ( not Init_pkgtype_module($pkg_type) ) {
+ if ( not init_pkgtype_module($pkg_type) ) {
carp qq{ERROR: Unable to init package engine $pkg_type};
return;
}
- return Pkg_purge($pkg_name);
+ return pkg_purge($pkg_name);
}
-sub Get_pkg_depends {
+sub get_pkg_depends {
my ( $pkg_type, $pkg_name ) = @_;
return if not( $pkg_type or $pkg_name );
- if ( not Init_pkgtype_module($pkg_type) ) {
+ if ( not init_pkgtype_module($pkg_type) ) {
carp qq{ERROR: Unable to init package engine $pkg_type};
return;
}
- return Pkg_depends($pkg_name);
+ return pkg_depends($pkg_name);
}
-sub Get_pkg_policy {
+sub get_pkg_policy {
my ( $pkg_type, $pkg_name, $version ) = @_;
return if not( $pkg_type or $pkg_name );
- if ( not Init_pkgtype_module($pkg_type) ) {
+ if ( not init_pkgtype_module($pkg_type) ) {
carp qq{ERROR: Unable to init package engine $pkg_type};
return;
}
- return Pkg_policy( $pkg_name, $version );
+ return pkg_policy( $pkg_name, $version );
}
-sub Cmp_pkg_version {
+sub cmp_pkg_version {
my ( $pkg_type, $pkg_name, $version1, $version2 ) = @_;
return if not( $pkg_type or $pkg_name or $version1 or $version2 );
- if ( not Init_pkgtype_module($pkg_type) ) {
+ if ( not init_pkgtype_module($pkg_type) ) {
carp qq{ERROR: Unable to init package engine $pkg_type};
return;
}
- return Pkg_compare_versions( $pkg_name, $version1, $version2 );
+ return pkg_compare_versions( $pkg_name, $version1, $version2 );
}
-sub Install_pkg {
+sub install_pkg {
my ( $pkg_type, $pkg_name, $version ) = @_;
return if not( $pkg_type or $pkg_name );
- if ( !Init_pkgtype_module($pkg_type) ) {
+ if ( !init_pkgtype_module($pkg_type) ) {
carp qq{ERROR: Unable to init package engine $pkg_type};
return;
}
- return Pkg_install( $pkg_name, $version );
+ return pkg_install( $pkg_name, $version );
}
1;
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Packages/DEB.pm
--- a/lib/PFTools/Packages/DEB.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Packages/DEB.pm Fri Aug 08 18:02:12 2014 +0200
@@ -30,13 +30,13 @@
use PFTools::Logger;
our @EXPORT = qw(
- Pkg_status
- Pkg_update_repository
- Pkg_compare_versions
- Pkg_depends
- Pkg_policy
- Pkg_install
- Pkg_purge
+ pkg_status
+ pkg_update_repository
+ pkg_compare_versions
+ pkg_depends
+ pkg_policy
+ pkg_install
+ pkg_purge
);
our @EXPORT_OK = qw();
@@ -53,7 +53,7 @@
my $VERBOSE = 1;
-sub Pkg_status {
+sub pkg_status {
my ($pkg_name) = @_;
return if !$pkg_name;
@@ -99,7 +99,7 @@
return $result;
}
-sub Pkg_update_repository {
+sub pkg_update_repository {
if ( deferredlogsystem( $PKG_CMD->{'update'} ) ) {
carp q{ERROR: while updating repository !} if ($VERBOSE);
@@ -108,7 +108,7 @@
return 1;
}
-sub Pkg_purge {
+sub pkg_purge {
my ($pkg_name) = @_;
return if !$pkg_name;
@@ -121,7 +121,7 @@
return 1;
}
-sub Pkg_depends {
+sub pkg_depends {
my ($pkg_name) = @_;
return if !$pkg_name;
@@ -167,7 +167,7 @@
return $dep_list;
}
-sub Pkg_policy {
+sub pkg_policy {
my ( $pkg_name, $version ) = @_;
return if !$pkg_name;
@@ -204,7 +204,7 @@
return ( $installed, $available, $specified_version );
}
-sub Pkg_compare_versions {
+sub pkg_compare_versions {
my ( $pkg_name, $version1, $version2 ) = @_;
return if !$pkg_name && !$version1 && !$version2;
@@ -229,7 +229,7 @@
}
}
-sub Pkg_install {
+sub pkg_install {
my ( $pkg_name, $version ) = @_;
return if !$pkg_name;
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Parser.pm
--- a/lib/PFTools/Parser.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Parser.pm Fri Aug 08 18:02:12 2014 +0200
@@ -35,7 +35,7 @@
sub parse_ini {
my ($file) = @_;
- return unless $file;
+ return if !$file;
# Config::IniFiles never croaks (it only carps), so eval is useless :/
my $parse = Config::IniFiles->new(
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Raid.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/PFTools/Raid.pm Fri Aug 08 18:02:12 2014 +0200
@@ -0,0 +1,837 @@
+package PFTools::Raid;
+
+#
+# Copyright (C) 2007 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
+#
+
+# XXX This package is not currently used, but it might be in the future.
+
+use strict;
+use warnings;
+
+use base qw( Exporter );
+use Carp;
+use English qw( -no_match_vars ); # Avoids regex performance penalty
+
+our @EXPORT = qw(
+);
+
+our @EXPORT_OK = qw();
+
+######################################
+### Constants
+
+#
+# Global(s) var(s)
+#
+
+### Command vars
+my $MDADM = q{/sbin/mdadm};
+my $DRBDADM = q{/sbin/drbdadm};
+my $MKFS = q{/sbin/mkfs.};
+my $FSCK = q{/sbin/fsck.};
+my $SFDISK = q{/sbin/sfdisk};
+my $FDISK = q{/sbin/fdisk};
+my $HALT = q{/sbin/halt};
+my $ECHO = q{/bin/echo};
+
+### Env vars
+our $DEBUG = 0;
+my $VERBOSE = 0;
+my $FOLLOW = q{};
+my $SIZE = q{};
+
+if ($DEBUG) { $VERBOSE = 1; }
+
+# Checking if all commands vars exists
+# foreach my $cmd ( $MDADM, $MKFS, $SFDISK, $FDISK, $HALT, $ECHO ) {
+# if ( ! -e $cmd ) {
+# carp "Command ".$cmd." doesn't exist\n" if ( $VERBOSE ) ;
+# exit 1 ;
+# }
+# }
+
+### /proc definitions for different files
+my $PROC_PART = '/proc/partitions';
+my $PROC_RAID = '/proc/mdstat';
+my $PROC_SCSI = '/proc/scsi/scsi';
+my $PROC_DRBD = '/proc/drbd';
+
+### Pattern(s) for misc checks
+# FIXME qr{} + hash
+my $DISK_DEV_PATTERN = '\/dev\/(h|s)d[a-z]([\d]+)?';
+my $RAID_DEV_PATTERN = '\/dev\/md([\d]+)';
+my $RAID_DEV = 'md0';
+my $RAID_DEV_STATUS = '(active sync|removed|faulty)';
+my $RAID_DEV_PART = '\/dev\/(h|s)d[a-z]4';
+my $RAID_PART_NUM = '4';
+my $RAID_PART_TYPE = 'fd';
+my $RAID_FS = 'ext3';
+my $DRBD_DEV_PATTERN = '\/dev\/drbd';
+my $DRBD_DEV = 'drbd0';
+
+### Misc files
+my $DUMP_PART_FILE = q{/tmp/device_part.dmp}; # FIXME File::Temp ?
+my $TPL_SPARC_PART = q{};
+
+#
+# Misc functions
+#
+
+# FIXME: duplicate code?
+sub exec_cmd {
+ my ( $cmd, $msg ) = @_;
+
+ return unless $cmd;
+ $msg = "Problem when executing command $cmd:\n"
+ unless $msg;
+
+ if ($DEBUG) {
+ print 'Exec :' . $cmd . "\n";
+ return 1;
+ }
+
+ system $cmd;
+ if ($CHILD_ERROR) {
+ carp $msg if $VERBOSE;
+ if ( $CHILD_ERROR == -1 ) {
+ carp "failed to execute: $OS_ERROR\n"
+ if $VERBOSE;
+ }
+ elsif ( $CHILD_ERROR & 127 ) {
+ carp "child died with signal %d, %s coredump\n",
+ ( $CHILD_ERROR & 127 ),
+ ( $CHILD_ERROR & 128 ) ? 'with' : 'without'
+ if $VERBOSE;
+ }
+ else {
+ carp "child exited with value %d\n", $CHILD_ERROR >> 8
+ if $VERBOSE;
+ }
+
+ return;
+ }
+
+ return 1;
+}
+
+#
+# System check and analysis ...
+#
+
+sub get_disk_device {
+
+ my $part;
+
+ # FIXME IO::File
+ if ( !open $part, q{<}, $PROC_PART ) {
+ carp q{get_disk_device -- Unable to parse }
+ . $PROC_PART
+ . " for analysing disk structures\n"
+ if $VERBOSE;
+ return;
+ }
+
+ # Parsing /proc/partitions file
+ my $result = {};
+ while (<$part>) {
+ next if /\A\z/xms;
+ next unless /^\s*([\d]+)\s+([\d]+)\s+([\d]+)\s+(\S+)$/;
+
+ my ( $major, $minor, $block_size, $name ) = ( $1, $2, $3, $4 );
+ if ( $name =~ /^$DISK_DEV_PATTERN$/ ) {
+ push @{ $result->{'disk'} }, $name;
+ if ( !defined $result->{$name} ) {
+ $result->{$name} = 0;
+ }
+ }
+ if ( $name =~ /^$DISK_DEV_PATTERN$/ ) {
+ $result->{$name} += 1;
+ }
+ if ( $name =~ /^$RAID_DEV_PATTERN$/ ) {
+ push @{ $result->{'raid'} }, $name;
+ }
+ if ( $name =~ /^$DRBD_DEV_PATTERN$/ ) {
+ push @{ $result->{'drbd'} }, $name;
+ }
+ }
+ close $part;
+
+ return $result;
+}
+
+sub get_disk_geometry {
+ my ( $device, $arch ) = @_;
+
+ return if !$device;
+ if ( !$arch ) {
+ $arch = 'i386'; # default
+ }
+
+ if ( $device !~ /^$DISK_DEV_PATTERN$/ ) {
+ carp
+ "get_disk_geometry -- device name $device doesn't match $DISK_DEV_PATTERN\n"
+ if $VERBOSE;
+ return;
+ }
+
+ # Local(s) var(s)
+ my $geo = { name => $device };
+ my ( $pad, $cyls, $heads, $sectors );
+
+ if ( $arch eq 'i386' ) {
+
+ # Retrieving geometry by sfdisk command
+ my $cmd = $SFDISK . ' -f -g ' . $device;
+ ( $pad, $cyls, $pad, $heads, $pad, $sectors ) = split /\s+/,
+ `$cmd`; # FIXME no `` ever!
+ if ( $cyls == 0 || $heads == 0 || $sectors == 0 ) {
+ carp
+ "get_disk_geometry -- Invalid values retriveved by sfdisk for device $device\n"
+ if $VERBOSE;
+ return;
+ }
+ $geo->{'cyls'} = $cyls;
+ $geo->{'heads'} = $heads;
+ $geo->{'sectors'} = $sectors;
+
+ return $geo;
+ }
+
+ if ( $arch eq 'sparc' ) {
+ my $cmd = $FDISK . ' -l /dev/' . $device;
+
+ # Disk /dev/sda: 160.0 GB, 160041885696 bytes
+ # 255 heads, 63 sectors/track, 19457 cylinders
+ # Units = cylinders of 16065 * 512 = 8225280 bytes
+ # Disk identifier: 0xf98d6e74
+
+ my $FDL;
+ if ( !open $FDL, q{<}, $cmd ) {
+ carp 'get_disk_geometry -- Unable to get geometry with command '
+ . $cmd . "\n"
+ if ($VERBOSE);
+ return undef;
+ }
+ while (<$FDL>) {
+ if (/^([\d]+) heads, ([\d]+) sectors\/track, ([\d]+) cylinders$/)
+ {
+ $geo->{'cyls'} = $3;
+ $geo->{'heads'} = $1;
+ $geo->{'sectors'} = $2;
+ }
+ }
+ close $FDL;
+
+ return $geo;
+ }
+
+ carp
+ "get_disk_geometry -- Unsupported architecture $arch: unable to get geometry\n"
+ if $VERBOSE;
+ return;
+}
+
+sub get_all_geometry {
+ my ( $dev_list, $arch ) = @_;
+
+ my $geo = {};
+ foreach my $disk ( @{ $dev_list->{'disk'} } ) {
+ $geo->{$disk} = get_disk_geometry( $disk, $arch );
+ if ( !defined( $geo->{$disk} ) ) {
+ carp
+ "get_all_geometry -- Cannot retrieve geometry for all disks: see message below\n"
+ if $VERBOSE;
+ return;
+ }
+ }
+ return $geo;
+}
+
+sub check_disk_geometry {
+ my ( $device, $ref_wanted, $arch ) = @_;
+
+ # Local(s) var(s)
+ my $ref_geo_device = {};
+ my ( $check_name, $wanted_name );
+
+ $ref_geo_device
+ = ref($device) eq 'HASH'
+ ? $device
+ : get_disk_geometry( $device, $arch );
+ if ( !defined $ref_geo_device ) {
+ carp 'check_disk_geometry -- Unable to retrive geometry for device '
+ . $device . "\n"
+ if $VERBOSE;
+ return;
+ }
+
+ $check_name = $ref_geo_device->{'name'};
+ $wanted_name = $ref_wanted->{'name'};
+ foreach my $char ( keys %{$ref_wanted} ) {
+ if ( $ref_geo_device->{$char} != $ref_wanted->{$char} ) {
+ carp 'check_disk_geometry -- Device '
+ . $check_name
+ . ' and reference device '
+ . $wanted_name
+ . " have not the same geometry\n"
+ if $VERBOSE;
+ return;
+ }
+ }
+
+ return 1;
+}
+
+sub check_all_geometry {
+ my ( $ref_wanted, $arch ) = @_;
+
+ my $dev_list = get_disk_device();
+ if ( !defined $dev_list ) {
+ carp "check_all_geometry -- Unable to get devices list on host\n"
+ if $VERBOSE;
+ return;
+ }
+
+ my $all_geo_dev = get_all_geometry( $dev_list, $arch );
+ if ( !defined $all_geo_dev ) {
+ carp
+ "check_all_geometry -- Unable to retrieve one ore more geometry : see error bellow\n"
+ if $VERBOSE;
+ return;
+ }
+
+ foreach my $disk ( keys %{$all_geo_dev} ) {
+ if ( !check_disk_geometry( $disk, $ref_wanted, $arch ) ) {
+ carp
+ "check_all_geometry -- One ore more disk(s) has not the same geometry see error bellow\n"
+ if $VERBOSE;
+ return;
+ }
+ }
+
+ return 1;
+}
+
+sub check_raid_array {
+ my ($raid_dev) = @_;
+
+ my $part;
+ if ( !open $part, q{<}, $MDADM . ' -D ' . $raid_dev ) {
+ carp 'Unable to analyse raid status for RAID array '
+ . $raid_dev . "\n";
+ return;
+ }
+
+ my $stat = { failed => 0 };
+ while (<$part>) {
+ if ( /^\s*Failed Devices : ([\d]+)$/ && $1 > 0 ) {
+ $stat->{'failed'} = $1;
+ }
+ elsif ( $stat->{'failed'} ) {
+ if (/^\s*([\d]+)\s([\d]+)\s*([\d]+)\s*([\d]+)\s*([$RAID_DEV_STATUS])\s*(\Q$RAID_DEV_PART\E)$/
+ )
+ {
+ my ( $number, $major, $minor, $raid_num, $status, $device )
+ = ( $1, $2, $3, $4, $5, $6 );
+ if ( $status !~ /^fault|failed$/ ) {
+ next;
+ }
+ else {
+ $device =~ s/[\d]$//;
+ push @{ $stat->{'failed_dev'} }, $device;
+ }
+ }
+ elsif (/^\s*UUID : ([^\s]+)$/) {
+ $stat->{'uid'} = $1;
+ }
+ }
+ }
+ close $part;
+
+ return $stat;
+}
+
+sub check_array_recovery {
+ my ($raid_dev) = @_;
+
+ my ( $active, $check, $fail, $last_size ) = ( 0, 0, 0, 0 );
+ my $build = 1;
+ my $proc;
+ while ( !$active ) {
+ if ( !open $proc, q{<}, $PROC_RAID ) {
+ carp 'Unable to open proc file '
+ . $PROC_RAID
+ . " for checking Raid ARRAY status\n";
+ return;
+ }
+
+# [>....................] recovery = 0.1% (90880/56998528) finish=93.9min speed=10097K/sec
+ while (<$proc>) {
+ if (/^$raid_dev : .*$/) { $check = 1; }
+ if (/^\s*(\[[^\]]+\])\s*recovery =\s*([\d]+.[\d+]%) \(([\d]+)\/[\d]+\).+$/
+ && $check )
+ {
+ if ( !$last_size ) {
+ $last_size = $3;
+ }
+ elsif ( $last_size == $3 ) {
+ if ( $fail == 3 ) {
+ carp "Failure during array RAID operation\n";
+ return;
+ }
+ else {
+ $fail += 1;
+ }
+ }
+ else {
+ $fail = 0;
+ }
+ print $1. q{ } . $2 . "\r";
+ sleep 1;
+ $build = 1;
+ }
+ if ( /^unused devices: .*$/ && $build ) {
+ $build = 0;
+ }
+ else {
+ $active = 1;
+ }
+ }
+ }
+
+ return 1;
+}
+
+sub check_drbd_syncer {
+ my ($drbd_dev) = @_;
+
+ unless ( $drbd_dev =~ /^$DRBD_DEV_PATTERN([\d])$/ ) {
+ carp "Unsupported drbd device name $drbd_dev\n";
+ return;
+ }
+ my $num_drbd = $1;
+
+ my ( $proc, $build, $active, $check, $fail, $last_size );
+ $active = $fail = $last_size = $check = 0;
+ $build = 1;
+ while ( !$active ) {
+ if ( !open $proc, q{<}, $PROC_DRBD ) {
+ carp 'Unable to open file '
+ . $PROC_DRBD
+ . " for checking DRBD syncer status\n";
+ return;
+ }
+
+ # 0: cs:SyncSource st:Primary/Secondary ld:Consistent
+ # ns:38460 nr:0 dw:0 dr:38460 al:0 bm:10431 lo:0 pe:18 ua:0 ap:0
+ # [>...................] sync'ed: 0.1% (166822/166859)M
+ # finish: 4:56:34 speed: 9,596 (9,596) K/sec
+ while (<$proc>) {
+ if (/^\s([\d]): cs:([^\s]+) st:([^\/]+)\/([^\s]+) ld:([^\s]+)$/) {
+ next if ( $1 != $num_drbd );
+ if ( $2 eq 'SyncSource' ) {
+ $check = 1;
+ }
+ elsif ( $2 eq 'Connected' ) {
+ $active = 1;
+ }
+ }
+ elsif (
+ /^\s*(\[[^\]]+\]) sync'ed: ([\d]+\.[\d]+\%) \(([\d]+)\/[\d]+\)+$/
+ && $check )
+ {
+ if ( !$last_size ) {
+ $last_size = $3;
+ }
+ elsif ( $last_size == $3 ) {
+ if ( $fail == 3 ) {
+ carp "Failure during array RAID operation\n";
+ return;
+ }
+ else {
+ $fail += 1;
+ }
+ }
+ else {
+ $fail = 0;
+ }
+ print $1. q{ } . $2 . "\r";
+ $check = 0;
+ sleep 1;
+ }
+ }
+ }
+
+ return 1;
+}
+
+#
+# Managing scsi disk(s) (add, remove)
+#
+
+sub manage_scsi_device {
+ my ( $ref_device, $action ) = @_;
+
+ unless ( $ref_device and $action ) {
+
+ #FIXME confess "BUG: invalid arguments";
+ return;
+ }
+
+ my $cmd;
+
+ if ( ref($ref_device) ne 'ARRAY' ) {
+ carp
+ "manage_scsi_device -- Wrong device definition for managing SCSI channel(s)\n"
+ if $VERBOSE;
+ return;
+ }
+ if ( $action eq 'add' ) {
+ $cmd
+ = $ECHO
+ . ' "scsi add-single-device '
+ . join( q{ }, @{$ref_device} ) . '" > '
+ . $PROC_SCSI;
+ }
+ elsif ( $action eq 'mod' ) {
+ $cmd
+ = $ECHO
+ . ' "scsi remove-single-device '
+ . join( q{ }, @{$ref_device} ) . '" > '
+ . $PROC_SCSI;
+ }
+ else {
+ carp 'manage_scsi_device -- Wrong action parameter ' . $action . "\n"
+ if $VERBOSE;
+ return;
+ }
+
+ return exec_cmd( $cmd,
+ 'Problem when managing SCSI device with command '
+ . $cmd
+ . " and with the following error(s)\n" );
+}
+
+#
+# Managing partitions (dump, restore, ...)
+#
+
+sub add_raid_partition {
+ my ( $device, $arch ) = @_;
+
+ return unless $device;
+ $arch = 'i386' unless $arch;
+
+ my $cmd;
+
+ if ( $arch eq 'i386' ) {
+ $cmd
+ = $SFDISK . ' -f '
+ . $device
+ . ' << EOF '
+ . $FOLLOW . q{,}
+ . $SIZE . q{,}
+ . $RAID_PART_TYPE . ' EOF';
+ return exec_cmd( $cmd,
+ 'Unable to add raid partition on device '
+ . $device
+ . ' with command '
+ . $cmd
+ . " and with the following error(s)\n" );
+ }
+ elsif ( $arch eq 'sparc' ) {
+ my $CMD;
+ if ( !open $CMD, q{>}, '| ' . $FDISK . q{ } . $device ) {
+ carp 'Unable to add raid partition on device '
+ . $device
+ . " with fdisk command\n"
+ if $VERBOSE;
+ return;
+ }
+ print {$CMD} "n\n4\n\n\nt\n4\n$RAID_PART_TYPE\nw\n";
+ close $CMD;
+
+# $cmd = "echo \"n\\n4t\\n4\\n$RAID_PART_TYPE\\nw\\n\" | ".$FDISK." ".$device. ;
+ }
+ else {
+ carp
+ "Unsupported architecture $arch: unable to add raid partition on device $device\n"
+ if $VERBOSE;
+ return;
+ }
+
+ # FIXME: notreached?
+ return exec_cmd( $cmd,
+ 'Unable to add raid partition on device '
+ . $device
+ . ' with command '
+ . $cmd
+ . " and with the following error(s)\n" );
+}
+
+# This function must be used with sparc architecture
+sub erase_all_partitions {
+ my ( $device, $arch ) = @_;
+
+ return unless $device;
+
+ my $disk_list = get_disk_device();
+ if ( !defined $disk_list ) {
+ carp "Unable to retrieve partitions for device $device\n"
+ if $VERBOSE;
+ return;
+ }
+
+ my @actions = ();
+ foreach my $part ( @{ $disk_list->{'disk'} } ) {
+ next if $part !~ /^\Q$device\E[\d]+$/;
+ $part =~ /^\Q$device\E([\d]+)$/;
+ push @actions, "d\n$1\n";
+ }
+ push @actions, "w\n";
+
+ my $ERASE;
+ if ( !open $ERASE, q{>}, q{|} . $FDISK . q{ } . $device ) {
+ carp "Unable to erase partition table for device $device\n"
+ if $VERBOSE;
+ return;
+ }
+ foreach my $action (@actions) {
+ print {$ERASE} $action;
+ }
+ close $ERASE;
+
+ return 1;
+}
+
+sub dump_all_partitions {
+ my ( $device, $arch ) = @_;
+
+ return unless $device;
+ $arch = 'i386' unless $arch;
+
+ my $cmd;
+ if ( $arch eq 'i386' ) {
+ $cmd = $SFDISK . ' -d ' . $device . ' > ' . $DUMP_PART_FILE;
+ return exec_cmd( $cmd,
+ 'Unable to dump partition table from device '
+ . $device
+ . ' with command '
+ . $cmd
+ . " and with the following error(s)\n" );
+ }
+ elsif ( $arch eq 'sparc' ) {
+ my @actions = ();
+
+ # Dumping partition via command $cmd
+ $cmd = $FDISK . ' -l ' . $device;
+
+# Device Boot Start End Blocks Id System
+# /dev/sda1 1 893 7168000 1c Hidden W95 FAT32 (LBA)
+# Partition 1 does not end on cylinder boundary.
+# /dev/sda2 * 894 4717 30716280 7 HPFS/NTFS
+# /dev/sda3 4718 7149 19535040 83 Linux
+# /dev/sda4 7150 19457 98864010 5 Extended
+# /dev/sda5 7150 7392 1951866 82 Linux swap / Solaris
+# /dev/sda6 7393 19457 96912081 83 Linux
+ my $DUMP;
+ if ( !open $DUMP, q{<}, $cmd . q{|} ) {
+ carp "Unable to dump partitions table for device $device\n"
+ if $VERBOSE;
+ return;
+ }
+ push @actions, "n\n3\n\nt\n3\n5\n";
+ while (<$DUMP>) {
+ my ( $part, $bootable, $first, $last, $type, $type_name );
+ next if /\Q$device\E\3.*Whole disk.*$/;
+
+ # Fetching partition description line(s)
+ if (/^$device([\d]+)\s*(\*)?\s*([\d]+)\s*([\d+])\s*[\d]+([^\s]+)\s*(.)*$/
+ )
+ {
+ ( $part, $bootable, $first, $last, $type, $type_name )
+ = ( $1, $2, $3, $4, $5, $6 );
+ }
+
+# Create the actions to do with fdisk command for creating partition which is parsed on this line
+ push @actions, "n\n$part\n$first\n$last\nt\n$part\n$type\n";
+ }
+ close $DUMP;
+
+ # Command for writing changes to disk and exit
+ push @actions, "w\n";
+
+ # Initialize dumpfile with sparc template ;
+ my $TPL;
+ if ( !open $TPL, q{<}, $TPL_SPARC_PART ) {
+ carp "Unable to initialize dump file for sparc device $device\n"
+ if $VERBOSE;
+ return;
+ }
+ @actions = <$TPL>;
+ close $TPL;
+
+ # Adding partitions retrieved by command $cmd
+ if ( !open $DUMP, q{>}, $DUMP_PART_FILE ) {
+ carp
+ "Unable to write dump partition for device $device on file $DUMP_PART_FILE\n"
+ if $VERBOSE;
+ return;
+ }
+ foreach my $action (@actions) {
+ print {$DUMP} $action;
+ }
+ close $DUMP;
+ }
+ else {
+ carp
+ "Unsupported architecture $arch: unable to dump partition table for device $device\n"
+ if $VERBOSE;
+ return;
+ }
+
+ return 1;
+}
+
+sub restore_all_partitions {
+ my ( $device, $dumpfile, $arch ) = @_;
+
+ return unless $device;
+ $dumpfile = $DUMP_PART_FILE unless $dumpfile;
+ $arch = 'i386' unless $arch;
+
+ # Local(s) var(s)
+ my $cmd;
+
+ if ( !-e $dumpfile ) {
+ carp "Dump file for partition table $dumpfile doesn't exist\n"
+ if $VERBOSE;
+ return;
+ }
+ elsif ( -z $dumpfile ) {
+ carp "Dump file for partition table $dumpfile is empty\n"
+ if $VERBOSE;
+ return;
+ }
+
+ if ( $arch eq 'i386' ) {
+ $cmd = $SFDISK . q{ } . $device . ' < ' . $dumpfile;
+ }
+ elsif ( $arch eq 'sparc' ) {
+ if ( !Erase_disk_partition($device) ) {
+ carp
+ "Unable to erase partition table before restoring from dump file $dumpfile\n"
+ if $VERBOSE;
+ return;
+ }
+ $cmd = $FDISK . q{ } . $device . ' < ' . $dumpfile;
+ }
+ else {
+ carp
+ "Unsupported architecture $arch: unable to restore partition table for device $device\n"
+ if $VERBOSE;
+ return;
+ }
+ return exec_cmd( $cmd,
+ 'Unable to restore partition table for '
+ . $device
+ . ' with command '
+ . $cmd
+ . " and with the following error(s)\n" );
+}
+
+#
+# Managing RAID array(s) (create, add a disk ...)
+#
+
+sub make_raid_array {
+ my ( $raid_dev, $raid_level, $dev_list ) = @_;
+
+ return unless $raid_dev and $raid_level;
+
+ my $cmd
+ = $MDADM . ' -C '
+ . $raid_dev . ' -l '
+ . $raid_level . ' -n '
+ . scalar( @{$dev_list} ) . q{ }
+ . join q{ }, @{$dev_list};
+
+ return
+ unless exec_cmd( $cmd,
+ "Unable to create RAID array level $raid_level with command $cmd and with the following error(s)\n"
+ );
+
+ return check_array_recovery($raid_dev);
+}
+
+sub add_device_on_array {
+ my ( $raid_dev, $device ) = @_;
+
+ return unless $raid_dev and $device;
+
+ my $cmd = "$MDADM $raid_dev -a $device";
+ return
+ unless exec_cmd( $cmd,
+ "Problem when adding device $device on ARRAY $raid_dev with command $cmd and with the following error(s)\n"
+ );
+
+ return check_array_recovery($raid_dev);
+}
+
+sub del_device_on_array {
+ my ( $raid_dev, $device ) = @_;
+
+ return unless $raid_dev and $device;
+
+ my $cmd = "$MDADM $raid_dev -r $device";
+ return exec_cmd( $cmd,
+ "Problem when deleting device $device on ARRAY $raid_dev with command $cmd and with the following error(s)\n"
+ );
+}
+
+#
+# Managing DRBD cluster(s)
+#
+
+#
+# Managing filesystems ( formatting, checking ...)
+#
+
+sub manage_filesystem {
+ my ( $device, $fs_type, $action ) = @_;
+
+ return unless $device and $fs_type and $action;
+
+ my $cmd;
+ if ( $action eq 'make' ) {
+ $cmd = $MKFS . $fs_type . q{ } . $device;
+ }
+ elsif ( $action eq 'check' ) {
+ $cmd = $FSCK . $fs_type . ' -y ' . $device;
+ }
+ else {
+ carp 'manage_filesystem -- Unknown action ' . $action
+ . " : allowed actions are make and check\n";
+ return;
+ }
+ return exec_cmd( $cmd,
+ "Unable to manage filesystem with command $cmd and with the following error(s)\n"
+ );
+}
+
+1;
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Structqueries.pm
--- a/lib/PFTools/Structqueries.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Structqueries.pm Fri Aug 08 18:02:12 2014 +0200
@@ -244,18 +244,18 @@
my ( $hostname, $global_config, $site_name ) = @_;
if ( not $hostname ) {
- croak q{ERROR: Invalid empty $hostname};
+ croak q{ERROR: Invalid empty 'hostname'};
}
if ( ref $hostname ) {
- croak q{ERROR: Invalid non-scalar $hostname};
+ croak q{ERROR: Invalid non-scalar 'hostname'};
}
if ( ref $global_config ne 'HASH' ) {
- croak q{ERROR: Invalid non-hash reference global_config};
+ croak q{ERROR: Invalid non-hash reference 'global_config'};
}
if ( $site_name and ref $site_name ) {
- croak q{ERROR: Invalid non-scalar site_name};
+ croak q{ERROR: Invalid non-scalar 'site_name'};
}
my $site_list
@@ -415,14 +415,14 @@
my ( $hostname, $global_config ) = @_;
if ( not $hostname ) {
- croak q{ERROR: Invalid empty hostname};
+ croak q{ERROR: Invalid empty 'hostname'};
}
if ( ref $hostname ) {
- croak q{ERROR: Invalid non-scalar hostname};
+ croak q{ERROR: Invalid non-scalar 'hostname'};
}
if ( ref $global_config ne 'HASH' ) {
- croak q{ERROR: Invalid non-hash reference global_config};
+ croak q{ERROR: Invalid non-hash reference 'global_config'};
}
my @site_list = ();
@@ -508,7 +508,7 @@
my ( $vlan_name, $global_config, $site_name ) = @_;
if ( !$site_name ) {
- croak q{ERROR: $site MUST BE defined};
+ croak q{ERROR: 'site' MUST BE defined};
}
my $site_ref = get_site_config( $site_name, $global_config );
@@ -576,11 +576,11 @@
my ( $vlan_name, $global_config, $site_name ) = @_;
if ( not $vlan_name ) {
- croak q{ERROR: Invalid empty $vlan_name};
+ croak q{ERROR: Invalid empty 'vlan_name'};
}
if ( not $site_name ) {
- croak q{ERROR: Invalid empty $site};
+ croak q{ERROR: Invalid empty 'site'};
}
my $site_ref = get_site_config( $site_name, $global_config );
@@ -604,13 +604,12 @@
return $scope eq 'private';
}
-=head2 resolve_hostname_from_global_config($arguments_ref)
+=head2 resolve_hostname_from_global_config()
Resolves (translates to an IP address) I<$hostname>, using the global
configuration hash. Returns a reference to the list of IP addresses.
-I<$arguments_ref> is a reference to a hash structure containing the following
-keys:
+It takes the following named arguments:
=over
@@ -712,4 +711,3 @@
}
1; # Magic true value required at end of module
-
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Update.pm
--- a/lib/PFTools/Update.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Update.pm Fri Aug 08 18:02:12 2014 +0200
@@ -34,9 +34,9 @@
use PFTools::Packages;
our @EXPORT = qw(
- Get_depends_for_action
- Exec_action
- Sort_config_sections
+ get_depends_for_action
+ exec_action
+ sort_config_sections
);
our @EXPORT_OK = qw();
@@ -76,7 +76,7 @@
sub __init_action_engine {
my ($action) = @_;
- return unless $action;
+ return if !$action;
my $module_name = q{PFTools::Update::} . uc $action;
my $module;
@@ -90,22 +90,22 @@
return 1;
}
-sub Get_depends_for_action ($$$$) {
+sub get_depends_for_action {
my ( $action, $ref_section, $dest, $options ) = @_;
__init_action_engine($action);
# Checking parameter
if ( ref($ref_section) ne 'HASH' ) {
- carp q{ERROR: non-hashref $ref_section};
+ carp q{ERROR: non-hashref 'ref_section'};
return;
}
if ( ref($options) ne 'HASH' ) {
- carp q{ERROR: non-hashref $options};
+ carp q{ERROR: non-hashref 'options'};
return;
}
if ( ref($action) || ref($dest) ) {
- carp q{ERROR: $action and/or $dest MUST be string(s)};
+ carp q{ERROR: 'action' and/or 'dest' MUST be string(s)};
return;
}
@@ -113,7 +113,7 @@
return;
}
-sub Exec_action ($$$$$$) {
+sub exec_action {
my ( $action, $ref_section, $dest, $options, $hash_subst, $global_config )
= @_;
@@ -123,7 +123,7 @@
$hash_subst->{'SECTIONNAME'} = $dest;
if ( $action eq q{apt-get} || $action eq q{installpkg} ) {
if ($APT_UPDATE) {
- if ( !Update_pkg_repository( $options->{'pkg_type'} ) ) {
+ if ( !update_pkg_repository( $options->{'pkg_type'} ) ) {
carp q{An error occured during updating packages lists};
return;
}
@@ -134,7 +134,7 @@
$global_config );
}
-sub __Sort_depends_prio ($$) {
+sub __sort_depends_prio {
my ( $action, $section ) = @_;
my $prio = 0;
@@ -174,25 +174,25 @@
$prio++;
# Fifth : removing files and dirs
- return $prio if ( $action =~ /\A remove/xms );
+ return $prio if ( $action =~ m{\A remove }xms );
$prio++;
# Last : other elements
return $prio;
}
-sub Sort_config_sections ($$$) {
+sub sort_config_sections {
my ( $host_config, $a, $b ) = @_;
- my $prioa = __Sort_depends_prio( $host_config->{$a}->{'action'}, $a );
- my $priob = __Sort_depends_prio( $host_config->{$b}->{'action'}, $b );
+ my $prioa = __sort_depends_prio( $host_config->{$a}->{'action'}, $a );
+ my $priob = __sort_depends_prio( $host_config->{$b}->{'action'}, $b );
if ( $prioa != $priob ) {
return $prioa <=> $priob;
}
# else {
- # return $a cmp $b;
+ # return $a cmp $b;
# }
}
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Update/ADDFILE.pm
--- a/lib/PFTools/Update/ADDFILE.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Update/ADDFILE.pm Fri Aug 08 18:02:12 2014 +0200
@@ -69,7 +69,7 @@
unlink $source;
foreach my $splitsource ( split q{ }, $ref_section->{'source'} ) {
$splitsource
- = Get_source( $splitsource, $options->{'host'}, $hash_subst );
+ = get_source( $splitsource, $options->{'host'}, $hash_subst );
if ( !-f $splitsource ) {
carp colored(
qq{ERROR: $splitsource no such file or directory},
@@ -87,7 +87,7 @@
}
}
else {
- $source = Get_source( $ref_section->{'source'},
+ $source = get_source( $ref_section->{'source'},
$options->{'host'}, $hash_subst );
}
@@ -99,7 +99,7 @@
$hash_subst->{'SOURCE'} = $source;
$hash_subst->{'DESTINATION'} = $tmp;
if ( defined( $ref_section->{'filter'} ) ) {
- my $filter = Subst_vars( $ref_section->{'filter'}, $hash_subst );
+ my $filter = subst_vars( $ref_section->{'filter'}, $hash_subst );
if ( deferredlogsystem($filter) ) {
carp qq{ERROR: Unable to apply filter $filter};
return;
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Update/ADDLINK.pm
--- a/lib/PFTools/Update/ADDLINK.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Update/ADDLINK.pm Fri Aug 08 18:02:12 2014 +0200
@@ -51,7 +51,7 @@
my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
$hash_subst->{'SECTIONNAME'} = $dest;
- my $source = Subst_vars( $ref_section->{'source'}, $hash_subst );
+ my $source = subst_vars( $ref_section->{'source'}, $hash_subst );
# Need to check the source ...
my $dep_src = $source;
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Update/ADDMOUNT.pm
--- a/lib/PFTools/Update/ADDMOUNT.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Update/ADDMOUNT.pm Fri Aug 08 18:02:12 2014 +0200
@@ -124,7 +124,7 @@
sub __resolve_fstab_entry {
my ($param) = @_;
- my $pf_config = Init_PF_CONFIG();
+ my $pf_config = init_pf_config();
my $fs_entry = $param->{'fs_entry'};
if ( $fs_entry->{'fstype'}
=~ m{\A $pf_config->{'regex'}->{'network_fstype'} \z}xms )
@@ -164,7 +164,7 @@
$fs_entry->{'dest'} = $param->{'dest'};
foreach my $key ( 'source', 'options' ) {
$fs_entry->{$key}
- = Subst_vars( $fs_entry->{$key}, $param->{'subst'} );
+ = subst_vars( $fs_entry->{$key}, $param->{'subst'} );
}
$fs_entry->{'options'}
@@ -202,12 +202,12 @@
= join( q{,}, sort split( /,/xms, $add_mount->{'options'} ) );
$hash_subst->{'FSTYPE'} = $ref_section->{'fstype'} || $DEFAULT_FSTYPE;
- my $current_fstab = Build_structure_from_fstab(q{/etc/fstab});
+ my $current_fstab = build_structure_from_fstab(q{/etc/fstab});
if ( !$current_fstab ) {
carp q{ERROR: Unable to build fstab structure from file /etc/fstab};
return;
}
- my $current_proc = Build_structure_from_fstab(q{/proc/mounts});
+ my $current_proc = build_structure_from_fstab(q{/proc/mounts});
if ( !$current_fstab ) {
carp q{ERROR: Unable to build fstab structure from file /proc/mounts};
return;
@@ -274,7 +274,7 @@
carp qq{ERROR: Unable to create tmp $tmp : $OS_ERROR};
return;
}
- my $new_fstab = Build_fstab_from_structure($current_fstab);
+ my $new_fstab = build_fstab_from_structure($current_fstab);
if ( !print {$output_fh} join "\n", @{$new_fstab} ) {
carp qq{ERROR: Unable to write on tmp $tmp : $OS_ERROR"};
return;
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Update/CREATEFILE.pm
--- a/lib/PFTools/Update/CREATEFILE.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Update/CREATEFILE.pm Fri Aug 08 18:02:12 2014 +0200
@@ -67,7 +67,7 @@
}
}
else {
- my $source = Get_source( $ref_section->{'source'},
+ my $source = get_source( $ref_section->{'source'},
$hash_subst->{'HOSTNAME'}, $hash_subst );
# Creating tmp destination from source
@@ -77,7 +77,7 @@
}
if ( defined( $ref_section->{'filter'} ) ) {
my $filter
- = Subst_vars( $ref_section->{'filter'}, $hash_subst );
+ = subst_vars( $ref_section->{'filter'}, $hash_subst );
if ( deferredlogsystem($filter) ) {
carp qq{ERROR: Unable to apply filter $filter};
return;
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Update/Common.pm
--- a/lib/PFTools/Update/Common.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Update/Common.pm Fri Aug 08 18:02:12 2014 +0200
@@ -162,7 +162,7 @@
sub do_moveold {
my ( $dest, $options ) = @_;
- my $pf_config = Init_PF_CONFIG();
+ my $pf_config = init_pf_config();
if ( -e $dest ) {
my $old
= $pf_config->{'path'}->{'checkout_dir'}
@@ -227,7 +227,7 @@
&& defined( $ref_section->{'on_config'} ) )
{
return exec_cmd(
- Subst_vars( $ref_section->{'on_config'}, $hash_subst ) );
+ subst_vars( $ref_section->{'on_config'}, $hash_subst ) );
}
return 1;
}
@@ -246,7 +246,7 @@
&& defined( $ref_section->{'before_change'} ) )
{
return exec_cmd(
- Subst_vars( $ref_section->{'before_change'}, $hash_subst ) );
+ subst_vars( $ref_section->{'before_change'}, $hash_subst ) );
}
return 1;
}
@@ -265,7 +265,7 @@
&& !$options->{'noaction'} )
{
return exec_cmd(
- Subst_vars( $ref_section->{'after_change'}, $hash_subst ) );
+ subst_vars( $ref_section->{'after_change'}, $hash_subst ) );
}
return 1;
}
@@ -284,7 +284,7 @@
&& $options->{'noaction'} )
{
return exec_cmd(
- Subst_vars( $ref_section->{'on_noaction'}, $hash_subst ) );
+ subst_vars( $ref_section->{'on_noaction'}, $hash_subst ) );
}
return 1;
}
@@ -320,7 +320,7 @@
sub get_tmp_dest {
my ($dest) = @_;
- my $pf_config = Init_PF_CONFIG();
+ my $pf_config = init_pf_config();
my $tmp = $pf_config->{'path'}->{'checkout_dir'} . q{/tmp/} . $dest;
mk_dest_dir($tmp);
if ( -d $tmp ) {
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Update/INSTALLPKG.pm
--- a/lib/PFTools/Update/INSTALLPKG.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Update/INSTALLPKG.pm Fri Aug 08 18:02:12 2014 +0200
@@ -53,7 +53,7 @@
if ( !$options->{'pkg_type'} ) {
$options->{'pkg_type'} = 'deb';
}
- my $deps = Get_pkg_depends( $options->{'pkg_type'}, $dest );
+ my $deps = get_pkg_depends( $options->{'pkg_type'}, $dest );
if ( !$deps ) {
if ( $options->{'verbose'} ) {
carp colored(
@@ -85,7 +85,7 @@
my $name_filter = $ref_section->{'name_filter'};
if ($name_filter) {
my $newdest
- = deferredlogpipe( Subst_vars( $name_filter, $hash_subst ) );
+ = deferredlogpipe( subst_vars( $name_filter, $hash_subst ) );
if ( !defined $newdest ) {
carp qq{ERROR: Unable to apply name_filter $name_filter};
return;
@@ -98,7 +98,7 @@
}
$hash_subst->{'SECTIONNAME'} = $dest;
( $installed_version, $available_version, $specified_version )
- = Get_pkg_policy( $options->{'pkg_type'},
+ = get_pkg_policy( $options->{'pkg_type'},
$dest, $ref_section->{'version'} );
if ( !$available_version ) {
carp qq{ERROR: Package $dest is unavailable};
@@ -112,7 +112,7 @@
$install++;
}
else {
- my $compare = Cmp_pkg_version( $options->{'pkg_type'},
+ my $compare = cmp_pkg_version( $options->{'pkg_type'},
$dest, $installed_version, $available_version );
if ( defined $compare && $compare < 0 ) {
$install++;
@@ -155,7 +155,7 @@
}
if ($debconf) {
my ( $DEB, $pkg );
- my $pf_config = Init_PF_CONFIG();
+ my $pf_config = init_pf_config();
my $vcs_tpl_dir
= $pf_config->{'path'}->{'checkout_dir'} . '/TEMPLATES';
Debconf::Db->load;
@@ -184,7 +184,7 @@
$install = q{};
}
if ( !$options->{'simul'} ) {
- if (!Install_pkg(
+ if (!install_pkg(
$options->{'pkg_type'}, $dest,
$ref_section->{'version'}
)
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Update/PURGEPKG.pm
--- a/lib/PFTools/Update/PURGEPKG.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Update/PURGEPKG.pm Fri Aug 08 18:02:12 2014 +0200
@@ -54,7 +54,7 @@
if ($name_filter) {
$hash_subst->{'SECTIONNAME'} = $dest;
my $newdest
- = deferredlogpipe( Subst_vars( $name_filter, $hash_subst ) );
+ = deferredlogpipe( subst_vars( $name_filter, $hash_subst ) );
if ( !defined $newdest ) {
carp qq{ERROR: Unable to apply name_filter $name_filter};
return;
@@ -66,7 +66,7 @@
$dest = $newdest;
}
- my $status = Get_pkg_status( $options->{'pkg_type'}, $dest );
+ my $status = get_pkg_status( $options->{'pkg_type'}, $dest );
if ( !$status ) {
carp qq{ERROR: Unable to retrieve status for $dest};
return;
@@ -79,7 +79,7 @@
do_on_config( $ref_section, $options, $hash_subst ) or return;
do_before_change( $ref_section, $options, $hash_subst ) or return;
if ( !$options->{'simul'}
- && !Purge_pkg( $options->{'pkg_type'}, $dest ) )
+ && !purge_pkg( $options->{'pkg_type'}, $dest ) )
{
carp qq{ERROR: During purge for $dest};
return;
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/Utils.pm
--- a/lib/PFTools/Utils.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/Utils.pm Fri Aug 08 18:02:12 2014 +0200
@@ -59,7 +59,7 @@
our @EXPORT = qw(
init_tools
- Do_update_from_GLOBAL
+ do_update_from_global
);
our @EXPORT_OK = qw(
@@ -107,7 +107,7 @@
$pf_config_file = $default_pf_config_file;
}
- my $pf_config = Init_PF_CONFIG($pf_config_file);
+ my $pf_config = init_pf_config($pf_config_file);
if ( !$global_store_file ) {
$global_store_file = $pf_config->{'path'}->{'global_struct'};
@@ -125,10 +125,10 @@
}
my $source
- = Get_source( "COMMON:/$pf_config->{'path'}->{'start_file'}",
+ = get_source( "COMMON:/$pf_config->{'path'}->{'start_file'}",
$hostname, {}, $pf_config );
- $global_struct = Init_GLOBAL_NETCONFIG( $source, {}, $pf_config );
+ $global_struct = init_global_netconfig( $source, {}, $pf_config );
store_global_config( $global_struct, $pf_config );
}
else {
@@ -451,7 +451,7 @@
my $hosttype
= get_hosttype_from_hostname( $hostname, $global_config, $site_name );
- my $subst_ref = Init_SUBST( $hostname, $hosttype, $pf_config );
+ my $subst_ref = init_subst( $hostname, $hosttype, $pf_config );
my $host_ref = get_host_config( $hostname, $global_config, $site_name );
my $site_ref = get_site_config( $site_name, $global_config );
@@ -647,7 +647,7 @@
# FIXME documentation
# FIXME s/options/args_ref/ and use check_*()
-sub Do_update_from_GLOBAL {
+sub do_update_from_global {
my ( $options, $global_config, $pf_config ) = @_;
my $hostname = $options->{'host'};
@@ -666,7 +666,7 @@
my $hosttype
= get_hosttype_from_hostname( $hostname, $global_config, $site_name );
- my $subst_ref = Init_SUBST( $hostname, $hosttype, $pf_config );
+ my $subst_ref = init_subst( $hostname, $hosttype, $pf_config );
my $host_ref = get_host_config( $hostname, $global_config, $site_name );
$subst_ref->{'DISTRIB'} = get_distrib_from_host_ref($host_ref);
@@ -676,7 +676,7 @@
$site_name );
my $host_config
- = Get_config_for_hostname_on_site( $hostname, $site_name, $subst_ref,
+ = get_config_for_hostname_on_site( $hostname, $site_name, $subst_ref,
$global_config, $pf_config );
if ( !$host_config ) {
croak
@@ -687,7 +687,7 @@
croak q{ERROR: update feature is deactivated in config file};
}
- my @sortedkeys = sort { Sort_config_sections( $host_config, $a, $b ) }
+ my @sortedkeys = sort { sort_config_sections( $host_config, $a, $b ) }
@{ $host_config->{'__sections_order'} };
local $OUTPUT_AUTOFLUSH = 1;
@@ -816,7 +816,7 @@
and not defined $host_config->{$section}->{'done'} )
{
$host_config->{$section}->{'doing'} = 1;
- Get_depends_for_action(
+ get_depends_for_action(
$host_config->{$section}->{'action'},
$host_config->{$section},
$section, $options
@@ -862,7 +862,7 @@
print colored( qq{[$section]\n}, q{white} );
}
- if (!Exec_action(
+ if (!exec_action(
$host_config->{$section}->{'action'},
$host_config->{$section},
$section, $options, $subst_ref, $global_config
@@ -2213,10 +2213,10 @@
$chomp_wanted = 1 if !defined $chomp_wanted;
if ( not $filename ) {
- croak q{ERROR: Invalid empty $filename};
+ croak q{ERROR: Invalid empty 'filename'};
}
if ( ref $filename ) {
- croak q{ERROR: Invalid non-scalar $filename};
+ croak q{ERROR: Invalid non-scalar 'filename'};
}
# Correctly handle q{-} for STDIN
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/VCS.pm
--- a/lib/PFTools/VCS.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/VCS.pm Fri Aug 08 18:02:12 2014 +0200
@@ -1,22 +1,30 @@
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
-#
+=head1 NAME
+
+PFTools::VCS - VCS module for PFTools
+
+=head1 LICENSE AND COPYRIGHT
+
+ 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
+
+=head1 SUBROUTINES/METHODS
+
+=cut
use strict;
use warnings;
@@ -34,11 +42,30 @@
our @EXPORT_OK = qw();
+=head2 vcs_checkout($hostname,$pf_config,$options)
+
+This function builds a NetAddr::IP object, in the same time permits the
+control of IP values defined for a given network definition.
+It takes the following arguments:
+
+=over
+
+=item I<hostname> the hostname
+
+=item I<pf_config> a reference to the pf-tools configuration hash
+
+=item I<option> options passed to the vcs command
+
+=back
+
+
+=cut
+
sub vcs_checkout {
my ( $hostname, $pf_config, $options ) = @_;
if ( !$pf_config ) {
- carp q{ERROR: $pf_config is invalid};
+ carp q{ERROR: 'pf_config' is invalid};
return;
}
my $module_name = 'PFTools::VCS::' . uc( $pf_config->{'vcs'}->{'type'} );
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/VCS/CVS.pm
--- a/lib/PFTools/VCS/CVS.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/VCS/CVS.pm Fri Aug 08 18:02:12 2014 +0200
@@ -36,22 +36,22 @@
my ( $hostname, $pf_config, $options ) = @_;
if ( !$hostname ) {
- croak q{ERROR: Invalid undefined or empty $hostname};
+ croak q{ERROR: Invalid undefined or empty 'hostname'};
}
if ( !$pf_config ) {
- croak q{ERROR: Invalid undefined or empty $pf_config};
+ croak q{ERROR: Invalid undefined or empty 'pf_config'};
}
if ( !$options ) {
- croak q{ERROR: Invalid undefined or empty $options};
+ croak q{ERROR: Invalid undefined or empty 'options'};
}
if ( ref $hostname ) {
- croak q{ERROR: Invalid non-scalar $hostname};
+ croak q{ERROR: Invalid non-scalar 'hostname'};
}
if ( ref $pf_config ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $pf_config};
+ croak q{ERROR: Invalid non-hashref 'pf_config'};
}
if ( ref $options ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $options};
+ croak q{ERROR: Invalid non-hashref 'options'};
}
my $cvs_cmd = $pf_config->{'vcs'}->{'command'};
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/VCS/HG.pm
--- a/lib/PFTools/VCS/HG.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/VCS/HG.pm Fri Aug 08 18:02:12 2014 +0200
@@ -37,22 +37,22 @@
my ( $hostname, $pf_config, $options ) = @_;
if ( !$hostname ) {
- croak q{ERROR: Invalid undefined or empty $hostname};
+ croak q{ERROR: Invalid undefined or empty 'hostname'};
}
if ( !$pf_config ) {
- croak q{ERROR: Invalid undefined or empty $pf_config};
+ croak q{ERROR: Invalid undefined or empty 'pf_config'};
}
if ( !$options ) {
- croak q{ERROR: Invalid undefined or empty $options};
+ croak q{ERROR: Invalid undefined or empty 'options'};
}
if ( ref $hostname ) {
- croak q{ERROR: Invalid non-scalar $hostname};
+ croak q{ERROR: Invalid non-scalar 'hostname'};
}
if ( ref $pf_config ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $pf_config};
+ croak q{ERROR: Invalid non-hashref 'pf_config'};
}
if ( ref $options ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $options};
+ croak q{ERROR: Invalid non-hashref 'options'};
}
my $hg_cmd = $pf_config->{'vcs'}->{'command'};
diff -r fc33cd0e9c62 -r ef9e72e07750 lib/PFTools/VCS/SVN.pm
--- a/lib/PFTools/VCS/SVN.pm Thu Aug 07 18:31:27 2014 +0200
+++ b/lib/PFTools/VCS/SVN.pm Fri Aug 08 18:02:12 2014 +0200
@@ -36,22 +36,22 @@
my ( $hostname, $pf_config, $options ) = @_;
if ( !$hostname ) {
- croak q{ERROR: Invalid undefined or empty $hostname};
+ croak q{ERROR: Invalid undefined or empty 'hostname'};
}
if ( !$pf_config ) {
- croak q{ERROR: Invalid undefined or empty $pf_config};
+ croak q{ERROR: Invalid undefined or empty 'pf_config'};
}
if ( !$options ) {
- croak q{ERROR: Invalid undefined or empty $options};
+ croak q{ERROR: Invalid undefined or empty 'options'};
}
if ( ref $hostname ) {
- croak q{ERROR: Invalid non-scalar $hostname};
+ croak q{ERROR: Invalid non-scalar 'hostname'};
}
if ( ref $pf_config ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $pf_config};
+ croak q{ERROR: Invalid non-hashref 'pf_config'};
}
if ( ref $options ne 'HASH' ) {
- croak q{ERROR: Invalid non-hashref $options};
+ croak q{ERROR: Invalid non-hashref 'options'};
}
my $svn_cmd = $pf_config->{'vcs'}->{'command'};
diff -r fc33cd0e9c62 -r ef9e72e07750 sbin/update-config
--- a/sbin/update-config Thu Aug 07 18:31:27 2014 +0200
+++ b/sbin/update-config Fri Aug 08 18:02:12 2014 +0200
@@ -99,7 +99,7 @@
$options->{'simul'} = 1;
}
-Do_update_from_GLOBAL( $options, $GLOBAL_STRUCT, $PF_CONFIG );
+do_update_from_global( $options, $GLOBAL_STRUCT, $PF_CONFIG );
exit 0;
diff -r fc33cd0e9c62 -r ef9e72e07750 t/11.vars.t
--- a/t/11.vars.t Thu Aug 07 18:31:27 2014 +0200
+++ b/t/11.vars.t Fri Aug 08 18:02:12 2014 +0200
@@ -5,19 +5,19 @@
use Test::More qw( no_plan );
-use PFTools::Conf qw( Subst_vars );
+use PFTools::Conf qw( subst_vars );
-can_ok( 'PFTools::Conf', qw( Subst_vars ) );
+can_ok( 'PFTools::Conf', qw( subst_vars ) );
-note('Testing PFTools::Conf::Subst_vars');
+note('Testing PFTools::Conf::subst_vars');
-ok !defined( Subst_vars() )
+ok !defined( subst_vars() )
=> 'Returns undef if no args';
-ok !defined( Subst_vars(undef) )
+ok !defined( subst_vars(undef) )
=> 'Returns undef if undef string';
-is Subst_vars( q{}, {} ),
+is subst_vars( q{}, {} ),
q{}
=> 'Returns empty string if $text is empty';
@@ -28,11 +28,11 @@
);
my $template_string = q{Some %VAR1% text %VAR10% %UNKNOWN_VAR% %%VAR2%%.};
-is Subst_vars( $template_string, 'foo' ),
+is subst_vars( $template_string, 'foo' ),
$template_string
=> 'Returns $text if $variables_ref is not a hashref';
-my $result = Subst_vars($template_string, \%variables);
+my $result = subst_vars($template_string, \%variables);
ok defined($result)
=> 'Returns something with real args';
diff -r fc33cd0e9c62 -r ef9e72e07750 t/12.storable.t
--- a/t/12.storable.t Thu Aug 07 18:31:27 2014 +0200
+++ b/t/12.storable.t Fri Aug 08 18:02:12 2014 +0200
@@ -13,15 +13,15 @@
note('Testing PFTools::Conf::store_global_config');
throws_ok { store_global_config() }
- qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] [\$] global_config }xms
+ qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] 'global_config' }xms
=> q{Dies on non-hashref global_config};
throws_ok { store_global_config( {} ) }
- qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] [\$] pf_config }xms
+ qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] 'pf_config' }xms
=> q{Dies on non-hashref pf_config};
throws_ok { store_global_config( {}, {}, {} ) }
- qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] flush_file }xms
+ qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] 'flush_file' }xms
=> q{Dies on non-scalar flush_file};
my $global_config = {
@@ -72,11 +72,11 @@
note('Testing PFTools::Conf::retrieve_global_config');
throws_ok { retrieve_global_config( {} ) }
- qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] path_global_file }xms
+ qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] 'path_global_file' }xms
=> q{Dies on non-scalar flush_file};
throws_ok { retrieve_global_config() }
- qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] path_global_file }xms
+ qr{ \A ERROR: [ ] Invalid [ ] empty [ ] 'path_global_file' }xms
=> q{Dies on empty flush_file};
throws_ok { retrieve_global_config($store3) }
diff -r fc33cd0e9c62 -r ef9e72e07750 t/13.conf.t
--- a/t/13.conf.t Thu Aug 07 18:31:27 2014 +0200
+++ b/t/13.conf.t Fri Aug 08 18:02:12 2014 +0200
@@ -48,8 +48,8 @@
=> 'Sorts correctly';
########################################################################
-note('Testing PFTools::Conf::Init_PF_CONFIG');
-can_ok( 'PFTools::Conf', qw( Init_PF_CONFIG ) );
+note('Testing PFTools::Conf::init_pf_config');
+can_ok( 'PFTools::Conf', qw( init_pf_config ) );
my $default_pf_config = get_default_pf_config();
ok defined $default_pf_config
@@ -64,12 +64,12 @@
=> 'Empty $PF_CONFIG'
or note explain $current_pf_config;
-my $config = Init_PF_CONFIG();
+my $config = init_pf_config();
is_deeply $config, $default_pf_config
=> q{Returns the default config}
or note explain $config;
-throws_ok { Init_PF_CONFIG('/non-existent-file') }
+throws_ok { init_pf_config('/non-existent-file') }
qr{\A ERROR: }xms
=> 'Dies with error message if non-existent configuration file';
@@ -94,14 +94,14 @@
},
};
-throws_ok { Init_PF_CONFIG($test_config_file) }
+throws_ok { init_pf_config($test_config_file) }
qr{\A ERROR: }xms
=> 'Dies with error message if configuration file has bad permissions';
chmod 0600, $test_config_file
or die qq{chmod $test_config_file: $OS_ERROR};
-my $parsed_configuration = Init_PF_CONFIG($test_config_file);
+my $parsed_configuration = init_pf_config($test_config_file);
ok ref $parsed_configuration eq 'HASH' && keys %{$parsed_configuration}
=> 'Returns a non-empty hashref';
@@ -115,7 +115,7 @@
=> 'Correctly sets $PF_CONFIG'
or note explain $current_pf_config;
-$parsed_configuration = Init_PF_CONFIG();
+$parsed_configuration = init_pf_config();
is_deeply $parsed_configuration, $expected_configuration
=> q{Correctly returns the real configuration on subsequent implicit calls}
or note explain $parsed_configuration;
@@ -152,7 +152,7 @@
},
};
$expected_configuration = merge( $default_pf_config, $test_configuration );
-$parsed_configuration = Init_PF_CONFIG($test_config_file);
+$parsed_configuration = init_pf_config($test_config_file);
is_deeply $parsed_configuration, $expected_configuration
=> qq{File $test_config_file correctly merged with the default configuration}
or note explain $parsed_configuration;
@@ -163,24 +163,24 @@
# Restore the default configuration for the other tests
reset_pf_config();
-$parsed_configuration = Init_PF_CONFIG();
+$parsed_configuration = init_pf_config();
is_deeply $parsed_configuration, $default_pf_config
=> q{Correctly restores the default configuration}
or note explain $parsed_configuration;
########################################################################
-note('Testing PFTools::Conf::Init_SUBST');
-can_ok( 'PFTools::Conf', qw( Init_SUBST ) );
+note('Testing PFTools::Conf::init_subst');
+can_ok( 'PFTools::Conf', qw( init_subst ) );
-throws_ok { Init_SUBST( undef, { foo => 1 } ) }
-qr{\A ERROR: [ ] Hosttype [ ] parameter [ ] must [ ] be [ ] a [ ] string }xms
+throws_ok { init_subst( undef, { foo => 1 } ) }
+qr{\A ERROR: [ ] 'hosttype' [ ] parameter [ ] must [ ] be [ ] a [ ] string }xms
=> 'Dies if $hosttype specified but not a scalar';
-lives_ok { Init_SUBST( undef, 'foo' ) }
+lives_ok { init_subst( undef, 'foo' ) }
'Accepts a scalar for $hosttype';
-throws_ok { Init_SUBST('1nvalid_hostname!') }
+throws_ok { init_subst('1nvalid_hostname!') }
qr{\A ERROR: [ ] Invalid [ ] hostname }xms
=> 'Dies if invalid $hostname';
@@ -233,38 +233,38 @@
foreach my $hostname ( keys %{$expected_subst_for} ) {
# we must fake the 'private' domainname
- my $got = Init_SUBST( $hostname, undef, undef, 'private' );
+ my $got = init_subst( $hostname, undef, undef, 'private' );
is_deeply $got, $expected_subst_for->{$hostname}
=> qq{Returns the correct information for host $hostname}
or note explain $got;
}
########################################################################
-note('Testing PFTools::Conf::Get_source');
-can_ok( 'PFTools::Conf', qw( Get_source ) );
+note('Testing PFTools::Conf::get_source');
+can_ok( 'PFTools::Conf', qw( get_source ) );
-throws_ok { Get_source() }
-qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] source }xms
+throws_ok { get_source() }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] 'source' }xms
=> 'Dies if empty $source';
-throws_ok { Get_source( q{foo bar baz}, undef, q{non-hashref $hash_subst} ) }
-qr{ \A ERROR: [ ] Invalid [ ] non-href [ ] [\$] hash_subst }xms
+throws_ok { get_source( q{foo bar baz}, undef, q{non-hashref $hash_subst} ) }
+qr{ \A ERROR: [ ] Invalid [ ] non-href [ ] 'hash_subst' }xms
=> q{Dies on non-hashref $hash_subst};
throws_ok {
- Get_source( q{foo bar baz}, undef, undef, q{non-hashref $pf_config} );
+ get_source( q{foo bar baz}, undef, undef, q{non-hashref $pf_config} );
}
-qr{ \A ERROR: [ ] Invalid [ ] non-href [ ] [\$] pf_config }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-href [ ] 'pf_config' }xms
=> q{Dies on non-hashref $pf_config};
throws_ok {
- Get_source( q{foo bar baz}, undef, undef, { missing => 'checkout_dir' } );
+ get_source( q{foo bar baz}, undef, undef, { missing => 'checkout_dir' } );
}
qr{ \A ERROR: [ ] Undefined [ ] configuration [ ] parameter: [ ] path.checkout_dir}xms
=> q{Dies on invalid $pf_config (no path.checkout_dir)};
throws_ok {
- Get_source(
+ get_source(
q{foo bar baz}, undef, undef,
{ path => { checkout_dir => '/tmp/co_dir' } }
);
@@ -272,59 +272,59 @@
qr{ \A ERROR: [ ] Undefined [ ] configuration [ ] parameter: [ ] vcs.module}xms
=> q{Dies on invalid $pf_config (no vcs.module)};
-is Get_source(q{MODSITE_FOOBAR:/my/path/to/file}),
+is get_source(q{MODSITE_FOOBAR:/my/path/to/file}),
q{/var/lib/cvsguest/config/SITE/FOOBAR/MODEL/my/path/to/file}
=> q{Good result for MODSITE_*:};
-is Get_source(q{MOD:/my/path/to/file}),
+is get_source(q{MOD:/my/path/to/file}),
q{/var/lib/cvsguest/config/MODEL/my/path/to/file}
=> q{Good result for MOD:};
-is Get_source(q{CONFSITE_FOOBAR:/my/path/to/file}),
+is get_source(q{CONFSITE_FOOBAR:/my/path/to/file}),
q{/var/lib/cvsguest/config/SITE/FOOBAR/CONFIG/my/path/to/file}
=> q{Good result for CONFSITE_*:};
-is Get_source(q{CONF:/my/path/to/file}),
+is get_source(q{CONF:/my/path/to/file}),
q{/var/lib/cvsguest/config/CONFIG/my/path/to/file}
=> q{Good result for CONF:};
-is Get_source(q{SITE_FOOBAR:/my/path/to/file}),
+is get_source(q{SITE_FOOBAR:/my/path/to/file}),
q{/var/lib/cvsguest/config/SITE/FOOBAR/my/path/to/file}
=> q{Good result for SITE_*:};
-is Get_source(q{SITE:/my/path/to/file}),
+is get_source(q{SITE:/my/path/to/file}),
q{/var/lib/cvsguest/config/SITE/my/path/to/file}
=> q{Good result for SITE:};
-is Get_source( q{HOSTSITE_FOOBAR:/my/path/to/file}, q{myhost00} ),
+is get_source( q{HOSTSITE_FOOBAR:/my/path/to/file}, q{myhost00} ),
q{/var/lib/cvsguest/config/SITE/FOOBAR/myhost/my/path/to/file}
=> q{Good result for HOSTSITE_*:};
-is Get_source( q{HOST:/my/path/to/file}, q{myhost00} ),
+is get_source( q{HOST:/my/path/to/file}, q{myhost00} ),
q{/var/lib/cvsguest/config/myhost/my/path/to/file}
=> q{Good result for HOST:};
-is Get_source( q{HOST:/my/path/to/file.%HOSTDIGITS%}, q{myhost00} ),
+is get_source( q{HOST:/my/path/to/file.%HOSTDIGITS%}, q{myhost00} ),
q{/var/lib/cvsguest/config/myhost/my/path/to/file.00}
=> q{Good result for HOST: and %HOSTDIGITS%};
-is Get_source(q{COMMON:/my/path/to/file}),
+is get_source(q{COMMON:/my/path/to/file}),
q{/var/lib/cvsguest/config/COMMON/my/path/to/file}
=> q{Good result for COMMON:};
-is Get_source(q{CONFIG:/my/path/to/file}),
+is get_source(q{CONFIG:/my/path/to/file}),
q{/var/lib/cvsguest/config/my/path/to/file}
=> q{Good result for CONFIG:/};
-is Get_source(q{CONFIG:my/path/to/file}),
+is get_source(q{CONFIG:my/path/to/file}),
q{/var/lib/cvsguest/config/my/path/to/file}
=> q{Good result for CONFIG:};
-is Get_source(q{CVS:config/my/path/to/file}),
+is get_source(q{CVS:config/my/path/to/file}),
q{/var/lib/cvsguest/config/my/path/to/file}
=> q{Good result for CVS:};
-is Get_source(q{GLOBAL:/my/path/to/file}),
+is get_source(q{GLOBAL:/my/path/to/file}),
q{/var/lib/cvsguest/config/GLOBAL/my/path/to/file}
=> q{Good result for CONFIG:};
@@ -407,51 +407,51 @@
########################################################################
-note('Testing PFTools::Conf::Load_conf');
-can_ok( 'PFTools::Conf', qw( Load_conf ) );
+note('Testing PFTools::Conf::load_conf');
+can_ok( 'PFTools::Conf', qw( load_conf ) );
-throws_ok { Load_conf() }
-qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] file }xms
+throws_ok { load_conf() }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] 'file' }xms
=> q{Dies if empty $file};
-throws_ok { Load_conf( 'file', {} ) }
-qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] context }xms
+throws_ok { load_conf( 'file', {} ) }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] 'context' }xms
=> q{Dies if empty $context};
-throws_ok { Load_conf( {}, {}, 'context', {} ) }
-qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] file }xms
+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
+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
+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
+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', {} ) }
+throws_ok { load_conf( 'file', {}, 'context', {} ) }
qr{ \A ERROR: [ ] Invalid [ ] context [ ] }xms
=> q{Dies if invalid $context};
-throws_ok { Load_conf( 'inexistent file', {}, 'config', $pf_config ) }
+throws_ok { load_conf( 'inexistent file', {}, 'config', $pf_config ) }
qr{ \A ERROR: [ ] Unable [ ] to [ ] load [ ] }xms
=> q{Dies if inexistent $file};
# Let's go back to our test configuration
$test_config_file = 't/13.conf.cfg1/etc/pf-tools.1.conf';
my $test_pf_config
- = Init_PF_CONFIG($test_config_file); # already tested OK above
+ = init_pf_config($test_config_file); # already tested OK above
my $cwd = getcwd;
my $test_config_dir = qq{$cwd/t/13.conf.cfg1};
my $test_hostname = lc hostname;
my $test_hash_subst
- = Init_SUBST( $test_hostname, undef, $test_pf_config, 'private' );
+ = init_subst( $test_hostname, undef, $test_pf_config, 'private' );
# bypass cvs/svn/whatever for the moment
unlink q{/tmp/pf-test/var/lib/cvsguest/config};
@@ -460,7 +460,7 @@
q{/tmp/pf-test/var/lib/cvsguest/config}
or diag qq{symlink: $OS_ERROR};
-$parsed_configuration = Load_conf(
+$parsed_configuration = load_conf(
q{COMMON:private-network}, $test_hash_subst,
q{network}, $test_pf_config
);
@@ -629,7 +629,7 @@
or note explain $parsed_configuration;
-$parsed_configuration = Load_conf(
+$parsed_configuration = load_conf(
q{CONFSITE_cbv4-pfds:/hostfile-cbv4-spawn}, $test_hash_subst,
q{host}, $test_pf_config
);
@@ -709,7 +709,7 @@
=> q{Returns the expected configuration hash in host context}
or note explain $parsed_configuration;
-$parsed_configuration = Load_conf(
+$parsed_configuration = load_conf(
q{MODSITE_cbv4-pfds:/model-cbv4-pfds}, $test_hash_subst,
q{model}, $test_pf_config
);
@@ -772,32 +772,32 @@
diag(
- qq{FIXME: add other files in $test_config_dir to test Load_conf() with real files and 'config' context}
+ qq{FIXME: add other files in $test_config_dir to test load_conf() with real files and 'config' context}
);
########################################################################
-note('Testing PFTools::Conf::Init_GLOBAL_NETCONFIG');
-can_ok( 'PFTools::Conf', qw( Init_GLOBAL_NETCONFIG ) );
+note('Testing PFTools::Conf::init_global_netconfig');
+can_ok( 'PFTools::Conf', qw( init_global_netconfig ) );
-throws_ok { Init_GLOBAL_NETCONFIG() }
-qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] start_file }xms
+throws_ok { init_global_netconfig() }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] 'start_file' }xms
=> q{Dies if empty $start_file};
-throws_ok { Init_GLOBAL_NETCONFIG( {} ) }
-qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] start_file }xms
+throws_ok { init_global_netconfig( {} ) }
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] 'start_file' }xms
=> q{Dies if non-scalar $start_file};
-throws_ok { Init_GLOBAL_NETCONFIG( 'start_file', 'hash_subst' ) }
-qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] [\$] hash_subst }xms
+throws_ok { init_global_netconfig( 'start_file', 'hash_subst' ) }
+qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] 'hash_subst' }xms
=> q{Dies if non-hashref $hash_subst};
-throws_ok { Init_GLOBAL_NETCONFIG( 'start_file', {}, 'pf_config' ) }
-qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] [\$] pf_config }xms
+throws_ok { init_global_netconfig( 'start_file', {}, 'pf_config' ) }
+qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] 'pf_config' }xms
=> q{Dies if non-hashref $pf_config};
$parsed_configuration
- = Init_GLOBAL_NETCONFIG( q{COMMON:private-network}, $test_hash_subst,
+ = init_global_netconfig( q{COMMON:private-network}, $test_hash_subst,
$test_pf_config );
$expected_configuration = {
@@ -1573,7 +1573,7 @@
or note explain $parsed_configuration;
$parsed_configuration
- = Init_GLOBAL_NETCONFIG( q{COMMON:private-network}, $test_hash_subst );
+ = init_global_netconfig( q{COMMON:private-network}, $test_hash_subst );
is_deeply $parsed_configuration, $expected_configuration
=> q{Returns the expected configuration hash when no explicit $pf_config was given}
or note explain $parsed_configuration;
@@ -1586,23 +1586,23 @@
my $global_config = $parsed_configuration;
throws_ok { get_hosttype_from_hostname() }
-qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] hostname }xms
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] 'hostname' }xms
=> 'Dies if no hostname';
throws_ok { get_hosttype_from_hostname( {} ) }
-qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] hostname }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] 'hostname' }xms
=> q{Dies if non-scalar $hostname};
throws_ok { get_hosttype_from_hostname('hostname') }
-qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] global_config }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] 'global_config' }xms
=> 'Dies if no global_config';
throws_ok { get_hosttype_from_hostname( 'hostname', 'global_config' ) }
-qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] global_config }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] 'global_config' }xms
=> q{Dies if non-hashref $global_config};
throws_ok { get_hosttype_from_hostname( 'hostname', {}, {} ) }
-qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] site_name }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] 'site_name' }xms
=> q{Dies if non-scalar $site_name};
throws_ok { get_hosttype_from_hostname( 'hostname', {} ) }
@@ -1623,46 +1623,46 @@
########################################################################
-note('Testing PFTools::Conf::Get_config_for_hostname_on_site');
-can_ok( 'PFTools::Conf', qw( Get_config_for_hostname_on_site ) );
+note('Testing PFTools::Conf::get_config_for_hostname_on_site');
+can_ok( 'PFTools::Conf', qw( get_config_for_hostname_on_site ) );
-throws_ok { Get_config_for_hostname_on_site() }
-qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] hostname }xms
+throws_ok { get_config_for_hostname_on_site() }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] 'hostname' }xms
=> 'Dies if no hostname';
-throws_ok { Get_config_for_hostname_on_site( {} ) }
-qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] hostname }xms
+throws_ok { get_config_for_hostname_on_site( {} ) }
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] 'hostname' }xms
=> q{Dies if non-scalar $hostname};
-throws_ok { Get_config_for_hostname_on_site('hostname') }
-qr{ \A ERROR: [ ] Invalid [ ] empty [ ] [\$] site }xms
+throws_ok { get_config_for_hostname_on_site('hostname') }
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] 'site' }xms
=> 'Dies if no site';
-throws_ok { Get_config_for_hostname_on_site( 'hostname', {} ) }
-qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] [\$] site }xms
+throws_ok { get_config_for_hostname_on_site( 'hostname', {} ) }
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] 'site' }xms
=> q{Dies if non-scalar $site};
throws_ok {
- Get_config_for_hostname_on_site( 'hostname', 'site', 'hash_subst' );
+ get_config_for_hostname_on_site( 'hostname', 'site', 'hash_subst' );
}
-qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] [\$] hash_subst }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] 'hash_subst' }xms
=> q{Dies if non-hashref $hash_subst};
throws_ok {
- Get_config_for_hostname_on_site( 'hostname', 'site', {},
+ get_config_for_hostname_on_site( 'hostname', 'site', {},
'global_config' );
}
-qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] [\$] global_config }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] 'global_config' }xms
=> q{Dies if non-hashref $global_config};
throws_ok {
- Get_config_for_hostname_on_site( 'hostname', 'site', {}, {},
+ get_config_for_hostname_on_site( 'hostname', 'site', {}, {},
'pf_config' );
}
-qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] [\$] pf_config }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-hashref [ ] 'pf_config' }xms
=> q{Dies if non-hashref $pf_config};
-$parsed_configuration = Get_config_for_hostname_on_site(
+$parsed_configuration = get_config_for_hostname_on_site(
'cbv4-spawn00', 'cbv4-pfds', $test_hash_subst, $global_config,
$test_pf_config
);
@@ -2280,27 +2280,27 @@
my @args = ();
throws_ok { get_host_config(@args); }
-qr{ \A ERROR: [ ] Invalid [ ] empty [ ] hostname }xms
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] 'hostname' }xms
=> q{No arguments};
@args = ( {} );
throws_ok { get_host_config(@args); }
-qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] hostname }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] 'hostname' }xms
=> q{Non-scalar hostname};
@args = qw( hostname );
throws_ok { get_host_config(@args); }
-qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] global_config }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] 'global_config' }xms
=> q{No global_config};
@args = ( q{hostname}, q{global_config} );
throws_ok { get_host_config(@args); }
-qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] global_config }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] 'global_config' }xms
=> q{No global_config};
@args = ( q{hostname}, $global_config, { site => q{name} } );
throws_ok { get_host_config(@args); }
-qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] site_name }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] 'site_name' }xms
=> q{Non-scalar site_name};
@args = ( q{hostname}, $global_config );
@@ -2368,27 +2368,27 @@
@args = ();
throws_ok { get_pkgtype_from_hostname(@args); }
-qr{ \A ERROR: [ ] Invalid [ ] empty [ ] hostname }xms
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] 'hostname' }xms
=> q{No arguments};
@args = ( {} );
throws_ok { get_pkgtype_from_hostname(@args); }
-qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] hostname }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] 'hostname' }xms
=> q{Non-scalar hostname};
@args = qw( hostname );
throws_ok { get_pkgtype_from_hostname(@args); }
-qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] global_config }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] 'global_config' }xms
=> q{No global_config};
@args = ( q{hostname}, q{global_config} );
throws_ok { get_pkgtype_from_hostname(@args); }
-qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] global_config }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] 'global_config' }xms
=> q{No global_config};
@args = ( q{hostname}, $global_config, { site => q{name} } );
throws_ok { get_pkgtype_from_hostname(@args); }
-qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] site_name }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] 'site_name' }xms
=> q{Non-scalar site_name};
@args = ( q{hostname}, $global_config );
@@ -2408,19 +2408,19 @@
can_ok( 'PFTools::Structqueries', qw( get_site_list_from_hostname ) );
throws_ok { get_site_list_from_hostname() }
-qr{ \A ERROR: [ ] Invalid [ ] empty [ ] hostname }xms
+qr{ \A ERROR: [ ] Invalid [ ] empty [ ] 'hostname' }xms
=> 'Dies if no hostname';
throws_ok { get_site_list_from_hostname( {} ) }
-qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] hostname }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-scalar [ ] 'hostname' }xms
=> q{Dies if non-scalar $hostname};
throws_ok { get_site_list_from_hostname('hostname') }
-qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] global_config }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] 'global_config' }xms
=> 'Dies if no global_config';
throws_ok { get_site_list_from_hostname( 'hostname', 'global_config' ) }
-qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] global_config }xms
+qr{ \A ERROR: [ ] Invalid [ ] non-hash [ ] reference [ ] 'global_config' }xms
=> q{Dies if non-hashref $global_config};
throws_ok { get_site_list_from_hostname( 'hostname', {} ) }
diff -r fc33cd0e9c62 -r ef9e72e07750 t/20.files.t
--- a/t/20.files.t Thu Aug 07 18:31:27 2014 +0200
+++ b/t/20.files.t Fri Aug 08 18:02:12 2014 +0200
@@ -19,12 +19,12 @@
# Let's go back to our test configuration
# FIXME: this depends on t/13.conf.t, but it probably should not.
my $config_file = 't/13.conf.cfg1/etc/pf-tools.1.conf';
-my $pf_config = Init_PF_CONFIG($config_file); # already tested OK in 13.conf.t
+my $pf_config = init_pf_config($config_file); # already tested OK in 13.conf.t
my $hostname = lc hostname;
-my $hash_subst = Init_SUBST( $hostname, undef, $pf_config, 'private' );
+my $hash_subst = init_subst( $hostname, undef, $pf_config, 'private' );
-my $global_config = Init_GLOBAL_NETCONFIG( q{COMMON:private-network}, $hash_subst );
+my $global_config = init_global_netconfig( q{COMMON:private-network}, $hash_subst );
########################################################################
note('Testing PFTools::Utils::__build_zone');
diff -r fc33cd0e9c62 -r ef9e72e07750 tools/kvmlaunch
--- a/tools/kvmlaunch Thu Aug 07 18:31:27 2014 +0200
+++ b/tools/kvmlaunch Fri Aug 08 18:02:12 2014 +0200
@@ -89,7 +89,7 @@
&& die "FATAL: Unable to load configuration.\n";
}
-my $Z = Init_lib_net( Get_source("GLOBAL:private-network") );
+my $Z = Init_lib_net( get_source("GLOBAL:private-network") );
my @hosts = __get_hosts( $Z, $option, @ARGV );
diff -r fc33cd0e9c62 -r ef9e72e07750 tools/umlaunch
--- a/tools/umlaunch Thu Aug 07 18:31:27 2014 +0200
+++ b/tools/umlaunch Fri Aug 08 18:02:12 2014 +0200
@@ -99,7 +99,7 @@
CVS_update( $options->{branchecvs}, $options )
&& die "Impossible de charger la configuration\n";
-my $Z = Init_lib_net( Get_source("GLOBAL:private-network") );
+my $Z = Init_lib_net( get_source("GLOBAL:private-network") );
my @hosts;
if ( $options->{'oneeach'} ) {
More information about the pf-tools-commits
mailing list