pf-tools/pf-tools: 20 new changesets
parmelan-guest at users.alioth.debian.org
parmelan-guest at users.alioth.debian.org
Mon Oct 4 11:50:17 UTC 2010
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/422fe965d13c
changeset: 825:422fe965d13c
user: "Christophe Caillet <quadchris at free.fr>"
date: Fri Sep 24 18:44:47 2010 +0200
description:
More coding style on regexp def
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/3b04a3413e70
changeset: 826:3b04a3413e70
user: "Christophe Caillet <quadchris at free.fr>"
date: Fri Sep 24 18:50:28 2010 +0200
description:
Coding style
Removing use of PFTools::Packages::DEB due to Module::Runtime
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/7d8337345724
changeset: 827:7d8337345724
user: "Christophe Caillet <quadchris at free.fr>"
date: Fri Sep 24 19:20:47 2010 +0200
description:
Coding style and cosmetics on error messages
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/a161a927873a
changeset: 828:a161a927873a
user: "Christophe Caillet <quadchris at free.fr>"
date: Wed Sep 29 18:30:04 2010 +0200
description:
Coding style and cosmetics
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/6732da34c7af
changeset: 829:6732da34c7af
user: "Christophe Caillet <quadchris at free.fr>"
date: Thu Sep 30 22:15:50 2010 +0200
description:
Coding style and correct values for return values true value for success else false value
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/7593b2689d18
changeset: 830:7593b2689d18
user: "Christophe Caillet <quadchris at free.fr>"
date: Thu Sep 30 22:41:22 2010 +0200
description:
Coding style and return values more perlish : need to debug now
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/187ff95519aa
changeset: 831:187ff95519aa
user: "Christophe Caillet <quadchris at free.fr>"
date: Thu Sep 30 22:41:30 2010 +0200
description:
Coding style and return values more perlish : need to debug now
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/771b26a98d5f
changeset: 832:771b26a98d5f
user: "Christophe Caillet <quadchris at free.fr>"
date: Thu Sep 30 22:57:09 2010 +0200
description:
Coding style, perlish return values and using API for Module::Runtime
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/5909ba6457e6
changeset: 833:5909ba6457e6
user: "Christophe Caillet <quadchris at free.fr>"
date: Thu Sep 30 22:59:45 2010 +0200
description:
Remove useless and API for Module::Runtime
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/99c1f5a8ad73
changeset: 834:99c1f5a8ad73
user: "Christophe Caillet <quadchris at free.fr>"
date: Thu Sep 30 23:00:34 2010 +0200
description:
Remove useless and API for Module::Runtime
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/8e07edebbc7c
changeset: 835:8e07edebbc7c
user: "Christophe Caillet <quadchris at free.fr>"
date: Fri Oct 01 18:47:39 2010 +0200
description:
Coding style, factorization, and perlsih return values
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/47126f814ca4
changeset: 836:47126f814ca4
user: "Christophe Caillet <quadchris at free.fr>"
date: Fri Oct 01 19:04:42 2010 +0200
description:
Coding style, factorization, and perlsih return values
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/4f426472377f
changeset: 837:4f426472377f
user: "Christophe Caillet <quadchris at free.fr>"
date: Fri Oct 01 19:08:00 2010 +0200
description:
Coding style, factorization, and perlsih return values
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/fbf1a969b2d1
changeset: 838:fbf1a969b2d1
user: "Christophe Caillet <quadchris at free.fr>"
date: Fri Oct 01 19:16:32 2010 +0200
description:
Coding style, factorization, and perlsih return values
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/fef34a26bcc0
changeset: 839:fef34a26bcc0
user: "Christophe Caillet <quadchris at free.fr>"
date: Fri Oct 01 19:22:46 2010 +0200
description:
Coding style, factorization, and perlsih return values
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/265d038d63f4
changeset: 840:265d038d63f4
user: "Christophe Caillet <quadchris at free.fr>"
date: Fri Oct 01 19:26:32 2010 +0200
description:
Coding style, factorization, and perlsih return values
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/c198d5bb1f8b
changeset: 841:c198d5bb1f8b
user: "Christophe Caillet <quadchris at free.fr>"
date: Mon Oct 04 12:00:27 2010 +0200
description:
Coding style and perlish return values
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/52ea3d73c93f
changeset: 842:52ea3d73c93f
user: "Christophe Caillet <quadchris at free.fr>"
date: Mon Oct 04 12:11:30 2010 +0200
description:
Better like this
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/a4c14980451a
changeset: 843:a4c14980451a
user: "Christophe Caillet <quadchris at free.fr>"
date: Mon Oct 04 12:13:33 2010 +0200
description:
Eval needs test case :)
details: http://hg.debian.org/hg/pf-tools/pf-tools/rev/494d020bfacd
changeset: 844:494d020bfacd
user: "Christophe Caillet <quadchris at free.fr>"
date: Mon Oct 04 13:49:20 2010 +0200
description:
Coding style and debug phase with my own script
diffstat:
20 files changed, 598 insertions(+), 611 deletions(-)
lib/PFTools/Packages.pm | 1
lib/PFTools/Update.pm | 5 -
lib/PFTools/Update/ADDFILE.pm | 80 ++++++++++++++++
lib/PFTools/Update/ADDLINK.pm | 44 +++++++++
lib/PFTools/Update/ADDMOUNT.pm | 172 +++++++++++++++++++++++++++++++++++
lib/PFTools/Update/Addfile.pm | 76 ---------------
lib/PFTools/Update/Addlink.pm | 43 --------
lib/PFTools/Update/Addmount.pm | 182 --------------------------------------
lib/PFTools/Update/CREATEFILE.pm | 51 ++++++++++
lib/PFTools/Update/Createfile.pm | 63 -------------
lib/PFTools/Update/INSTALLPKG.pm | 99 ++++++++++++++++++++
lib/PFTools/Update/Installpkg.pm | 98 --------------------
lib/PFTools/Update/MKDIR.pm | 40 ++++++++
lib/PFTools/Update/Mkdir.pm | 40 --------
lib/PFTools/Update/PURGEPKG.pm | 45 +++++++++
lib/PFTools/Update/Purgepkg.pm | 43 --------
lib/PFTools/Update/REMOVEDIR.pm | 32 ++++++
lib/PFTools/Update/REMOVEFILE.pm | 32 ++++++
lib/PFTools/Update/Removedir.pm | 32 ------
lib/PFTools/Update/Removefile.pm | 31 ------
diffs (3558 lines):
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Compat/Parser.pm
--- a/lib/PFTools/Compat/Parser.pm Thu Sep 23 18:59:47 2010 +0200
+++ b/lib/PFTools/Compat/Parser.pm Mon Oct 04 13:49:20 2010 +0200
@@ -250,7 +250,7 @@
}
elsif ( $1 eq "include" && !$inc ) {
print
- "There is an include idrective which is deactivate\n"
+ "There is an include directive which is deactivate\n"
if ($DEBUG);
$CONF->{ "\@include-" . $2 } = 1;
}
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Conf/Host.pm
--- a/lib/PFTools/Conf/Host.pm Thu Sep 23 18:59:47 2010 +0200
+++ b/lib/PFTools/Conf/Host.pm Mon Oct 04 13:49:20 2010 +0200
@@ -323,7 +323,7 @@
foreach my $key ( keys %{$ref_srv} ) {
my $suffix;
next if( $key eq 'type' or $key =~ /^__/);
- my ( $key_type, $spec, $hostnum ) = split( /\./, $key );
+ my ( $key_type, $spec, $hostnum ) = split( m{\.}, $key );
if( $key_type eq 'alias' ) {
$result->{'dns'}->{$key} = $ref_srv->{$key};
}
@@ -339,7 +339,7 @@
my $key_name = ( $spec ) ? "$key_type\.$spec" : $key_type;
$result->{'dns'}->{$key_name} = $ref_srv->{$key};
}
- elsif( $key_type =~ /^(comment|order|number|nodes|site)$/ ) {
+ elsif( $key_type =~ m{\A (comment|order|number|nodes|site) \Z}xms ) {
$result->{'hostgroup'}->{$key_type} = $ref_srv->{$key};
}
}
@@ -374,7 +374,13 @@
my $iface_def = $ref_host->{$iface_section};
my $nodes = $ref_host->{'hostgroup'}->{'nodes'} || 0;
my $host_number = ($hostnode) ? $hostnum . $hostnode : $hostnum;
- $iface =~ m{\A((eth|bond)[\d]+)(\.(TAG[\d]+))?\Z};
+ $iface =~ m{\A (
+ (eth|bond)[\d]+
+ )
+ (\.
+ (TAG[\d]+)
+ )?
+ \Z}xms;
( $ifraw, $iftag ) = ( $1, $4 );
# Check vlan
@@ -404,7 +410,7 @@
# Check tag
my $net_tag = $net_site->{$vlan}->{'tag'};
- if ( $iftag && $iftag =~ m{\A\d+\Z} && $net_tag ne $iftag ) {
+ if ( $iftag && $iftag =~ m{\A \d+ \Z}xms && $net_tag ne $iftag ) {
croak qq{ERROR: $iftag for $iface_section differs from $vlan def};
}
@@ -415,7 +421,7 @@
: split( m{\s*,\s*}, $iface_def->{'slaves'} );
foreach my $if (@slaves) {
croak qq{ERROR: $if cannot be enslaved to $iface for $hostname}
- if ( grep ( m{\A$if\Z}, @{$ref_if_list} ) );
+ if ( grep ( m{\A $if \Z}xms, @{$ref_if_list} ) );
}
$add_if->{'slaves'} = join( " ", @slaves );
$add_if->{'mode'} =
@@ -495,7 +501,7 @@
}
$route2add .= $net_site->{$vlan}->{$gw_key};
}
- elsif ( $via =~ /[g-zG-Z]+/ ) {
+ elsif ( $via =~ m{[g-zG-Z]+} ) {
# Potentially not parsed host ...
# skipping this case for now
$route2add .= $via;
@@ -539,7 +545,7 @@
$dhcp_part->{$dhcpvlan}->{$hostclass} = {}
unless( $dhcp_part->{$dhcpvlan}->{$hostclass} );
my $fixed_addr = $param->{'iface_def'}->{$param->{'ip_type'}};
- $fixed_addr =~ s/\/[\d]+$//;
+ $fixed_addr =~ s{/[\d]+\Z}{};
$dhcp_part->{$dhcpvlan}->{$hostclass}->{$hostname} = [
'hardware ethernet '. $param->{'iface_def'}->{'mac'} . ";",
'fixed-address ' . $fixed_addr . ';',
@@ -558,7 +564,7 @@
my $host_number = $param->{'host_number'};
my $vlan = $param->{'iface_def'}->{'vlan'};
my $zone_ip = $param->{'iface_def'}->{$param->{'ip_type'}};
- $zone_ip =~ s{/[\d]+$}{}xms;
+ $zone_ip =~ s{/[\d]+ \Z}{}xms;
my $zone_part = $param->{'zone_part'};
my $zone_key = ( $param->{'ip_type'} eq 'ipv6') ? 'ZONE6' : 'ZONE';
my $zone = $param->{'zone_name'};
@@ -596,7 +602,7 @@
}
foreach my $key ( keys %{ $param->{'dns_def'} } ) {
next if ( $key !~ /^alias/ );
- my ( $key_type, $alias, $host_num ) = split( /\./, $key );
+ my ( $key_type, $alias, $host_num ) = split( m{\.}, $key );
$host_part->{$alias} = $shortname;
$host_part->{ $alias . $param->{'index'} } = $hostname;
if ( $param->{'dns_def'}->{$key} eq $vlan ) {
@@ -614,11 +620,11 @@
# Checking path for PXE elements kernel, initrd ...
my $boot_def = $DEF_SECTIONS->{'host'}->{'boot'};
foreach my $key ( keys %{$boot_def} ) {
- next if( $key =~ /^MANDATORY/ );
+ next if( $key =~ m{\A MANDATORY}xms );
my $value = $host2add->{'boot'}->{"$key\.$host_number"}
|| $host2add->{'boot'}->{$key};
unless ( $value ) {
- if ( $key =~ /^(console|cmdline)$/ ) {
+ if ( $key =~ m{\A (console|cmdline) \Z}xms ) {
$value = ( $key eq 'console' )
? $site_part->{$key}
: "";
@@ -626,7 +632,7 @@
}
next unless( $value );
if (
- $key !~ /^(console|cdline)$/
+ $key !~ m{\A (console|cdline) \Z}xms
&& ! -e $pf_config->{'path'}->{'tftp_dir'} . $value
) {
Warn( $CODE->{'OPEN'},
@@ -726,7 +732,7 @@
my $hostclass = $host2add->{'hostgroup'}->{'hosttype'} || $shortname;
my $site_list = Get_site_list( $host2add->{'hostgroup'}, $global_config );
my $pf_tftp_dir = $pf_config->{'path'}->{'tftp_dir'};
- $pf_tftp_dir .= '/' if ( $pf_tftp_dir !~ /\/$/ );
+ $pf_tftp_dir .= '/' if ( $pf_tftp_dir !~ m{/\Z} );
my ( $host_last, $node_last )
= __Get_host_indexes( $host2add->{'hostgroup'}, $hostname_model );
@@ -782,7 +788,14 @@
$site_part, $pf_config
);
my $iface_name = $iface;
- if ( $iface =~ m{\A((eth|bond)[\d]+)(\.(TAG[\d]+))\Z} ) {
+ if ( $iface =~ m{\A
+ (
+ (eth|bond)[\d]+)
+ (\.(TAG[\d]+)
+ )
+
+ \Z}xms
+ ) {
$iface_name =
$1 . '.'
. __Get_vlan_tag_from_site(
@@ -810,7 +823,7 @@
my $zone_key = "ZONE".$suffix;
my $dhcp_key = "DHCP".$suffix;
my $zone_ip = $if2add->{$ip_type};
- $zone_ip =~ s/\/.+$//;
+ $zone_ip =~ s{/.+\Z}{};
my $zone_part
= $global_config->{$zone_key}->{'BY_NAME'}
->{$zone}->{'BY_SITE'}->{$site};
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Packages.pm
--- a/lib/PFTools/Packages.pm Thu Sep 23 18:59:47 2010 +0200
+++ b/lib/PFTools/Packages.pm Mon Oct 04 13:49:20 2010 +0200
@@ -21,11 +21,9 @@
use warnings;
use base qw( Exporter );
+use Carp;
use English qw( -no_match_vars ); # Avoids regex performance penalty
use Module::Runtime qw( use_module );
-
-use PFTools::Logger;
-use PFTools::Packages::DEB;
our @EXPORT = qw(
Cmp_pkg_version
@@ -49,6 +47,9 @@
my $module_name = "PFTools::Packages::".uc( $pkg_type );
my $module;
eval { $module = use_module($module_name); };
+ if( $EVAL_ERROR ) {
+ croak qq{Unable to init package engine $module_name};
+ }
$module->import();
return 1;
}
@@ -60,8 +61,7 @@
my $result = {};
if( ! Init_pkgtype_module ( $pkg_type ) ) {
- Warn ($CODE->{'OPEN'},
- "Unable to init package engine" );
+ carp qq{ERROR: Unable to init package engine $pkg_type};
return;
}
return Pkg_status ( $pkg_name );
@@ -73,8 +73,7 @@
return unless $pkg_type;
if( ! Init_pkgtype_module ( $pkg_type ) ) {
- Warn ($CODE->{'OPEN'},
- "Unable to init package engine" );
+ carp qq{ERROR: Unable to init package engine $pkg_type};
return;
}
return Pkg_update_repository ();
@@ -86,8 +85,7 @@
return unless $pkg_type or $pkg_name;
if( ! Init_pkgtype_module ( $pkg_type ) ) {
- Warn ($CODE->{'OPEN'},
- "Unable to init package engine" );
+ carp qq{ERROR: Unable to init package engine $pkg_type};
return;
}
return Pkg_purge ( $pkg_name );
@@ -99,8 +97,7 @@
return unless $pkg_type or $pkg_name;
if( ! Init_pkgtype_module ( $pkg_type ) ) {
- Warn ($CODE->{'OPEN'},
- "Unable to init package engine" );
+ carp qq{ERROR: Unable to init package engine $pkg_type};
return;
}
return Pkg_depends ( $pkg_name );
@@ -112,8 +109,7 @@
return unless $pkg_type or $pkg_name;
if( ! Init_pkgtype_module ( $pkg_type ) ) {
- Warn ($CODE->{'OPEN'},
- "Unable to init package engine" );
+ carp qq{ERROR: Unable to init package engine $pkg_type};
return;
}
return Pkg_policy ( $pkg_name, $version );
@@ -125,8 +121,7 @@
return unless $pkg_type or $pkg_name or $version1 or $version2;
if( ! Init_pkgtype_module ( $pkg_type ) ) {
- Warn ($CODE->{'OPEN'},
- "Unable to init package engine" );
+ carp qq{ERROR: Unable to init package engine $pkg_type};
return;
}
return Pkg_compare_versions ( $pkg_name, $version1, $version2 );
@@ -138,8 +133,7 @@
return unless $pkg_type or $pkg_name;
if( ! Init_pkgtype_module ( $pkg_type ) ) {
- Warn ($CODE->{'OPEN'},
- "Unable to init package engine" );
+ carp qq{ERROR: Unable to init package engine $pkg_type};
return;
}
return Pkg_install ( $pkg_name, $version );
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Packages/DEB.pm
--- a/lib/PFTools/Packages/DEB.pm Thu Sep 23 18:59:47 2010 +0200
+++ b/lib/PFTools/Packages/DEB.pm Mon Oct 04 13:49:20 2010 +0200
@@ -22,6 +22,7 @@
use warnings;
use base qw( Exporter );
+use Carp;
use English qw( -no_match_vars ); # Avoids regex performance penalty
use IO::File;
@@ -63,28 +64,27 @@
"$PKG_CMD->{'status'} '$pkg_name' 2>/dev/null |"
)
) {
- Warn( $CODE->{'OPEN'},
- "Unable to retrieve status for package $pkg_name : $OS_ERROR" )
- if ($VERBOSE);
+ carp qq{ERROR: while getting status for $pkg_name : $OS_ERROR}
+ if( $VERBOSE );
return;
}
while (<$output_fh>) {
- if (/^Status:\s+/) {
- if ( !/^Status:\s+install\s+ok\s+installed\s*$/ ) {
+ if( m{\A Status:\s+}xms ) {
+ if ( ! m{\A Status:\s+install\s+ok\s+installed\s* \Z}xms ) {
$result->{'installed'} = 0;
}
else {
$result->{'installed'} = 1;
}
}
- if (/^Version:\s+(.+)\s*$/) {
+ if ( m{\A Version:\s+(.+)\s* \Z}xms ) {
$result->{'version'} = $1;
last;
}
}
unless( $output_fh->close() ) {
- Warn( $CODE->{'OPEN'},
- "Unable to close pkg_status command : $OS_ERROR" );
+ carp qq{ERROR: while closing pkg_status command : $OS_ERROR"}
+ if( $VERBOSE );
return;
}
return $result;
@@ -93,7 +93,7 @@
sub Pkg_update_repository {
if ( deferredlogsystem( $PKG_CMD->{'update'} ) ) {
- Warn( $CODE->{'OPEN'}, "Updating repository failed !" ) if ($VERBOSE);
+ carp q{ERROR: while updating repository !} if( $VERBOSE );
return;
}
return 1;
@@ -105,8 +105,8 @@
return unless $pkg_name;
if ( deferredlogsystem( "$PKG_CMD->{'purge'} '$pkg_name'" ) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to purge $pkg_name : $OS_ERROR" ) if ($VERBOSE);
+ carp qq{ERROR: while purging $pkg_name : $OS_ERROR"}
+ if( $VERBOSE );
return;
}
return 1;
@@ -124,17 +124,17 @@
"$PKG_CMD->{'depends'} '$pkg_name' 2>/dev/null |"
)
) {
- Warn( $CODE->{'OPEN'},
- "Unable to get depends for $pkg_name : $OS_ERROR" ) if ($VERBOSE);
- return;
+ carp qq{ERROR: while getting deps for $pkg_name : $OS_ERROR"}
+ if( $VERBOSE );
+ return;
}
- while (<$output_fh>) {
- if (m/^Depends: (.*)$/) {
- foreach my $pkg ( split( /,/, $1 ) ) {
- if ( $pkg =~ /|/ ) {
- $pkg =~ s/\([^\)]+\)//g;
- $pkg =~ s/\s+//g;
- foreach my $possible_pkg ( split( /\|/, $pkg ) ) {
+ while( <$output_fh> ) {
+ if( m{\A Depends: (.*) \Z}xms ) {
+ foreach my $pkg ( split( m{,}, $1 ) ) {
+ if ( $pkg =~ m{|} ) {
+ $pkg =~ s{\([^\)]+\)}{}g;
+ $pkg =~ s{\s+}{}g;
+ foreach my $possible_pkg ( split( m{|}, $pkg ) ) {
if ( $possible_pkg ne $pkg_name ) {
$dep_list .= " " . $possible_pkg;
}
@@ -147,13 +147,13 @@
}
}
unless( $output_fh->close() ) {
- Warn( $CODE->{'OPEN'},
- "Unable to close depends command : $OS_ERROR" ) if ($VERBOSE);
+ carp qq{ERROR: while closing depends command : $OS_ERROR"}
+ if ($VERBOSE);
return;
}
#Removing trailing spaces
- $dep_list =~ s/^\s*//;
- $dep_list =~ s/\s*$//;
+ $dep_list =~ s{\A \s*}{}xms;
+ $dep_list =~ s{\s* \Z}{}xms;
return $dep_list;
}
@@ -168,26 +168,26 @@
"$PKG_CMD->{'policy'} '$pkg_name' 2>/dev/null |"
);
unless ($output_fh) {
- Warn( $CODE->{'OPEN'},
- "Unable to get policy for package $pkg_name : $OS_ERROR"
- ) if ($VERBOSE);
+ carp qq{ERROR: while getting policy for $pkg_name : $OS_ERROR}
+ if ($VERBOSE);
return;
}
while( <$output_fh> ) {
- if (m/^ Installed: (.*)$/) {
+ chomp;
+ if( m{\A \s+Installed: (.*) \Z}xms ) {
$installed = $1;
undef $installed if ( $installed eq '' or $installed eq "(none)" );
}
- elsif (m/^ Candidate: (.*)$/) {
+ elsif( m{\A \s*Candidate: (.*) \Z}xms ) {
$available = $1;
}
- elsif ( defined $version && /\Q$version\E/ ) {
+ elsif ( defined $version && m{\Q$version\E} ) {
$specified_version = 1;
}
}
unless( $output_fh->close() ) {
- Warn( $CODE->{'OPEN'},
- "Unable to close policy command : $OS_ERROR" ) if ($VERBOSE);
+ carp qq{ERROR: while closing policy command : $OS_ERROR"}
+ if ($VERBOSE);
return;
}
return ( $installed, $available, $specified_version );
@@ -223,8 +223,8 @@
? "'$pkg_name=$version'"
: "'$pkg_name'";
if ( deferredlogsystem($install_cmd) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to install package $pkg_name : $OS_ERROR") if( $VERBOSE );
+ carp qq{ERROR while installing $pkg_name : $OS_ERROR"}
+ if( $VERBOSE );
return;
}
return 1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update.pm
--- a/lib/PFTools/Update.pm Thu Sep 23 18:59:47 2010 +0200
+++ b/lib/PFTools/Update.pm Mon Oct 04 13:49:20 2010 +0200
@@ -26,20 +26,22 @@
use warnings;
use base qw( Exporter );
+use Carp;
use English qw( -no_match_vars ); # Avoids regex performance penalty
+use Module::Runtime qw( use_module );
use PFTools::Logger;
use PFTools::Packages;
-use PFTools::Update::Addfile;
-use PFTools::Update::Addlink;
-use PFTools::Update::Addmount;
-use PFTools::Update::Common;
-use PFTools::Update::Createfile;
-use PFTools::Update::Installpkg;
-use PFTools::Update::Mkdir;
-use PFTools::Update::Purgepkg;
-use PFTools::Update::Removedir;
-use PFTools::Update::Removefile;
+#use PFTools::Update::Addfile;
+#use PFTools::Update::Addlink;
+#use PFTools::Update::Addmount;
+#use PFTools::Update::Common;
+#use PFTools::Update::Createfile;
+#use PFTools::Update::Installpkg;
+#use PFTools::Update::Mkdir;
+#use PFTools::Update::Purgepkg;
+#use PFTools::Update::Removedir;
+#use PFTools::Update::Removefile;
our @EXPORT = qw(
Get_depends_for_action
@@ -55,73 +57,65 @@
my $STARTTIME = time();
my $APT_UPDATE = 1;
+sub __Init_action_engine {
+ my ( $action ) = @_;
+
+ return unless $action;
+
+ my $module_name = "PFTools::Update::".uc( $action );
+ my $module;
+ eval { $module = use_module($module_name); };
+ if( $EVAL_ERROR ) {
+ print "$EVAL_ERROR\n";
+ croak qq{ERROR: Unable to init action engine $module_name for $action};
+ return;
+ }
+ $module->import();
+ return 1;
+}
+
sub Get_depends_for_action ($$$$) {
my ( $action, $ref_section, $dest, $options ) = @_;
- if ( $action eq "addfile" ) {
- Addfile_depends( $ref_section, $dest, $options );
+ __Init_action_engine ( $action );
+
+ # Checking parameter
+ unless( ref( $ref_section ) eq 'HASH' ) {
+ carp q{ERROR: non-hashref $ref_section};
+ return;
}
- elsif ( $action eq "apt-get" || $action eq "installpkg" ) {
- Installpkg_depends( $ref_section, $dest, $options );
+ unless( ref( $options ) eq 'HASH' ) {
+ carp q{ERROR: non-hashref $options};
+ return;
}
- elsif ( $action eq "mkdir" ) {
- Mkdir_depends( $ref_section, $dest, $options );
+ if( ref( $action ) || ref( $dest ) ) {
+ carp q{ERROR: $action and/or $dest MUST be string(s)};
+ return;
}
- elsif ( $action eq "addmount" ) {
- Addmount_depends( $ref_section, $dest, $options );
- }
- elsif ( $action eq "createfile" ) {
- Createfile_depends( $ref_section, $dest, $options );
- }
- elsif ( $action eq "addlink" ) {
- Addlink_depends( $ref_section, $dest, $options );
- }
+
+ Action_depends( $ref_section, $dest, $options );
}
sub Exec_action ($$$$$$) {
my ( $action, $ref_section, $dest, $options, $hash_subst, $global_config )
= @_;
+ __Init_action_engine ( $action );
# Adding some commons entries into substitution hash : $hash_subst
$hash_subst->{'SECTIONNAME'} = $dest;
- return 0 if ( $action eq "ignore" );
- return Addfile_action( $ref_section, $dest, $options, $hash_subst,
- $global_config )
- if ( $action eq "addfile" );
+ return 1 if ( $action eq "ignore" );
if ( $action eq "apt-get" || $action eq "installpkg" ) {
- if ($APT_UPDATE) {
- if ( !Update_pkg_repository( $options->{'pkg_type'} ) ) {
- Warn( $CODE->{'OPEN'},
- "An error occured during updating packages lists" );
- return 1;
+ if($APT_UPDATE) {
+ if( !Update_pkg_repository( $options->{'pkg_type'} ) ) {
+ carp q{An error occured during updating packages lists};
+ return;
}
$APT_UPDATE = 0;
}
- return Installpkg_action( $ref_section, $dest, $options, $hash_subst,
- $global_config )
- if ( $action eq "apt-get" || $action eq "installpkg" );
}
- return Purgepkg_action( $ref_section, $dest, $options, $hash_subst,
- $global_config )
- if ( $action eq "dpkg-purge" || $action eq "purgepkg" );
- return Mkdir_action( $ref_section, $dest, $options, $hash_subst,
- $global_config )
- if ( $action eq "mkdir" );
- return Addmount_action( $ref_section, $dest, $options, $hash_subst,
- $global_config )
- if ( $action eq "addmount" );
- return Createfile_action( $ref_section, $dest, $options, $hash_subst,
- $global_config )
- if ( $action eq "createfile" );
- return Addlink_action( $ref_section, $dest, $options, $hash_subst,
- $global_config )
- if ( $action eq "addlink" );
- return Removefile_action( $ref_section, $dest, $options, $hash_subst,
- $global_config )
- if ( $action eq "removefile" );
- return Removedir_action( $ref_section, $dest, $options, $hash_subst,
- $global_config )
- if ( $action eq "removedir" );
+ return Action_exec(
+ $ref_section, $dest, $options, $hash_subst, $global_config
+ );
}
sub __Sort_depends_prio ($$) {
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/ADDFILE.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/PFTools/Update/ADDFILE.pm Mon Oct 04 13:49:20 2010 +0200
@@ -0,0 +1,160 @@
+package PFTools::Update::ADDFILE;
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
+
+use strict;
+use warnings;
+
+use base qw( Exporter );
+use Carp;
+use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Compare;
+use File::Copy;
+use Text::Diff;
+
+use PFTools::Conf;
+use PFTools::Logger;
+use PFTools::Update::Common;
+
+our @EXPORT = qw(
+ Action_depends
+ Action_exec
+);
+
+our @EXPORT_OK = qw();
+
+sub Action_depends {
+ my ( $ref_section, $dest, $options ) = @_;
+
+ while( $dest ne "/" && $dest ne "." ) {
+ my $new_dest = dirname( $dest );
+ $ref_section->{'depends'} .= " " . $new_dest
+ if ( $new_dest ne "." && $new_dest ne "/" );
+ $dest = $new_dest;
+ }
+}
+
+sub Action_exec {
+ my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
+ my ( $source, $tmp, $cmp );
+
+ my $diff = 0;
+ $hash_subst->{'SECTIONNAME'} = $dest;
+ $tmp = Get_tmp_dest( $dest );
+ # Removing trailing space from source
+ $ref_section->{'source'} =~ s{\A\s*}{};
+ $ref_section->{'source'} =~ s{\s*\Z}{};
+ if ( $ref_section->{'source'} =~ m{\s} ) {
+ $source = Get_tmp_dest($dest) . ".merged";
+ unlink( $source );
+ my $splitsource;
+ foreach $splitsource ( split( ' ', $ref_section->{'source'} ) ) {
+ $splitsource = Get_source(
+ $splitsource,
+ $options->{'host'},
+ $hash_subst
+ );
+ if( !-f $splitsource ) {
+ carp qq{ERROR: $splitsource no such file or directory};
+ return;
+ }
+ if( deferredlogsystem(
+ "cat '" . $splitsource . "' >> " . $source
+ )
+ ) {
+ carp qq{ERROR: Unable to append $splitsource to $source};
+ return;
+ }
+ }
+ }
+ else {
+ $source = Get_source(
+ $ref_section->{'source'}, $options->{'host'}, $hash_subst
+ );
+ }
+
+ if( !-e $source ) {
+ carp qq{ERROR: $source no such file or directory};
+ return;
+ }
+ $hash_subst->{'SOURCE'} = $source;
+ $hash_subst->{'DESTINATION'} = $tmp;
+ if( defined( $ref_section->{'filter'} ) ) {
+ my $filter = Subst_vars( $ref_section->{'filter'}, $hash_subst );
+ if ( deferredlogsystem( $filter ) ) {
+ carp qq{ERROR: Unable to apply filter $filter};
+ return;
+ }
+ }
+ else {
+ unless( copy( $source, $tmp ) ) {
+ carp qq{ERROR: Unable to copy $source to $tmp};
+ return;
+ }
+ }
+
+ if( !-f $tmp ) {
+ carp qq{ERROR: Unable to open $tmp};
+ return;
+ }
+
+ if( compare( $tmp, $dest ) ) {
+ $diff = 1;
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+ if ( $options->{'diff'} ) {
+ if( !-e $dest ) {
+ print diff ( [], $tmp, { STYLE => "Unified" } );
+ }
+ else {
+ print diff ( $dest, $tmp, { STYLE => "Unified" } );
+ }
+ }
+ print "on_config ...\n";
+ Do_on_config( $ref_section, $options, $hash_subst ) or return;
+ print "before_change ...\n";
+ Do_before_change( $ref_section, $options, $hash_subst ) or return;
+ if( ! $options->{'simul'} ) {
+ # Fuck dpkg conffiles
+ if ( $options->{'noaction'}
+ && -e $dest
+ && !-e $dest . '.dpkg-dist'
+ ) {
+ copy( $dest, $dest . '.dpkg-dist' );
+ }
+ Do_moveold( $dest, $options );
+ if ( ! Mk_dest_dir( $dest ) || ! copy( $tmp, $dest ) ) {
+ carp qq{ERROR: Unable to copy file $tmp to $dest};
+ return;
+ }
+ Do_chownmod( $ref_section, $dest, $options );
+ }
+ if( $diff ) {
+ print "after_change ...\n";
+ Do_after_change( $ref_section, $options, $hash_subst ) or return;
+ print "on_noaction ...\n";
+ Do_on_noaction( $ref_section, $options, $hash_subst ) or return;
+ }
+ }
+ return 1;
+}
+
+1;
+
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/ADDLINK.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/PFTools/Update/ADDLINK.pm Mon Oct 04 13:49:20 2010 +0200
@@ -0,0 +1,88 @@
+package PFTools::Update::ADDLINK;
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
+
+use strict;
+use warnings;
+
+use base qw( Exporter );
+use Carp;
+use English qw( -no_match_vars ); # Avoids regex performance penalty
+
+use PFTools::Conf;
+use PFTools::Logger;
+use PFTools::Update::Common;
+
+our @EXPORT = qw(
+ Action_depends
+ Action_exec
+);
+
+our @EXPORT_OK = qw();
+
+sub Action_depends {
+ my ( $ref_section, $dest, $options ) = @_;
+
+ while ( $dest ne "/" && $dest ne "." ) {
+ $ref_section->{'depends'} .= " " . dirname( $dest );
+ $dest = dirname( $dest );
+ }
+}
+
+sub Action_exec {
+ my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
+
+ $hash_subst->{'SECTIONNAME'} = $dest;
+ my $source = Subst_vars( $ref_section->{'source'}, $hash_subst );
+
+ # Need to check the source ...
+ my $dep_src = $source;
+ while ( $dep_src ne "/" && $dep_src ne "." ) {
+ $ref_section->{'depends'} .= " " . dirname( $dep_src );
+ $dep_src = dirname( $dep_src );
+ }
+ if ( ! -l $dest || ( -l $dest && readlink( $dest ) ne $source ) ) {
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+ if ( $options->{'diff'} ) {
+ if ( -l $dest ) {
+ Log( "( readlink = " . readlink($dest) . ")" );
+ }
+ else {
+ Log( "( ! -l " . $dest . ")" );
+ }
+ }
+ Do_on_config( $ref_section, $options, $hash_subst ) or return;
+ Do_before_change( $ref_section, $options, $hash_subst ) or return;
+ if ( !$options->{'simul'} ) {
+ Do_moveold( $dest, $options );
+ if ( ! Mk_dest_dir($dest) || ! ln_sfn( $source, $dest ) ) {
+ carp qq{ERROR: Unable to symlink $dest to $source};
+ return;
+ }
+ }
+ Do_after_change( $ref_section, $options, $hash_subst ) or return;
+ Do_on_noaction( $ref_section, $options, $hash_subst ) or return;
+ }
+ return 1;
+}
+
+1;
+
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/ADDMOUNT.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/PFTools/Update/ADDMOUNT.pm Mon Oct 04 13:49:20 2010 +0200
@@ -0,0 +1,344 @@
+package PFTools::Update::ADDMOUNT;
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
+
+use strict;
+use warnings;
+
+use base qw( Exporter );
+use Carp;
+use English qw( -no_match_vars ); # Avoids regex performance penalty
+use IO::File;
+use File::Copy;
+use File::Path qw( make_path );
+use Text::Diff;
+
+use PFTools::Conf;
+use PFTools::Disk;
+use PFTools::Logger;
+use PFTools::Net;
+use PFTools::Parser;
+use PFTools::Structqueries;
+use PFTools::Update::Common;
+#use PFTools::Update::Mkdir;
+
+our @EXPORT = qw(
+ Action_depends
+ Action_exec
+);
+# Addmount_depends
+# Addmount_action
+
+our @EXPORT_OK = qw();
+
+###############################################
+# Constants
+
+my $DEFAULT_FSTYPE = 'nfs';
+my $DEFAULT_OPTIONS = 'defaults,noexec,nosuid,nodev,hard,intr';
+
+###############################################
+# Functions
+
+sub Action_depends {
+ my ( $ref_section, $dest, $options ) = @_;
+
+ while ( $dest ne "/" && $dest ne "." ) {
+ $ref_section->{'depends'} .= " " . dirname( $dest );
+ $dest = dirname( $dest );
+ }
+}
+
+sub __Get_ip_host_from_GLOBAL {
+ my ( $host, $global_config ) = @_;
+
+ my $ip = $host;
+ $host =~ m{\A ([^\.]+)(\..*)? \Z}xms;
+ my $zone = Get_zone_from_hostname( $1, $global_config );
+ unless( $zone ) {
+ carp qq{ERROR: Unable to retrieve zone for $host};
+ return;
+ }
+ $ip =~ s{\.$zone \Z}{}xms;
+ $ip =~ m{\A ([^.]+)(\.([^.]+))? \Z}xms;
+ my ( $hostshort, $hostvlan ) = ( $1, $3 );
+ my $hosttype = Get_hosttype_from_hostname( $hostshort, $global_config );
+ unless( $hosttype ) {
+ carp qq{ERROR: Unable to retrieve hosttype for $host};
+ return;
+ }
+ my $site_list = Get_site_from_hostname( $hostshort, $global_config );
+ my $site;
+ if ( ! defined $site_list || scalar @{$site_list} > 1 ) {
+ carp qq{ERROR: Unknown or multiple site for $host};
+ return;
+ }
+ else {
+ $site = shift @{$site_list};
+ }
+ if( ! isipaddr( $ip ) ) {
+ my $resolved = Resolv_hostname_from_GLOBAL(
+ $ip, $global_config, $site, $zone, $hosttype
+ );
+ if ( ! defined $resolved || scalar @{$resolved} > 1 ) {
+ carp qq{ERROR: Unknown or multiple IPs for $host};
+ return;
+ }
+ else {
+ $ip = shift @{$resolved};
+ }
+ }
+ return $ip;
+}
+
+sub __Resolve_fstab_entry {
+ my ( $param ) = @_;
+
+ 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 )
+ {
+ foreach my $key ( 'source', 'options' ) {
+ my $value
+ = ( $key eq 'options' )
+ ? $fs_entry->{$key} || $DEFAULT_OPTIONS
+ : $fs_entry->{$key};
+ my $val_addr = $value;
+ my $regex
+ = ( $key eq 'options' )
+ ? '^(?<pre>.*,)?(ip=(?<ip>[^,]+))?(?<suf>,.*)?$'
+ : '^(?<ip>[^\:]+):(?<suf>.+)$';
+ $val_addr =~ s{$regex}{$+{ip}};
+ if ( defined $val_addr && $val_addr ne $value ) {
+ my $val_ip = __Get_ip_host_from_GLOBAL( $val_addr,
+ $param->{'global_config'} );
+ return unless( $val_ip );
+ $regex
+ = ( $key eq 'options' )
+ ? '^(?<pre>(.*,)?(ip=)?)(?<ip>[^,]+)?(?<suf>,.*)?$'
+ : '^(?<pre>\s*)(?<ip>[^\:]+):(?<suf>.+)$';
+ $value =~ s{$regex}{$+{pre}$val_ip$+{suf}};
+ }
+ $fs_entry->{$key} = $value;
+ }
+ }
+ return 1;
+}
+
+sub __Build_fstab_entry_from_config {
+ my ($param) = @_;
+
+ my $fs_entry = $param->{'ref_section'};
+ $fs_entry->{'dest'} = $param->{'dest'};
+ foreach my $key ( 'source', 'options' ) {
+ $fs_entry->{$key}
+ = Subst_vars( $fs_entry->{$key}, $param->{'subst'} );
+ }
+ my $resolve_param = {
+ 'fs_entry' => $fs_entry,
+ 'global_config' => $param->{'global_config'}
+ };
+ if ( ! __Resolve_fstab_entry($resolve_param) ) {
+ return;
+ }
+ return $fs_entry;
+}
+
+sub Action_exec {
+ my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
+
+ $hash_subst->{'SECTIONNAME'} = $dest;
+
+ # Source
+ my $add_mount = __Build_fstab_entry_from_config(
+ { 'dest' => $dest,
+ 'subst' => $hash_subst,
+ 'global_config' => $global_config,
+ 'ref_section' => $ref_section
+ }
+ );
+ unless( $add_mount ) {
+ carp qq{ERROR: Unable to build addmount entry $dest};
+ return;
+ }
+ $hash_subst->{'SOURCE'} = $add_mount->{'source'};
+ $hash_subst->{'OPTIONS'}
+ = join( ',', sort split( ',', $add_mount->{'options'} ) );
+ $hash_subst->{'FSTYPE'} = $ref_section->{'fstype'} || $DEFAULT_FSTYPE;
+
+ my $current_fstab = Build_structure_from_fstab( "/etc/fstab" );
+ unless( $current_fstab ) {
+ carp q{ERROR: Unable to build fstab structure from file /etc/fstab};
+ return;
+ }
+ my $current_proc = Build_structure_from_fstab( "/proc/mounts" );
+ unless( $current_fstab ) {
+ carp q{ERROR: Unable to build fstab structure from file /proc/mounts};
+ return;
+ }
+ my $addfstab = 0;
+ if ( ! defined $current_fstab->{$dest} ) {
+ foreach
+ my $key ( 'source', 'dest', 'fstype', 'options', 'dump', 'pass' )
+ {
+ $current_fstab->{$dest}->{$key} = $add_mount->{$key} || 0;
+ }
+ push( @{ $current_fstab->{'__mnt_order'} }, $dest );
+ $addfstab = 1;
+ }
+ else {
+ foreach my $key ( 'source', 'dest', 'fstype', 'options' ) {
+ if ( $add_mount->{$key} ne $current_fstab->{$dest}->{$key} ) {
+ $current_fstab->{$dest}->{$key} = $add_mount->{$key};
+ $addfstab = 1;
+ }
+ }
+ }
+
+ my $addproc = 0;
+ if ( !defined $current_proc->{$dest} ) {
+ $addproc = 1;
+ }
+ else {
+ my $fs_proc = $current_proc->{$dest};
+ foreach my $key ( 'source', 'dest', 'fstype', 'options' ) {
+ if ( $key eq 'options' ) {
+ $addproc = 1
+ if (
+ $add_mount->{$key} ne $current_fstab->{$dest}->{$key} );
+ }
+ else {
+ $addproc = 1
+ if (
+ $add_mount->{$key} ne $current_proc->{$dest}->{$key} );
+ }
+ }
+ }
+
+ if ( $addfstab || $addproc || !-d $dest ) {
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+ Do_on_config( $ref_section, $options, $hash_subst ) or return;
+ Do_before_change( $ref_section, $options, $hash_subst ) or return;
+ if ( ! -d $dest && $dest ne 'none' ) {
+ unless( make_path( $dest ) ) {
+ carp qq{ERROR: while creating mountpoints $dest};
+ return;
+ }
+ }
+ if( $addfstab ) {
+ my $tmp = Get_tmp_dest( "/etc/fstab" );
+ my $output_fh;
+ unless( $output_fh = IO::File->new ( '>'. $tmp ) ) {
+ carp qq{ERROR: Unable to create tmp $tmp : $OS_ERROR};
+ return;
+ }
+ my $new_fstab = Build_fstab_from_structure( $current_fstab );
+ unless( print $output_fh join "\n", @{$new_fstab} ) {
+ carp qq{ERROR: Unable to write on tmp $tmp : $OS_ERROR"};
+ return;
+ }
+ unless( $output_fh->close() ) {
+ carp qq{ERROR: Unable to close tmp $tmp : $OS_ERROR"};
+ return;
+ }
+ if( $options->{'diff'} ) {
+ print diff ( '/etc/fstab', $tmp, { STYLE => 'Unified' } );
+ }
+ if( ! $options->{'simul'} ) {
+ if ( ! move( $tmp, "/etc/fstab" ) ) {
+ carp qq{ERROR: Unable to move $tmp to /etc/fstab};
+ return;
+ }
+ }
+ }
+ if( $addproc ) {
+ my $remount = 1;
+ if( defined $current_proc->{$dest} ) {
+ foreach my $key ( 'source', 'dest', 'fstype' ) {
+ $remount = 0
+ if ( $add_mount->{$key} ne
+ $current_proc->{$dest}->{$key} );
+ }
+ }
+ if( $options->{'diff'} ) {
+ foreach my $key ( 'source', 'dest', 'fstype', 'options' ) {
+ my $value = $current_proc->{$dest}->{$key} || '?';
+ if( $key eq 'options' ) {
+ Log( $key . " "
+ . $value . " -> "
+ . $add_mount->{$key} )
+ if ( $current_fstab->{$dest}->{$key} ne
+ $add_mount->{$key}
+ || ! defined $current_proc->{$dest}->{$key} );
+ }
+ else {
+ Log( $key . " "
+ . $value . " -> "
+ . $add_mount->{$key} )
+ if ( $value ne $add_mount->{$key} );
+ }
+ }
+ }
+ if( ! $options->{'simul'} && !$options->{'noaction'} ) {
+ if( $remount ) {
+ my $cmd
+ = "mount -o 'remount,"
+ . $add_mount->{'options'} . "' '"
+ . $dest . "'";
+ if ( deferredlogsystem( $cmd ) ) {
+ carp qq{ERROR: while remounting $dest with
+ $add_mount->{'options'}
+ };
+ return;
+ }
+ }
+ else {
+ my $umount
+ = ( $add_mount->{'source'} ne
+ $current_proc->{$dest}->{'source'} )
+ ? $current_proc->{$dest}->{'source'}
+ : $add_mount->{'source'};
+ if ( deferredlogsystem( "umount '" . $umount . "'" ) ) {
+ carp qq{ERROR: Unable to unmount $umount};
+ return;
+ }
+ my $mount_cmd
+ = "mount -t '"
+ . $add_mount->{'fstype'}
+ . "' - o '"
+ . $add_mount->{'options'} . "' '"
+ . $add_mount->{'source'} . "' '"
+ . $add_mount->{'dest'} . "'";
+ if ( deferredlogsystem($mount_cmd) ) {
+ carp qq{ERROR: while mounting $dest with $mount_cmd};
+ return;
+ }
+ }
+ }
+ }
+ Do_after_change( $ref_section, $options, $hash_subst ) or return;
+ Do_on_noaction( $ref_section, $options, $hash_subst ) or return;
+ }
+ return 1;
+}
+
+1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/Addfile.pm
--- a/lib/PFTools/Update/Addfile.pm Thu Sep 23 18:59:47 2010 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,152 +0,0 @@
-package PFTools::Update::Addfile;
-
-#
-# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-#
-
-use strict;
-use warnings;
-
-use base qw( Exporter );
-use English qw( -no_match_vars ); # Avoids regex performance penalty
-use File::Compare;
-use File::Copy;
-use Text::Diff;
-
-use PFTools::Conf;
-use PFTools::Logger;
-use PFTools::Update::Common;
-
-our @EXPORT = qw(
- Addfile_depends
- Addfile_action
-);
-
-our @EXPORT_OK = qw();
-
-sub Addfile_depends ($$$) {
- my ( $ref_section, $dest, $options ) = @_;
-
- while ( $dest ne "/" && $dest ne "." ) {
- my $new_dest = dirname($dest);
- $ref_section->{'depends'} .= " " . $new_dest
- if ( $new_dest ne "." && $new_dest ne "/" );
- $dest = $new_dest;
- }
-}
-
-sub Addfile_action ($$$$$) {
- my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
- my ( $source, $tmp, $cmp );
-
- my $diff = 0;
- $hash_subst->{'SECTIONNAME'} = $dest;
- if ( $ref_section->{'source'} =~ /\s/ ) {
- $source = Get_tmp_dest($dest) . ".merged";
- unlink($source);
- my $splitsource;
- foreach $splitsource ( split( ' ', $ref_section->{'source'} ) ) {
- $splitsource
- = Get_source( $splitsource, $options->{'host'}, $hash_subst );
- if ( !-f $splitsource ) {
- Warn( $CODE->{'OPEN'}, "Unable to open " . $splitsource );
- return 1;
- }
- if (deferredlogsystem(
- "cat '" . $splitsource . "' >> " . $source
- )
- )
- {
- Warn( $CODE->{'EXEC'},
- "Unable to append file " . $splitsource . " to " . $tmp );
- return 1;
- }
- }
- }
- else {
- $source = Get_source( $ref_section->{'source'},
- $options->{'host'}, $hash_subst );
- }
-
- if ( !-e $source ) {
- Warn( $CODE->{'OPEN'}, $source . " : no such file or directory" );
- return 1;
- }
- $hash_subst->{'SOURCE'} = $source;
- $tmp = Get_tmp_dest($dest);
- $hash_subst->{'DESTINATION'} = $tmp;
- if ( defined( $ref_section->{'filter'} ) ) {
- my $filter = Subst_vars( $ref_section->{'filter'}, $hash_subst );
- if ( deferredlogsystem($filter) ) {
- Warn( $CODE->{'OPEN'}, "Unable to apply filter " . $filter );
- return 1;
- }
- }
- else {
- if ( !copy( $source, $tmp ) ) {
- Warn( $CODE->{'COPY'},
- "Unable to copy " . $source . " to " . $tmp );
- return 1;
- }
- }
-
- if ( !-f $tmp ) {
- Warn( $CODE->{'OPEN'}, "Unable to open " . $tmp );
- return 1;
- }
- elsif ( compare( $tmp, $dest ) ) {
- $diff = 1;
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
- if ( $options->{'diff'} ) {
- if ( !-e $dest ) {
- print diff ( [], $tmp, { STYLE => "Unified" } );
- }
- else {
- print diff ( $dest, $tmp, { STYLE => "Unified" } );
- }
- }
- Do_on_config( $ref_section, $options, $hash_subst ) && return 1;
- Do_before_change( $ref_section, $options, $hash_subst ) && return 1;
- if ( !$options->{'simul'} ) {
-
- # Fuck dpkg conffiles
- if ( $options->{'noaction'}
- && -e $dest
- && !-e $dest . '.dpkg-dist' )
- {
- copy( $dest, $dest . '.dpkg-dist' );
- }
- Do_moveold( $dest, $options );
- if ( !Mk_dest_dir($dest) || !copy( $tmp, $dest ) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to copy file " . $tmp . " to " . $dest );
- return 1;
- }
- Do_chownmod( $ref_section, $dest, $options );
- }
- if ($diff) {
- Do_after_change( $ref_section, $options, $hash_subst )
- && return 1;
- Do_on_noaction( $ref_section, $options, $hash_subst ) && return 1;
- }
- }
- return 0;
-}
-
-1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/Addlink.pm
--- a/lib/PFTools/Update/Addlink.pm Thu Sep 23 18:59:47 2010 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,87 +0,0 @@
-package PFTools::Update::Addlink;
-
-#
-# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-#
-
-use strict;
-use warnings;
-
-use base qw( Exporter );
-use English qw( -no_match_vars ); # Avoids regex performance penalty
-
-use PFTools::Conf;
-use PFTools::Logger;
-use PFTools::Update::Common;
-
-our @EXPORT = qw(
- Addlink_depends
- Addlink_action
-);
-
-our @EXPORT_OK = qw();
-
-sub Addlink_depends ($$$) {
- my ( $ref_section, $dest, $options ) = @_;
-
- while ( $dest ne "/" && $dest ne "." ) {
- $ref_section->{'depends'} .= " " . dirname($dest);
- $dest = dirname($dest);
- }
-}
-
-sub Addlink_action ($$$$$) {
- my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
-
- $hash_subst->{'SECTIONNAME'} = $dest;
- my $source = Subst_vars( $ref_section->{'source'}, $hash_subst );
-
- # Need to check the source ...
- my $dep_src = $source;
- while ( $dep_src ne "/" && $dep_src ne "." ) {
- $ref_section->{'depends'} .= " " . dirname($dep_src);
- $dep_src = dirname($dep_src);
- }
- if ( !-l $dest || ( -l $dest && readlink($dest) ne $source ) ) {
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
- if ( $options->{'diff'} ) {
- if ( -l $dest ) {
- Log( "( readlink = " . readlink($dest) . ")" );
- }
- else {
- Log( "( ! -l " . $dest . ")" );
- }
- }
- Do_on_config( $ref_section, $options, $hash_subst ) && return 1;
- Do_before_change( $ref_section, $options, $hash_subst ) && return 1;
- if ( !$options->{'simul'} ) {
- Do_moveold( $dest, $options );
- if ( !Mk_dest_dir($dest) || ln_sfn( $source, $dest ) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to symlink " . $dest . " to " . $source );
- return 1;
- }
- }
- Do_after_change( $ref_section, $options, $hash_subst ) && return 1;
- Do_on_noaction( $ref_section, $options, $hash_subst ) && return 1;
- }
- return 0;
-}
-
-1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/Addmount.pm
--- a/lib/PFTools/Update/Addmount.pm Thu Sep 23 18:59:47 2010 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,365 +0,0 @@
-package PFTools::Update::Addmount;
-
-#
-# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-#
-
-use strict;
-use warnings;
-
-use base qw( Exporter );
-use English qw( -no_match_vars ); # Avoids regex performance penalty
-use IO::File;
-use File::Copy;
-use Text::Diff;
-
-use PFTools::Conf;
-use PFTools::Disk;
-use PFTools::Logger;
-use PFTools::Net;
-use PFTools::Parser;
-use PFTools::Structqueries;
-use PFTools::Update::Common;
-use PFTools::Update::Mkdir;
-
-our @EXPORT = qw(
- Addmount_depends
- Addmount_action
-);
-
-our @EXPORT_OK = qw();
-
-###############################################
-# Constants
-
-my $DEFAULT_FSTYPE = 'nfs';
-my $DEFAULT_OPTIONS = 'defaults,noexec,nosuid,nodev,hard,intr';
-
-###############################################
-# Functions
-
-sub Addmount_depends ($$$) {
- my ( $ref_section, $dest, $options ) = @_;
-
- while ( $dest ne "/" && $dest ne "." ) {
- $ref_section->{'depends'} .= " " . dirname($dest);
- $dest = dirname($dest);
- }
-}
-
-sub __Get_ip_host_from_GLOBAL ($$) {
- my ( $host, $global_config ) = @_;
-
- my $ip = $host;
- $host =~ /^([^\.]+)(\..*)?$/;
- my $zone = Get_zone_from_hostname( $1, $global_config );
- if ( !defined $zone ) {
- Warn( $CODE->{'UNDEF_KEY'},
- "Unable to retrieve zone for hostname " . $host );
- return undef;
- }
- $ip =~ s/\.$zone$//;
- $ip =~ /^([^.]+)(\.([^.]+))?$/;
- my ( $hostshort, $hostvlan ) = ( $1, $3 );
- my $hosttype = Get_hosttype_from_hostname( $hostshort, $global_config );
- if ( !defined $hosttype ) {
- Warn( $CODE->{'UNDEF_KEY'},
- "Unable to retrieve hosttype for hostname " . $host );
- return undef;
- }
- my $site_list = Get_site_from_hostname( $hostshort, $global_config );
- my $site;
- if ( !defined $site_list || scalar @{$site_list} > 1 ) {
- Warn( $CODE->{'UNDEF_KEY'},
- "Unable to retrieve site for hostname "
- . $host
- . " : unknown or multiple declaration" );
- return undef;
- }
- else {
- $site = shift @{$site_list};
- }
- if ( !isipaddr($ip) ) {
- my $resolved
- = Resolv_hostname_from_GLOBAL( $ip, $global_config, $site, $zone,
- $hosttype );
- if ( !defined $resolved ) {
- Warn( $CODE->{'RESOLV'}, "Unknown host " . $host );
- return undef;
- }
- elsif ( scalar @{$resolved} > 1 ) {
- Warn( $CODE->{'RESOLV'},
- "Multiple response for "
- . $host
- . " : unable to choose the right one" );
- return undef;
- }
- else {
- $ip = shift @{$resolved};
- }
- }
- return $ip;
-}
-
-sub __Resolve_fstab_entry ($) {
- my ($param) = @_;
-
- my $pf_config = Init_PF_CONFIG();
- my $fs_entry = $param->{'fs_entry'};
- if ( $fs_entry->{'fstype'}
- =~ /^$pf_config->{'regex'}->{'network_fstype'}$/ )
- {
- foreach my $key ( 'source', 'options' ) {
- my $value
- = ( $key eq 'options' )
- ? $fs_entry->{$key} || $DEFAULT_OPTIONS
- : $fs_entry->{$key};
- my $val_addr = $value;
- my $regex
- = ( $key eq 'options' )
- ? '^(?<pre>.*,)?(ip=(?<ip>[^,]+))?(?<suf>,.*)?$'
- : '^(?<ip>[^\:]+):(?<suf>.+)$';
- $val_addr =~ s/$regex/$+{ip}/;
- if ( defined $val_addr && $val_addr ne $value ) {
- my $val_ip = __Get_ip_host_from_GLOBAL( $val_addr,
- $param->{'global_config'} );
- return 1 if ( !defined $val_ip );
- $regex
- = ( $key eq 'options' )
- ? '^(?<pre>(.*,)?(ip=)?)(?<ip>[^,]+)?(?<suf>,.*)?$'
- : '^(?<pre>\s*)(?<ip>[^\:]+):(?<suf>.+)$';
- $value =~ s/$regex/$+{pre}$val_ip$+{suf}/;
- }
- $fs_entry->{$key} = $value;
- }
- }
- return 0;
-}
-
-sub __Build_fstab_entry_from_config {
- my ($param) = @_;
-
- my $fs_entry = $param->{'ref_section'};
- $fs_entry->{'dest'} = $param->{'dest'};
- foreach my $key ( 'source', 'options' ) {
- $fs_entry->{$key}
- = Subst_vars( $fs_entry->{$key}, $param->{'subst'} );
- }
- my $resolve_param = {
- 'fs_entry' => $fs_entry,
- 'global_config' => $param->{'global_config'}
- };
- if ( __Resolve_fstab_entry($resolve_param) ) {
- return undef;
- }
- return $fs_entry;
-}
-
-sub Addmount_action ($$$$$) {
- my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
-
- $hash_subst->{'SECTIONNAME'} = $dest;
-
- # Source
- my $add_mount = __Build_fstab_entry_from_config(
- { 'dest' => $dest,
- 'subst' => $hash_subst,
- 'global_config' => $global_config,
- 'ref_section' => $ref_section
- }
- );
- return 1 if ( !defined $add_mount );
- $hash_subst->{'SOURCE'} = $add_mount->{'source'};
- $hash_subst->{'OPTIONS'}
- = join( ',', sort split( ',', $add_mount->{'options'} ) );
- $hash_subst->{'FSTYPE'} = $ref_section->{'fstype'} || $DEFAULT_FSTYPE;
-
- my $current_fstab = Build_structure_from_fstab("/etc/fstab");
- if ( !defined $current_fstab ) {
- Warn( $CODE->{'UNDEF_KEY'},
- "Unable to build fstab structure from file /etc/fstab" );
- return undef;
- }
- my $current_proc = Build_structure_from_fstab("/proc/mounts");
- if ( !defined $current_fstab ) {
- Warn( $CODE->{'UNDEF_KEY'},
- "Unable to build fstab structure from file /proc/mounts" );
- return undef;
- }
- my $addfstab = 0;
- if ( !defined $current_fstab->{$dest} ) {
- foreach
- my $key ( 'source', 'dest', 'fstype', 'options', 'dump', 'pass' )
- {
- $current_fstab->{$dest}->{$key}
- = ( defined $add_mount->{$key} )
- ? $add_mount->{$key}
- : 0;
- }
- push( @{ $current_fstab->{'__mnt_order'} }, $dest );
- $addfstab = 1;
- }
- else {
- foreach my $key ( 'source', 'dest', 'fstype', 'options' ) {
- if ( $add_mount->{$key} ne $current_fstab->{$dest}->{$key} ) {
- $current_fstab->{$dest}->{$key} = $add_mount->{$key};
- $addfstab = 1;
- }
- }
- }
-
- my $addproc = 0;
- if ( !defined $current_proc->{$dest} ) {
- $addproc = 1;
- }
- else {
- my $fs_proc = $current_proc->{$dest};
- foreach my $key ( 'source', 'dest', 'fstype', 'options' ) {
- if ( $key eq 'options' ) {
- $addproc = 1
- if (
- $add_mount->{$key} ne $current_fstab->{$dest}->{$key} );
- }
- else {
- $addproc = 1
- if (
- $add_mount->{$key} ne $current_proc->{$dest}->{$key} );
- }
- }
- }
-
- if ( $addfstab || $addproc || !-d $dest ) {
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
- Do_on_config( $ref_section, $options, $hash_subst ) && return 1;
- Do_before_change( $ref_section, $options, $hash_subst ) && return 1;
- if ( !-d $dest && $dest ne 'none' ) {
- Mkdir_action( $ref_section, $dest, $options, $hash_subst,
- $global_config );
- }
- if ($addfstab) {
- my $tmp = Get_tmp_dest("/etc/fstab");
- my $output_fh;
- unless ( $output_fh = IO::File->new ( '>'. $tmp ) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to create tmp destination $tmp : $OS_ERROR " );
- return 1;
- }
- my $new_fstab = Build_fstab_from_structure($current_fstab);
- unless ( print $output_fh join "\n", @{$new_fstab} ) {
- Warn( $CODE->{'OPEN'},
- "Unable to write on tmp destination $tmp : $OS_ERROR" );
- return 1;
- }
- unless ( $output_fh->close() ) {
- Warn ( $CODE->{'OPEN'},
- "Unable to close tmp destination $tmp : $OS_ERROR" );
- return 1;
- }
- if ( $options->{'diff'} ) {
- print diff ( '/etc/fstab', $tmp, { STYLE => 'Unified' } );
- }
- if ( !$options->{'simul'} ) {
- if ( !move( $tmp, "/etc/fstab" ) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to move new fstab "
- . $tmp
- . " to /etc/fstab" );
- return 1;
- }
- }
- }
- if ($addproc) {
- my $remount = 1;
- if ( defined $current_proc->{$dest} ) {
- foreach my $key ( 'source', 'dest', 'fstype' ) {
- $remount = 0
- if ( $add_mount->{$key} ne
- $current_proc->{$dest}->{$key} );
- }
- }
- if ( $options->{'diff'} ) {
- foreach my $key ( 'source', 'dest', 'fstype', 'options' ) {
- my $value = $current_proc->{$dest}->{$key} || '?';
- if ( $key eq 'options' ) {
- Log( $key . " "
- . $value . " -> "
- . $add_mount->{$key} )
- if ( $current_fstab->{$dest}->{$key} ne
- $add_mount->{$key}
- || !defined $current_proc->{$dest}->{$key} );
- }
- else {
- Log( $key . " "
- . $value . " -> "
- . $add_mount->{$key} )
- if ( $value ne $add_mount->{$key} );
- }
- }
- }
- if ( !$options->{'simul'} && !$options->{'noaction'} ) {
- if ($remount) {
- my $cmd
- = "mount -o 'remount,"
- . $add_mount->{'options'} . "' '"
- . $dest . "'";
- if ( deferredlogsystem($cmd) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to remount "
- . $dest
- . " with options "
- . $add_mount->{'options'} );
- return 1;
- }
- }
- else {
- my $umount
- = ( $add_mount->{'source'} ne
- $current_proc->{$dest}->{'source'} )
- ? $current_proc->{$dest}->{'source'}
- : $add_mount->{'source'};
- if ( deferredlogsystem( "umount '" . $umount . "'" ) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to unmount " . $umount );
- return 1;
- }
- my $mount_cmd
- = "mount -t '"
- . $add_mount->{'fstype'}
- . "' - o '"
- . $add_mount->{'options'} . "' '"
- . $add_mount->{'source'} . "' '"
- . $add_mount->{'dest'} . "'";
- if ( deferredlogsystem($mount_cmd) ) {
- Warn( $CODE->{'EXEC'},
- "Unable to mount "
- . $dest
- . " with command "
- . $mount_cmd );
- return 1;
- }
- }
- }
- }
- Do_after_change( $ref_section, $options, $hash_subst ) && return 1;
- Do_on_noaction( $ref_section, $options, $hash_subst ) && return 1;
- }
- return 0;
-}
-
-1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/CREATEFILE.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/PFTools/Update/CREATEFILE.pm Mon Oct 04 13:49:20 2010 +0200
@@ -0,0 +1,103 @@
+package PFTools::Update::CREATEFILE;
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
+
+use strict;
+use warnings;
+
+use base qw( Exporter );
+use Carp;
+use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Copy;
+
+use PFTools::Conf;
+use PFTools::Logger;
+use PFTools::Update::Common;
+
+our @EXPORT = qw(
+ Action_depends
+ Action_exec
+);
+
+our @EXPORT_OK = qw();
+
+sub Action_depends {
+ my ( $ref_section, $dest, $options ) = @_;
+
+ while ( $dest ne "/" && $dest ne "." ) {
+ $ref_section->{'depends'} .= " " . dirname($dest);
+ $dest = dirname($dest);
+ }
+}
+
+sub Action_exec {
+ my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
+
+ $hash_subst->{'SECTIONNAME'} = $dest;
+ my $tmp = Get_tmp_dest( $dest );
+ $hash_subst->{'DESTINATION'} = $tmp;
+ unless( -f $dest ) {
+ if( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+ if( ! defined $ref_section->{'source'} ) {
+ # Creating an empty tmp destination
+ if( deferredlogsystem( "/usr/bin/touch '$tmp'" ) ) {
+ carp qq{ERROR: Unable to touch $tmp};
+ return;
+ }
+ }
+ else {
+ my $source = Get_source(
+ $ref_section->{'source'}, $hash_subst->{'HOSTNAME'},
+ $hash_subst
+ );
+ # Creating tmp destination from source
+ unless( -f $source ) {
+ carp qq{ERROR: Unable to open source $source};
+ return;
+ }
+ if ( defined( $ref_section->{'filter'} ) ) {
+ my $filter = Subst_vars( $ref_section->{'filter'}, $hash_subst );
+ if( deferredlogsystem( $filter ) ) {
+ carp qq{ERROR: Unable to apply filter $filter};
+ return;
+ }
+ }
+ else {
+ if( !copy( $source, $tmp ) ) {
+ carp qq{ERROR: Unable to copy $source to $tmp};
+ return;
+ }
+ }
+ }
+ Do_on_config( $ref_section, $options, $hash_subst ) or return;
+ Do_before_change( $ref_section, $options, $hash_subst ) or return;
+ if ( ! $options->{'simul'} && ! copy ( $tmp, $dest ) ) {
+ carp qq{ERROR: Unable to create $dest with $tmp};
+ return;
+ }
+ Do_chownmod( $ref_section, $dest, $options ) or return;
+ Do_after_change( $ref_section, $options, $hash_subst ) or return;
+ Do_on_noaction( $ref_section, $options, $hash_subst ) or return;
+ }
+ return 1;
+}
+
+1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/Common.pm
--- a/lib/PFTools/Update/Common.pm Thu Sep 23 18:59:47 2010 +0200
+++ b/lib/PFTools/Update/Common.pm Mon Oct 04 13:49:20 2010 +0200
@@ -22,6 +22,7 @@
use warnings;
use base qw( Exporter );
+use Carp;
use English qw( -no_match_vars ); # Avoids regex performance penalty
use File::Copy;
use File::Path qw( make_path );
@@ -56,82 +57,82 @@
my $DEFAULT_GROUP = 'root';
my $STARTTIME = time();
-# my $DEFAULT_FSTYPE = 'nfs';
-# my $DEFAULT_OPTIONS = 'defaults,noexec,nosuid,nodev,hard,intr';
-
-# Fonctions utilisees dans les fichiers de conf
-
##############################################
###
-sub isipaddr ($) {
- my ($ip) = @_;
+sub isipaddr {
+ my ( $ip ) = @_;
- my @sub = split( '\.', $ip );
- return 0 if ( $#sub != 3 );
+ my @sub = split( m{\.}, $ip );
+ return if ( $#sub != 3 );
foreach my $octet ( 0 .. 3 ) {
- return 0 if ( $sub[$octet] < 0 || $sub[$octet] > 255 );
+ return if ( $sub[$octet] < 0 || $sub[$octet] > 255 );
}
return 1;
}
-sub __full_rights ($$$$;$) {
+sub __full_rights {
my ( $type, $dest, $options, $right1, $right2 ) = @_;
if ( $options->{'verbose'} || $options->{'simul'} ) {
Log("(chown needed)");
}
- if ( $options->{'simul'} ) {
- return 0;
- }
- my ( $dev, $ino, $mode, $nlink, $uid, $gid, @others ) = stat($dest);
+ return 1 if( $options->{'simul'} );
+ my ( $dev, $ino, $mode, $nlink, $uid, $gid, @others ) = stat( $dest );
if ( $type eq 'chown' ) {
- my $newuid = getpwnam($right1);
- my $newgid = getgrnam($right2);
- if ( ( defined($uid) && $uid == $newuid )
- && ( defined($gid) && $gid == $newgid ) )
- {
- return 0;
+ my $newuid = getpwnam( $right1 );
+ my $newgid = getgrnam( $right2 );
+ if( ( $uid && $uid == $newuid )
+ && ( $gid && $gid == $newgid )
+ ) {
+ print "Useless $type for $dest" if( $options->{'verbose'} );
+ return 1;
}
- return !chown( $newuid, $newgid, $dest );
+ return chown( $newuid, $newgid, $dest );
}
elsif ( $type eq 'chmod' ) {
- if ( defined($mode) && ( $mode & 07777 ) == $right1 ) {
- return 0;
+ if ( $mode && ( $mode & 07777 ) == $right1 ) {
+ print "Useless $type for $dest" if( $options->{'verbose'} );
+ return 1;
}
- return !chmod( $right1, $dest );
+ return chmod( $right1, $dest );
}
+ else {
+ carp q{ERROR: invalid $type parameter};
+ return;
+ }
+ return 1;
}
-sub fullchown ($$$$) {
+sub fullchown {
my ( $owner, $group, $dest, $options ) = @_;
return __full_rights( 'chown', $dest, $options, $owner, $group );
}
-sub fullchmod ($$$) {
+sub fullchmod {
my ( $newmode, $dest, $options ) = @_;
return __full_rights( 'chmod', $dest, $options, $newmode );
}
-sub ln_sfn ($$) {
+sub ln_sfn {
my ( $source, $dest ) = @_;
- unlink($dest);
- rmdir($dest);
- return !symlink( $source, $dest );
+ unlink( $dest );
+ rmdir( $dest );
+ return symlink( $source, $dest );
}
sub dirname {
- my ($file) = @_;
+ my ( $file ) = @_;
- $file =~ s://:/:g;
+ $file =~ s{//}{/}g;
- if ( $file =~ m|/| ) {
- $file =~ s|^(.*)/[^/]+/?$|$1|;
- $file = "." if ( $file =~ /^\s*$/ );
+ if ( $file =~ m{/} ) {
+ $file =~ s{\A (.*)/[^/]+/? \Z}{$1}xms;
+ $file = "." if( $file =~ m{\A \s* \Z}xms );
}
else {
$file = '.';
@@ -140,69 +141,54 @@
return $file;
}
-sub Do_moveold ($$) {
+sub Do_moveold {
my ( $dest, $options ) = @_;
my $pf_config = Init_PF_CONFIG();
- if ( -e $dest ) {
+ if( -e $dest ) {
my $old
= $pf_config->{'path'}->{'checkout_dir'} . "/old/"
. $dest . "."
. $STARTTIME;
- if ( $options->{'verbose'} ) {
- Log( "(moving old to " . $old . ")" );
- }
- if ( !$options->{'simul'} ) {
- Mk_dest_dir($old);
- return !move( $old, $dest );
+ Log( "(moving old to " . $old . ")" ) if ( $options->{'verbose'} );
+ unless ( $options->{'simul'} ) {
+ Mk_dest_dir( $old );
+ return move( $old, $dest );
}
}
+ return 1;
}
-sub Do_chownmod ($$$) {
+sub Do_chownmod {
my ( $ref_section, $dest, $options ) = @_;
- my $owner
- = defined( $ref_section->{'owner'} )
- ? $ref_section->{'owner'}
- : $DEFAULT_OWNER;
- my $group
- = defined( $ref_section->{'group'} )
- ? $ref_section->{'group'}
- : $DEFAULT_GROUP;
+ my $owner = $ref_section->{'owner'} || $DEFAULT_OWNER;
+ my $group = $ref_section->{'group'} || $DEFAULT_GROUP;
- if ( fullchown( $owner, $group, $dest, $options ) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to change owner and/or group to "
- . $owner . " and "
- . $group
- . " for file "
- . $dest );
- return 1;
+ unless( fullchown( $owner, $group, $dest, $options ) ) {
+ carp qq{ERROR: Unable to chown with $owner and/or $group for $dest};
+ return;
}
- my $mode
- = defined( $ref_section->{'mode'} )
- ? $ref_section->{'mode'}
- : ( ( -d $dest ) ? $DEFAULT_DIRMODE : $DEFAULT_MODE );
- $mode =~ s/^[^0]/0$&/;
+ my $mode = $ref_section->{'mode'}
+ || ( -d $dest ) ? $DEFAULT_DIRMODE : $DEFAULT_MODE;
+ $mode =~ s{\A [^0]}{0$&}xms;
- if ( fullchmod( eval($mode), $dest, $options ) ) {
- Warn( $CODE->{'OPEN'},
- "unable to change rights to " . $mode . " for file " . $dest );
- return 1;
+ unless( fullchmod( eval($mode), $dest, $options ) ) {
+ carp qq{ERROR: Unable to chmod to $mode for $dest};
+ return;
}
- return 0;
+ return 1;
}
-sub Exec_cmd ($) {
- my ($cmd) = @_;
+sub Exec_cmd {
+ my ( $cmd ) = @_;
if ( deferredlogsystem($cmd) ) {
- Warn( $CODE->{'OPEN'}, "Unable to execute [" . $cmd . "]" );
- return 1;
+ carp qq{ERROR: Unable to execute [$cmd]};
+ return;
}
- return 0;
+ return 1;
}
sub Do_on_config ($$$) {
@@ -211,14 +197,16 @@
if ( $ref_section->{'actiongroup'} ) {
Log( "Triggering actiongroup " . $ref_section->{'actiongroup'} )
if ( $options->{'verbose'} );
- return 0;
+ return 1;
}
- if ( !$options->{'simul'}
+ if ( ! $options->{'simul'}
&& 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;
}
sub Do_before_change ($$$) {
@@ -227,15 +215,16 @@
if ( $ref_section->{'actiongroup'} ) {
Log( "Triggering actiongroup " . $ref_section->{'actiongroup'} )
if ( $options->{'verbose'} );
- return 0;
+ return 1;
}
- if ( !$options->{'simul'}
- && !$options->{'noaction'}
+ if ( ! $options->{'simul'}
+ && ! $options->{'noaction'}
&& defined( $ref_section->{'before_change'} ) )
{
return Exec_cmd(
Subst_vars( $ref_section->{'before_change'}, $hash_subst ) );
}
+ return 1;
}
sub Do_after_change ($$$) {
@@ -244,7 +233,7 @@
if ( $ref_section->{'actiongroup'} ) {
Log( "Triggering actiongroup " . $ref_section->{'actiongroup'} )
if ( $options->{'verbose'} );
- return 0;
+ return 1;
}
if ( !$options->{'simul'}
&& defined( $ref_section->{'after_change'} )
@@ -253,6 +242,7 @@
return Exec_cmd(
Subst_vars( $ref_section->{'after_change'}, $hash_subst ) );
}
+ return 1;
}
sub Do_on_noaction ($$$) {
@@ -261,7 +251,7 @@
if ( $ref_section->{'actiongroup'} ) {
Log( "Triggering actiongroup " . $ref_section->{'actiongroup'} )
if ( $options->{'verbose'} );
- return 0;
+ return 1;
}
if ( !$options->{'simul'}
&& defined( $ref_section->{'on_noaction'} )
@@ -270,6 +260,7 @@
return Exec_cmd(
Subst_vars( $ref_section->{'on_noaction'}, $hash_subst ) );
}
+ return 1;
}
# Mk_dest_dir: wrapper around make_path, trying to remove any existing
@@ -281,19 +272,19 @@
return unless $dir;
# FIXME rewrite this part, it's really unreadable!!
- $dir =~ s://:/:g; # supprimer // sinon ca marche moins bien
- $dir =~ s:/[^/]+/*$::;
+ $dir =~ s{//}{/}g; # supprimer // sinon ca marche moins bien
+ $dir =~ s{/[^/]+/* \Z}{}xms;
my $dir2 = $dir;
while ( $dir2 ne "" && !-e $dir2 ) {
- $dir2 =~ s:/[^/]+/*$::;
+ $dir2 =~ s{/[^/]+/* \Z}{}xms;
}
if ( $dir2 ne "" && -e $dir2 && !-d $dir2 ) {
unlink($dir2);
}
eval { make_path($dir); };
- if ($EVAL_ERROR) {
- Warn( $CODE->{'OPEN'}, "make_path($dir): $EVAL_ERROR" );
+ if( $EVAL_ERROR ) {
+ carp qq{ERROR: make_path($dir): $EVAL_ERROR};
return;
}
@@ -307,10 +298,10 @@
my $tmp = $pf_config->{'path'}->{'checkout_dir'} . "/tmp/" . $dest;
Mk_dest_dir($tmp);
if ( -d $tmp ) {
- rmdir($tmp);
+ rmdir( $tmp );
}
elsif ( -e $tmp ) {
- unlink($tmp);
+ unlink( $tmp );
}
return $tmp;
}
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/Createfile.pm
--- a/lib/PFTools/Update/Createfile.pm Thu Sep 23 18:59:47 2010 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,127 +0,0 @@
-package PFTools::Update::Createfile;
-
-#
-# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-#
-
-use strict;
-use warnings;
-
-use base qw( Exporter );
-use English qw( -no_match_vars ); # Avoids regex performance penalty
-use File::Copy;
-
-use PFTools::Conf;
-use PFTools::Logger;
-use PFTools::Update::Common;
-
-our @EXPORT = qw(
- Createfile_depends
- Createfile_action
-);
-
-our @EXPORT_OK = qw();
-
-sub Createfile_depends ($$$) {
- my ( $ref_section, $dest, $options ) = @_;
-
- while ( $dest ne "/" && $dest ne "." ) {
- $ref_section->{'depends'} .= " " . dirname($dest);
- $dest = dirname($dest);
- }
-}
-
-sub Createfile_action ($$$$$) {
- my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
-
- my $cmp = 0;
- $hash_subst->{'SECTIONNAME'} = $dest;
- if ( !defined $ref_section->{'source'} ) {
- if ( !-f $dest ) {
- $cmp = 1;
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
- Do_on_config( $ref_section, $options, $hash_subst ) && return 1;
- Do_before_change( $ref_section, $options, $hash_subst )
- && return 1;
- if ( !$options->{'simul'} ) {
- if ( deferredlogsystem( "/usr/bin/touch '" . $dest . "'" ) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to create empty file " . $dest );
- return 1;
- }
- }
- }
- }
- else {
- my $source = Get_source( $ref_section->{'source'},
- $hash_subst->{'HOSTNAME'}, $hash_subst );
- $hash_subst->{'SOURCE'} = $source;
- my $tmp = Get_tmp_dest($dest);
- $hash_subst->{'DESTINATION'} = $tmp;
- if ( !-f $source ) {
- Warn( $CODE->{'OPEN'}, "Unable to open source " . $source );
- return 1;
- }
- if ( defined( $ref_section->{'filter'} ) ) {
- my $filter = Subst_vars( $ref_section->{'filter'}, $hash_subst );
- if ( deferredlogsystem($filter) ) {
- Warn( $CODE->{'OPEN'}, "Unable to apply filter " . $filter );
- return 1;
- }
- }
- else {
- if ( !copy( $source, $tmp ) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to copy " . $source . " to " . $tmp );
- return 1;
- }
- }
- if ( !-f $tmp ) {
- Warn( $CODE->{'OPEN'}, "Unable top open file " . $tmp );
- return 1;
- }
- if ( !-f $dest ) {
- $cmp = 1;
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
- Do_on_config( $ref_section, $options, $hash_subst ) && return 1;
- Do_before_change( $ref_section, $options, $hash_subst )
- && return 1;
- if ( !$options->{'simul'} ) {
- if ( !copy( $source, $dest ) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to create file "
- . $dest
- . " from source "
- . $source );
- return 1;
- }
- }
- }
- }
- Do_chownmod( $ref_section, $dest, $options );
- if ($cmp) {
- Do_after_change( $ref_section, $options, $hash_subst ) && return 1;
- Do_on_noaction( $ref_section, $options, $hash_subst ) && return 1;
- }
- return 0;
-}
-
-1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/INSTALLPKG.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/PFTools/Update/INSTALLPKG.pm Mon Oct 04 13:49:20 2010 +0200
@@ -0,0 +1,199 @@
+package PFTools::Update::INSTALLPKG;
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
+
+use strict;
+use warnings;
+
+use base qw( Exporter );
+use Carp;
+use Debconf::ConfModule;
+use Debconf::Db;
+use Debconf::Template;
+use English qw( -no_match_vars ); # Avoids regex performance penalty
+
+use PFTools::Conf;
+use PFTools::Logger;
+use PFTools::Packages;
+use PFTools::Update::Common;
+
+our @EXPORT = qw(
+ Action_depends
+ Action_exec
+);
+
+our @EXPORT_OK = qw();
+
+###########################################
+### Environement vars
+$ENV{'PATH'} = $ENV{'PATH'} . ":/usr/local/sbin:/usr/local/bin";
+$ENV{'DEBIAN_FRONTEND'} = "noninteractive";
+$ENV{'DEBIAN_PRIORITY'} = "critical";
+
+sub Action_depends {
+ my ( $ref_section, $dest, $options ) = @_;
+
+ $options->{'pkg_type'} = 'deb' unless( $options->{'pkg_type'} );
+ my $deps = Get_pkg_depends( $options->{'pkg_type'}, $dest );
+ unless( $deps ) {
+ carp qq{ERROR: Unable to get depends for $dest};
+ return;
+ }
+ if( $ref_section->{'depends'} ) {
+ $ref_section->{'depends'} .= $deps;
+ }
+ else {
+ $ref_section->{'depends'} = $deps;
+ }
+}
+
+sub Action_exec {
+ my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
+
+ $options->{'pkg_type'} = 'deb' unless( $options->{'pkg_type'} );
+ my $installed_version;
+ my $available_version;
+ my $specified_version = 0;
+ my $install = 0;
+
+ my $name_filter = $ref_section->{'name_filter'};
+ if( $name_filter ) {
+ my $newdest = deferredlogpipe(
+ Subst_vars( $name_filter, $hash_subst )
+ );
+ unless ( defined $newdest ) {
+ carp qq{ERROR: Unable to apply name_filter $name_filter};
+ return;
+ }
+ unless( $newdest ) {
+ carp qq{ERROR: Empty result for name_filter $name_filter};
+ return;
+ }
+ $dest = $newdest;
+ }
+ $hash_subst->{'SECTIONNAME'} = $dest;
+ ( $installed_version, $available_version, $specified_version )
+ = Get_pkg_policy(
+ $options->{'pkg_type'}, $dest, $ref_section->{'version'}
+ );
+ unless( $available_version ) {
+ carp qq{ERROR: Package $dest is unavailable};
+ return;
+ }
+ if( defined( $ref_section->{'version'} ) && ! $specified_version ) {
+ carp qq{ERROR: $dest ($ref_section->{'version'}) is unavailable};
+ return;
+ }
+ if ( ! defined $installed_version ) {
+ $install++;
+ }
+ else {
+ my $compare = Cmp_pkg_version(
+ $options->{'pkg_type'}, $dest,
+ $installed_version, $available_version
+ );
+ $install++ if ( defined $compare && $compare < 0 );
+ }
+ if( $install ) {
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+ if ( $options->{'diff'} ) {
+ Log("(inst = "
+ . (
+ defined($installed_version) ? $installed_version : '?'
+ )
+ . ", avail = "
+ . (
+ defined($available_version) ? $available_version : '?'
+ )
+ . ", target = "
+ . (
+ defined($available_version) ? $available_version : '?'
+ )
+ . ")"
+ );
+ }
+ if( defined( $ref_section->{'delay'} ) && ! $options->{'noaction'} ) {
+ $hash_subst->{'HOSTNAME'} =~ m{\d+ \Z}xms;
+ if ( $& ne "" ) {
+ sleep( 120 * $& );
+ }
+ }
+ if( !$options->{'simul'} ) {
+ my $debconf = 0;
+ my $debconf_vars = {};
+ foreach my $key ( keys %{$ref_section} ) {
+ next if ( $key !~ m{\A debconf}xmso );
+ $debconf = 1;
+ $key =~ m{\A debconf\.(.*) \Z}xmso;
+ $debconf_vars->{$1} = $ref_section->{$key};
+ }
+ if( $debconf ) {
+ my ( $DEB, $conf, $pkg );
+ my $pf_config = Init_PF_CONFIG();
+ my $vcs_tpl_dir
+ = $pf_config->{'path'}->{'checkout_dir'} . '/TEMPLATES';
+ Debconf::Db->load;
+ foreach $conf ( keys %{ $ref_section->{'debconf'} } ) {
+ ($pkg) = split( m{/}, $conf );
+ if ( !$DEB->{$pkg} ) {
+ $DEB->{$pkg} = 1;
+ Debconf::Template->load(
+ $vcs_tpl_dir . "/" . $pkg, $pkg
+ );
+ }
+ Debconf::ConfModule->command_set(
+ $conf, $ref_section->{'debconf'}->{$conf}
+ );
+ Debconf::ConfModule->command_fset(
+ $conf, "seen", "true"
+ );
+ }
+ Debconf::Db->save;
+ }
+ }
+ Do_on_config( $ref_section, $options, $hash_subst ) or return;
+ Do_before_change( $ref_section, $options, $hash_subst ) or return;
+ if( defined( $ref_section->{'reply'} ) ) {
+ $install = $ref_section->{'reply'};
+ eval "\$install = sprintf (\"echo '$install' |\")";
+ }
+ else {
+ $install = '';
+ }
+ if( !$options->{'simul'} ) {
+ if(
+ !Install_pkg(
+ $options->{'pkg_type'}, $dest,
+ $ref_section->{'version'}
+ )
+ ) {
+ carp qq{ERROR: Unable to install $dest};
+ return;
+ }
+ }
+ Do_after_change( $ref_section, $options, $hash_subst ) or return;
+ Do_on_noaction( $ref_section, $options, $hash_subst ) or return;
+ }
+ return 1;
+}
+
+1;
+
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/Installpkg.pm
--- a/lib/PFTools/Update/Installpkg.pm Thu Sep 23 18:59:47 2010 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,196 +0,0 @@
-package PFTools::Update::Installpkg;
-
-#
-# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-#
-
-use strict;
-use warnings;
-
-use base qw( Exporter );
-use Debconf::ConfModule;
-use Debconf::Db;
-use Debconf::Template;
-use English qw( -no_match_vars ); # Avoids regex performance penalty
-
-use PFTools::Conf;
-use PFTools::Logger;
-use PFTools::Packages;
-use PFTools::Update::Common;
-
-our @EXPORT = qw(
- Installpkg_depends
- Installpkg_action
-);
-
-our @EXPORT_OK = qw();
-
-###########################################
-### Environement vars
-$ENV{'PATH'} = $ENV{'PATH'} . ":/usr/local/sbin:/usr/local/bin";
-$ENV{'DEBIAN_FRONTEND'} = "noninteractive";
-$ENV{'DEBIAN_PRIORITY'} = "critical";
-
-sub Installpkg_depends ($$$) {
- my ( $ref_section, $dest, $options ) = @_;
-
- $options->{'pkg_type'} = 'deb' if ( !defined $options->{'pkg_type'} );
- my $deps = Get_pkg_depends( $options->{'pkg_type'}, $dest );
- if ( !defined $deps ) {
- Warn( $CODE->{'OPEN'}, "Unable to get depends for package " . $dest );
- return 1;
- }
- else {
- $ref_section->{'depends'} = $deps;
- }
-}
-
-sub Installpkg_action ($$$$$) {
- my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
-
- $options->{'pkg_type'} = 'deb' if ( !defined $options->{'pkg_type'} );
- my $installed_version;
- my $available_version;
- my $specified_version = 0;
- my $install = 0;
-
- my $name_filter = $ref_section->{'name_filter'};
- if ($name_filter) {
- my $newdest
- = deferredlogpipe( Subst_vars( $name_filter, $hash_subst ) );
- unless ( defined $newdest ) {
- Warn( $CODE->{'OPEN'},
- "Unable to apply name_filter" . $name_filter );
- return 1;
- }
- unless ($newdest) {
- Warn( $CODE->{'OPEN'},
- "Empty result for name_filter" . $name_filter );
- return 1;
- }
- $dest = $newdest;
- }
- $hash_subst->{'SECTIONNAME'} = $dest;
- ( $installed_version, $available_version, $specified_version )
- = Get_pkg_policy( $options->{'pkg_type'},
- $dest, $ref_section->{'version'} );
- if ( !defined($available_version) ) {
- Warn( $CODE->{'OPEN'}, "Package " . $dest . " is unavailable" );
- return 1;
- }
- if ( defined( $ref_section->{'version'} ) && !$specified_version ) {
- Warn( $CODE->{'OPEN'},
- "Package "
- . $dest
- . " in version "
- . $ref_section->{'version'}
- . " is unavailable" );
- return 1;
- }
- if ( !defined $installed_version ) {
- $install++;
- }
- else {
- my $compare = Cmp_pkg_version( $options->{'pkg_type'},
- $dest, $installed_version, $available_version );
- $install++ if ( defined $compare && $compare < 0 );
- }
- if ($install) {
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
- if ( $options->{'diff'} ) {
- Log("(inst = "
- . (
- defined($installed_version) ? $installed_version : '?'
- )
- . ", avail = "
- . (
- defined($available_version) ? $available_version : '?'
- )
- . ", target = "
- . (
- defined($available_version) ? $available_version : '?'
- )
- . ")"
- );
- }
- if ( defined( $ref_section->{'delay'} ) && !$options->{'noaction'} ) {
- $hash_subst->{'HOSTNAME'} =~ /\d+$/;
- if ( $& ne "" ) {
- sleep( 120 * $& );
- }
- }
- if ( !$options->{'simul'} ) {
- my $debconf = 0;
- my $debconf_vars = {};
- foreach my $key ( keys %{$ref_section} ) {
- next if ( $key !~ /^debconf/ );
- $debconf = 1;
- $key =~ /^debconf\.(.*)$/;
- $debconf_vars->{$1} = $ref_section->{$key};
- }
- if ($debconf) {
- my $DEB;
- my $conf;
- my $pkg;
- my $pf_config = Init_PF_CONFIG();
- my $vcs_tpl_dir
- = $pf_config->{'path'}->{'checkout_dir'} . '/TEMPLATES';
- Debconf::Db->load;
- foreach $conf ( keys %{ $ref_section->{'debconf'} } ) {
- ($pkg) = split( m:/:, $conf );
- if ( !$DEB->{$pkg} ) {
- $DEB->{$pkg} = 1;
- Debconf::Template->load( $vcs_tpl_dir . "/" . $pkg,
- $pkg );
- }
- Debconf::ConfModule->command_set( $conf,
- $ref_section->{'debconf'}->{$conf} );
- Debconf::ConfModule->command_fset( $conf, "seen",
- "true" );
- }
- Debconf::Db->save;
- }
- }
- Do_on_config( $ref_section, $options, $hash_subst ) && return 1;
- Do_before_change( $ref_section, $options, $hash_subst ) && return 1;
- if ( defined( $ref_section->{'reply'} ) ) {
- $install = $ref_section->{'reply'};
- eval "\$install = sprintf (\"echo '$install' |\")";
- }
- else {
- $install = '';
- }
- if ( !$options->{'simul'} ) {
- if (!Install_pkg(
- $options->{'pkg_type'}, $dest,
- $ref_section->{'version'}
- )
- )
- {
- Warn( $CODE->{'OPEN'}, "Unable to install " . $dest );
- return 1;
- }
- }
- Do_after_change( $ref_section, $options, $hash_subst ) && return 1;
- Do_on_noaction( $ref_section, $options, $hash_subst ) && return 1;
- }
- return 0;
-}
-
-1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/MKDIR.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/PFTools/Update/MKDIR.pm Mon Oct 04 13:49:20 2010 +0200
@@ -0,0 +1,81 @@
+package PFTools::Update::MKDIR;
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
+
+use strict;
+use warnings;
+
+use base qw( Exporter );
+use Carp;
+use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Path qw( make_path );
+
+use PFTools::Conf;
+use PFTools::Logger;
+use PFTools::Update::Common;
+
+our @EXPORT = qw(
+ Action_depends
+ Action_exec
+);
+
+our @EXPORT_OK = qw();
+
+sub Action_depends {
+ my ( $ref_section, $dest, $options ) = @_;
+
+ while ( $dest ne "/" && $dest ne "." ) {
+ my $new_dest = dirname($dest);
+ $ref_section->{'depends'} .= " " . $new_dest
+ if ( $new_dest ne "/" || $new_dest ne "." );
+ $dest = $new_dest;
+ }
+}
+
+sub Action_exec {
+ my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
+
+ my $cmp = 0;
+
+ $hash_subst->{'SECTIONNAME'} = $dest;
+ unless( -d $dest ) {
+ $cmp = 1;
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+ Do_on_config( $ref_section, $options, $hash_subst ) or return;
+ Do_before_change( $ref_section, $options, $hash_subst ) or return;
+ if ( !$options->{'simul'} ) {
+ Do_moveold( $dest, $options );
+ eval { make_path($dest); };
+ if ($EVAL_ERROR) {
+ carp qq{ERROR: make_path($dest): $EVAL_ERROR};
+ return;
+ }
+ }
+ }
+ Do_chownmod( $ref_section, $dest, $options );
+ if ($cmp) {
+ Do_after_change( $ref_section, $options, $hash_subst ) or return;
+ Do_on_noaction( $ref_section, $options, $hash_subst ) or return;
+ }
+ return 1;
+}
+
+1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/Mkdir.pm
--- a/lib/PFTools/Update/Mkdir.pm Thu Sep 23 18:59:47 2010 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,80 +0,0 @@
-package PFTools::Update::Mkdir;
-
-#
-# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-#
-
-use strict;
-use warnings;
-
-use base qw( Exporter );
-use English qw( -no_match_vars ); # Avoids regex performance penalty
-use File::Path qw( make_path );
-
-use PFTools::Conf;
-use PFTools::Logger;
-use PFTools::Update::Common;
-
-our @EXPORT = qw(
- Mkdir_depends
- Mkdir_action
-);
-
-our @EXPORT_OK = qw();
-
-sub Mkdir_depends ($$$) {
- my ( $ref_section, $dest, $options ) = @_;
-
- while ( $dest ne "/" && $dest ne "." ) {
- my $new_dest = dirname($dest);
- $ref_section->{'depends'} .= " " . $new_dest
- if ( $new_dest ne "/" || $new_dest ne "." );
- $dest = $new_dest;
- }
-}
-
-sub Mkdir_action ($$$$$) {
- my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
-
- my $cmp = 0;
-
- $hash_subst->{'SECTIONNAME'} = $dest;
- if ( !-d $dest ) {
- $cmp = 1;
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
- Do_on_config( $ref_section, $options, $hash_subst ) && return 1;
- Do_before_change( $ref_section, $options, $hash_subst ) && return 1;
- if ( !$options->{'simul'} ) {
- Do_moveold( $dest, $options );
- eval { make_path($dest); };
- if ($EVAL_ERROR) {
- Warn( $CODE->{'OPEN'}, "make_path($dest): $EVAL_ERROR" );
- return 1;
- }
- }
- }
- Do_chownmod( $ref_section, $dest, $options );
- if ($cmp) {
- Do_after_change( $ref_section, $options, $hash_subst ) && return 1;
- Do_on_noaction( $ref_section, $options, $hash_subst ) && return 1;
- }
- return 0;
-}
-
-1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/PURGEPKG.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/PFTools/Update/PURGEPKG.pm Mon Oct 04 13:49:20 2010 +0200
@@ -0,0 +1,90 @@
+package PFTools::Update::PURGEPKG;
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
+
+use strict;
+use warnings;
+
+use base qw( Exporter );
+use Carp;
+use English qw( -no_match_vars ); # Avoids regex performance penalty
+
+use PFTools::Conf;
+use PFTools::Logger;
+use PFTools::Packages;
+use PFTools::Update::Common;
+
+our @EXPORT = qw(
+ Action_depends
+ Action_exec
+);
+
+our @EXPORT_OK = qw();
+
+sub Action_depends {
+ # Useless funciton but need to define
+ return 1;
+}
+
+sub Action_exec {
+ my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
+
+ $options->{'pkg_type'} = 'deb' unless( $options->{'pkg_type'} );
+ my $name_filter = $ref_section->{'name_filter'};
+ if( $name_filter ) {
+ $hash_subst->{'SECTIONNAME'} = $dest;
+ my $newdest = deferredlogpipe(
+ Subst_vars( $name_filter, $hash_subst )
+ );
+ unless ( defined $newdest ) {
+ carp qq{ERROR: Unable to apply name_filter $name_filter};
+ return;
+ }
+ unless( $newdest ) {
+ carp qq{ERROR: Empty result for name_filter $name_filter};
+ return;
+ }
+ $dest = $newdest;
+ }
+
+ my $status = Get_pkg_status( $options->{'pkg_type'}, $dest );
+ unless( $status ) {
+ carp qq{ERROR: Unable to retrieve status for $dest};
+ return;
+ }
+
+ if ( $status->{'installed'} ) {
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+ 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 )
+ ) {
+ carp qq{ERROR: During purge for $dest};
+ return;
+ }
+ Do_after_change( $ref_section, $options, $hash_subst ) or return;
+ Do_on_noaction( $ref_section, $options, $hash_subst ) or return;
+ }
+ return 1;
+}
+
+1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/Purgepkg.pm
--- a/lib/PFTools/Update/Purgepkg.pm Thu Sep 23 18:59:47 2010 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,86 +0,0 @@
-package PFTools::Update::Purgepkg;
-
-#
-# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-#
-
-use strict;
-use warnings;
-
-use base qw( Exporter );
-use English qw( -no_match_vars ); # Avoids regex performance penalty
-
-use PFTools::Conf;
-use PFTools::Logger;
-use PFTools::Packages;
-use PFTools::Update::Common;
-
-our @EXPORT = qw(
- Purgepkg_action
-);
-
-our @EXPORT_OK = qw();
-
-sub Purgepkg_action ($$$$$) {
- my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
-
- $options->{'pkg_type'} = 'deb' if ( !defined $options->{'pkg_type'} );
- my $name_filter = $ref_section->{'name_filter'};
- if ($name_filter) {
- $hash_subst->{'SECTIONNAME'} = $dest;
- my $newdest
- = deferredlogpipe( Subst_vars( $name_filter, $hash_subst ) );
- unless ( defined $newdest ) {
- Warn( $CODE->{'OPEN'},
- "Unable to apply name_filter" . $name_filter );
- return 1;
- }
- unless ($newdest) {
- Warn( $CODE->{'OPEN'},
- "Empty result for name_filter " . $name_filter );
- return 1;
- }
- $dest = $newdest;
- }
-
- my $status = Get_pkg_status( $options->{'pkg_type'}, $dest );
- if ( !defined $status ) {
- Warn( $CODE->{'OPEN'},
- "Unable to retrieve status for package " . $dest );
- return 1;
- }
-
- if ( $status->{'installed'} ) {
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
- Do_on_config( $ref_section, $options, $hash_subst ) && return 1;
- Do_before_change( $ref_section, $options, $hash_subst ) && return 1;
- if ( !$options->{'simul'} ) {
- if ( !Purge_pkg( $options->{'pkg_type'}, $dest ) ) {
- Warn( $CODE->{'OPEN'},
- "An error occured during purge for package " . $dest );
- return 1;
- }
- }
- Do_after_change( $ref_section, $options, $hash_subst ) && return 1;
- Do_on_noaction( $ref_section, $options, $hash_subst ) && return 1;
- }
- return 0;
-}
-
-1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/REMOVEDIR.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/PFTools/Update/REMOVEDIR.pm Mon Oct 04 13:49:20 2010 +0200
@@ -0,0 +1,64 @@
+package PFTools::Update::REMOVEDIR;
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
+
+use strict;
+use warnings;
+
+use base qw( Exporter );
+use Carp;
+use English qw( -no_match_vars ); # Avoids regex performance penalty
+
+use PFTools::Conf;
+use PFTools::Logger;
+use PFTools::Update::Common;
+
+our @EXPORT = qw(
+ Action_depends
+ Action_exec
+);
+
+our @EXPORT_OK = qw();
+
+sub Action_depends {
+ return 1;
+}
+
+sub Action_exec {
+ my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
+
+ # Is $options->{'simul'} necessary ?
+ if ( ! -d $dest && !$options->{'simul'} ) {
+ carp qq{ERROR: $dest MUST BE a directory};
+ return;
+ }
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+ Do_on_config( $ref_section, $options, $hash_subst ) or return;
+ Do_before_change( $ref_section, $options, $hash_subst ) or return;
+ if ( !$options->{'simul'} ) {
+ Do_moveold( $dest, $options );
+ }
+ Do_after_change( $ref_section, $options, $hash_subst ) or return;
+ Do_on_noaction( $ref_section, $options, $hash_subst ) or return;
+ return 1;
+}
+
+1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/REMOVEFILE.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/PFTools/Update/REMOVEFILE.pm Mon Oct 04 13:49:20 2010 +0200
@@ -0,0 +1,64 @@
+package PFTools::Update::REMOVEFILE;
+
+#
+# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
+
+use strict;
+use warnings;
+
+use base qw( Exporter );
+use Carp;
+use English qw( -no_match_vars ); # Avoids regex performance penalty
+
+use PFTools::Conf;
+use PFTools::Logger;
+use PFTools::Update::Common;
+
+our @EXPORT = qw(
+ Action_depends
+ Action_exec
+);
+
+our @EXPORT_OK = qw();
+
+sub Action_depends {
+ return 1;
+}
+
+sub Action_exec {
+ my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
+
+ # Is $options->{'simul'} necessary ?
+ if( ! -f $dest && ! $options->{'simul'} ) {
+ carp qq{ERROR: $dest MUST BE a file};
+ return;
+ }
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+ Do_on_config( $ref_section, $options, $hash_subst ) or return;
+ Do_before_change( $ref_section, $options, $hash_subst ) or return;
+ if ( ! $options->{'simul'} ) {
+ Do_moveold( $dest, $options );
+ }
+ Do_after_change( $ref_section, $options, $hash_subst ) or return;
+ Do_on_noaction( $ref_section, $options, $hash_subst ) or return;
+ return 1;
+}
+
+1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/Removedir.pm
--- a/lib/PFTools/Update/Removedir.pm Thu Sep 23 18:59:47 2010 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,64 +0,0 @@
-package PFTools::Update::Removedir;
-
-#
-# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-#
-
-use strict;
-use warnings;
-
-use base qw( Exporter );
-use English qw( -no_match_vars ); # Avoids regex performance penalty
-
-use PFTools::Conf;
-use PFTools::Logger;
-use PFTools::Update::Common;
-
-our @EXPORT = qw(
- Removedir_action
-);
-
-our @EXPORT_OK = qw();
-
-sub Removedir_action ($$$$$) {
- my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
-
- my $cmp = 0;
- if ( !$options->{'simul'} && -e $dest && !-d $dest ) {
- Warn( $CODE->{'OPEN'},
- "Destination " . $dest . " MUST BE a directory" );
- return 1;
- }
- if ( -d $dest ) {
- $cmp = 1;
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
- Do_on_config( $ref_section, $options, $hash_subst ) && return 1;
- Do_before_change( $ref_section, $options, $hash_subst ) && return 1;
- if ( !$options->{'simul'} ) {
- Do_moveold( $dest, $options );
- }
- }
- if ($cmp) {
- Do_after_change( $ref_section, $options, $hash_subst ) && return 1;
- Do_on_noaction( $ref_section, $options, $hash_subst ) && return 1;
- }
- return 0;
-}
-
-1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Update/Removefile.pm
--- a/lib/PFTools/Update/Removefile.pm Thu Sep 23 18:59:47 2010 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,63 +0,0 @@
-package PFTools::Update::Removefile;
-
-#
-# Copyright (C) 2010 Christophe Caillet <quadchris at free.fr>
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-#
-
-use strict;
-use warnings;
-
-use base qw( Exporter );
-use English qw( -no_match_vars ); # Avoids regex performance penalty
-
-use PFTools::Conf;
-use PFTools::Logger;
-use PFTools::Update::Common;
-
-our @EXPORT = qw(
- Removefile_action
-);
-
-our @EXPORT_OK = qw();
-
-sub Removefile_action ($$$$$) {
- my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
-
- my $cmp = 0;
- if ( !-f $dest && !$options->{'simul'} ) {
- Warn( $CODE->{'OPEN'}, "Destination " . $dest . " MUST BE a file" );
- return 1;
- }
- if ( -f $dest ) {
- $cmp = 1;
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
- Do_on_config( $ref_section, $options, $hash_subst ) && return 1;
- Do_before_change( $ref_section, $options, $hash_subst ) && return 1;
- if ( !$options->{'simul'} ) {
- Do_moveold( $dest, $options );
- }
- }
- if ($cmp) {
- Do_after_change( $ref_section, $options, $hash_subst ) && return 1;
- Do_on_noaction( $ref_section, $options, $hash_subst ) && return 1;
- }
- return 0;
-}
-
-1;
diff -r b441904c18bf -r 494d020bfacd lib/PFTools/Utils.pm
--- a/lib/PFTools/Utils.pm Thu Sep 23 18:59:47 2010 +0200
+++ b/lib/PFTools/Utils.pm Mon Oct 04 13:49:20 2010 +0200
@@ -1056,7 +1056,7 @@
}
}
Log( "[" . $section . "]" );
- if (Exec_action(
+ if( ! Exec_action(
$host_config->{$section}->{'action'},
$host_config->{$section},
$section,
diff -r b441904c18bf -r 494d020bfacd tools/Translate_old_config
--- a/tools/Translate_old_config Thu Sep 23 18:59:47 2010 +0200
+++ b/tools/Translate_old_config Mon Oct 04 13:49:20 2010 +0200
@@ -29,6 +29,7 @@
use File::Basename;
use English qw( -no_match_vars ); # Avoids regex performance penalty
use Getopt::Long qw ( :config ignore_case_always bundling );
+use IO::File;
use PFTools::Compat::Parser;
use PFTools::Compat::Translation;
@@ -36,11 +37,21 @@
#################################
# Global vars
-my $INPUT = "";
-my $OUTPUT = "";
-my $INCLUDE = 0;
-my $TYPE = "config";
-my $HELP = 0;
+
+my @options_specs = (
+ 'help',
+ 'type|t=s',
+ 'include',
+ 'input|i=s',
+ 'output|o=s',
+);
+
+my $options = {
+ 'help' => 0,
+ 'output' => '-',
+ 'type' => 'config',
+ 'include' => 0,
+};
my $program = basename $PROGRAM_NAME;
@@ -54,6 +65,7 @@
-t --type : type of configuration file, allowed types are : config, network
- config is for update-* file
- network is for file like old private-network
+ --include : parse include file if defined (default disabled)
-i --input : source for old configuration file
-o --output : destination for modified configuration file
# ENDHELP
@@ -62,50 +74,49 @@
#######################################################""
### MAIN
-GetOptions(
- 'help' => \$HELP,
- 'include' => \$INCLUDE,
- 't|type=s' => \$TYPE,
- 'i|input=s' => \$INPUT,
- 'o|output=s' => \$OUTPUT
-) or die "Didn't grok options (see --help).\n";
+GetOptions( $options, @options_specs )
+ or die "Didn't grok options (see --help).\n";
-if ($HELP) {
+if ($options->{'help'}) {
Do_help();
exit 0;
}
-if ( !-e $INPUT ) {
+if ( !-e $options->{'input'} ) {
Abort( $CODE->{'UNDEF_KEY'},
"File "
- . $INPUT
+ . $options->{'input'}
. " doesn't exist : unable to translate old configuration" );
}
-my $old_parsing = Parser_pftools( $INPUT, {}, $INCLUDE );
+my $old_parsing = Parser_pftools(
+ $options->{'input'},
+ {},
+ $options->{'include'}
+);
my $trans = {};
-if ( $TYPE eq 'config' ) {
- $trans = Translate_old2new_config($old_parsing);
+if ( $options->{'type'} eq 'config' ) {
+ $trans = Translate_old2new_config( $old_parsing );
}
else {
foreach my $section ( keys %{$old_parsing} ) {
if ( $old_parsing->{$section}->{'type'} eq 'network' ) {
- $trans->{$section}
- = Translate_old2new_network( $old_parsing->{$section},
- $section );
+ $trans->{$section} = Translate_old2new_network(
+ $old_parsing->{$section},
+ $section
+ );
}
elsif ( $old_parsing->{$section}->{'type'} =~ /-server$/ ) {
my $pftools = 0;
-
- # Need to see if it is a "virtual pf-tools" host or a "real pf-tools" host
+ # Need to see if it is a "virtual pf-tools" host
+ # or a "real pf-tools" host
foreach my $key ( keys %{ $old_parsing->{$section} } ) {
- if ( $key =~ /^ether\.\d+$/ ) {
+ if ( $key =~ m{\A ether\.\d+ \Z}xms ) {
$pftools++;
last;
}
}
- if ($pftools) {
-
+ if( $pftools ) {
# We need to translate into a hostfile configuration
$trans->{'__hostfile'} = {
$section => Translate_old2new_host(
@@ -116,27 +127,28 @@
}
}
}
-unless ( open OUTPUT, ">" . $OUTPUT ) {
- Abort( $CODE->{'OPEN'},
- "Unable to open " . $OUTPUT . " for translation" );
-}
-if ( $TYPE eq 'config' ) {
+
+my $output_fh = IO::File->new( ">" . $options->{'output'} );
+die "Unable to open $options->{'output'} for translation "
+ unless( $output_fh );
+
+if ( $options->{'type'} eq 'config' ) {
foreach my $section ( keys %{$trans} ) {
- next if ( $section =~ /^@/ );
- print OUTPUT "[" . $section . "]\n";
+ next if ( $section =~ m{\A@} );
+ $output_fh->print( "[" . $section . "]\n" );
foreach my $key ( keys %{ $trans->{$section} } ) {
- next if ( $key =~ /^__/ );
- print OUTPUT "\t"
- . $key . "\t= "
- . $trans->{$section}->{$key} . "\n";
+ next if ( $key =~ m{\A__} );
+ $output_fh->print( "\t$key\t= $trans->{$section}->{$key}\n" );
}
- print OUTPUT "\n";
+ $output_fh->print( "\n" );
}
}
else {
- print "Need to implement the output for other type " . $TYPE;
+ print "Need to implement the output for other type " . $options->{'type'};
print Dumper $trans;
}
-close(OUTPUT);
+
+$output_fh->close();
exit 0;
+
More information about the pf-tools-commits
mailing list