pf-tools commit: r879 [parmelan-guest] - in /branches/next-gen/lib/PFTools: ./ Compat/ Conf/ Update/
parmelan-guest at users.alioth.debian.org
parmelan-guest at users.alioth.debian.org
Tue Sep 7 08:54:39 UTC 2010
Author: parmelan-guest
Date: Tue Sep 7 08:54:37 2010
New Revision: 879
URL: http://svn.debian.org/wsvn/pf-tools/?sc=1&rev=879
Log:
perltidy lib
Modified:
branches/next-gen/lib/PFTools/Bridge.pm
branches/next-gen/lib/PFTools/Compat/Parser.pm
branches/next-gen/lib/PFTools/Compat/Translation.pm
branches/next-gen/lib/PFTools/Conf.pm
branches/next-gen/lib/PFTools/Conf/Host.pm
branches/next-gen/lib/PFTools/Conf/Network.pm
branches/next-gen/lib/PFTools/Conf/Syntax.pm
branches/next-gen/lib/PFTools/Disk.pm
branches/next-gen/lib/PFTools/Logger.pm
branches/next-gen/lib/PFTools/Net.pm
branches/next-gen/lib/PFTools/Packages.pm
branches/next-gen/lib/PFTools/Parser.pm
branches/next-gen/lib/PFTools/Structqueries.pm
branches/next-gen/lib/PFTools/Update.pm
branches/next-gen/lib/PFTools/Update/Addfile.pm
branches/next-gen/lib/PFTools/Update/Addlink.pm
branches/next-gen/lib/PFTools/Update/Addmount.pm
branches/next-gen/lib/PFTools/Update/Common.pm
branches/next-gen/lib/PFTools/Update/Createfile.pm
branches/next-gen/lib/PFTools/Update/Installpkg.pm
branches/next-gen/lib/PFTools/Update/Mkdir.pm
branches/next-gen/lib/PFTools/Update/Purgepkg.pm
branches/next-gen/lib/PFTools/Update/Removedir.pm
branches/next-gen/lib/PFTools/Update/Removefile.pm
branches/next-gen/lib/PFTools/Utils.pm
branches/next-gen/lib/PFTools/VCS.pm
Modified: branches/next-gen/lib/PFTools/Bridge.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Bridge.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Bridge.pm (original)
+++ branches/next-gen/lib/PFTools/Bridge.pm Tue Sep 7 08:54:37 2010
@@ -1,4 +1,4 @@
-package PFTools::Bridge ;
+package PFTools::Bridge;
##
## $Id$
##
@@ -19,18 +19,18 @@
## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
##
-use strict ;
-use warnings ;
-use Data::Dumper ;
+use strict;
+use warnings;
+use Data::Dumper;
BEGIN {
- if ( `which vconfig 2>/dev/null` eq ""
- || `which brctl 2>/dev/null` eq ""
- || `which tunctl 2>/dev/null` eq ""
- || `which ip 2>/dev/null` eq "" )
- {
- die "Sorry, I need vlan, bridge-utils, uml-utilities and iproute2" ;
- }
+ if ( `which vconfig 2>/dev/null` eq ""
+ || `which brctl 2>/dev/null` eq ""
+ || `which tunctl 2>/dev/null` eq ""
+ || `which ip 2>/dev/null` eq "" )
+ {
+ die "Sorry, I need vlan, bridge-utils, uml-utilities and iproute2";
+ }
}
use Exporter;
@@ -38,246 +38,316 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Get_all_bridges
- Check_host_bridge
-
- Bridge_primary_exist
- Bridge_exist
-
- Mk_primary_bridge
- Rm_primary_bridge
-
- Attach_host_bridge
- Detach_host_bridge
- Add_host_bridge
- Del_host_bridge
+ Get_all_bridges
+ Check_host_bridge
+
+ Bridge_primary_exist
+ Bridge_exist
+
+ Mk_primary_bridge
+ Rm_primary_bridge
+
+ Attach_host_bridge
+ Detach_host_bridge
+ Add_host_bridge
+ Del_host_bridge
);
our @EXPORT_OK = qw();
-
-my $brctl_cmd = '/usr/sbin/brctl' ;
-my $tunctl_cmd = '/usr/sbin/tunctl' ;
-my $ip_cmd = '/sbin/ip' ;
-my $vconf_cmd = '/sbin/vconfig' ;
-
-my $DEBUG = 1 ;
-my $IFNAMSIZ = 16 ;
-my $VLAN_MTU = 1496 ;
-my $ETHTRUNK = 'eth1' ;
-my $XEN_CFG_DIR = '' ;
-my $XEN_USER = 'root' ;
+my $brctl_cmd = '/usr/sbin/brctl';
+my $tunctl_cmd = '/usr/sbin/tunctl';
+my $ip_cmd = '/sbin/ip';
+my $vconf_cmd = '/sbin/vconfig';
+
+my $DEBUG = 1;
+my $IFNAMSIZ = 16;
+my $VLAN_MTU = 1496;
+my $ETHTRUNK = 'eth1';
+my $XEN_CFG_DIR = '';
+my $XEN_USER = 'root';
sub Sysexec ($) {
- my ( $cmd ) = @_ ;
-
- print "DEBUG --> Executing command ".$cmd."\n" ;
- system ( $cmd ) if ( ! $DEBUG );
- if ( $? ) {
- if ( $? == -1 ) {
- warn "failed to execute: $!\n" ;
- return 0 ;
- } elsif ( $? & 127 ) {
- printf STDERR "child died with signal %d, %s coredump\n", ( $? & 127 ), ( $? & 128 ) ? 'with' : 'without' ;
- return 0 ;
- } else {
- printf STDERR "child exited with value %d\n", $? >> 8 ;
- return 0 ;
- }
- }
- return 1 ;
+ my ($cmd) = @_;
+
+ print "DEBUG --> Executing command " . $cmd . "\n";
+ system($cmd ) if ( !$DEBUG );
+ if ($?) {
+ if ( $? == -1 ) {
+ warn "failed to execute: $!\n";
+ return 0;
+ }
+ elsif ( $? & 127 ) {
+ printf STDERR "child died with signal %d, %s coredump\n",
+ ( $? & 127 ), ( $? & 128 ) ? 'with' : 'without';
+ return 0;
+ }
+ else {
+ printf STDERR "child exited with value %d\n", $? >> 8;
+ return 0;
+ }
+ }
+ return 1;
}
sub Sanitize_bridge_name ($) {
- my ( $br_name ) = @_ ;
-
- if ( length ( $br_name ) > $IFNAMSIZ - 1 ) {
- print "Sanitizing bridge name from ".$br_name." to " if ( $DEBUG ) ;
- $br_name = substr ( $br_name, length ( $br_name ) - $IFNAMSIZ + 1 );
- print $br_name."\n" if ( $DEBUG ) ;
- }
- return $br_name ;
+ my ($br_name) = @_;
+
+ if ( length($br_name) > $IFNAMSIZ - 1 ) {
+ print "Sanitizing bridge name from " . $br_name . " to " if ($DEBUG);
+ $br_name = substr( $br_name, length($br_name) - $IFNAMSIZ + 1 );
+ print $br_name. "\n" if ($DEBUG);
+ }
+ return $br_name;
}
sub Get_all_bridges () {
- my $res = {} ;
- my ( $cur_br, $brlist ) ;
-
- unless ( open ( $brlist, $brctl_cmd.' show |' ) ) {
- die "Unable top execute command /usr/sbin/brctl show\n" ;
- }
- while ( <$brlist> ) {
- chomp ;
- if ( /^br([\d]+)/ ) {
- my ( $brname, $br_id, $stp, $iface ) = split ( /\s+/, $_ ) ;
- $cur_br = $brname ;
- push ( @{$res->{$cur_br}->{'iface'}}, $iface ) ;
- } elsif ( /^bridge/ ) {
- next ;
- } else {
- /^\s*([\S]+)\s*$/ ;
- push ( @{$res->{$cur_br}->{'iface'}}, $1 ) ;
- }
- }
- close ( $brlist ) ;
- return $res ;
+ my $res = {};
+ my ( $cur_br, $brlist );
+
+ unless ( open( $brlist, $brctl_cmd . ' show |' ) ) {
+ die "Unable top execute command /usr/sbin/brctl show\n";
+ }
+ while (<$brlist>) {
+ chomp;
+ if (/^br([\d]+)/) {
+ my ( $brname, $br_id, $stp, $iface ) = split( /\s+/, $_ );
+ $cur_br = $brname;
+ push( @{ $res->{$cur_br}->{'iface'} }, $iface );
+ }
+ elsif (/^bridge/) {
+ next;
+ }
+ else {
+ /^\s*([\S]+)\s*$/;
+ push( @{ $res->{$cur_br}->{'iface'} }, $1 );
+ }
+ }
+ close($brlist);
+ return $res;
}
sub Bridge_primary_exist ($) {
- my ( $br_name, $br_list ) = @_ ;
-
- ( defined $br_list->{$br_name} ) ? return 1 : return 0 ;
+ my ( $br_name, $br_list ) = @_;
+
+ ( defined $br_list->{$br_name} ) ? return 1 : return 0;
}
sub Bridge_exist ($$) {
- my ( $br_name, $br_list ) = @_ ;
-
- my ( $hostname, $tag ) = split ( /\./, $br_name ) ;
- return grep /^$br_name$/, @{$br_list->{'br'.$tag}->{'iface'}} ;
+ my ( $br_name, $br_list ) = @_;
+
+ my ( $hostname, $tag ) = split( /\./, $br_name );
+ return grep /^$br_name$/, @{ $br_list->{ 'br' . $tag }->{'iface'} };
}
sub Mk_primary_bridge ($) {
- my ( $primary ) = @_ ;
- $primary =~ /^br([\d]+)$/ ;
- my $tag = $1 ;
-
- # Adding bridge
- print "Creating primary bridge ".$primary."\n" if ( $DEBUG ) ;
- my $cmd = $brctl_cmd." addbr ".$primary ;
- if ( ! Sysexec ( $cmd ) ) {
- warn "Unable to add primary bridge ".$primary."\n" ;
- return 0 ;
- }
- # Setting spanning tree on bridge off
- print "Setting up sapnning tree off for primary bridge ".$primary."\n" if ( $DEBUG ) ;
- if ( ! Sysexec ( $brctl_cmd." stp ".$primary." off " ) ) {
- warn "Unable to deactivate spanning tree protocol on ".$primary."\n" ;
- }
- # Setting some timeout on bridge
- print "Setting up some timeout on primary bridge ".$primary."\n" if ( $DEBUG ) ;
- foreach my $act ( 'setfd', 'sethello' ) {
- if ( ! Sysexec ( $brctl_cmd." ".$act." ".$primary." 1" ) ) {
- warn "Unablr to set timeout for action ".$act." on bridge ".$primary."\n" ;
- }
- }
- print "Checking if TRUNK is configured for vlan tagged as ".$tag."\n" if ( $DEBUG ) ;
- if ( ! Sysexec ( $ip_cmd." addr show dev ".$ETHTRUNK.".".$tag ) ) {
- if ( ! Sysexec ( $vconf_cmd."set_name_type DEV_PLUS_VID_NO_PAD" ) ) {
- warn "Unable to set_name_type for vconfig creation\n" ;
- }
- print "Adding vlan tagged as ".$tag." on trunk interface ".$ETHTRUNK."\n" if ( $DEBUG ) ;
- if ( ! Sysexec ( $vconf_cmd." add ".$ETHTRUNK." ".$tag ) ) {
- warn "Unable to add vlan tagged as ".$tag." on ".$ETHTRUNK."\n" ;
- return 0 ;
- }
- print "Activating promiscuous mode for ".$ETHTRUNK.".".$tag."\n" if ( $DEBUG ) ;
- if ( ! Sysexec ( $ip_cmd." link set ".$ETHTRUNK.".".$tag." up promisc on mtu ".$VLAN_MTU ) ) {
- warn "Unable to set promiscuous mode and mtu on interface ".$ETHTRUNK.".".$tag."\n" ;
- return 0 ;
- }
- print "Setting ip address for ".$ETHTRUNK.".".$tag."\n" if ( $DEBUG ) ;
- if ( ! Sysexec ( $ip_cmd." addr add 0.0.0.0 dev ".$ETHTRUNK.".".$tag ) ) {
- warn "Unable to set ip address for ".$ETHTRUNK.".".$tag."\n" ;
- return 0 ;
- }
- }
- print "Attaching primary bridge ".$primary." to ".$ETHTRUNK.".".$tag."\n" if ( $DEBUG ) ;
- return Sysexec ( $brctl_cmd." addif ".$primary." ".$ETHTRUNK.".".$tag ) ;
+ my ($primary) = @_;
+ $primary =~ /^br([\d]+)$/;
+ my $tag = $1;
+
+ # Adding bridge
+ print "Creating primary bridge " . $primary . "\n" if ($DEBUG);
+ my $cmd = $brctl_cmd . " addbr " . $primary;
+ if ( !Sysexec($cmd) ) {
+ warn "Unable to add primary bridge " . $primary . "\n";
+ return 0;
+ }
+
+ # Setting spanning tree on bridge off
+ print "Setting up sapnning tree off for primary bridge " . $primary . "\n"
+ if ($DEBUG);
+ if ( !Sysexec( $brctl_cmd . " stp " . $primary . " off " ) ) {
+ warn "Unable to deactivate spanning tree protocol on " . $primary
+ . "\n";
+ }
+
+ # Setting some timeout on bridge
+ print "Setting up some timeout on primary bridge " . $primary . "\n"
+ if ($DEBUG);
+ foreach my $act ( 'setfd', 'sethello' ) {
+ if ( !Sysexec( $brctl_cmd . " " . $act . " " . $primary . " 1" ) ) {
+ warn "Unablr to set timeout for action "
+ . $act
+ . " on bridge "
+ . $primary . "\n";
+ }
+ }
+ print "Checking if TRUNK is configured for vlan tagged as " . $tag . "\n"
+ if ($DEBUG);
+ if ( !Sysexec( $ip_cmd . " addr show dev " . $ETHTRUNK . "." . $tag ) ) {
+ if ( !Sysexec( $vconf_cmd . "set_name_type DEV_PLUS_VID_NO_PAD" ) ) {
+ warn "Unable to set_name_type for vconfig creation\n";
+ }
+ print "Adding vlan tagged as "
+ . $tag
+ . " on trunk interface "
+ . $ETHTRUNK . "\n"
+ if ($DEBUG);
+ if ( !Sysexec( $vconf_cmd . " add " . $ETHTRUNK . " " . $tag ) ) {
+ warn "Unable to add vlan tagged as "
+ . $tag . " on "
+ . $ETHTRUNK . "\n";
+ return 0;
+ }
+ print "Activating promiscuous mode for "
+ . $ETHTRUNK . "."
+ . $tag . "\n"
+ if ($DEBUG);
+ if (!Sysexec(
+ $ip_cmd
+ . " link set "
+ . $ETHTRUNK . "."
+ . $tag
+ . " up promisc on mtu "
+ . $VLAN_MTU
+ )
+ )
+ {
+ warn "Unable to set promiscuous mode and mtu on interface "
+ . $ETHTRUNK . "."
+ . $tag . "\n";
+ return 0;
+ }
+ print "Setting ip address for " . $ETHTRUNK . "." . $tag . "\n"
+ if ($DEBUG);
+ if (!Sysexec(
+ $ip_cmd . " addr add 0.0.0.0 dev " . $ETHTRUNK . "." . $tag
+ )
+ )
+ {
+ warn "Unable to set ip address for "
+ . $ETHTRUNK . "."
+ . $tag . "\n";
+ return 0;
+ }
+ }
+ print "Attaching primary bridge "
+ . $primary . " to "
+ . $ETHTRUNK . "."
+ . $tag . "\n"
+ if ($DEBUG);
+ return Sysexec(
+ $brctl_cmd . " addif " . $primary . " " . $ETHTRUNK . "." . $tag );
}
sub Rm_primary_bridge ($;$) {
- my ( $primary, $ref_brlist ) = @_ ;
-
- if ( ! defined $ref_brlist ) {
- print "Need to retrieve bridges configuration on host\n" if ( $DEBUG ) ;
- $ref_brlist = Get_all_bridges () ;
- if ( ! defined $ref_brlist ) {
- warn "Unable to retrieve briges list : unable to remove primary bridge ".$primary."\n" ;
- return 0 ;
- }
- }
- if ( ! defined $ref_brlist->{$primary} ) {
- warn "No such primary bridge ".$primary."\n" ;
- return 0 ;
- }
- foreach my $iface ( @{$ref_brlist->{$primary}} ) {
- if ( ! Detach_host_bridge ( $iface, $primary ) ) {
- warn "Unable to detach interface ".$iface." from primary bridge ".$primary." before removing it\n" ;
- return 0 ;
- }
- }
- return Sysexec ( $brctl_cmd." delbr ".$primary ) ;
+ my ( $primary, $ref_brlist ) = @_;
+
+ if ( !defined $ref_brlist ) {
+ print "Need to retrieve bridges configuration on host\n" if ($DEBUG);
+ $ref_brlist = Get_all_bridges();
+ if ( !defined $ref_brlist ) {
+ warn
+ "Unable to retrieve briges list : unable to remove primary bridge "
+ . $primary . "\n";
+ return 0;
+ }
+ }
+ if ( !defined $ref_brlist->{$primary} ) {
+ warn "No such primary bridge " . $primary . "\n";
+ return 0;
+ }
+ foreach my $iface ( @{ $ref_brlist->{$primary} } ) {
+ if ( !Detach_host_bridge( $iface, $primary ) ) {
+ warn "Unable to detach interface "
+ . $iface
+ . " from primary bridge "
+ . $primary
+ . " before removing it\n";
+ return 0;
+ }
+ }
+ return Sysexec( $brctl_cmd . " delbr " . $primary );
}
sub Detach_host_bridge ($$) {
- my ( $br_name, $primary ) = @_ ;
-
- print "Detaching bridge ".$br_name." from primary ".$primary."\n" if ( $DEBUG ) ;
- my $cmd = $brctl_cmd." delif ".$primary." ".$br_name ;
- return Sysexec ( $cmd ) ;
+ my ( $br_name, $primary ) = @_;
+
+ print "Detaching bridge " . $br_name . " from primary " . $primary . "\n"
+ if ($DEBUG);
+ my $cmd = $brctl_cmd . " delif " . $primary . " " . $br_name;
+ return Sysexec($cmd);
}
sub Attach_host_bridge ($$) {
- my ( $br_name, $primary ) = @_ ;
-
- print "Attaching bridge ".$br_name." to primary bridge ".$primary."\n" if ( $DEBUG ) ;
- my $cmd = $brctl_cmd." addif ".$primary." ".$br_name ;
- return Sysexec ( $cmd ) ;
+ my ( $br_name, $primary ) = @_;
+
+ print "Attaching bridge "
+ . $br_name
+ . " to primary bridge "
+ . $primary . "\n"
+ if ($DEBUG);
+ my $cmd = $brctl_cmd . " addif " . $primary . " " . $br_name;
+ return Sysexec($cmd);
}
sub Add_host_bridge ($$) {
- my ( $hostname, $tag ) = @_ ;
- my $primary = "br".$tag ;
-
- my $br_name = Sanitize_bridge_name ( $hostname.".".$tag ) ;
- my $cmd = $tunctl_cmd." -b -u ".$XEN_USER." -t ".$br_name ;
- if ( ! Bridge_primary_exist ( $primary ) ) {
- if ( ! Mk_primary_bridge ( $primary ) ) {
- warn "Unable to create primary bridge ".$primary."\n" ;
- return undef ;
- }
- }
- print "Adding host TUN/TAP interface ".$br_name."\n" if ( $DEBUG ) ;
- if ( ! Sysexec ( $cmd ) ) {
- warn "Unable to add host bridge ".$br_name."\n" ;
- return undef ;
- }
- return $br_name ;
+ my ( $hostname, $tag ) = @_;
+ my $primary = "br" . $tag;
+
+ my $br_name = Sanitize_bridge_name( $hostname . "." . $tag );
+ my $cmd = $tunctl_cmd . " -b -u " . $XEN_USER . " -t " . $br_name;
+ if ( !Bridge_primary_exist($primary) ) {
+ if ( !Mk_primary_bridge($primary) ) {
+ warn "Unable to create primary bridge " . $primary . "\n";
+ return undef;
+ }
+ }
+ print "Adding host TUN/TAP interface " . $br_name . "\n" if ($DEBUG);
+ if ( !Sysexec($cmd) ) {
+ warn "Unable to add host bridge " . $br_name . "\n";
+ return undef;
+ }
+ return $br_name;
}
sub Del_host_bridge ($$) {
- my ( $hostname, $tag ) = @_ ;
- my $primary = "br".$tag ;
-
- if ( ! Detach_host_bridge ( $hostname.".".$tag, $primary ) ) {
- warn "Unable to detach ".$hostname.".".$tag." from ".$primary."\n" ;
- return 0 ;
- }
- print "Deleting host bridge ".$hostname.".".$tag."\n" if ( $DEBUG ) ;
- return Sysexec ( $tunctl_cmd." -b -d ".$hostname.".".$tag ) ;
+ my ( $hostname, $tag ) = @_;
+ my $primary = "br" . $tag;
+
+ if ( !Detach_host_bridge( $hostname . "." . $tag, $primary ) ) {
+ warn "Unable to detach "
+ . $hostname . "."
+ . $tag
+ . " from "
+ . $primary . "\n";
+ return 0;
+ }
+ print "Deleting host bridge " . $hostname . "." . $tag . "\n" if ($DEBUG);
+ return Sysexec( $tunctl_cmd . " -b -d " . $hostname . "." . $tag );
}
sub Check_host_bridge ($$$) {
- my ( $ref_net, $hostname, $ref_brlist ) = @_ ;
-
- my $hosttype = $hostname ;
- $hosttype =~ s/[\d]+$// ;
-
- print "$hosttype\n" ;
- if ( ! defined ( $ref_net->{'SERVERS'}->{'BY_NAME'}->{$hosttype}->{'SRVLIST'}->{$hostname} ) ) {
- die "Hostname ".$hostname." doesn't exist\n" ;
- }
- my $HOST = $ref_net->{'SERVERS'}->{'BY_NAME'}->{$hosttype}->{'SRVLIST'}->{$hostname} ;
- foreach my $vlan ( keys %{$HOST->{'ifup'}} ) {
- $vlan =~ s/^$hostname\.// ;
- die "No tag defined for vlan ".$vlan."\n" if ( ! defined ( $ref_net->{'NETWORK'}->{'BY_NAME'}->{$vlan}->{'tag'} ) ) ;
- my $tag = $ref_net->{'NETWORK'}->{'BY_NAME'}->{$vlan}->{'tag'} ;
- if ( ! Bridge_exist ( $hostname.'.'.$tag, $ref_brlist ) ) {
- print "Need to create bridge ".$hostname.".".$tag."\n" ;
- Add_host_bridge ( $hostname, $tag ) ;
- Attach_host_bridge ( 'br'.$tag, $hostname.".".$tag ) ;
- } else {
- print "Bridge ".$hostname.".".$tag." already exists\n" ;
- }
- }
-}
+ my ( $ref_net, $hostname, $ref_brlist ) = @_;
+
+ my $hosttype = $hostname;
+ $hosttype =~ s/[\d]+$//;
+
+ print "$hosttype\n";
+ if (!defined(
+ $ref_net->{'SERVERS'}->{'BY_NAME'}->{$hosttype}->{'SRVLIST'}
+ ->{$hostname}
+ )
+ )
+ {
+ die "Hostname " . $hostname . " doesn't exist\n";
+ }
+ my $HOST = $ref_net->{'SERVERS'}->{'BY_NAME'}->{$hosttype}->{'SRVLIST'}
+ ->{$hostname};
+ foreach my $vlan ( keys %{ $HOST->{'ifup'} } ) {
+ $vlan =~ s/^$hostname\.//;
+ die "No tag defined for vlan " . $vlan . "\n"
+ if (
+ !defined( $ref_net->{'NETWORK'}->{'BY_NAME'}->{$vlan}->{'tag'} )
+ );
+ my $tag = $ref_net->{'NETWORK'}->{'BY_NAME'}->{$vlan}->{'tag'};
+ if ( !Bridge_exist( $hostname . '.' . $tag, $ref_brlist ) ) {
+ print "Need to create bridge " . $hostname . "." . $tag . "\n";
+ Add_host_bridge( $hostname, $tag );
+ Attach_host_bridge( 'br' . $tag, $hostname . "." . $tag );
+ }
+ else {
+ print "Bridge " . $hostname . "." . $tag . " already exists\n";
+ }
+ }
+}
Modified: branches/next-gen/lib/PFTools/Compat/Parser.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Compat/Parser.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Compat/Parser.pm (original)
+++ branches/next-gen/lib/PFTools/Compat/Parser.pm Tue Sep 7 08:54:37 2010
@@ -27,8 +27,8 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Subst_vars
- Parser_pftools
+ Subst_vars
+ Parser_pftools
);
our @EXPORT_OK = qw();
@@ -55,25 +55,26 @@
my ( $V, $var, $val ) = @_;
if ( $var =~ /^((\\\.|[^.])*[^\\])\./ ) {
- my $esc1 = $1;
- my $quote = $';
- $esc1 =~ s/\\\././g;
- if ( !defined( $V->{$esc1} ) ) {
- $V->{$esc1} = {};
- }
- if ( !ref( $V->{$esc1} ) ) {
- return ($CODE->{'SYNTAX'});
- }
- __Add_var( $V->{$esc1}, $quote, $val );
+ my $esc1 = $1;
+ my $quote = $';
+ $esc1 =~ s/\\\././g;
+ if ( !defined( $V->{$esc1} ) ) {
+ $V->{$esc1} = {};
+ }
+ if ( !ref( $V->{$esc1} ) ) {
+ return ( $CODE->{'SYNTAX'} );
+ }
+ __Add_var( $V->{$esc1}, $quote, $val );
}
else {
- $var =~ s/\\\././g;
- if ( defined( $V->{$var} ) ) {
-# print "Syntax error\n" ;
- return ($CODE->{'SYNTAX'});
- }
- $V->{$var} = $val;
- return (0);
+ $var =~ s/\\\././g;
+ if ( defined( $V->{$var} ) ) {
+
+ # print "Syntax error\n" ;
+ return ( $CODE->{'SYNTAX'} );
+ }
+ $V->{$var} = $val;
+ return (0);
}
}
@@ -81,7 +82,7 @@
sub Subst_vars ($$) {
my ( $str, $hash_subst ) = @_;
- $str =~ s/%([^\%]+)%/$hash_subst->{$1}/gm;
+ $str =~ s/%([^\%]+)%/$hash_subst->{$1}/gm;
return $str;
}
@@ -91,263 +92,275 @@
my ( $fic_conf, $substdestvars, $inc ) = @_;
my $CONF = {};
- my $LOCATION = {} ;
+ my $LOCATION = {};
my $current = ']';
my @FIC_CONF = ();
my @ALL_CONF = ();
- my @FH = () ;
+ my @FH = ();
my @line = ();
my @cond = ();
unshift @FIC_CONF, $fic_conf;
unshift @ALL_CONF, $fic_conf;
unshift @line, 0;
- print "Opening $FIC_CONF[0]\n" if ( $DEBUG );
+ print "Opening $FIC_CONF[0]\n" if ($DEBUG);
open( $FH[0], $FIC_CONF[0] )
- || Abort( $$CODE->{'OPEN'}, "Impossible d'ouvrir " . $FIC_CONF[0] );
- print "Filehandles --> @FH\n" if ( $DEBUG );
+ || Abort( $$CODE->{'OPEN'}, "Impossible d'ouvrir " . $FIC_CONF[0] );
+ print "Filehandles --> @FH\n" if ($DEBUG);
while ( $#FH >= 0 ) {
- my $fh = $FH[0]; # Perl gruik, ne pas simplifier!!!
+ my $fh = $FH[0]; # Perl gruik, ne pas simplifier!!!
LOADCONFLINE: while (<$fh>) {
-# print "Using fh --> $fh\n" ;
- # Compter les lignes
- $line[0]++;
-
- # Eliminer les commentaires et les espaces inutiles
- chomp;
- s/^\s*//;
- s/\s*$//;
- s/\s*#.*$//;
-
- # Ne pas traiter les lignes vides
- next if (/^$/);
-
- # Traitement des directives IF (0 param)
- if (/^\@([^\s]+)$/) {
- if ( $1 eq "else" ) {
- if ( $#cond < 0 ) {
- Abort ( $CODE->{'SYNTAX'},
- $FIC_CONF[0] . ":"
- . $line[0]
- . ": else sans if" );
- }
- $cond[0] = ( $#cond > 0 && !$cond[1] ) ? 0 : !$cond[0];
- next;
- }
- elsif ( $1 eq "endif" ) {
- if ( $#cond < 0 ) {
- Abort( $CODE->{'SYNTAX'},
- $FIC_CONF[0] . ":"
- . $line[0]
- . ": endif sans if" );
- }
- shift @cond;
- next;
- }
- }
-
- # Traitement des directives IF (1 param)
- if (/^\@([^\s]+)\s+([^\s]+)$/) {
- if ( $1 eq "ifdef" ) {
- if ( defined $PFTOOLS_VARS->{$2} ) {
- unshift @cond, ( $#cond > 0 && !$cond[1] ) ? 0 : 1;
- }
- else {
- unshift @cond, 0;
- }
- next;
- }
- elsif ( $1 eq "ifndef" ) {
- if ( not defined $PFTOOLS_VARS->{$2} ) {
- unshift @cond, 0;
- }
- else {
- unshift @cond, ( $#cond > 0 && !$cond[1] ) ? 0 : 1;
- }
- next;
- }
- elsif ( $1 eq "if" ) {
- if ( defined $PFTOOLS_VARS->{$2} && $PFTOOLS_VARS->{$2} ) {
- unshift @cond, ( $#cond > 0 && !$cond[1] ) ? 0 : 1;
- }
- else {
- unshift @cond, 0;
- }
- next;
- }
- elsif ( $1 eq "ifnot" ) {
- if ( defined $PFTOOLS_VARS->{$2} && ! $PFTOOLS_VARS->{$2} ) {
- unshift @cond, 0;
- }
- else {
- unshift @cond, ( $#cond > 0 && !$cond[1] ) ? 0 : 1;
- }
- next;
- }
- }
-
- # Seulement les directives IF si condition fausse
- next if ( $#cond >= 0 && !$cond[0] );
-
- if (/^\@([^\s]+)\s+([^\s]+)$/) {
- if ( $1 eq "include" && $inc ) {
- my $fic_conf = $2;
- my $oldficconf;
-
- if ( $fic_conf =~ m|/| ) {
- Abort( $CODE->{'OPEN'},
- $FIC_CONF[1] . ":"
- . $line[1]
- . ": Include avec chemin interdit" );
- }
-
- if ( $FIC_CONF[0] =~ m|^(.*)/[^/]*$| ) {
- $fic_conf = $1 . '/include-' . $fic_conf;
- }
- else {
- $fic_conf = "include-" . $fic_conf;
- }
-
- foreach $oldficconf (@ALL_CONF) {
- if ( $fic_conf eq $oldficconf ) {
- Warn( $CODE->{'OPEN'},
- $FIC_CONF[0] . ":"
- . $line[0] . ": "
- . $fic_conf
- . " deja inclus ligne "
- . $LOCATION->{'include'}->{$fic_conf}->{'line'}
- . " dans "
- . $LOCATION->{'include'}->{$fic_conf}->{'source'} );
- next LOADCONFLINE;
- }
- }
- $LOCATION->{'include'}->{$fic_conf}->{'line'} = $line[0] ;
- $LOCATION->{'include'}->{$fic_conf}->{'source'} = $FIC_CONF[0] ;
- unshift @FIC_CONF, $fic_conf;
- unshift @ALL_CONF, $fic_conf;
- unshift @line, 0;
- print "Opening $FIC_CONF[0]\n" if ( $DEBUG );
- my $newfh ;
- open( $newfh, $FIC_CONF[0] )
- || Abort( $CODE->{'OPEN'},
- $FIC_CONF[1] . ":"
- . $line[1]
- . ": Impossible d'inclure "
- . $FIC_CONF[0] );
- ; # Perl gruik, ne pas simplifier!!!
- print "File list after including $FIC_CONF[0] ".join ( " ", @ALL_CONF )."\n" if ( $DEBUG );
- unshift @FH, $newfh ;
- $fh = $newfh ;
- print "Filehandles list after inclusion --> @FH\n" if ( $DEBUG );
- }
- elsif ( $1 eq "include" && ! $inc ) {
- print "There is an include idrective which is deactivate\n" if ( $DEBUG );
- $CONF->{"\@include-".$2} = 1;
- }
- elsif ( $1 eq "define" ) {
- if ( defined( $PFTOOLS_VARS->{$2} ) ) {
- Warn( $CODE->{'OPEN'},
- $FIC_CONF[0] . ":"
- . $line[0] . ": "
- . $2
- . " deja defini" );
- }
- else {
- $PFTOOLS_VARS->{$2} = 1;
- }
- }
- elsif ( $1 eq "undef" ) {
- if ( not defined( $PFTOOLS_VARS->{$2} ) ) {
- Warn( $CODE->{'OPEN'},
- $FIC_CONF[0] . ":"
- . $line[0] . ": "
- . $2
- . " deja non defini" );
- }
- else {
- undef $PFTOOLS_VARS->{$2};
- }
- }
- else {
- Abort( $CODE->{'SYNTAX'},
- $FIC_CONF[0] . ":"
- . $line[0]
- . ": Directive "
- . $1
- . " inconnue" );
- }
- next;
- }
-
- # Detection des sections
- if (/^\[([^\]]+)\]$/) {
- if ( defined $substdestvars && $substdestvars ) {
- $current = Subst_vars( $1, $substdestvars );
- }
- else {
- $current = $1;
- }
- if ( defined( $CONF->{$current} ) ) {
- Abort( $CODE->{'SYNTAX'},
- $FIC_CONF[0] . ":"
- . $line[0] . ": ["
- . $current
- . "] dupliquee (precedente a "
- . $LOCATION->{$current}->{_location}
- . ")" );
- }
- else {
- $CONF->{$current} = {};
- $LOCATION->{$current}->{_location}
- = $FIC_CONF[0] . ":" . $line[0];
- }
- next;
- }
-
- # Traitement des variables
- if (/^([^\s]+)\s*=\s*(.+)$/) {
- my ( $var, $val ) = ( $1, $2 ) ;
- if ( defined( $CONF->{$current}->{$var} ) ) {
- Abort( $CODE->{'SYNTAX'},
- $FIC_CONF[0] . ":"
- . $line[0] . ": "
- . $var
- . " dupliquee (precedente a "
- . $LOCATION->{$current}->{$var}->{_location}
- . ")" );
- }
- else {
-
- if ( __Add_var( $CONF->{$current}, $var, $val ) == $CODE->{'SYNTAX'} )
- {
- Abort( $CODE->{'SYNTAX'},
- $FIC_CONF[0] . ":"
- . $line[0] . ": "
- . $var
- . " dupliquee (precedente a "
- . $LOCATION->{$current}->{$var}->{_location}
- . ")" );
- }
- $LOCATION->{$current}->{$var}->{_location}
- = $FIC_CONF[0] . ":" . $line[0];
- }
- }
- else {
- Abort( $CODE->{'SYNTAX'},
- $FIC_CONF[0] . ":" . $line[0] . ": Erreur de syntaxe" );
- }
- }
- close( $FH[0] ) ;
- print "Closing $FIC_CONF[0] -- $FH[0]\n" if ( $DEBUG );
- shift @FH;
- print "Filehandles after closing --> @FH\n" if ( $DEBUG );
- shift @line;
- shift @FIC_CONF;
+
+ # print "Using fh --> $fh\n" ;
+ # Compter les lignes
+ $line[0]++;
+
+ # Eliminer les commentaires et les espaces inutiles
+ chomp;
+ s/^\s*//;
+ s/\s*$//;
+ s/\s*#.*$//;
+
+ # Ne pas traiter les lignes vides
+ next if (/^$/);
+
+ # Traitement des directives IF (0 param)
+ if (/^\@([^\s]+)$/) {
+ if ( $1 eq "else" ) {
+ if ( $#cond < 0 ) {
+ Abort( $CODE->{'SYNTAX'},
+ $FIC_CONF[0] . ":"
+ . $line[0]
+ . ": else sans if" );
+ }
+ $cond[0] = ( $#cond > 0 && !$cond[1] ) ? 0 : !$cond[0];
+ next;
+ }
+ elsif ( $1 eq "endif" ) {
+ if ( $#cond < 0 ) {
+ Abort( $CODE->{'SYNTAX'},
+ $FIC_CONF[0] . ":"
+ . $line[0]
+ . ": endif sans if" );
+ }
+ shift @cond;
+ next;
+ }
+ }
+
+ # Traitement des directives IF (1 param)
+ if (/^\@([^\s]+)\s+([^\s]+)$/) {
+ if ( $1 eq "ifdef" ) {
+ if ( defined $PFTOOLS_VARS->{$2} ) {
+ unshift @cond, ( $#cond > 0 && !$cond[1] ) ? 0 : 1;
+ }
+ else {
+ unshift @cond, 0;
+ }
+ next;
+ }
+ elsif ( $1 eq "ifndef" ) {
+ if ( not defined $PFTOOLS_VARS->{$2} ) {
+ unshift @cond, 0;
+ }
+ else {
+ unshift @cond, ( $#cond > 0 && !$cond[1] ) ? 0 : 1;
+ }
+ next;
+ }
+ elsif ( $1 eq "if" ) {
+ if ( defined $PFTOOLS_VARS->{$2} && $PFTOOLS_VARS->{$2} )
+ {
+ unshift @cond, ( $#cond > 0 && !$cond[1] ) ? 0 : 1;
+ }
+ else {
+ unshift @cond, 0;
+ }
+ next;
+ }
+ elsif ( $1 eq "ifnot" ) {
+ if ( defined $PFTOOLS_VARS->{$2} && !$PFTOOLS_VARS->{$2} )
+ {
+ unshift @cond, 0;
+ }
+ else {
+ unshift @cond, ( $#cond > 0 && !$cond[1] ) ? 0 : 1;
+ }
+ next;
+ }
+ }
+
+ # Seulement les directives IF si condition fausse
+ next if ( $#cond >= 0 && !$cond[0] );
+
+ if (/^\@([^\s]+)\s+([^\s]+)$/) {
+ if ( $1 eq "include" && $inc ) {
+ my $fic_conf = $2;
+ my $oldficconf;
+
+ if ( $fic_conf =~ m|/| ) {
+ Abort( $CODE->{'OPEN'},
+ $FIC_CONF[1] . ":"
+ . $line[1]
+ . ": Include avec chemin interdit" );
+ }
+
+ if ( $FIC_CONF[0] =~ m|^(.*)/[^/]*$| ) {
+ $fic_conf = $1 . '/include-' . $fic_conf;
+ }
+ else {
+ $fic_conf = "include-" . $fic_conf;
+ }
+
+ foreach $oldficconf (@ALL_CONF) {
+ if ( $fic_conf eq $oldficconf ) {
+ Warn( $CODE->{'OPEN'},
+ $FIC_CONF[0] . ":"
+ . $line[0] . ": "
+ . $fic_conf
+ . " deja inclus ligne "
+ . $LOCATION->{'include'}->{$fic_conf}
+ ->{'line'}
+ . " dans "
+ . $LOCATION->{'include'}->{$fic_conf}
+ ->{'source'} );
+ next LOADCONFLINE;
+ }
+ }
+ $LOCATION->{'include'}->{$fic_conf}->{'line'} = $line[0];
+ $LOCATION->{'include'}->{$fic_conf}->{'source'}
+ = $FIC_CONF[0];
+ unshift @FIC_CONF, $fic_conf;
+ unshift @ALL_CONF, $fic_conf;
+ unshift @line, 0;
+ print "Opening $FIC_CONF[0]\n" if ($DEBUG);
+ my $newfh;
+ open( $newfh, $FIC_CONF[0] )
+ || Abort( $CODE->{'OPEN'},
+ $FIC_CONF[1] . ":"
+ . $line[1]
+ . ": Impossible d'inclure "
+ . $FIC_CONF[0] );
+ ; # Perl gruik, ne pas simplifier!!!
+ print "File list after including $FIC_CONF[0] "
+ . join( " ", @ALL_CONF ) . "\n"
+ if ($DEBUG);
+ unshift @FH, $newfh;
+ $fh = $newfh;
+ print "Filehandles list after inclusion --> @FH\n"
+ if ($DEBUG);
+ }
+ elsif ( $1 eq "include" && !$inc ) {
+ print
+ "There is an include idrective which is deactivate\n"
+ if ($DEBUG);
+ $CONF->{ "\@include-" . $2 } = 1;
+ }
+ elsif ( $1 eq "define" ) {
+ if ( defined( $PFTOOLS_VARS->{$2} ) ) {
+ Warn( $CODE->{'OPEN'},
+ $FIC_CONF[0] . ":"
+ . $line[0] . ": "
+ . $2
+ . " deja defini" );
+ }
+ else {
+ $PFTOOLS_VARS->{$2} = 1;
+ }
+ }
+ elsif ( $1 eq "undef" ) {
+ if ( not defined( $PFTOOLS_VARS->{$2} ) ) {
+ Warn( $CODE->{'OPEN'},
+ $FIC_CONF[0] . ":"
+ . $line[0] . ": "
+ . $2
+ . " deja non defini" );
+ }
+ else {
+ undef $PFTOOLS_VARS->{$2};
+ }
+ }
+ else {
+ Abort( $CODE->{'SYNTAX'},
+ $FIC_CONF[0] . ":"
+ . $line[0]
+ . ": Directive "
+ . $1
+ . " inconnue" );
+ }
+ next;
+ }
+
+ # Detection des sections
+ if (/^\[([^\]]+)\]$/) {
+ if ( defined $substdestvars && $substdestvars ) {
+ $current = Subst_vars( $1, $substdestvars );
+ }
+ else {
+ $current = $1;
+ }
+ if ( defined( $CONF->{$current} ) ) {
+ Abort( $CODE->{'SYNTAX'},
+ $FIC_CONF[0] . ":"
+ . $line[0] . ": ["
+ . $current
+ . "] dupliquee (precedente a "
+ . $LOCATION->{$current}->{_location}
+ . ")" );
+ }
+ else {
+ $CONF->{$current} = {};
+ $LOCATION->{$current}->{_location}
+ = $FIC_CONF[0] . ":" . $line[0];
+ }
+ next;
+ }
+
+ # Traitement des variables
+ if (/^([^\s]+)\s*=\s*(.+)$/) {
+ my ( $var, $val ) = ( $1, $2 );
+ if ( defined( $CONF->{$current}->{$var} ) ) {
+ Abort( $CODE->{'SYNTAX'},
+ $FIC_CONF[0] . ":"
+ . $line[0] . ": "
+ . $var
+ . " dupliquee (precedente a "
+ . $LOCATION->{$current}->{$var}->{_location}
+ . ")" );
+ }
+ else {
+
+ if ( __Add_var( $CONF->{$current}, $var, $val )
+ == $CODE->{'SYNTAX'} )
+ {
+ Abort( $CODE->{'SYNTAX'},
+ $FIC_CONF[0] . ":"
+ . $line[0] . ": "
+ . $var
+ . " dupliquee (precedente a "
+ . $LOCATION->{$current}->{$var}->{_location}
+ . ")" );
+ }
+ $LOCATION->{$current}->{$var}->{_location}
+ = $FIC_CONF[0] . ":" . $line[0];
+ }
+ }
+ else {
+ Abort( $CODE->{'SYNTAX'},
+ $FIC_CONF[0] . ":" . $line[0] . ": Erreur de syntaxe" );
+ }
+ }
+ close( $FH[0] );
+ print "Closing $FIC_CONF[0] -- $FH[0]\n" if ($DEBUG);
+ shift @FH;
+ print "Filehandles after closing --> @FH\n" if ($DEBUG);
+ shift @line;
+ shift @FIC_CONF;
}
# Conditions non fermees
if ( $#cond >= 0 ) {
- Abort( $CODE->{'SYNTAX'}, "EOC: endif manquant" );
+ Abort( $CODE->{'SYNTAX'}, "EOC: endif manquant" );
}
return ($CONF);
Modified: branches/next-gen/lib/PFTools/Compat/Translation.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Compat/Translation.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Compat/Translation.pm (original)
+++ branches/next-gen/lib/PFTools/Compat/Translation.pm Tue Sep 7 08:54:37 2010
@@ -27,9 +27,9 @@
our @ISA = ('Exporter');
our @EXPORT = qw (
- Translate_old2new_host
- Translate_old2new_network
- Translate_old2new_config
+ Translate_old2new_host
+ Translate_old2new_network
+ Translate_old2new_config
);
our @EXPORT_OK = qw();
@@ -38,231 +38,318 @@
use NetAddr::IP;
sub Translate_old2new_config ($) {
- my ( $conf_parsed ) = @_;
-
- my $new_conf = $conf_parsed;
- foreach my $section ( keys %{$new_conf} ) {
- if ( $section =~ /^@(.*)$/ ) {
- $new_conf->{$1} = {
- 'type' => 'include'
- };
- next;
- }
- foreach my $key ( keys %{$new_conf->{$section}} ) {
- # Filter substitution
- $new_conf->{$section}->{$key} =~ s/(filter_(\S+)) (\S+) (\S+) (\S+)/$1 -i $3 -h $4 -o $5/g;
- $new_conf->{$section}->{$key} =~ s/^apt-get$/installpkg/;
- $new_conf->{$section}->{$key} =~ s/^dpkg-purge$/purgepkg/;
- if ( $new_conf->{$section}->{$key} =~ /mk_pxelinuxcfg/ ) {
- $new_conf->{$section}->{$key} =~ s/mk_pxelinuxcfg (\S+) (\S+)/mk_pxelinuxcfg/;
- }
- elsif ( $new_conf->{$section}->{$key} =~ /mk_grubopt/ ) {
- $new_conf->{$section}->{$key} =~ s/mk_grubopt -d (\S+) --host (\S+)/mk_grubopt -h $2 -o $1 --grub 1/;
- }
- elsif ( $new_conf->{$section}->{$key} =~ /mk_grub2opt/ ) {
- $new_conf->{$section}->{$key} =~ s/mk_grubopt -d (\S+) --host (\S+)/mk_grubopt -h $2 -o $1/;
- }
- elsif ( $new_conf->{$section}->{$key} =~ /mk_resolvconf/ ) {
- $new_conf->{$section}->{$key} =~ s/mk_resolvconf (\S+) (\S+) (\S+)/mk_resolvconf -h $2 -o $3/;
- }
- elsif ( $new_conf->{$section}->{$key} =~ /mk_interfaces/ ) {
- $new_conf->{$section}->{$key} =~ s/mk_interfaces (\S+) (\S+) (\S+)/mk_interfaces -h $2 -o $3/;
- }
- elsif ( $new_conf->{$section}->{$key} =~ /mk_dhcp/ ) {
- $new_conf->{$section}->{$key} =~ s/mk_dhcp (\S+) (\S+) (\S+)/mk_dhcp -H $1 -o $3/;
- }
- elsif ( $new_conf->{$section}->{$key} =~ /mk_privatezone/ ) {
- $new_conf->{$section}->{$key} =~ s/mk_privatezone (\S+) (\S+)/mk_sitezone -o $2/;
- }
- elsif ( $new_conf->{$section}->{$key} =~ /mk_sourceslist/ ) {
- $new_conf->{$section}->{$key} =~ s/mk_sourceslist -s (\S+) -d (\S+)--host (\S+)/mk_sourceslist -h $2 -o $1/;
- }
- }
- }
- return $new_conf;
+ my ($conf_parsed) = @_;
+
+ my $new_conf = $conf_parsed;
+ foreach my $section ( keys %{$new_conf} ) {
+ if ( $section =~ /^@(.*)$/ ) {
+ $new_conf->{$1} = { 'type' => 'include' };
+ next;
+ }
+ foreach my $key ( keys %{ $new_conf->{$section} } ) {
+
+ # Filter substitution
+ $new_conf->{$section}->{$key}
+ =~ s/(filter_(\S+)) (\S+) (\S+) (\S+)/$1 -i $3 -h $4 -o $5/g;
+ $new_conf->{$section}->{$key} =~ s/^apt-get$/installpkg/;
+ $new_conf->{$section}->{$key} =~ s/^dpkg-purge$/purgepkg/;
+ if ( $new_conf->{$section}->{$key} =~ /mk_pxelinuxcfg/ ) {
+ $new_conf->{$section}->{$key}
+ =~ s/mk_pxelinuxcfg (\S+) (\S+)/mk_pxelinuxcfg/;
+ }
+ elsif ( $new_conf->{$section}->{$key} =~ /mk_grubopt/ ) {
+ $new_conf->{$section}->{$key}
+ =~ s/mk_grubopt -d (\S+) --host (\S+)/mk_grubopt -h $2 -o $1 --grub 1/;
+ }
+ elsif ( $new_conf->{$section}->{$key} =~ /mk_grub2opt/ ) {
+ $new_conf->{$section}->{$key}
+ =~ s/mk_grubopt -d (\S+) --host (\S+)/mk_grubopt -h $2 -o $1/;
+ }
+ elsif ( $new_conf->{$section}->{$key} =~ /mk_resolvconf/ ) {
+ $new_conf->{$section}->{$key}
+ =~ s/mk_resolvconf (\S+) (\S+) (\S+)/mk_resolvconf -h $2 -o $3/;
+ }
+ elsif ( $new_conf->{$section}->{$key} =~ /mk_interfaces/ ) {
+ $new_conf->{$section}->{$key}
+ =~ s/mk_interfaces (\S+) (\S+) (\S+)/mk_interfaces -h $2 -o $3/;
+ }
+ elsif ( $new_conf->{$section}->{$key} =~ /mk_dhcp/ ) {
+ $new_conf->{$section}->{$key}
+ =~ s/mk_dhcp (\S+) (\S+) (\S+)/mk_dhcp -H $1 -o $3/;
+ }
+ elsif ( $new_conf->{$section}->{$key} =~ /mk_privatezone/ ) {
+ $new_conf->{$section}->{$key}
+ =~ s/mk_privatezone (\S+) (\S+)/mk_sitezone -o $2/;
+ }
+ elsif ( $new_conf->{$section}->{$key} =~ /mk_sourceslist/ ) {
+ $new_conf->{$section}->{$key}
+ =~ s/mk_sourceslist -s (\S+) -d (\S+)--host (\S+)/mk_sourceslist -h $2 -o $1/;
+ }
+ }
+ }
+ return $new_conf;
}
sub Translate_old2new_network ($$) {
- my ( $network_parsed, $network_name ) = @_;
- my $new_network;
-
- if ( $network_parsed->{'type'} ne 'network' ) {
- Warn ( $CODE->{'INVALID_CONTEXT'}, "Unable to translate into new format a section which is not a network declaration" );
- return;
- }
- my $net = new NetAddr::IP ( $network_parsed->{'network'}, $network_parsed->{'netmask'} );
- if ( ! defined $net ) {
- Warn ( $CODE->{'INVALID_VALUE'}, "Invalid network definition for network name ".$network_name );
- return;
- }
- $new_network = {
- 'type' => 'network',
- 'comment' => $network_parsed->{'comment'},
- 'network' => $net->cidr(),
- 'tag' => $network_parsed->{'tag'},
- 'site' => 'UNDEFINED',
- 'scope' => ( $network_parsed->{'network_parsed'} =~ /^10\./ ) ? 'private' : 'public'
- };
- return $new_network;
+ my ( $network_parsed, $network_name ) = @_;
+ my $new_network;
+
+ if ( $network_parsed->{'type'} ne 'network' ) {
+ Warn( $CODE->{'INVALID_CONTEXT'},
+ "Unable to translate into new format a section which is not a network declaration"
+ );
+ return;
+ }
+ my $net = new NetAddr::IP( $network_parsed->{'network'},
+ $network_parsed->{'netmask'} );
+ if ( !defined $net ) {
+ Warn( $CODE->{'INVALID_VALUE'},
+ "Invalid network definition for network name " . $network_name );
+ return;
+ }
+ $new_network = {
+ 'type' => 'network',
+ 'comment' => $network_parsed->{'comment'},
+ 'network' => $net->cidr(),
+ 'tag' => $network_parsed->{'tag'},
+ 'site' => 'UNDEFINED',
+ 'scope' => ( $network_parsed->{'network_parsed'} =~ /^10\./ )
+ ? 'private'
+ : 'public'
+ };
+ return $new_network;
}
sub Translate_old2new_host ($$) {
- my ( $host_parsed, $hostname ) = @_;
- my $new_host = {};
-
- if ( $host_parsed->{'type'} !~ /-server$/ ) {
- Warn ( $CODE->{'INVALID_CONTEXT'}, "Unable to translate into new format a section which is not a host declaration" );
- return;
- }
-
- $new_host->{'hostgroup'}->{'hostname'} = $hostname;
- $new_host->{'hostgroup'}->{'comment'} = $host_parsed->{'comment'} || "";
- foreach my $key ( keys %{$host_parsed} ) {
- if ( $key eq 'shortname' ) {
- $new_host->{'dns'}->{'shortname'} = $host_parsed->{'shortname'};
- }
- elsif ( $key eq 'ether' ) {
- foreach my $num ( sort keys %{$host_parsed->{'ether'}} ) {
- $new_host->{'interface::eth0'}->{'mac.'.$num} = $host_parsed->{$key}->{$num};
- }
- }
- elsif ( $key =~ /^arch|distrib|deploymode$/ ) {
- my $new_key = ( $key eq 'deploymode' ) ? 'mode' : $key;
- if ( ref $host_parsed->{$key} eq 'HASH' ) {
- foreach my $subkey ( keys %{$host_parsed->{$key}} ) {
- if ( $subkey eq 'default' ) {
- $new_host->{'deployment'}->{$new_key} = $host_parsed->{$key}->{$subkey};
- }
- else {
- $new_host->{'deployment'}->{$new_key.'.'.$subkey} = $host_parsed->{$key}->{$subkey};
- }
- }
- }
- else {
- $new_host->{'deployment'}->{$new_key} = $host_parsed->{$key};
- }
- }
- elsif ( $key =~ /^order|number$/ ) {
- $new_host->{'hostgroup'}->{$key} = $host_parsed->{$key};
- }
- elsif ( $key eq 'interface' ) {
- foreach my $iface ( keys %{$host_parsed->{$key}} ){
- my $vlan = $host_parsed->{$key}->{$iface};
- $new_host->{'interface::'.$iface}->{'vlan'} = $vlan;
- if ( defined $host_parsed->{'ipstart'}->{$vlan} ) {
- $new_host->{'interface::'.$iface}->{'ipv4'} = $host_parsed->{'ipstart'}->{$vlan};
- }
- elsif ( defined $host_parsed->{'ip'}->{$vlan} ) {
- foreach my $subkey ( keys %{$host_parsed->{'ip'}->{$vlan}} ) {
- if ( $subkey eq 'default' && ! defined $new_host->{'interface::'.$iface}->{'ipv4'} ) {
- $new_host->{'interface::'.$iface}->{'ipv4'} = $host_parsed->{'ip'}->{$vlan}->{$subkey};
- }
- else {
- $new_host->{'interface::'.$iface}->{'ipv4.'.$subkey} = $host_parsed->{'ip'}->{$vlan}->{$subkey};
- }
- }
- }
- else {
- $new_host->{'interface::'.$iface}->{'ipv4'} = $host_parsed->{'ipstart'}->{'default'};
- }
- if ( defined $host_parsed->{$iface} ) {
- foreach my $route ( keys %{$host_parsed->{$iface}} ) {
- if ( ref $host_parsed->{$iface}->{$route} eq 'HASH' ) {
- foreach my $subkey ( keys %{$host_parsed->{$iface}->{$route}} ) {
- if ( $subkey eq 'default' ) {
- push ( @{$new_host->{'interface::'.$iface}->{'@route'}}, $host_parsed->{$iface}->{$route}->{$subkey} );
- }
- else {
- push ( @{$new_host->{'interface::'.$iface}->{'@route.'.$subkey}}, $host_parsed->{$iface}->{$route}->{$subkey} );
- }
- }
- }
- }
- if ( $iface =~ /^bond/ ) {
- if ( ref $host_parsed->{'bonding'}->{$iface} eq 'HASH' ) {
- foreach my $subkey ( keys %{$host_parsed->{'bonding'}->{$iface}} ) {
- if ( $subkey eq 'default' ) {
- $new_host->{'interface::'.$iface}->{'slaves'} = $host_parsed->{'bonding'}->{$iface}->{$subkey};
- }
- else {
- $new_host->{'interface::'.$iface}->{'slaves.'.$subkey} = $host_parsed->{'bonding'}->{$iface}->{$subkey};
- }
- }
- }
- else {
- $new_host->{'interface::'.$iface}->{'slaves'} = $host_parsed->{'bonding'}->{$iface};
- }
- my $ref_cmdline = {};
- if ( ref $host_parsed->{'cmdline'} eq 'HASH' ) {
- $ref_cmdline = $host_parsed->{'cmdline'};
- } else {
- $ref_cmdline->{'default'} = $host_parsed->{'cmdline'};
- }
- foreach my $cmdline ( keys %{$ref_cmdline} ) {
- my $newcmd_key = ( $cmdline eq 'default' ) ? 'cmdline' : 'cmdline.'.$cmdline;
- my $newopt_key = ( $cmdline eq 'default' ) ? 'options' : 'options.'.$cmdline;
- my $newmode_key = ( $cmdline eq 'default' ) ? 'mode' : 'mode.'.$cmdline;
- foreach my $cmd ( split ( / /, $ref_cmdline->{$cmdline} ) ) {
- if ( $cmd =~ /^bonding\.(.+)$/ ) {
- my ( $opt, $val ) = split ( /=/, $1 );
- my $new_opt;
- if ( $opt eq 'mode' ) {
- $new_host->{'interface::'.$iface}->{$newmode_key} = $val;
- }
- else {
- $new_host->{'interface::'.$iface}->{$newopt_key} = $opt.'='.$val.' ';
- }
- }
- else {
- $new_host->{'boot'}->{$newcmd_key} .= $cmd." ";
- }
- }
- $new_host->{'interface::'.$iface}->{$newopt_key} =~ s/\s*$//;
- $new_host->{'boot'}->{$newcmd_key} =~ s/\s*$// if ( $new_host->{'boot'}->{$newcmd_key} );
- }
- }
- }
- }
- }
- elsif ( $key eq 'alias' ) {
- foreach my $alias ( keys %{$host_parsed->{$key}} ) {
- $new_host->{'dns'}->{'alias.'.$alias} = $host_parsed->{$key}->{$alias};
- }
- }
- elsif ( $key eq 'dns' ) {
- if ( ref $host_parsed->{$key} eq 'HASH' ) {
- foreach my $subkey ( keys %{$host_parsed->{$key}} ) {
- my $new_key = ( $subkey eq 'default' ) ? 'resolver' : 'resolver.'.$subkey;
- $new_host->{'dns'}->{$new_key} = $host_parsed->{$key}->{$subkey};
- }
- }
- else {
- $new_host->{'dns'}->{'resolver'} = $host_parsed->{$key};
- }
- }
- elsif ( $key =~ /^console|(pxe|uml)?filename$/ ) {
- my $new_key;
- if ( defined $1 ) {
- $new_key = ( $1 eq 'uml' ) ? 'kerneluml' : 'kernel';
- }
- elsif ( $key eq 'filename' ) {
- $new_key = 'pxefilename';
- }
- else {
- $new_key = $key;
- }
- if ( ref $host_parsed->{$key} eq 'HASH' ) {
- foreach my $subkey ( keys %{$host_parsed->{$key}} ) {
- my $newsub_key = ( $subkey eq 'default' ) ? $new_key : $new_key.'.'.$subkey;
- $new_host->{'boot'}->{$newsub_key} = $host_parsed->{$key}->{$subkey};
- }
- }
- else {
- $new_host->{'boot'}->{$new_key} = $host_parsed->{$key};
- }
- }
- }
- return $new_host;
+ my ( $host_parsed, $hostname ) = @_;
+ my $new_host = {};
+
+ if ( $host_parsed->{'type'} !~ /-server$/ ) {
+ Warn( $CODE->{'INVALID_CONTEXT'},
+ "Unable to translate into new format a section which is not a host declaration"
+ );
+ return;
+ }
+
+ $new_host->{'hostgroup'}->{'hostname'} = $hostname;
+ $new_host->{'hostgroup'}->{'comment'} = $host_parsed->{'comment'} || "";
+ foreach my $key ( keys %{$host_parsed} ) {
+ if ( $key eq 'shortname' ) {
+ $new_host->{'dns'}->{'shortname'} = $host_parsed->{'shortname'};
+ }
+ elsif ( $key eq 'ether' ) {
+ foreach my $num ( sort keys %{ $host_parsed->{'ether'} } ) {
+ $new_host->{'interface::eth0'}->{ 'mac.' . $num }
+ = $host_parsed->{$key}->{$num};
+ }
+ }
+ elsif ( $key =~ /^arch|distrib|deploymode$/ ) {
+ my $new_key = ( $key eq 'deploymode' ) ? 'mode' : $key;
+ if ( ref $host_parsed->{$key} eq 'HASH' ) {
+ foreach my $subkey ( keys %{ $host_parsed->{$key} } ) {
+ if ( $subkey eq 'default' ) {
+ $new_host->{'deployment'}->{$new_key}
+ = $host_parsed->{$key}->{$subkey};
+ }
+ else {
+ $new_host->{'deployment'}
+ ->{ $new_key . '.' . $subkey }
+ = $host_parsed->{$key}->{$subkey};
+ }
+ }
+ }
+ else {
+ $new_host->{'deployment'}->{$new_key} = $host_parsed->{$key};
+ }
+ }
+ elsif ( $key =~ /^order|number$/ ) {
+ $new_host->{'hostgroup'}->{$key} = $host_parsed->{$key};
+ }
+ elsif ( $key eq 'interface' ) {
+ foreach my $iface ( keys %{ $host_parsed->{$key} } ) {
+ my $vlan = $host_parsed->{$key}->{$iface};
+ $new_host->{ 'interface::' . $iface }->{'vlan'} = $vlan;
+ if ( defined $host_parsed->{'ipstart'}->{$vlan} ) {
+ $new_host->{ 'interface::' . $iface }->{'ipv4'}
+ = $host_parsed->{'ipstart'}->{$vlan};
+ }
+ elsif ( defined $host_parsed->{'ip'}->{$vlan} ) {
+ foreach
+ my $subkey ( keys %{ $host_parsed->{'ip'}->{$vlan} } )
+ {
+ if ( $subkey eq 'default'
+ && !
+ defined $new_host->{ 'interface::' . $iface }
+ ->{'ipv4'} )
+ {
+ $new_host->{ 'interface::' . $iface }->{'ipv4'}
+ = $host_parsed->{'ip'}->{$vlan}->{$subkey};
+ }
+ else {
+ $new_host->{ 'interface::' . $iface }
+ ->{ 'ipv4.' . $subkey }
+ = $host_parsed->{'ip'}->{$vlan}->{$subkey};
+ }
+ }
+ }
+ else {
+ $new_host->{ 'interface::' . $iface }->{'ipv4'}
+ = $host_parsed->{'ipstart'}->{'default'};
+ }
+ if ( defined $host_parsed->{$iface} ) {
+ foreach my $route ( keys %{ $host_parsed->{$iface} } ) {
+ if ( ref $host_parsed->{$iface}->{$route} eq 'HASH' )
+ {
+ foreach my $subkey (
+ keys %{ $host_parsed->{$iface}->{$route} } )
+ {
+ if ( $subkey eq 'default' ) {
+ push(
+ @{ $new_host->{ 'interface::'
+ . $iface }->{'@route'}
+ },
+ $host_parsed->{$iface}->{$route}
+ ->{$subkey}
+ );
+ }
+ else {
+ push(
+ @{ $new_host->{ 'interface::'
+ . $iface }
+ ->{ '@route.' . $subkey }
+ },
+ $host_parsed->{$iface}->{$route}
+ ->{$subkey}
+ );
+ }
+ }
+ }
+ }
+ if ( $iface =~ /^bond/ ) {
+ if (ref $host_parsed->{'bonding'}->{$iface} eq
+ 'HASH' )
+ {
+ foreach my $subkey (
+ keys %{ $host_parsed->{'bonding'}->{$iface} }
+ )
+ {
+ if ( $subkey eq 'default' ) {
+ $new_host->{ 'interface::' . $iface }
+ ->{'slaves'}
+ = $host_parsed->{'bonding'}->{$iface}
+ ->{$subkey};
+ }
+ else {
+ $new_host->{ 'interface::' . $iface }
+ ->{ 'slaves.' . $subkey }
+ = $host_parsed->{'bonding'}->{$iface}
+ ->{$subkey};
+ }
+ }
+ }
+ else {
+ $new_host->{ 'interface::' . $iface }->{'slaves'}
+ = $host_parsed->{'bonding'}->{$iface};
+ }
+ my $ref_cmdline = {};
+ if ( ref $host_parsed->{'cmdline'} eq 'HASH' ) {
+ $ref_cmdline = $host_parsed->{'cmdline'};
+ }
+ else {
+ $ref_cmdline->{'default'}
+ = $host_parsed->{'cmdline'};
+ }
+ foreach my $cmdline ( keys %{$ref_cmdline} ) {
+ my $newcmd_key
+ = ( $cmdline eq 'default' )
+ ? 'cmdline'
+ : 'cmdline.' . $cmdline;
+ my $newopt_key
+ = ( $cmdline eq 'default' )
+ ? 'options'
+ : 'options.' . $cmdline;
+ my $newmode_key
+ = ( $cmdline eq 'default' )
+ ? 'mode'
+ : 'mode.' . $cmdline;
+ foreach my $cmd (
+ split( / /, $ref_cmdline->{$cmdline} ) )
+ {
+ if ( $cmd =~ /^bonding\.(.+)$/ ) {
+ my ( $opt, $val ) = split( /=/, $1 );
+ my $new_opt;
+ if ( $opt eq 'mode' ) {
+ $new_host->{ 'interface::' . $iface }
+ ->{$newmode_key} = $val;
+ }
+ else {
+ $new_host->{ 'interface::' . $iface }
+ ->{$newopt_key}
+ = $opt . '=' . $val . ' ';
+ }
+ }
+ else {
+ $new_host->{'boot'}->{$newcmd_key}
+ .= $cmd . " ";
+ }
+ }
+ $new_host->{ 'interface::' . $iface }
+ ->{$newopt_key} =~ s/\s*$//;
+ $new_host->{'boot'}->{$newcmd_key} =~ s/\s*$//
+ if ( $new_host->{'boot'}->{$newcmd_key} );
+ }
+ }
+ }
+ }
+ }
+ elsif ( $key eq 'alias' ) {
+ foreach my $alias ( keys %{ $host_parsed->{$key} } ) {
+ $new_host->{'dns'}->{ 'alias.' . $alias }
+ = $host_parsed->{$key}->{$alias};
+ }
+ }
+ elsif ( $key eq 'dns' ) {
+ if ( ref $host_parsed->{$key} eq 'HASH' ) {
+ foreach my $subkey ( keys %{ $host_parsed->{$key} } ) {
+ my $new_key
+ = ( $subkey eq 'default' )
+ ? 'resolver'
+ : 'resolver.' . $subkey;
+ $new_host->{'dns'}->{$new_key}
+ = $host_parsed->{$key}->{$subkey};
+ }
+ }
+ else {
+ $new_host->{'dns'}->{'resolver'} = $host_parsed->{$key};
+ }
+ }
+ elsif ( $key =~ /^console|(pxe|uml)?filename$/ ) {
+ my $new_key;
+ if ( defined $1 ) {
+ $new_key = ( $1 eq 'uml' ) ? 'kerneluml' : 'kernel';
+ }
+ elsif ( $key eq 'filename' ) {
+ $new_key = 'pxefilename';
+ }
+ else {
+ $new_key = $key;
+ }
+ if ( ref $host_parsed->{$key} eq 'HASH' ) {
+ foreach my $subkey ( keys %{ $host_parsed->{$key} } ) {
+ my $newsub_key
+ = ( $subkey eq 'default' )
+ ? $new_key
+ : $new_key . '.' . $subkey;
+ $new_host->{'boot'}->{$newsub_key}
+ = $host_parsed->{$key}->{$subkey};
+ }
+ }
+ else {
+ $new_host->{'boot'}->{$new_key} = $host_parsed->{$key};
+ }
+ }
+ }
+ return $new_host;
}
1;
Modified: branches/next-gen/lib/PFTools/Conf.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Conf.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Conf.pm (original)
+++ branches/next-gen/lib/PFTools/Conf.pm Tue Sep 7 08:54:37 2010
@@ -41,15 +41,15 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Subst_vars
- Init_SUBST
- Init_PF_CONFIG
- Init_GLOBAL_NETCONFIG
- Load_conf
- Flush2disk_GLOBAL
- Retrieve_GLOBAL
- Get_source
- Get_config_for_hostname_on_site
+ Subst_vars
+ Init_SUBST
+ Init_PF_CONFIG
+ Init_GLOBAL_NETCONFIG
+ Load_conf
+ Flush2disk_GLOBAL
+ Retrieve_GLOBAL
+ Get_source
+ Get_config_for_hostname_on_site
);
our @EXPORT_OK = qw();
@@ -63,449 +63,556 @@
#################################
### Constants
-my $DEBUG = 0 ;
+my $DEBUG = 0;
#############################################################
### Default value for configuration with new method
-our $PF_CONFIG = {};
+our $PF_CONFIG = {};
$PF_CONFIG->{'path'} = {
- 'status_dir' => '/var/lib/pftools',
- 'distrib_dir' => '/distrib',
- 'tftp_dir' => '/distrib/tftpboot',
- 'pxefiles_dir' => '/distrib/tftpboot/pxelinux.cfg',
- 'global_struct' => '/var/lib/pf-tools/global_struct.stor',
- 'deploy_docroot' => '/var/www',
- 'preseed_dir' => '/var/www/preseed',
- 'checkout_dir' => '/var/lib/cvsguest',
- 'templates_dir' => '/usr/share/pf-tools/templates',
- 'common_config' => 'update-common',
- 'start_file' => 'private-network'
+ 'status_dir' => '/var/lib/pftools',
+ 'distrib_dir' => '/distrib',
+ 'tftp_dir' => '/distrib/tftpboot',
+ 'pxefiles_dir' => '/distrib/tftpboot/pxelinux.cfg',
+ 'global_struct' => '/var/lib/pf-tools/global_struct.stor',
+ 'deploy_docroot' => '/var/www',
+ 'preseed_dir' => '/var/www/preseed',
+ 'checkout_dir' => '/var/lib/cvsguest',
+ 'templates_dir' => '/usr/share/pf-tools/templates',
+ 'common_config' => 'update-common',
+ 'start_file' => 'private-network'
};
$PF_CONFIG->{'features'} = {
- 'ipv4' => 1,
- 'ipv6' => 0,
- 'update' => 1
+ 'ipv4' => 1,
+ 'ipv6' => 0,
+ 'update' => 1
};
$PF_CONFIG->{'vcs'} = {
- 'type' => 'cvs',
- 'user' => 'cvsguest',
- 'password' => '',
- 'method' => 'rsh',
- 'rsh' => '/usr/local/sbin/cvs_rsh',
- 'server' => 'cvs.private',
- 'vcsroot' => '/var/lib/cvs/repository',
- 'module' => 'config',
- 'umask' => '0077',
- 'command' => '',
- 'branche' => ''
+ 'type' => 'cvs',
+ 'user' => 'cvsguest',
+ 'password' => '',
+ 'method' => 'rsh',
+ 'rsh' => '/usr/local/sbin/cvs_rsh',
+ 'server' => 'cvs.private',
+ 'vcsroot' => '/var/lib/cvs/repository',
+ 'module' => 'config',
+ 'umask' => '0077',
+ 'command' => '',
+ 'branche' => ''
};
$PF_CONFIG->{'debian'} = {
- 'preseed' => 'standard-preseed',
- 'pxe' => 'standard-installer',
- 'sources_list' => 'sources.list',
- 'default_sections' => 'main contrib non-free',
- 'custom-sections' => 'common',
- 'grub' => '/boot/grub/menu.lst',
- 'grub2' => '/etc/default/grub'
+ 'preseed' => 'standard-preseed',
+ 'pxe' => 'standard-installer',
+ 'sources_list' => 'sources.list',
+ 'default_sections' => 'main contrib non-free',
+ 'custom-sections' => 'common',
+ 'grub' => '/boot/grub/menu.lst',
+ 'grub2' => '/etc/default/grub'
};
$PF_CONFIG->{'ubuntu'} = {
- 'preseed' => 'ubuntu-preseed',
- 'pxe' => 'ubuntu-installer',
- 'sources_list' => 'ubuntu-sources.list',
- 'default_sections' => 'main universe restricted',
- 'custom-sections' => 'common'
+ 'preseed' => 'ubuntu-preseed',
+ 'pxe' => 'ubuntu-installer',
+ 'sources_list' => 'ubuntu-sources.list',
+ 'default_sections' => 'main universe restricted',
+ 'custom-sections' => 'common'
};
$PF_CONFIG->{'regex'} = {
- 'hostname_model' => $MODEL_CONFIG_REGEX,
- 'hostname' => $HOST_CONFIG_REGEX,
- 'hosttype' => $HOSTTYPE_CONFIG_REGEX,
- 'deploy_hosts' => $DEPLOY_CONFIG_REGEX,
- 'network_fstype' => '(nfs|cifs)'
+ 'hostname_model' => $MODEL_CONFIG_REGEX,
+ 'hostname' => $HOST_CONFIG_REGEX,
+ 'hosttype' => $HOSTTYPE_CONFIG_REGEX,
+ 'deploy_hosts' => $DEPLOY_CONFIG_REGEX,
+ 'network_fstype' => '(nfs|cifs)'
};
$PF_CONFIG->{'location'} = {
- 'site' => '',
- 'zone' => ''
+ 'site' => '',
+ 'zone' => ''
};
# Subst_vars
sub Subst_vars ($$) {
my ( $str, $hash_subst ) = @_;
- $str =~ s/%([^\%]+)%/$hash_subst->{$1}/gm;
+ $str =~ s/%([^\%]+)%/$hash_subst->{$1}/gm;
return $str;
}
sub Init_PF_CONFIG (;$) {
- my ( $config_file ) = @_;
-
- return $PF_CONFIG if ( ! defined $config_file );
- if ( ! -e $config_file ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unable to proceed with configuration file ".$config_file." : no such file or directory" );
- }
- if ( -r $config_file ) {
- my ( $dev, $ino, $mode, $nlink, $uid, $gid, @lstat_vars ) = lstat($config_file);
+ my ($config_file) = @_;
+
+ return $PF_CONFIG if ( !defined $config_file );
+ if ( !-e $config_file ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unable to proceed with configuration file "
+ . $config_file
+ . " : no such file or directory" );
+ }
+ if ( -r $config_file ) {
+ my ( $dev, $ino, $mode, $nlink, $uid, $gid, @lstat_vars )
+ = lstat($config_file);
+
# unless ( $uid == 0 && $gid == 0 && S_IMODE($mode) == 0600 && S_ISREG($mode) ) {
- unless ( S_IMODE($mode) == 0600 && S_ISREG($mode) ) {
- Abort ( $CODE->{'RIGHTS'},
- "Ignoring weak rights for configuration file ".$config_file." (check owner/group/mode)" );
- }
- }
-
- my $conf_parsed = Parser_ini ( $config_file );
- Abort ( $CODE->{'SYNTAX'}, "Unable to parse configuration file ".$config_file ) if ( ! defined $conf_parsed );
- foreach my $section ( keys %{$PF_CONFIG} ) {
- next if ( ! defined $conf_parsed->{$section} );
- foreach my $key ( keys %{$PF_CONFIG->{$section}} ) {
- if ( defined $conf_parsed->{$section}->{$key} ) {
- $PF_CONFIG->{$section}->{$key} = $conf_parsed->{$section}->{$key};
- }
- }
- }
- return $PF_CONFIG;
+ unless ( S_IMODE($mode) == 0600 && S_ISREG($mode) ) {
+ Abort( $CODE->{'RIGHTS'},
+ "Ignoring weak rights for configuration file "
+ . $config_file
+ . " (check owner/group/mode)" );
+ }
+ }
+
+ my $conf_parsed = Parser_ini($config_file);
+ Abort( $CODE->{'SYNTAX'},
+ "Unable to parse configuration file " . $config_file )
+ if ( !defined $conf_parsed );
+ foreach my $section ( keys %{$PF_CONFIG} ) {
+ next if ( !defined $conf_parsed->{$section} );
+ foreach my $key ( keys %{ $PF_CONFIG->{$section} } ) {
+ if ( defined $conf_parsed->{$section}->{$key} ) {
+ $PF_CONFIG->{$section}->{$key}
+ = $conf_parsed->{$section}->{$key};
+ }
+ }
+ }
+ return $PF_CONFIG;
}
sub Init_SUBST (;$$$$) {
- my ( $host, $hosttype, $pf_config, $domain ) = @_ ;
- my $host_regex; my $ref_subst = {};
-
- if ( ! defined $pf_config ) {
- $pf_config = Init_PF_CONFIG ();
- }
-
- if ( ! defined $host ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unable to init substitution hash for hostname ".$host."\n" );
- return ;
- }
- $ref_subst->{'HOSTNAME'} = ( $host ne "" ) ? $host : hostname;
- $ref_subst->{'DOMAINNAME'} = $domain || $pf_config->{'location'}->{'zone'} || "";
- if ( $ref_subst->{'DOMAINNAME'} eq "" ) {
- if ( -x "/bin/domainname" ) {
- chomp( $ref_subst->{'DOMAINNAME'} = `/bin/domainname 2>>/dev/null` );
- }
- elsif ( -x "/bin/dnsdomainname" ) {
- chomp( $ref_subst->{'DOMAINNAME'} = `/bin/dnsdomainname 2>>/dev/null` );
- }
- }
- chomp ( $ref_subst->{'OS_RELEASE'} = `/bin/uname -r` ) ;
- if ( defined $pf_config->{'regex'}->{'hostname'} ) {
- $host_regex = $pf_config->{'regex'}->{'hostname'};
- }
- else {
- $host_regex = $HOST_CONFIG_REGEX;
- }
- unless ($ref_subst->{'HOSTNAME'} =~ m/$host_regex/) {
- Abort( $CODE->{'OPEN'}, "Init_SUBST failed: invalid hostname $ref_subst->{'HOSTNAME'}" );
- }
- $ref_subst->{'HOSTTYPE'} = $hosttype || $+{HOSTTYPE} ;
- $ref_subst->{'HOSTDIGITS'} = $+{HOSTDIGITS} ;
- $ref_subst->{'HOSTCLUSTER'} = $+{HOSTDIGITS}.$+{HOSTNODEINDEX} if ( defined $+{HOSTDIGITS} && defined $+{HOSTNODEINDEX} );
- $ref_subst->{'HOSTNODEINDEX'} = $+{HOSTNODEINDEX} || "" ;
- $ref_subst->{'POPNAME'} = $+{POPNAME} || "" ;
- $ref_subst->{'HOSTNUM'} = $ref_subst->{'HOSTDIGITS'} ;
- $ref_subst->{'HOSTNUM'} =~ s/^0*// ;
- if ( $ref_subst->{'HOSTNUM'} eq "" ) {
- $ref_subst->{'HOSTNUM'} = 0 ;
- }
- $ref_subst->{'HOSTMINUTE'} = $ref_subst->{'HOSTNUM'} % 60 ;
- $ref_subst->{'HOSTHOUR'} = $ref_subst->{'HOSTNUM'} % 24 ;
- return $ref_subst;
+ my ( $host, $hosttype, $pf_config, $domain ) = @_;
+ my $host_regex;
+ my $ref_subst = {};
+
+ if ( !defined $pf_config ) {
+ $pf_config = Init_PF_CONFIG();
+ }
+
+ if ( !defined $host ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unable to init substitution hash for hostname " . $host . "\n" );
+ return;
+ }
+ $ref_subst->{'HOSTNAME'} = ( $host ne "" ) ? $host : hostname;
+ $ref_subst->{'DOMAINNAME'}
+ = $domain
+ || $pf_config->{'location'}->{'zone'}
+ || "";
+ if ( $ref_subst->{'DOMAINNAME'} eq "" ) {
+ if ( -x "/bin/domainname" ) {
+ chomp( $ref_subst->{'DOMAINNAME'}
+ = `/bin/domainname 2>>/dev/null` );
+ }
+ elsif ( -x "/bin/dnsdomainname" ) {
+ chomp( $ref_subst->{'DOMAINNAME'}
+ = `/bin/dnsdomainname 2>>/dev/null` );
+ }
+ }
+ chomp( $ref_subst->{'OS_RELEASE'} = `/bin/uname -r` );
+ if ( defined $pf_config->{'regex'}->{'hostname'} ) {
+ $host_regex = $pf_config->{'regex'}->{'hostname'};
+ }
+ else {
+ $host_regex = $HOST_CONFIG_REGEX;
+ }
+ unless ( $ref_subst->{'HOSTNAME'} =~ m/$host_regex/ ) {
+ Abort( $CODE->{'OPEN'},
+ "Init_SUBST failed: invalid hostname $ref_subst->{'HOSTNAME'}" );
+ }
+ $ref_subst->{'HOSTTYPE'} = $hosttype || $+{HOSTTYPE};
+ $ref_subst->{'HOSTDIGITS'} = $+{HOSTDIGITS};
+ $ref_subst->{'HOSTCLUSTER'} = $+{HOSTDIGITS} . $+{HOSTNODEINDEX}
+ if ( defined $+{HOSTDIGITS} && defined $+{HOSTNODEINDEX} );
+ $ref_subst->{'HOSTNODEINDEX'} = $+{HOSTNODEINDEX} || "";
+ $ref_subst->{'POPNAME'} = $+{POPNAME} || "";
+ $ref_subst->{'HOSTNUM'} = $ref_subst->{'HOSTDIGITS'};
+ $ref_subst->{'HOSTNUM'} =~ s/^0*//;
+
+ if ( $ref_subst->{'HOSTNUM'} eq "" ) {
+ $ref_subst->{'HOSTNUM'} = 0;
+ }
+ $ref_subst->{'HOSTMINUTE'} = $ref_subst->{'HOSTNUM'} % 60;
+ $ref_subst->{'HOSTHOUR'} = $ref_subst->{'HOSTNUM'} % 24;
+ return $ref_subst;
}
sub Get_source ($$;$$) {
my ( $source, $hostname, $hash_subst, $pf_config ) = @_;
- if ( ! defined $hash_subst ) {
- $hash_subst = Init_SUBST ( $hostname, $pf_config ) ;
- }
- if ( ! defined $pf_config ) {
- $pf_config = $PF_CONFIG;
- }
- my $vcs_work_dir = $pf_config->{'path'}->{'checkout_dir'};
- my $module = $pf_config->{'vcs'}->{'module'};
- $source =~ s!^MODSITE_([^:]+):!$vcs_work_dir/$module/SITE/$1/MODEL!;
- $source =~ s!^MOD:!$vcs_work_dir/$module/MODEL!;
- $source =~ s!^CONFSITE_([^:]+):!$vcs_work_dir/$module/SITE/$1/CONFIG!;
- $source =~ s!^CONF:!$vcs_work_dir/$module/CONFIG!;
- $source =~ s!^SITE_([^:]+):!$vcs_work_dir/$module/SITE/$1!;
- $source =~ s!^SITE:!$vcs_work_dir/$module/SITE!;
- $source =~ s!^HOSTSITE_([^:]+):!$vcs_work_dir/$module/SITE/$1/$hash_subst->{'HOSTTYPE'}!;
- $source =~ s!^HOST:!$vcs_work_dir/$module/$hash_subst->{'HOSTTYPE'}!;
- $source =~ s!^COMMON:!$vcs_work_dir/$module/COMMON!;
- $source =~ s!^CONFIG:!$vcs_work_dir/$module/!;
- $source =~ s!^CVS:!$vcs_work_dir/!;
- $source =~ s!^GLOBAL:!$vcs_work_dir/$module/GLOBAL!;
- return $source;
+ if ( !defined $hash_subst ) {
+ $hash_subst = Init_SUBST( $hostname, $pf_config );
+ }
+ if ( !defined $pf_config ) {
+ $pf_config = $PF_CONFIG;
+ }
+ my $vcs_work_dir = $pf_config->{'path'}->{'checkout_dir'};
+ my $module = $pf_config->{'vcs'}->{'module'};
+ $source =~ s!^MODSITE_([^:]+):!$vcs_work_dir/$module/SITE/$1/MODEL!;
+ $source =~ s!^MOD:!$vcs_work_dir/$module/MODEL!;
+ $source =~ s!^CONFSITE_([^:]+):!$vcs_work_dir/$module/SITE/$1/CONFIG!;
+ $source =~ s!^CONF:!$vcs_work_dir/$module/CONFIG!;
+ $source =~ s!^SITE_([^:]+):!$vcs_work_dir/$module/SITE/$1!;
+ $source =~ s!^SITE:!$vcs_work_dir/$module/SITE!;
+ $source
+ =~ s!^HOSTSITE_([^:]+):!$vcs_work_dir/$module/SITE/$1/$hash_subst->{'HOSTTYPE'}!;
+ $source =~ s!^HOST:!$vcs_work_dir/$module/$hash_subst->{'HOSTTYPE'}!;
+ $source =~ s!^COMMON:!$vcs_work_dir/$module/COMMON!;
+ $source =~ s!^CONFIG:!$vcs_work_dir/$module/!;
+ $source =~ s!^CVS:!$vcs_work_dir/!;
+ $source =~ s!^GLOBAL:!$vcs_work_dir/$module/GLOBAL!;
+ return $source;
}
sub __Get_config_path ($$$) {
- my ( $hostvalue, $pf_config, $site ) = @_;
-
- my $site_conf_file = Get_source ( 'CONFSITE_'.$site.':/update-'.$hostvalue, $hostvalue, {}, $pf_config );
- return $site_conf_file if ( -e $site_conf_file );
- my $default_conf_file = Get_source ( 'CONFIG:/update-'.$hostvalue, $hostvalue, {}, $pf_config );
- return $default_conf_file if ( -e $default_conf_file );
- return undef;
+ my ( $hostvalue, $pf_config, $site ) = @_;
+
+ my $site_conf_file
+ = Get_source( 'CONFSITE_' . $site . ':/update-' . $hostvalue,
+ $hostvalue, {}, $pf_config );
+ return $site_conf_file if ( -e $site_conf_file );
+ my $default_conf_file = Get_source( 'CONFIG:/update-' . $hostvalue,
+ $hostvalue, {}, $pf_config );
+ return $default_conf_file if ( -e $default_conf_file );
+ return undef;
}
sub __Merge_host_config ($$) {
- my ( $hash_to_merge, $hash_subst ) = @_;
- my $merge = {};
-
- if ( $hash_to_merge->{'hostgroup'}->{'__model'} ) {
- $merge = $hash_to_merge->{'hostgroup'}->{'__model'};
- }
- foreach my $section ( @{$hash_to_merge->{'__sections_order'}} ) {
- if ( defined $merge->{$section} ) {
- foreach my $key ( keys %{$hash_to_merge->{$section}} ) {
- next if ( $section eq 'hostgroup' && $key eq '__model' );
- # Adding key if not defined into model else overriding it
- if ( $key =~ /^\@/ ) {
- push ( @{$merge->{$section}->{$key}}, @{$hash_to_merge->{$section}->{$key}} );
- }
- else {
- $merge->{$section}->{$key} = $hash_to_merge->{$section}->{$key};
- }
- }
- }
- else {
- push ( @{$merge->{'__sections_order'}}, $section );
- $merge->{$section} = $hash_to_merge->{$section};
- }
- }
- return $merge;
-}
-
-# sub __Merge_other_context
+ my ( $hash_to_merge, $hash_subst ) = @_;
+ my $merge = {};
+
+ if ( $hash_to_merge->{'hostgroup'}->{'__model'} ) {
+ $merge = $hash_to_merge->{'hostgroup'}->{'__model'};
+ }
+ foreach my $section ( @{ $hash_to_merge->{'__sections_order'} } ) {
+ if ( defined $merge->{$section} ) {
+ foreach my $key ( keys %{ $hash_to_merge->{$section} } ) {
+ next if ( $section eq 'hostgroup' && $key eq '__model' );
+
+ # Adding key if not defined into model else overriding it
+ if ( $key =~ /^\@/ ) {
+ push(
+ @{ $merge->{$section}->{$key} },
+ @{ $hash_to_merge->{$section}->{$key} }
+ );
+ }
+ else {
+ $merge->{$section}->{$key}
+ = $hash_to_merge->{$section}->{$key};
+ }
+ }
+ }
+ else {
+ push( @{ $merge->{'__sections_order'} }, $section );
+ $merge->{$section} = $hash_to_merge->{$section};
+ }
+ }
+ return $merge;
+}
+
+# sub __Merge_other_context
sub __Merge_conf_includes ($$$) {
- my ( $hash_to_merge, $hash_subst, $context ) = @_;
- my $host_context = 0;
- my $global_order = [];
- my $global_parsed = {};
-
- if ( $context =~ /^host|model$/ ) {
- return __Merge_host_config ( $hash_to_merge, $hash_subst );
- }
- else {
- my $select = ( $context eq 'config' ) ? 'action' : 'type';
- foreach my $section ( @{$hash_to_merge->{'__sections_order'}} ) {
- if ( $hash_to_merge->{$section}->{$select} ne 'include' ) {
- push ( @{$global_parsed->{'__sections_order'}}, $section );
- $global_parsed->{$section} = $hash_to_merge->{$section};
- }
- else {
- my $tmp_merged = __Merge_conf_includes ( $hash_to_merge->{$section}->{'__content'}, $hash_subst, $context );
- foreach my $tomerge_section ( @{$tmp_merged->{'__sections_order'}} ) {
- if ( defined $global_parsed->{$tomerge_section} ) {
- if ( ! defined $tmp_merged->{$tomerge_section}->{'override'} || $tmp_merged->{$tomerge_section}->{'override'} ne 'replace' ) {
- Warn ( $CODE->{'WARNING'}, "Section ".$tomerge_section." from file ".$section." already defined ... skipping it\n" );
- next;
- }
- else {
- Warn ( $CODE->{'WARNING'}, "Section ".$tomerge_section." already defined but override is set to replace ... overriding it\n" );
- # Need to evalute if order must be changed
- # push ( @{$global_parsed->{'__sections_order'}}, $tomerge_section );
- }
- }
- else {
- push ( @{$global_parsed->{'__sections_order'}}, $tomerge_section );
- }
- $global_parsed->{$tomerge_section} = $tmp_merged->{$tomerge_section};
- }
- }
- }
- }
- return $global_parsed;
+ my ( $hash_to_merge, $hash_subst, $context ) = @_;
+ my $host_context = 0;
+ my $global_order = [];
+ my $global_parsed = {};
+
+ if ( $context =~ /^host|model$/ ) {
+ return __Merge_host_config( $hash_to_merge, $hash_subst );
+ }
+ else {
+ my $select = ( $context eq 'config' ) ? 'action' : 'type';
+ foreach my $section ( @{ $hash_to_merge->{'__sections_order'} } ) {
+ if ( $hash_to_merge->{$section}->{$select} ne 'include' ) {
+ push( @{ $global_parsed->{'__sections_order'} }, $section );
+ $global_parsed->{$section} = $hash_to_merge->{$section};
+ }
+ else {
+ my $tmp_merged
+ = __Merge_conf_includes(
+ $hash_to_merge->{$section}->{'__content'},
+ $hash_subst, $context );
+ foreach my $tomerge_section (
+ @{ $tmp_merged->{'__sections_order'} } )
+ {
+ if ( defined $global_parsed->{$tomerge_section} ) {
+ if ( !defined $tmp_merged->{$tomerge_section}
+ ->{'override'}
+ || $tmp_merged->{$tomerge_section}->{'override'}
+ ne 'replace' )
+ {
+ Warn( $CODE->{'WARNING'},
+ "Section "
+ . $tomerge_section
+ . " from file "
+ . $section
+ . " already defined ... skipping it\n" );
+ next;
+ }
+ else {
+ Warn( $CODE->{'WARNING'},
+ "Section "
+ . $tomerge_section
+ . " already defined but override is set to replace ... overriding it\n"
+ );
+
+ # Need to evalute if order must be changed
+ # push ( @{$global_parsed->{'__sections_order'}}, $tomerge_section );
+ }
+ }
+ else {
+ push(
+ @{ $global_parsed->{'__sections_order'} },
+ $tomerge_section
+ );
+ }
+ $global_parsed->{$tomerge_section}
+ = $tmp_merged->{$tomerge_section};
+ }
+ }
+ }
+ }
+ return $global_parsed;
}
sub Load_conf ($$$$) {
- my ( $file, $hash_subst, $context, $pf_config ) = @_;
- my ( $sect_type, $iface_name );
- my $parsed;
-
- if ( defined $context && $context !~ /^$ALLOWED_PARSING_CONTEXT$/ ) {
- Abort ( $CODE->{'INVALID_CONTEXT'},
- "Context ".$context." for file ".$file
- ." doesn't match ".$ALLOWED_PARSING_CONTEXT );
- }
-
- $parsed = Parser_ini ( $file );
- if ( ! defined $parsed ) {
- Abort ( $CODE->{'PARSING'}, "Parsing error for file ".$file );
- }
-
- if ( $context =~ /^(model|host)$/ ) {
- if ( defined $parsed->{'hostgroup'}->{'model'} ) {
- $parsed->{'hostgroup'}->{'__model'} =
- Load_conf ( Get_source ( $parsed->{'hostgroup'}->{'model'}, "", $hash_subst, $pf_config ), $hash_subst, 'model', $pf_config );
- }
- }
- else {
- my $select = ( $context eq 'config' ) ? 'action' : 'type';
- foreach my $section ( keys %{$parsed} ) {
- next if ( $section =~ /^__/ );
- if ( ! defined $parsed->{$section}->{$select} ) {
- Abort ( $CODE->{'UNDEF_KEY'}, "Key ".$select." on section ".$section." from file ".$file." MUST BE defined" );
- }
- $sect_type = $parsed->{$section}->{$select};
- if ( $sect_type eq 'include' ) {
- # We need to dive into deep ...
- $parsed->{$section}->{'__content'} =
- Load_conf ( Get_source ( $section, "", $hash_subst, $pf_config ), $hash_subst, $context, $pf_config );
- }
- }
- }
- # Merging if needed
- $parsed = __Merge_conf_includes ( $parsed, $hash_subst, $context );
-
- # Basic checks
- foreach my $section ( keys %{$parsed} ) {
- next if ( $section =~ /^__/ );
- if ( $context =~ /^(host|model)$/ ) {
- $section =~ /^([^:]+)(::(.+))?$/;
- $sect_type = $1;
- $iface_name = $3;
- }
- else {
- my $select = ( $context eq 'config' ) ? 'action' : 'type';
- if ( ! defined $parsed->{$section}->{$select} ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Key ".$select." on section ".$section." from file ".$file." MUST BE defined" );
- }
- $sect_type = $parsed->{$section}->{$select};
- }
- my ( $code, $msg ) = Chk_section_struct ( $section, $sect_type, $parsed->{$section}, $context );
- if ( $code > 1 ) {
- Warn ( $code, "Errors occur during parsing model from file ". $file );
- Abort ( $code, $msg );
- }
- }
- return $parsed;
+ my ( $file, $hash_subst, $context, $pf_config ) = @_;
+ my ( $sect_type, $iface_name );
+ my $parsed;
+
+ if ( defined $context && $context !~ /^$ALLOWED_PARSING_CONTEXT$/ ) {
+ Abort( $CODE->{'INVALID_CONTEXT'},
+ "Context "
+ . $context
+ . " for file "
+ . $file
+ . " doesn't match "
+ . $ALLOWED_PARSING_CONTEXT );
+ }
+
+ $parsed = Parser_ini($file);
+ if ( !defined $parsed ) {
+ Abort( $CODE->{'PARSING'}, "Parsing error for file " . $file );
+ }
+
+ if ( $context =~ /^(model|host)$/ ) {
+ if ( defined $parsed->{'hostgroup'}->{'model'} ) {
+ $parsed->{'hostgroup'}->{'__model'} = Load_conf(
+ Get_source(
+ $parsed->{'hostgroup'}->{'model'},
+ "", $hash_subst, $pf_config
+ ),
+ $hash_subst,
+ 'model',
+ $pf_config
+ );
+ }
+ }
+ else {
+ my $select = ( $context eq 'config' ) ? 'action' : 'type';
+ foreach my $section ( keys %{$parsed} ) {
+ next if ( $section =~ /^__/ );
+ if ( !defined $parsed->{$section}->{$select} ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Key "
+ . $select
+ . " on section "
+ . $section
+ . " from file "
+ . $file
+ . " MUST BE defined" );
+ }
+ $sect_type = $parsed->{$section}->{$select};
+ if ( $sect_type eq 'include' ) {
+
+ # We need to dive into deep ...
+ $parsed->{$section}->{'__content'}
+ = Load_conf(
+ Get_source( $section, "", $hash_subst, $pf_config ),
+ $hash_subst, $context, $pf_config );
+ }
+ }
+ }
+
+ # Merging if needed
+ $parsed = __Merge_conf_includes( $parsed, $hash_subst, $context );
+
+ # Basic checks
+ foreach my $section ( keys %{$parsed} ) {
+ next if ( $section =~ /^__/ );
+ if ( $context =~ /^(host|model)$/ ) {
+ $section =~ /^([^:]+)(::(.+))?$/;
+ $sect_type = $1;
+ $iface_name = $3;
+ }
+ else {
+ my $select = ( $context eq 'config' ) ? 'action' : 'type';
+ if ( !defined $parsed->{$section}->{$select} ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Key "
+ . $select
+ . " on section "
+ . $section
+ . " from file "
+ . $file
+ . " MUST BE defined" );
+ }
+ $sect_type = $parsed->{$section}->{$select};
+ }
+ my ( $code, $msg )
+ = Chk_section_struct( $section, $sect_type, $parsed->{$section},
+ $context );
+ if ( $code > 1 ) {
+ Warn( $code,
+ "Errors occur during parsing model from file " . $file );
+ Abort( $code, $msg );
+ }
+ }
+ return $parsed;
}
### Like old Init_lib_net
sub __Sort_net_prio ($$) {
- my ( $type, $section ) = @_;
-
- my $prio = 0;
-
- foreach my $prio_type ( 'zone', 'site', 'network', 'server', 'service' ) {
- return $prio if ( $type eq $prio_type );
- $prio++;
- }
- return $prio;
+ my ( $type, $section ) = @_;
+
+ my $prio = 0;
+
+ foreach my $prio_type ( 'zone', 'site', 'network', 'server', 'service' ) {
+ return $prio if ( $type eq $prio_type );
+ $prio++;
+ }
+ return $prio;
}
sub __Sort_net_section ($$$) {
- my ( $net_parsed, $a, $b ) = @_;
-
- return __Sort_net_prio ( $net_parsed->{$a}->{'type'}, $a ) <=> __Sort_net_prio ( $net_parsed->{$b}->{'type'}, $b )
+ my ( $net_parsed, $a, $b ) = @_;
+
+ return __Sort_net_prio( $net_parsed->{$a}->{'type'}, $a )
+ <=> __Sort_net_prio( $net_parsed->{$b}->{'type'}, $b );
}
sub Init_GLOBAL_NETCONFIG ($$;$) {
- my ( $start_file, $hash_subst, $pf_config ) = @_;
-
- if ( ! defined $pf_config ) {
- $pf_config = $PF_CONFIG;
- }
-
- my $GLOBAL = {
- 'SITE' => {
- 'BY_NAME' => {},
- }
- };
- foreach my $ip_type ( 'ipv4', 'ipv6' ) {
- next if ( ! $pf_config->{'features'}->{$ip_type} );
- my $zone_key = ( $ip_type eq 'ipv6' ) ? 'ZONE6' : 'ZONE';
- my $dhcp_key = ( $ip_type eq 'ipv6' ) ? 'DHCP6' : 'DHCP';
- $GLOBAL->{$zone_key} = {
- 'BY_NAME' => {},
- 'BY_SITE' => {}
- };
- $GLOBAL->{$dhcp_key} = {
- 'BY_SITE' => {}
- };
- }
-
- my $net_parsed = Load_conf ( $start_file, $hash_subst, 'network', $pf_config );
- my @sortnetkeys = sort { __Sort_net_section ( $net_parsed, $a, $b ) } @{$net_parsed->{'__sections_order'}};
- foreach my $section ( @sortnetkeys ) {
- if ( $net_parsed->{$section}->{'type'} eq 'zone' ) {
- Add_zone ( $start_file, $section, $net_parsed->{$section}, $GLOBAL, $pf_config );
- }
- elsif ( $net_parsed->{$section}->{'type'} eq 'site' ) {
- Add_site ( $start_file, $section, $net_parsed->{$section}, $GLOBAL, $pf_config );
- }
- elsif ( $net_parsed->{$section}->{'type'} eq 'network' ) {
- Add_network ( $start_file, $section, $net_parsed->{$section}, $GLOBAL, $pf_config );
- }
- elsif ( $net_parsed->{$section}->{'type'} eq 'server' ) {
- Add_server ( $start_file, $section, $net_parsed->{$section}, $GLOBAL, $pf_config );
- }
- elsif ( $net_parsed->{$section}->{'type'} eq 'service' ) {
- my $site_list = Get_site_list ( $net_parsed->{$section}, $GLOBAL );
- foreach my $site ( @{$site_list} ) {
- my $service_part = $GLOBAL->{'SITE'}->{'BY_NAME'}->{$site}->{'SERVICE'}->{'BY_NAME'};
- foreach my $host ( @{$net_parsed->{$section}->{'@host'}} ) {
- my $hostfile = Get_source ( $host, "", $hash_subst, $pf_config );
- my $host_parsed = Load_conf ( $hostfile, $hash_subst, 'host', $pf_config );
- Add_host ( $hostfile, $host_parsed, $GLOBAL, $pf_config );
- push ( @{$service_part->{$section}}, $host );
- }
-
- }
- }
- }
- return $GLOBAL;
+ my ( $start_file, $hash_subst, $pf_config ) = @_;
+
+ if ( !defined $pf_config ) {
+ $pf_config = $PF_CONFIG;
+ }
+
+ my $GLOBAL = { 'SITE' => { 'BY_NAME' => {}, } };
+ foreach my $ip_type ( 'ipv4', 'ipv6' ) {
+ next if ( !$pf_config->{'features'}->{$ip_type} );
+ my $zone_key = ( $ip_type eq 'ipv6' ) ? 'ZONE6' : 'ZONE';
+ my $dhcp_key = ( $ip_type eq 'ipv6' ) ? 'DHCP6' : 'DHCP';
+ $GLOBAL->{$zone_key} = {
+ 'BY_NAME' => {},
+ 'BY_SITE' => {}
+ };
+ $GLOBAL->{$dhcp_key} = { 'BY_SITE' => {} };
+ }
+
+ my $net_parsed
+ = Load_conf( $start_file, $hash_subst, 'network', $pf_config );
+ my @sortnetkeys = sort { __Sort_net_section( $net_parsed, $a, $b ) }
+ @{ $net_parsed->{'__sections_order'} };
+ foreach my $section (@sortnetkeys) {
+ if ( $net_parsed->{$section}->{'type'} eq 'zone' ) {
+ Add_zone( $start_file, $section, $net_parsed->{$section},
+ $GLOBAL, $pf_config );
+ }
+ elsif ( $net_parsed->{$section}->{'type'} eq 'site' ) {
+ Add_site( $start_file, $section, $net_parsed->{$section},
+ $GLOBAL, $pf_config );
+ }
+ elsif ( $net_parsed->{$section}->{'type'} eq 'network' ) {
+ Add_network( $start_file, $section, $net_parsed->{$section},
+ $GLOBAL, $pf_config );
+ }
+ elsif ( $net_parsed->{$section}->{'type'} eq 'server' ) {
+ Add_server( $start_file, $section, $net_parsed->{$section},
+ $GLOBAL, $pf_config );
+ }
+ elsif ( $net_parsed->{$section}->{'type'} eq 'service' ) {
+ my $site_list = Get_site_list( $net_parsed->{$section}, $GLOBAL );
+ foreach my $site ( @{$site_list} ) {
+ my $service_part
+ = $GLOBAL->{'SITE'}->{'BY_NAME'}->{$site}->{'SERVICE'}
+ ->{'BY_NAME'};
+ foreach my $host ( @{ $net_parsed->{$section}->{'@host'} } ) {
+ my $hostfile
+ = Get_source( $host, "", $hash_subst, $pf_config );
+ my $host_parsed
+ = Load_conf( $hostfile, $hash_subst, 'host',
+ $pf_config );
+ Add_host( $hostfile, $host_parsed, $GLOBAL, $pf_config );
+ push( @{ $service_part->{$section} }, $host );
+ }
+
+ }
+ }
+ }
+ return $GLOBAL;
}
sub Flush2disk_GLOBAL ($$;$) {
- my ( $global_config, $pf_config, $path_global_file ) = @_;
-
- my $flush_file = $path_global_file || $pf_config->{'path'}->{'global_struct'};
- if ( ! store ( $global_config, $flush_file ) ) {
- Warn ( $CODE->{'STORABLE'},
- "An error occured when trying to flush global structure to file ".$flush_file );
- return 1;
- }
- return 0;
+ my ( $global_config, $pf_config, $path_global_file ) = @_;
+
+ my $flush_file = $path_global_file
+ || $pf_config->{'path'}->{'global_struct'};
+ if ( !store( $global_config, $flush_file ) ) {
+ Warn( $CODE->{'STORABLE'},
+ "An error occured when trying to flush global structure to file "
+ . $flush_file );
+ return 1;
+ }
+ return 0;
}
sub Retrieve_GLOBAL ($) {
- my ( $path_global_file ) = @_;
-
- if ( ! -e $path_global_file ) {
- Abort ( $CODE->{'OPEN'},
- "Unable to open global configuration storable file ".$path_global_file." : no such file or directory" );
- }
- return retrieve ( $path_global_file );
+ my ($path_global_file) = @_;
+
+ if ( !-e $path_global_file ) {
+ Abort( $CODE->{'OPEN'},
+ "Unable to open global configuration storable file "
+ . $path_global_file
+ . " : no such file or directory" );
+ }
+ return retrieve($path_global_file);
}
sub Get_config_for_hostname_on_site ($$$$$) {
- my ( $hostname, $site, $hash_subst, $global_config, $pf_config ) = @_;
-
- # Common configuration file e.g. update-common
- my $global_host_conf = Load_conf ( Get_source ( 'COMMON:/'.$pf_config->{'path'}->{'common_config'}, $hostname, $hash_subst, $pf_config ), $hash_subst, 'config', $pf_config );
- my $hosttype = Get_hosttype_from_hostname ( $hostname, $global_config, $site );
- if ( ! defined $hosttype ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unable to get hosttype from hostname ".$hostname." for getting hosttype configuration file" );
- }
- # Hosttype configuration file e.g. update-<hosttype>
- my $hosttype_conf_file = __Get_config_path ( $hosttype, $pf_config, $site );
- # Hostname configuration file e.g. update-<hostname>
- my $hostname_conf_file = __Get_config_path ( $hostname, $pf_config, $site );
- foreach my $file ( $hosttype_conf_file, $hostname_conf_file ) {
- next if ( ! defined $file );
- my $config = Load_conf ( $file, $hash_subst, 'config', $pf_config );
- foreach my $section ( @{$config->{'__sections_order'}} ) {
- push ( @{$global_host_conf->{'__sections_order'}}, $section ) if ( ! defined $global_host_conf->{$section} );
- $global_host_conf->{$section} = $config->{$section};
- }
- }
- return $global_host_conf;
+ my ( $hostname, $site, $hash_subst, $global_config, $pf_config ) = @_;
+
+ # Common configuration file e.g. update-common
+ my $global_host_conf = Load_conf(
+ Get_source(
+ 'COMMON:/' . $pf_config->{'path'}->{'common_config'},
+ $hostname, $hash_subst, $pf_config
+ ),
+ $hash_subst,
+ 'config',
+ $pf_config
+ );
+ my $hosttype
+ = Get_hosttype_from_hostname( $hostname, $global_config, $site );
+ if ( !defined $hosttype ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unable to get hosttype from hostname "
+ . $hostname
+ . " for getting hosttype configuration file" );
+ }
+
+ # Hosttype configuration file e.g. update-<hosttype>
+ my $hosttype_conf_file
+ = __Get_config_path( $hosttype, $pf_config, $site );
+
+ # Hostname configuration file e.g. update-<hostname>
+ my $hostname_conf_file
+ = __Get_config_path( $hostname, $pf_config, $site );
+ foreach my $file ( $hosttype_conf_file, $hostname_conf_file ) {
+ next if ( !defined $file );
+ my $config = Load_conf( $file, $hash_subst, 'config', $pf_config );
+ foreach my $section ( @{ $config->{'__sections_order'} } ) {
+ push( @{ $global_host_conf->{'__sections_order'} }, $section )
+ if ( !defined $global_host_conf->{$section} );
+ $global_host_conf->{$section} = $config->{$section};
+ }
+ }
+ return $global_host_conf;
}
1;
Modified: branches/next-gen/lib/PFTools/Conf/Host.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Conf/Host.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Conf/Host.pm (original)
+++ branches/next-gen/lib/PFTools/Conf/Host.pm Tue Sep 7 08:54:37 2010
@@ -27,8 +27,8 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Add_server
- Add_host
+ Add_server
+ Add_host
);
our @EXPORT_OK = qw();
@@ -56,19 +56,19 @@
# WARNING : by convention only EDGE sites are authorized for prefixing hostname
#
sub __Get_site_prefix ($$) {
- my ( $site, $ref_site ) = @_;
-
- if ( $ref_site->{'state'} eq 'EDGE' ) {
- if ( defined $ref_site->{'prefix'} ) {
- return $ref_site->{'prefix'}.'-';
- }
- else {
- return $site.'-';
- }
- }
- else {
- return '';
- }
+ my ( $site, $ref_site ) = @_;
+
+ if ( $ref_site->{'state'} eq 'EDGE' ) {
+ if ( defined $ref_site->{'prefix'} ) {
+ return $ref_site->{'prefix'} . '-';
+ }
+ else {
+ return $site . '-';
+ }
+ }
+ else {
+ return '';
+ }
}
#########################################################################
@@ -84,57 +84,65 @@
# Returns a list containing last number and last nodes for a hostgroup
#
sub __Get_host_indexes ($$) {
- my ( $ref_hostgroup, $hostname_model ) = @_;
- my ( $node_last, $num_last, $digits, $nodes );
-
-
- $node_last = ( $ref_hostgroup->{'nodes'} )
- ? ( $ref_hostgroup->{'nodes'} -1 )
- : 0;
- $num_last = $ref_hostgroup->{'number'} - 1;
- $hostname_model =~ /(%*)(_*)$/;
- $digits = length ($1) || 0;
- $nodes = length ($2) || 0;
- # Checking nodes
- if ( $node_last && ! $nodes ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Unable to affect all ".$node_last." nodes : no _ defined in key hostname" );
- }
- elsif ( $node_last && ceil ( log($node_last) / log(26) ) > $nodes ) {
- Warn ( $CODE->{'INVALID_VALUE'},
- "Not enough places for indexing nodes definition for host ".$hostname_model );
- }
- # Checking hostnum
- if ( $num_last && ! $digits ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Unable to affect all host number(s) : no % defined in key hostname ".$hostname_model );
- }
- elsif ( $num_last && $num_last > 10**$digits ) {
- Warn ( $CODE->{'INVALID_VALUE'},
- "Not enough places for indexing host number(s) according to hostname ".$hostname_model );
- }
- return ( $num_last, $node_last );
+ my ( $ref_hostgroup, $hostname_model ) = @_;
+ my ( $node_last, $num_last, $digits, $nodes );
+
+ $node_last
+ = ( $ref_hostgroup->{'nodes'} )
+ ? ( $ref_hostgroup->{'nodes'} - 1 )
+ : 0;
+ $num_last = $ref_hostgroup->{'number'} - 1;
+ $hostname_model =~ /(%*)(_*)$/;
+ $digits = length($1) || 0;
+ $nodes = length($2) || 0;
+
+ # Checking nodes
+ if ( $node_last && !$nodes ) {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Unable to affect all "
+ . $node_last
+ . " nodes : no _ defined in key hostname" );
+ }
+ elsif ( $node_last && ceil( log($node_last) / log(26) ) > $nodes ) {
+ Warn( $CODE->{'INVALID_VALUE'},
+ "Not enough places for indexing nodes definition for host "
+ . $hostname_model );
+ }
+
+ # Checking hostnum
+ if ( $num_last && !$digits ) {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Unable to affect all host number(s) : no % defined in key hostname "
+ . $hostname_model );
+ }
+ elsif ( $num_last && $num_last > 10**$digits ) {
+ Warn( $CODE->{'INVALID_VALUE'},
+ "Not enough places for indexing host number(s) according to hostname "
+ . $hostname_model );
+ }
+ return ( $num_last, $node_last );
}
sub __Get_hostnumber_from_model ($$$) {
- my ( $model, $num, $node ) = @_;
- my ( $digits, $nodes, $index );
-
- if ( $model !~ /%+/ && $model !~ /_+/ ) {
- return "";
- }
- $model =~ /(%*)(_*)$/;
- $digits = length ($1) || 0;
- $nodes = length ($2) || 0;
- $index = "";
- while ( $digits > length ( $num ) ) {
- $index .= "0";
- $digits--;
- }
- $index = ( $node )
- ? $index.$num.$node
- : $index.$num;
- return $index;
+ my ( $model, $num, $node ) = @_;
+ my ( $digits, $nodes, $index );
+
+ if ( $model !~ /%+/ && $model !~ /_+/ ) {
+ return "";
+ }
+ $model =~ /(%*)(_*)$/;
+ $digits = length($1) || 0;
+ $nodes = length($2) || 0;
+ $index = "";
+ while ( $digits > length($num) ) {
+ $index .= "0";
+ $digits--;
+ }
+ $index
+ = ($node)
+ ? $index . $num . $node
+ : $index . $num;
+ return $index;
}
#########################################################################
@@ -153,14 +161,16 @@
# Returns a string containing th hostname
#
sub __Get_hostname_from_model ($$$$) {
- my ( $hostname_model, $hostnum, $hostnode, $site_prefix, $ref_host ) = @_;
- my ( $hostname, $index );
-
- $hostname = $hostname_model;
- $index = __Get_hostnumber_from_model ( $hostname_model, $hostnum, $hostnode );
- $hostname =~ s/(%*)(_*)$/$index/;
- $hostname = $site_prefix.$hostname if ( $ref_host->{'prefix'} && $ref_host->{'prefix'} eq 'true' );
- return $hostname;
+ my ( $hostname_model, $hostnum, $hostnode, $site_prefix, $ref_host ) = @_;
+ my ( $hostname, $index );
+
+ $hostname = $hostname_model;
+ $index
+ = __Get_hostnumber_from_model( $hostname_model, $hostnum, $hostnode );
+ $hostname =~ s/(%*)(_*)$/$index/;
+ $hostname = $site_prefix . $hostname
+ if ( $ref_host->{'prefix'} && $ref_host->{'prefix'} eq 'true' );
+ return $hostname;
}
#########################################################################
@@ -175,15 +185,15 @@
# Returns an arrayref containing the interfaces list
#
sub __Get_host_interfaces ($) {
- my ( $ref_src ) = @_;
- my ( @if_list );
-
- foreach my $section ( keys %{$ref_src} ) {
- next if ( $section !~ /^interface/ );
- $section =~ /^interface::(((eth|bond)[\d]+)(\.(TAG[\d]+|\d+))?)$/;
- push ( @if_list, $1 );
- }
- return @if_list;
+ my ($ref_src) = @_;
+ my (@if_list);
+
+ foreach my $section ( keys %{$ref_src} ) {
+ next if ( $section !~ /^interface/ );
+ $section =~ /^interface::(((eth|bond)[\d]+)(\.(TAG[\d]+|\d+))?)$/;
+ push( @if_list, $1 );
+ }
+ return @if_list;
}
#########################################################################
@@ -202,20 +212,25 @@
# Returns a NetAddr::IP object containing the IP
#
sub __Get_ip_from_hostindex ($$;$$$) {
- my ( $net_block, $ipstart, $hostnum, $hostnode, $nodes ) = @_;
-
- my $ip = new NetAddr::IP ( $net_block->prefix().$ipstart, $net_block->mask() );
- if ( ! defined $ip ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unable to create IP object from prefix ".$net_block->prefix()." and host ".$ipstart );
- }
- if ( $hostnum ) {
- my $add = ( $hostnode )
- ? ( $hostnum * $nodes ) + $hostnode
- : $hostnum;
- $ip = $ip + $add;
- }
- return $ip;
+ my ( $net_block, $ipstart, $hostnum, $hostnode, $nodes ) = @_;
+
+ my $ip = new NetAddr::IP( $net_block->prefix() . $ipstart,
+ $net_block->mask() );
+ if ( !defined $ip ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unable to create IP object from prefix "
+ . $net_block->prefix()
+ . " and host "
+ . $ipstart );
+ }
+ if ($hostnum) {
+ my $add
+ = ($hostnode)
+ ? ( $hostnum * $nodes ) + $hostnode
+ : $hostnum;
+ $ip = $ip + $add;
+ }
+ return $ip;
}
#########################################################################
@@ -237,21 +252,34 @@
# Returns a NetAddr::IP object containing the checked IP
#
sub __Check_host_ip ($$$$$$$$) {
- my ( $ip_type, $vlan_block, $ipstart, $hostnum, $hostnode, $nodes, $site, $ref_site ) = @_;
-
- my $prefix = $vlan_block->prefix();
- my $realip = __Get_ip_from_hostindex ( $vlan_block, $ipstart, $hostnum, $hostnode, $nodes ) ;
- my $host_addr_site = $ref_site->{'HOST'}->{'BY_ADDR'};
- if ( defined $host_addr_site->{$realip->addr()} ) {
- Abort ( $CODE->{'DUPLICATE_VALUE'},
- "IP ".$realip->addr()." is already in use by host ".$host_addr_site->{$realip->cidr()}
- ." on site ".$site );
- }
- if ( ! $vlan_block->contains ( $realip ) ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "IP of type ".$ip_type." is out of ".$vlan_block->cidr()." on site ".$site );
- }
- return $realip;
+ my ( $ip_type, $vlan_block, $ipstart, $hostnum, $hostnode, $nodes, $site,
+ $ref_site )
+ = @_;
+
+ my $prefix = $vlan_block->prefix();
+ my $realip
+ = __Get_ip_from_hostindex( $vlan_block, $ipstart, $hostnum, $hostnode,
+ $nodes );
+ my $host_addr_site = $ref_site->{'HOST'}->{'BY_ADDR'};
+ if ( defined $host_addr_site->{ $realip->addr() } ) {
+ Abort( $CODE->{'DUPLICATE_VALUE'},
+ "IP "
+ . $realip->addr()
+ . " is already in use by host "
+ . $host_addr_site->{ $realip->cidr() }
+ . " on site "
+ . $site );
+ }
+ if ( !$vlan_block->contains($realip) ) {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "IP of type "
+ . $ip_type
+ . " is out of "
+ . $vlan_block->cidr()
+ . " on site "
+ . $site );
+ }
+ return $realip;
}
#####################################################################################
@@ -266,15 +294,16 @@
# Returns an arrayref containing the vlan list
#
sub __Get_vlan_list_from_server ($) {
- my ( $ref_srv ) = @_;
- my $vlan_list = [];
-
- foreach my $key ( keys %{$ref_srv} ) {
- next if ( $key !~ /^ipv/ );
- my ( $type, $vlan, $num ) = split ( /\./, $key );
- push ( @{$vlan_list}, $vlan ) if ( ! grep ( /^$vlan$/, @{$vlan_list} ) );
- }
- return $vlan_list;
+ my ($ref_srv) = @_;
+ my $vlan_list = [];
+
+ foreach my $key ( keys %{$ref_srv} ) {
+ next if ( $key !~ /^ipv/ );
+ my ( $type, $vlan, $num ) = split( /\./, $key );
+ push( @{$vlan_list}, $vlan )
+ if ( !grep ( /^$vlan$/, @{$vlan_list} ) );
+ }
+ return $vlan_list;
}
########################################################################################
@@ -291,18 +320,18 @@
# Returns an arrayref containing the alias list
#
sub __Get_alias_list_from_server ($$;$) {
- my ( $ref_parsed, $vlan, $host_number ) = @_;
- my $alias_list = [];
-
- foreach my $key ( keys %{$ref_parsed} ) {
- next if ( $key !~ /^alias/ );
- my ( $alias, $name, $host_num ) = split ( /\./, $key );
- next if ( $host_number && $host_num && $host_num ne $host_number );
- push ( @{$alias_list}, $name ) if (
- $vlan eq $ref_parsed->{$key}
- && ! grep ( /^$name$/, @{$alias_list} ) );
- }
- return $alias_list;
+ my ( $ref_parsed, $vlan, $host_number ) = @_;
+ my $alias_list = [];
+
+ foreach my $key ( keys %{$ref_parsed} ) {
+ next if ( $key !~ /^alias/ );
+ my ( $alias, $name, $host_num ) = split( /\./, $key );
+ next if ( $host_number && $host_num && $host_num ne $host_number );
+ push( @{$alias_list}, $name )
+ if ( $vlan eq $ref_parsed->{$key}
+ && !grep ( /^$name$/, @{$alias_list} ) );
+ }
+ return $alias_list;
}
########################################################################################
@@ -320,12 +349,20 @@
# Returns the tag if defined undef undef if not.
#
sub __Get_vlan_tag_from_site ($$$) {
- my ( $vlan, $site, $global_config ) = @_;
-
- foreach my $tag ( keys %{$global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'NETWORK'}->{'BY_TAG'}} ) {
- return $tag if ( $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'NETWORK'}->{'BY_TAG'}->{$tag} eq $vlan );
- }
- return;
+ my ( $vlan, $site, $global_config ) = @_;
+
+ foreach my $tag (
+ keys %{
+ $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'NETWORK'}
+ ->{'BY_TAG'}
+ }
+ )
+ {
+ return $tag
+ if ( $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'NETWORK'}
+ ->{'BY_TAG'}->{$tag} eq $vlan );
+ }
+ return;
}
#########################################################################
@@ -341,96 +378,167 @@
# - $pf_config : hashref where are stored pf-tools configuration datas
#
sub Add_server ($$$$$) {
- my ( $srvfile, $srvname_model, $srv2add, $global_config, $pf_config ) = @_;
-
- $srvname_model =~ /^$pf_config->{'regex'}->{'hostname_model'}$/ ;
- my $shortname = $1;
- my $hostclass = $shortname;
- my $site_list = Get_site_list ( $srv2add, $global_config );
- my ( $host_last, $node_last ) = __Get_host_indexes ( $srv2add, $srvname_model );
- my $nodes = $srv2add->{'nodes'} || 0;
- foreach my $site ( @{$site_list} ) {
- my $site_part = $global_config->{'SITE'}->{'BY_NAME'}->{$site};
- if ( ! defined $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass} ) {
- $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass} = {};
- }
- my $srv_part = $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass};
- my $zone = $site_part->{'zone'};
- my $prefix = __Get_site_prefix ( $site, $global_config->{'SITE'}->{'BY_NAME'}->{$site} );
- my $vlan_list = __Get_vlan_list_from_server ( $srv2add );
- foreach my $hostnum ( 0 .. $host_last ) {
- foreach my $hostnode ( 0 .. $node_last ) {
- my $srvname = __Get_hostname_from_model ( $srvname_model, $hostnum, $hostnode, $prefix );
- if ( $srv_part->{$srvname} ) {
- Warn ( $CODE->{'DUPLICATE_VALUE'},
- "Hostclass ".$hostclass." already contains hostname ".$srvname." definition from file "
- .$srvfile." and for site ".$site." : skipping this hostname" );
- next;
- }
- my $index = __Get_hostnumber_from_model ( $srvname_model, $hostnum, $hostnode);
- my $srv_number = ( $hostnode ) ? $hostnum.$hostnode : $hostnum;
- my $short_vlan = $srv2add->{'shortname.'.$srv_number} || $srv2add->{'shortname'} || "";
- my $iface_idx = 0;
- foreach my $ip_type ( 'ipv4', 'ipv6' ) {
- next if ( ! $pf_config->{'features'}->{$ip_type} );
- my $addr_key = ( $ip_type eq 'ipv6' ) ? 'BY_ADDR6' : 'BY_ADDR';
- my $zone_key = ( $ip_type eq 'ipv6' ) ? 'ZONE6' : 'ZONE';
- my $dhcp_key = ( $ip_type eq 'ipv6' ) ? 'DHCP6' : 'DHCP';
- my $suffix = ( $ip_type eq 'ipv6' ) ? '6' : '';
- my $zone_part = $global_config->{$zone_key}->{'BY_NAME'}->{$zone}->{'BY_SITE'}->{$site};
- foreach my $vlan ( @{$vlan_list} ) {
- my $net_block = Get_netblock_from_vlan ( $ip_type, $site_part->{'NETWORK'}->{'BY_NAME'}->{$vlan} );
- if ( ! defined $net_block ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Unable to retrieve network block of type ".$ip_type." for vlan ".$vlan
- ." on site ".$site." for host ".$srvname );
- }
- my $realip;
- if ( $srv2add->{$ip_type.'.'.$vlan.'.'.$srv_number} ) {
- $realip = __Check_host_ip ( $ip_type, $net_block, $srv2add->{$ip_type.'.'.$vlan.'.'.$srv_number}, 0, 0, 0, $site, $site_part );
- }
- else {
- $realip = __Check_host_ip ( $ip_type, $net_block, $srv2add->{$ip_type.'.'.$vlan}, $hostnum, $hostnode, $nodes, $site, $site_part );
- }
- $srv_part->{$srvname} = {
- 'interfaces' => {}
- } if ( ! defined $srv_part->{$srvname} );
- $srv_part->{$srvname}->{'interfaces'}->{'eth'.$iface_idx} = {
- $ip_type => $realip->addr(),
- 'netmask'.$suffix => $realip->mask(),
- 'vlan' => $vlan
- };
- $iface_idx++;
- $site_part->{'HOST'}->{$addr_key}->{$realip->addr()} = $srvname.'.'.$vlan;
- if ( ! defined $zone_part->{$hostclass} ){
- $zone_part->{$hostclass} = {};
- push ( @{$global_config->{$zone_key}->{'BY_NAME'}->{$zone}->{'__hostclass_order'}->{$site}}, $hostclass );
- }
- $zone_part->{$hostclass}->{$srvname.'.'.$vlan} = "A\t".$realip->addr();
- if ( $short_vlan eq $vlan ) {
- if ( $shortname ne $srvname ) {
- push ( @{$zone_part->{$hostclass}->{$shortname.'.'.$vlan}}, "A\t".$realip->addr() );
- }
- else {
- $zone_part->{$hostclass}->{$shortname} = "CNAME\t".$shortname.'.'.$vlan;
- }
- }
- my $alias_list = __Get_alias_list_from_server ( $srv2add, $vlan, $srv_number );
- foreach my $alias ( @{$alias_list} ) {
- $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass}->{$alias} = $shortname;
- if ( ! defined $zone_part->{$hostclass}->{$alias.'.'.$vlan} ) {
- $zone_part->{$hostclass}->{$alias} = "CNAME\t".$shortname.'.'.$vlan;
- }
- if ( $shortname ne $srvname ) {
- $zone_part->{$hostclass}->{$alias.$index} = "CNAME\t".$srvname.'.'.$vlan;
- $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass}->{$alias.$index} = $srvname;
- }
- }
- }
- }
- }
- }
- }
+ my ( $srvfile, $srvname_model, $srv2add, $global_config, $pf_config )
+ = @_;
+
+ $srvname_model =~ /^$pf_config->{'regex'}->{'hostname_model'}$/;
+ my $shortname = $1;
+ my $hostclass = $shortname;
+ my $site_list = Get_site_list( $srv2add, $global_config );
+ my ( $host_last, $node_last )
+ = __Get_host_indexes( $srv2add, $srvname_model );
+ my $nodes = $srv2add->{'nodes'} || 0;
+ foreach my $site ( @{$site_list} ) {
+ my $site_part = $global_config->{'SITE'}->{'BY_NAME'}->{$site};
+ if ( !defined $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass} ) {
+ $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass} = {};
+ }
+ my $srv_part = $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass};
+ my $zone = $site_part->{'zone'};
+ my $prefix = __Get_site_prefix( $site,
+ $global_config->{'SITE'}->{'BY_NAME'}->{$site} );
+ my $vlan_list = __Get_vlan_list_from_server($srv2add);
+ foreach my $hostnum ( 0 .. $host_last ) {
+ foreach my $hostnode ( 0 .. $node_last ) {
+ my $srvname
+ = __Get_hostname_from_model( $srvname_model, $hostnum,
+ $hostnode, $prefix );
+ if ( $srv_part->{$srvname} ) {
+ Warn( $CODE->{'DUPLICATE_VALUE'},
+ "Hostclass "
+ . $hostclass
+ . " already contains hostname "
+ . $srvname
+ . " definition from file "
+ . $srvfile
+ . " and for site "
+ . $site
+ . " : skipping this hostname" );
+ next;
+ }
+ my $index
+ = __Get_hostnumber_from_model( $srvname_model, $hostnum,
+ $hostnode );
+ my $srv_number
+ = ($hostnode) ? $hostnum . $hostnode : $hostnum;
+ my $short_vlan
+ = $srv2add->{ 'shortname.' . $srv_number }
+ || $srv2add->{'shortname'}
+ || "";
+ my $iface_idx = 0;
+ foreach my $ip_type ( 'ipv4', 'ipv6' ) {
+ next if ( !$pf_config->{'features'}->{$ip_type} );
+ my $addr_key
+ = ( $ip_type eq 'ipv6' ) ? 'BY_ADDR6' : 'BY_ADDR';
+ my $zone_key = ( $ip_type eq 'ipv6' ) ? 'ZONE6' : 'ZONE';
+ my $dhcp_key = ( $ip_type eq 'ipv6' ) ? 'DHCP6' : 'DHCP';
+ my $suffix = ( $ip_type eq 'ipv6' ) ? '6' : '';
+ my $zone_part
+ = $global_config->{$zone_key}->{'BY_NAME'}->{$zone}
+ ->{'BY_SITE'}->{$site};
+ foreach my $vlan ( @{$vlan_list} ) {
+ my $net_block = Get_netblock_from_vlan( $ip_type,
+ $site_part->{'NETWORK'}->{'BY_NAME'}->{$vlan} );
+ if ( !defined $net_block ) {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Unable to retrieve network block of type "
+ . $ip_type
+ . " for vlan "
+ . $vlan
+ . " on site "
+ . $site
+ . " for host "
+ . $srvname );
+ }
+ my $realip;
+ if ($srv2add->{ $ip_type . '.'
+ . $vlan . '.'
+ . $srv_number } )
+ {
+ $realip = __Check_host_ip(
+ $ip_type,
+ $net_block,
+ $srv2add->{
+ $ip_type . '.' . $vlan . '.' . $srv_number
+ },
+ 0, 0, 0, $site,
+ $site_part
+ );
+ }
+ else {
+ $realip = __Check_host_ip(
+ $ip_type,
+ $net_block,
+ $srv2add->{ $ip_type . '.' . $vlan },
+ $hostnum,
+ $hostnode,
+ $nodes,
+ $site,
+ $site_part
+ );
+ }
+ $srv_part->{$srvname} = { 'interfaces' => {} }
+ if ( !defined $srv_part->{$srvname} );
+ $srv_part->{$srvname}->{'interfaces'}
+ ->{ 'eth' . $iface_idx } = {
+ $ip_type => $realip->addr(),
+ 'netmask' . $suffix => $realip->mask(),
+ 'vlan' => $vlan
+ };
+ $iface_idx++;
+ $site_part->{'HOST'}->{$addr_key}->{ $realip->addr() }
+ = $srvname . '.' . $vlan;
+ if ( !defined $zone_part->{$hostclass} ) {
+ $zone_part->{$hostclass} = {};
+ push(
+ @{ $global_config->{$zone_key}->{'BY_NAME'}
+ ->{$zone}->{'__hostclass_order'}
+ ->{$site}
+ },
+ $hostclass
+ );
+ }
+ $zone_part->{$hostclass}->{ $srvname . '.' . $vlan }
+ = "A\t" . $realip->addr();
+ if ( $short_vlan eq $vlan ) {
+ if ( $shortname ne $srvname ) {
+ push(
+ @{ $zone_part->{$hostclass}
+ ->{ $shortname . '.' . $vlan }
+ },
+ "A\t" . $realip->addr()
+ );
+ }
+ else {
+ $zone_part->{$hostclass}->{$shortname}
+ = "CNAME\t" . $shortname . '.' . $vlan;
+ }
+ }
+ my $alias_list
+ = __Get_alias_list_from_server( $srv2add, $vlan,
+ $srv_number );
+ foreach my $alias ( @{$alias_list} ) {
+ $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass}
+ ->{$alias} = $shortname;
+ if ( !defined $zone_part->{$hostclass}
+ ->{ $alias . '.' . $vlan } )
+ {
+ $zone_part->{$hostclass}->{$alias}
+ = "CNAME\t" . $shortname . '.' . $vlan;
+ }
+ if ( $shortname ne $srvname ) {
+ $zone_part->{$hostclass}->{ $alias . $index }
+ = "CNAME\t" . $srvname . '.' . $vlan;
+ $site_part->{'HOST'}->{'BY_NAME'}
+ ->{$hostclass}->{ $alias . $index }
+ = $srvname;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
}
#####################################################################################################
@@ -450,142 +558,244 @@
# - $pf_config : hashref where are stored pf-tools configuration datas
#
sub __Add_host_interface ($$$$$$$$$$) {
- my ( $iface, $hostname, $hostnum, $hostnode, $index, $ref_host, $ref_if_list, $site, $ref_site, $pf_config ) = @_;
- my ( @if_list, $vlan, $ifraw, $iftag, $add_if, $iface_opt );
-
- my $network_site = $ref_site->{'NETWORK'};
- my $host_site = $ref_site->{'HOST'};
- my $iface_section = 'interface::'.$iface;
- my $nodes = $ref_host->{'hostgroup'}->{'nodes'} || 0;
- my $host_number = ( $hostnode ) ? $hostnum.$hostnode : $hostnum;
- $iface =~ /^((eth|bond)[\d]+)(\.(TAG[\d]+))?$/;
- ( $ifraw, $iftag ) = ( $1, $4 );
- $vlan = $ref_host->{$iface_section}->{'vlan.'.$host_number} || $ref_host->{$iface_section}->{'vlan'};
- $iface_opt = $ref_host->{$iface_section}->{'iface_opt.'.$host_number} || $ref_host->{$iface_section}->{'iface_opt'};
- $add_if->{'vlan'} = $vlan;
- $add_if->{'iface_opt'} = $iface_opt if ( defined $iface_opt );
- # Check MAC address if defined
- if ( defined $ref_host->{$iface_section}->{'mac.'.$host_number} ) {
- my $mac = $ref_host->{$iface_section}->{'mac.'.$host_number};
- if ( $host_site->{'BY_MAC'}->{$mac} ) {
- my ( $ifdef, $hostdef, $vlandef ) = split ( /\./, $host_site->{'BY_MAC'}->{$mac} );
- Abort ( $CODE->{'DUPLICATE_VALUE'},
- "MAC address ".$mac." is already defined for interface ".$ifdef." in host ".$hostdef
- ." which is on vlan ".$vlandef );
- }
- $add_if->{'mac'} = $mac;
- }
- # Check tag
- if ( $iftag && $iftag =~ /^\d+$/ ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Tag ".$iftag." defined on section name ".$iface_section." differs from "
- .$ref_host->{'vlan'}." network definition" );
- }
- if ( $iface =~ /^bond/ && ! $iftag ) {
- # Check if slaves not in use
- my @slaves = ( $ref_host->{$iface_section}->{'slaves.'.$host_number} )
- ? split ( /\s*,\s*/, $ref_host->{$iface_section}->{'slaves.'.$host_number} )
- : split ( /\s*,\s*/, $ref_host->{$iface_section}->{'slaves'} );
- foreach my $if ( @slaves ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Interface ".$if." cannot be enslaved by ".$iface." : already in use for "
- .$hostname ) if ( grep ( /$if/, @{$ref_if_list} ) );
- }
- $add_if->{'slaves'} = join ( " ", @slaves );
- $add_if->{'mode'} = $ref_host->{$iface_section}->{'mode.'.$host_number} || $ref_host->{$iface_section}->{'mode'};
- $add_if->{'options'} = $ref_host->{$iface_section}->{'options.'.$host_number} || $ref_host->{$iface_section}->{'options'};
- }
- # Check vlan
- if ( ! defined $network_site->{'BY_NAME'}->{$vlan} ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Unknown vlan ".$vlan." on site ".$site." for interface ".$iface.
- " defined on host ".$hostname );
- }
- # Check address and route values
- foreach my $ip_type ( 'ipv4', 'ipv6' ) {
- next if ( ! $pf_config->{'features'}->{$ip_type} );
- my $suffix = ( $ip_type eq 'ipv6' ) ? '6' : '';
- my $netblock = Get_netblock_from_vlan ( $ip_type, $network_site->{'BY_NAME'}->{$vlan} );
- if ( ! defined $netblock ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Unable to retrieve network block of type ".$ip_type." for vlan ".$vlan
- ." on site ".$site." for host ".$hostname );
- }
- my $realip;
- if ( $ref_host->{$iface_section}->{$ip_type.'.'.$host_number} ) {
- $realip = __Check_host_ip ( $ip_type, $netblock, $ref_host->{$iface_section}->{$ip_type.'.'.$host_number}, 0, 0, 0, $site, $ref_site );
- }
- else {
- $realip = __Check_host_ip ( $ip_type, $netblock, $ref_host->{$iface_section}->{$ip_type}, $hostnum, $hostnode, $nodes, $site, $ref_site );
- }
- $add_if->{$ip_type} = $realip->cidr();
- my $route_key = ( $ip_type eq 'ipv6' ) ? '@route6' : '@route';
- $route_key .= $hostnum if ( $ref_host->{$iface_section}->{$route_key.'.'.$host_number} );
- my $gw_key = ( $ip_type eq 'ipv6' ) ? 'gateway6' : 'gateway';
- if ( defined $ref_host->{$iface_section}->{$route_key} ) {
- foreach my $route ( @{$ref_host->{$iface_section}->{$route_key}} ) {
- $route =~ /^(\S+)\s*(via\s*(\S+))?$/;
- my ( $dest, $via ) = ( $1, $3 );
- my $route2add = '';
- if ( $dest ne 'default' ) {
- my $ip_dest;
- if ( $dest =~ /[g-zG-Z]+/ ) {
- if ( defined $network_site->{'BY_NAME'}->{$dest} ) {
- # Dest is a defined network ... translating into IP
- $ip_dest = new NetAddr::IP ( $network_site->{'BY_NAME'}->{$dest}->{'network'}, $network_site->{'BY_NAME'}->{$dest}->{'netmask'} );
- $route2add .= $ip_dest->cidr()." via ";
- }
- else {
- # Potentially not parsed host on this site
- $route2add .= $dest." via ";
- }
- }
- else {
- $ip_dest = new NetAddr::IP ( $dest );
- if ( ! defined $ip_dest ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Unable to check dest IP ".$dest." of type ".$ip_type." on \@route key for interface ".$iface
- ." for host ".$hostname." on site ".$site );
- }
- $route2add .= $ip_dest->cidr()." via ";
- }
- }
- else {
- $route2add .= "default via ";
- }
- if ( $via ) {
- my $ip_via;
- if ( $via eq 'GATEWAY' ) {
- if ( ! defined $network_site->{'BY_NAME'}->{$vlan}->{$gw_key} ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Unable to define default route by vlan ".$vlan." : no gateway defined on this one" );
- }
- $route2add .= $network_site->{'BY_NAME'}->{$vlan}->{$gw_key};
- }
- elsif ( $via =~ /[g-zG-Z]+/ ) {
- # Potentially not parsed host ... skipping this case for now
- $route2add .= $via;
- }
- else {
- my $ip_via = new NetAddr::IP ( $via );
- if ( ! defined $ip_via ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Unable to check IP ".$via." of type ".$ip_type." as gateway for interface ".$iface
- ." for host ".$hostname." on site ".$site );
- }
- elsif ( ! $netblock->contains ( $ip_via ) ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "IP ".$ip_via." of type ".$ip_type." for gateway on interface ".$iface
- ." is out of ".$netblock." for host ".$hostname." on site ".$site );
- }
- $route2add .= $ip_via->addr();
- }
- }
- push ( @{$add_if->{$route_key}}, $route2add );
- }
- }
- }
- return $add_if;
+ my ($iface, $hostname, $hostnum, $hostnode, $index,
+ $ref_host, $ref_if_list, $site, $ref_site, $pf_config
+ ) = @_;
+ my ( @if_list, $vlan, $ifraw, $iftag, $add_if, $iface_opt );
+
+ my $network_site = $ref_site->{'NETWORK'};
+ my $host_site = $ref_site->{'HOST'};
+ my $iface_section = 'interface::' . $iface;
+ my $nodes = $ref_host->{'hostgroup'}->{'nodes'} || 0;
+ my $host_number = ($hostnode) ? $hostnum . $hostnode : $hostnum;
+ $iface =~ /^((eth|bond)[\d]+)(\.(TAG[\d]+))?$/;
+ ( $ifraw, $iftag ) = ( $1, $4 );
+ $vlan = $ref_host->{$iface_section}->{ 'vlan.' . $host_number }
+ || $ref_host->{$iface_section}->{'vlan'};
+ $iface_opt = $ref_host->{$iface_section}->{ 'iface_opt.' . $host_number }
+ || $ref_host->{$iface_section}->{'iface_opt'};
+ $add_if->{'vlan'} = $vlan;
+ $add_if->{'iface_opt'} = $iface_opt if ( defined $iface_opt );
+
+ # Check MAC address if defined
+ if ( defined $ref_host->{$iface_section}->{ 'mac.' . $host_number } ) {
+ my $mac = $ref_host->{$iface_section}->{ 'mac.' . $host_number };
+ if ( $host_site->{'BY_MAC'}->{$mac} ) {
+ my ( $ifdef, $hostdef, $vlandef )
+ = split( /\./, $host_site->{'BY_MAC'}->{$mac} );
+ Abort( $CODE->{'DUPLICATE_VALUE'},
+ "MAC address "
+ . $mac
+ . " is already defined for interface "
+ . $ifdef
+ . " in host "
+ . $hostdef
+ . " which is on vlan "
+ . $vlandef );
+ }
+ $add_if->{'mac'} = $mac;
+ }
+
+ # Check tag
+ if ( $iftag && $iftag =~ /^\d+$/ ) {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Tag "
+ . $iftag
+ . " defined on section name "
+ . $iface_section
+ . " differs from "
+ . $ref_host->{'vlan'}
+ . " network definition" );
+ }
+ if ( $iface =~ /^bond/ && !$iftag ) {
+
+ # Check if slaves not in use
+ my @slaves
+ = ( $ref_host->{$iface_section}->{ 'slaves.' . $host_number } )
+ ? split( /\s*,\s*/,
+ $ref_host->{$iface_section}->{ 'slaves.' . $host_number } )
+ : split( /\s*,\s*/, $ref_host->{$iface_section}->{'slaves'} );
+ foreach my $if (@slaves) {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Interface "
+ . $if
+ . " cannot be enslaved by "
+ . $iface
+ . " : already in use for "
+ . $hostname )
+ if ( grep ( /$if/, @{$ref_if_list} ) );
+ }
+ $add_if->{'slaves'} = join( " ", @slaves );
+ $add_if->{'mode'}
+ = $ref_host->{$iface_section}->{ 'mode.' . $host_number }
+ || $ref_host->{$iface_section}->{'mode'};
+ $add_if->{'options'}
+ = $ref_host->{$iface_section}->{ 'options.' . $host_number }
+ || $ref_host->{$iface_section}->{'options'};
+ }
+
+ # Check vlan
+ if ( !defined $network_site->{'BY_NAME'}->{$vlan} ) {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Unknown vlan "
+ . $vlan
+ . " on site "
+ . $site
+ . " for interface "
+ . $iface
+ . " defined on host "
+ . $hostname );
+ }
+
+ # Check address and route values
+ foreach my $ip_type ( 'ipv4', 'ipv6' ) {
+ next if ( !$pf_config->{'features'}->{$ip_type} );
+ my $suffix = ( $ip_type eq 'ipv6' ) ? '6' : '';
+ my $netblock = Get_netblock_from_vlan( $ip_type,
+ $network_site->{'BY_NAME'}->{$vlan} );
+ if ( !defined $netblock ) {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Unable to retrieve network block of type "
+ . $ip_type
+ . " for vlan "
+ . $vlan
+ . " on site "
+ . $site
+ . " for host "
+ . $hostname );
+ }
+ my $realip;
+ if ( $ref_host->{$iface_section}->{ $ip_type . '.' . $host_number } )
+ {
+ $realip = __Check_host_ip(
+ $ip_type,
+ $netblock,
+ $ref_host->{$iface_section}
+ ->{ $ip_type . '.' . $host_number },
+ 0,
+ 0,
+ 0,
+ $site,
+ $ref_site
+ );
+ }
+ else {
+ $realip
+ = __Check_host_ip( $ip_type, $netblock,
+ $ref_host->{$iface_section}->{$ip_type},
+ $hostnum, $hostnode, $nodes, $site, $ref_site );
+ }
+ $add_if->{$ip_type} = $realip->cidr();
+ my $route_key = ( $ip_type eq 'ipv6' ) ? '@route6' : '@route';
+ $route_key .= $hostnum
+ if ( $ref_host->{$iface_section}
+ ->{ $route_key . '.' . $host_number } );
+ my $gw_key = ( $ip_type eq 'ipv6' ) ? 'gateway6' : 'gateway';
+ if ( defined $ref_host->{$iface_section}->{$route_key} ) {
+ foreach
+ my $route ( @{ $ref_host->{$iface_section}->{$route_key} } )
+ {
+ $route =~ /^(\S+)\s*(via\s*(\S+))?$/;
+ my ( $dest, $via ) = ( $1, $3 );
+ my $route2add = '';
+ if ( $dest ne 'default' ) {
+ my $ip_dest;
+ if ( $dest =~ /[g-zG-Z]+/ ) {
+ if ( defined $network_site->{'BY_NAME'}->{$dest} ) {
+
+ # Dest is a defined network ... translating into IP
+ $ip_dest = new NetAddr::IP(
+ $network_site->{'BY_NAME'}->{$dest}
+ ->{'network'},
+ $network_site->{'BY_NAME'}->{$dest}
+ ->{'netmask'}
+ );
+ $route2add .= $ip_dest->cidr() . " via ";
+ }
+ else {
+
+ # Potentially not parsed host on this site
+ $route2add .= $dest . " via ";
+ }
+ }
+ else {
+ $ip_dest = new NetAddr::IP($dest);
+ if ( !defined $ip_dest ) {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Unable to check dest IP "
+ . $dest
+ . " of type "
+ . $ip_type
+ . " on \@route key for interface "
+ . $iface
+ . " for host "
+ . $hostname
+ . " on site "
+ . $site );
+ }
+ $route2add .= $ip_dest->cidr() . " via ";
+ }
+ }
+ else {
+ $route2add .= "default via ";
+ }
+ if ($via) {
+ my $ip_via;
+ if ( $via eq 'GATEWAY' ) {
+ if ( !defined $network_site->{'BY_NAME'}->{$vlan}
+ ->{$gw_key} )
+ {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Unable to define default route by vlan "
+ . $vlan
+ . " : no gateway defined on this one" );
+ }
+ $route2add
+ .= $network_site->{'BY_NAME'}->{$vlan}->{$gw_key};
+ }
+ elsif ( $via =~ /[g-zG-Z]+/ ) {
+
+ # Potentially not parsed host ... skipping this case for now
+ $route2add .= $via;
+ }
+ else {
+ my $ip_via = new NetAddr::IP($via);
+ if ( !defined $ip_via ) {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Unable to check IP "
+ . $via
+ . " of type "
+ . $ip_type
+ . " as gateway for interface "
+ . $iface
+ . " for host "
+ . $hostname
+ . " on site "
+ . $site );
+ }
+ elsif ( !$netblock->contains($ip_via) ) {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "IP "
+ . $ip_via
+ . " of type "
+ . $ip_type
+ . " for gateway on interface "
+ . $iface
+ . " is out of "
+ . $netblock
+ . " for host "
+ . $hostname
+ . " on site "
+ . $site );
+ }
+ $route2add .= $ip_via->addr();
+ }
+ }
+ push( @{ $add_if->{$route_key} }, $route2add );
+ }
+ }
+ }
+ return $add_if;
}
#########################################################################
@@ -601,142 +811,283 @@
# - $pf_config : hashref where are stored pf-tools configuration datas
#
sub Add_host ($$$$) {
- my ( $hostfile, $host2add, $global_config, $pf_config ) = @_;
-
- my $hostname_model = $host2add->{'hostgroup'}->{'hostname'};
- $hostname_model =~ /^$pf_config->{'regex'}->{'hostname_model'}$/ ;
- my $shortname = $1;
- 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 !~ /\/$/ );
- my ( $host_last, $node_last ) = __Get_host_indexes ( $host2add->{'hostgroup'}, $hostname_model );
-
- foreach my $site ( @{$site_list} ) {
- my $site_part = $global_config->{'SITE'}->{'BY_NAME'}->{$site};
- if ( ! defined $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass} ) {
- $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass} = {};
- push ( @{$site_part->{'HOST'}->{'__hostclass_pxe'}}, $hostclass );
- }
- my $host_part = $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass};
- my $zone = $site_part->{'zone'};
- my $prefix = __Get_site_prefix ( $site, $global_config->{'SITE'}->{'BY_NAME'}->{$site} );
- foreach my $hostnum ( 0 .. $host_last ) {
- foreach my $hostnode ( 0 .. $node_last ) {
- my $hostname = __Get_hostname_from_model ( $hostname_model, $hostnum, $hostnode, $prefix );
- if ( $host_part->{$hostname} ) {
- Warn ( $CODE->{'DUPLICATE_VALUE'},
- "Hostclass ".$hostclass." already contains hostname ".$hostname." definition from file "
- .$hostfile." and for site ".$site." : skipping this hostname" );
- next;
- }
- my $index = __Get_hostnumber_from_model ( $hostname_model, $hostnum, $hostnode);
- my $host_number = ( $hostnode ) ? $hostnum.$hostnode : $hostnum;
- # Checking path for PXE elements kernel, initrd ...
- foreach my $key ( 'pxefilename', 'kernel', 'initrd', 'kerneluml', 'initrduml', 'console', 'cmdline' ) {
- my $value;
- if ( $key eq 'console' ) {
- $value = $host2add->{'boot'}->{$key.'.'.$host_number} || $host2add->{'boot'}->{$key} || $site_part->{$key};
- }
- elsif ( $key eq 'cmdline' ) {
- $value = $host2add->{'boot'}->{$key.'.'.$host_number} || $host2add->{'boot'}->{$key} || "";
- }
- else {
- $value = $host2add->{'boot'}->{$key.'.'.$host_number} || $host2add->{'boot'}->{$key};
- next if ( ! defined $value );
- if ( ! -e $pf_tftp_dir.$value ) {
- Warn ( $CODE->{'OPEN'},
- "Unable to find file ".$pf_tftp_dir.$value." for key ".$key." for host ".$hostname." from file ".$hostfile );
- }
- }
- $host_part->{$hostname}->{'boot'}->{$key} = $value;
- }
- my $dhcpvlan = $host2add->{'deployment'}->{'dhcpvlan.'.$host_number} || $host2add->{'deployment'}->{'dhcpvlan'} || $site_part->{'dhcpvlan'};
- if ( ! defined $site_part->{'NETWORK'}->{'BY_NAME'}->{$dhcpvlan} ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Vlan ".$dhcpvlan." defined for ".$hostname." from file ".$hostfile." doesn't exist on site ".$site );
- }
- foreach my $key ( 'arch', 'distrib', 'mode', 'os_type' ) {
- my $value = $host2add->{'deployment'}->{$key.'.'.$host_number} || $host2add->{'deployment'}->{$key};
- next if ( ! defined $value );
- $host_part->{$hostname}->{'deployment'}->{$key} = $value;
- }
- $host_part->{$hostname}->{'deployment'}->{'hostname_model'} = $host2add->{'hostgroup'}->{'hostname'};
- $host_part->{$hostname}->{'deployment'}->{'hosttype'} = $hostclass;
- $host_part->{$hostname}->{'deployment'}->{'host_config'} = 'SITE:'.$site.'/CONFIG/update-'.$hostclass;
- $host_part->{$hostname}->{'dns'}->{'resolver'} = $host2add->{'dns'}->{'resolver.'.$host_number} || $host2add->{'dns'}->{'resolver'};
- # Check interfaces
- my @if_list = __Get_host_interfaces ($host2add);
- foreach my $iface ( @if_list ) {
- my $if2add = __Add_host_interface ( $iface, $hostname, $hostnum, $hostnode, $host_number, $host2add, \@if_list, $site, $site_part, $pf_config );
- my $iface_name = $iface;
- if ( $iface =~ /^((eth|bond)[\d]+)(\.(TAG[\d]+))$/ ) {
- $iface_name = $1.'.'.__Get_vlan_tag_from_site ( $if2add->{'vlan'}, $site, $global_config );
- }
- # Adding interface and IPs into site's zone
- $host_part->{$hostname}->{'interfaces'} = {} if ( ! defined $host_part->{$hostname}->{'interfaces'} );
- $host_part->{$hostname}->{'interfaces'}->{$iface_name} = $if2add;
- $site_part->{'HOST'}->{'BY_MAC'}->{$if2add->{'mac'}} = $iface.'.'.$hostname.'.'.$if2add->{'vlan'} if ( $if2add->{'mac'} );
- if ( $if2add->{'vlan'} eq $dhcpvlan && ! defined $if2add->{'mac'} ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "MAC address MUST BE defined for interface ".$iface." which is on dhcpvlan ".$dhcpvlan );
- }
- foreach my $ip_type ( 'ipv4', 'ipv6' ) {
- next if ( ! $pf_config->{'features'}->{$ip_type} );
- my $addr_key = ( $ip_type eq 'ipv6' ) ? 'BY_ADDR6' : 'BY_ADDR';
- my $zone_key = ( $ip_type eq 'ipv6' ) ? 'ZONE6' : 'ZONE';
- my $dhcp_key = ( $ip_type eq 'ipv6' ) ? 'DHCP6' : 'DHCP';
- my $suffix = ( $ip_type eq 'ipv6' ) ? '6' : '';
- my $zone_ip = $if2add->{$ip_type}; $zone_ip =~ s/\/.+$//;
- my $zone_part = $global_config->{$zone_key}->{'BY_NAME'}->{$zone}->{'BY_SITE'}->{$site};
- my $dhcp_part = $global_config->{$dhcp_key}->{'BY_SITE'}->{$site};
- $site_part->{'HOST'}->{$addr_key}->{$if2add->{$ip_type}} = $hostname.'.'.$if2add->{'vlan'};
- if ( ! defined $zone_part->{$hostclass} ) {
- $zone_part->{$hostclass} = {};
- push ( @{$global_config->{$zone_key}->{'BY_NAME'}->{$zone}->{'__hostclass_order'}->{$site}}, $hostclass );
- }
- $zone_part->{$hostclass}->{$hostname.'.'.$if2add->{'vlan'}} = "A\t".$zone_ip;
- my $shortname_vlan = $host2add->{'dns'}->{'shortname.'.$host_number} || $host2add->{'dns'}->{'shortname'} || "";
- if ( $shortname_vlan eq $if2add->{'vlan'} ) {
- push ( @{$zone_part->{$hostclass}->{$shortname.'.'.$if2add->{'vlan'}}}, "A\t".$zone_ip );
- $zone_part->{$hostclass}->{$shortname} = "CNAME\t".$shortname.'.'.$if2add->{'vlan'};
- }
- foreach my $key ( keys %{$host2add->{'dns'}} ) {
- next if ( $key !~ /^alias/ );
- my ( $key_type, $alias, $host_num ) = split ( /\./, $key );
- $host_part->{$alias} = $shortname if ( ! defined $host_part->{$alias} );
- $host_part->{$alias.$index} = $hostname;
- if ( $host2add->{'dns'}->{$key} eq $if2add->{'vlan'} ) {
- $zone_part->{$hostclass}->{$alias} = "CNAME\t".$shortname.'.'.$if2add->{'vlan'};
- $zone_part->{$hostclass}->{$alias.$index} = "CNAME\t".$hostname.'.'.$if2add->{'vlan'};
-
- }
- }
- my $resolver = $host2add->{'dns'}->{'resolver.'.$host_number} || $host2add->{'dns'}->{'resolver'};
- if ( $if2add->{'vlan'} eq $dhcpvlan ) {
- $host_part->{$hostname}->{'deployment'}->{'dhcpvlan'} = $dhcpvlan;
- if ( ! defined $dhcp_part->{$dhcpvlan} ) {
- $dhcp_part->{$dhcpvlan} = {};
- $dhcp_part->{$dhcpvlan}->{'subnet'} = $site_part->{'NETWORK'}->{'BY_NAME'}->{$dhcpvlan}->{'network'.$suffix};
- $dhcp_part->{$dhcpvlan}->{'netmask'} = $site_part->{'NETWORK'}->{'BY_NAME'}->{$dhcpvlan}->{'netmask'.$suffix};
- if ( $site_part->{'NETWORK'}->{'BY_NAME'}->{$dhcpvlan}->{'gateway'.$suffix} ) {
- $dhcp_part->{$dhcpvlan}->{'routers'} = $site_part->{'NETWORK'}->{'BY_NAME'}->{$dhcpvlan}->{'gateway'.$suffix};
- }
- }
- $dhcp_part->{$dhcpvlan}->{$hostclass} = {} if ( ! defined $dhcp_part->{$dhcpvlan}->{$hostclass} );
- my $fixed_addr = $if2add->{$ip_type}; $fixed_addr =~ s!/[\d]+$!!;
- $dhcp_part->{$dhcpvlan}->{$hostclass}->{$hostname} = [
- 'hardware ethernet '.$if2add->{'mac'}.';',
- 'fixed-address '.$fixed_addr.';',
- 'filename '.$host2add->{'boot'}->{'pxefilename'}.';',
- 'option domain-name-servers '.$resolver.';'
- ];
- }
- }
- }
- }
- }
- }
+ my ( $hostfile, $host2add, $global_config, $pf_config ) = @_;
+
+ my $hostname_model = $host2add->{'hostgroup'}->{'hostname'};
+ $hostname_model =~ /^$pf_config->{'regex'}->{'hostname_model'}$/;
+ my $shortname = $1;
+ 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 !~ /\/$/ );
+ my ( $host_last, $node_last )
+ = __Get_host_indexes( $host2add->{'hostgroup'}, $hostname_model );
+
+ foreach my $site ( @{$site_list} ) {
+ my $site_part = $global_config->{'SITE'}->{'BY_NAME'}->{$site};
+ if ( !defined $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass} ) {
+ $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass} = {};
+ push( @{ $site_part->{'HOST'}->{'__hostclass_pxe'} },
+ $hostclass );
+ }
+ my $host_part = $site_part->{'HOST'}->{'BY_NAME'}->{$hostclass};
+ my $zone = $site_part->{'zone'};
+ my $prefix = __Get_site_prefix( $site,
+ $global_config->{'SITE'}->{'BY_NAME'}->{$site} );
+ foreach my $hostnum ( 0 .. $host_last ) {
+ foreach my $hostnode ( 0 .. $node_last ) {
+ my $hostname
+ = __Get_hostname_from_model( $hostname_model, $hostnum,
+ $hostnode, $prefix );
+ if ( $host_part->{$hostname} ) {
+ Warn( $CODE->{'DUPLICATE_VALUE'},
+ "Hostclass "
+ . $hostclass
+ . " already contains hostname "
+ . $hostname
+ . " definition from file "
+ . $hostfile
+ . " and for site "
+ . $site
+ . " : skipping this hostname" );
+ next;
+ }
+ my $index
+ = __Get_hostnumber_from_model( $hostname_model, $hostnum,
+ $hostnode );
+ my $host_number
+ = ($hostnode) ? $hostnum . $hostnode : $hostnum;
+
+ # Checking path for PXE elements kernel, initrd ...
+ foreach my $key (
+ 'pxefilename', 'kernel', 'initrd', 'kerneluml',
+ 'initrduml', 'console', 'cmdline'
+ )
+ {
+ my $value;
+ if ( $key eq 'console' ) {
+ $value
+ = $host2add->{'boot'}
+ ->{ $key . '.' . $host_number }
+ || $host2add->{'boot'}->{$key}
+ || $site_part->{$key};
+ }
+ elsif ( $key eq 'cmdline' ) {
+ $value
+ = $host2add->{'boot'}
+ ->{ $key . '.' . $host_number }
+ || $host2add->{'boot'}->{$key}
+ || "";
+ }
+ else {
+ $value
+ = $host2add->{'boot'}
+ ->{ $key . '.' . $host_number }
+ || $host2add->{'boot'}->{$key};
+ next if ( !defined $value );
+ if ( !-e $pf_tftp_dir . $value ) {
+ Warn( $CODE->{'OPEN'},
+ "Unable to find file "
+ . $pf_tftp_dir
+ . $value
+ . " for key "
+ . $key
+ . " for host "
+ . $hostname
+ . " from file "
+ . $hostfile );
+ }
+ }
+ $host_part->{$hostname}->{'boot'}->{$key} = $value;
+ }
+ my $dhcpvlan
+ = $host2add->{'deployment'}
+ ->{ 'dhcpvlan.' . $host_number }
+ || $host2add->{'deployment'}->{'dhcpvlan'}
+ || $site_part->{'dhcpvlan'};
+ if ( !defined $site_part->{'NETWORK'}->{'BY_NAME'}
+ ->{$dhcpvlan} )
+ {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Vlan "
+ . $dhcpvlan
+ . " defined for "
+ . $hostname
+ . " from file "
+ . $hostfile
+ . " doesn't exist on site "
+ . $site );
+ }
+ foreach my $key ( 'arch', 'distrib', 'mode', 'os_type' ) {
+ my $value
+ = $host2add->{'deployment'}
+ ->{ $key . '.' . $host_number }
+ || $host2add->{'deployment'}->{$key};
+ next if ( !defined $value );
+ $host_part->{$hostname}->{'deployment'}->{$key} = $value;
+ }
+ $host_part->{$hostname}->{'deployment'}->{'hostname_model'}
+ = $host2add->{'hostgroup'}->{'hostname'};
+ $host_part->{$hostname}->{'deployment'}->{'hosttype'}
+ = $hostclass;
+ $host_part->{$hostname}->{'deployment'}->{'host_config'}
+ = 'SITE:' . $site . '/CONFIG/update-' . $hostclass;
+ $host_part->{$hostname}->{'dns'}->{'resolver'}
+ = $host2add->{'dns'}->{ 'resolver.' . $host_number }
+ || $host2add->{'dns'}->{'resolver'};
+
+ # Check interfaces
+ my @if_list = __Get_host_interfaces($host2add);
+ foreach my $iface (@if_list) {
+ my $if2add = __Add_host_interface(
+ $iface, $hostname, $hostnum, $hostnode,
+ $host_number, $host2add, \@if_list, $site,
+ $site_part, $pf_config
+ );
+ my $iface_name = $iface;
+ if ( $iface =~ /^((eth|bond)[\d]+)(\.(TAG[\d]+))$/ ) {
+ $iface_name
+ = $1 . '.'
+ . __Get_vlan_tag_from_site( $if2add->{'vlan'},
+ $site, $global_config );
+ }
+
+ # Adding interface and IPs into site's zone
+ $host_part->{$hostname}->{'interfaces'} = {}
+ if (
+ !defined $host_part->{$hostname}->{'interfaces'} );
+ $host_part->{$hostname}->{'interfaces'}->{$iface_name}
+ = $if2add;
+ $site_part->{'HOST'}->{'BY_MAC'}->{ $if2add->{'mac'} }
+ = $iface . '.' . $hostname . '.' . $if2add->{'vlan'}
+ if ( $if2add->{'mac'} );
+ if ( $if2add->{'vlan'} eq $dhcpvlan
+ && !defined $if2add->{'mac'} )
+ {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "MAC address MUST BE defined for interface "
+ . $iface
+ . " which is on dhcpvlan "
+ . $dhcpvlan );
+ }
+ foreach my $ip_type ( 'ipv4', 'ipv6' ) {
+ next if ( !$pf_config->{'features'}->{$ip_type} );
+ my $addr_key
+ = ( $ip_type eq 'ipv6' ) ? 'BY_ADDR6' : 'BY_ADDR';
+ my $zone_key
+ = ( $ip_type eq 'ipv6' ) ? 'ZONE6' : 'ZONE';
+ my $dhcp_key
+ = ( $ip_type eq 'ipv6' ) ? 'DHCP6' : 'DHCP';
+ my $suffix = ( $ip_type eq 'ipv6' ) ? '6' : '';
+ my $zone_ip = $if2add->{$ip_type};
+ $zone_ip =~ s/\/.+$//;
+ my $zone_part
+ = $global_config->{$zone_key}->{'BY_NAME'}
+ ->{$zone}->{'BY_SITE'}->{$site};
+ my $dhcp_part
+ = $global_config->{$dhcp_key}->{'BY_SITE'}
+ ->{$site};
+ $site_part->{'HOST'}->{$addr_key}
+ ->{ $if2add->{$ip_type} }
+ = $hostname . '.' . $if2add->{'vlan'};
+
+ if ( !defined $zone_part->{$hostclass} ) {
+ $zone_part->{$hostclass} = {};
+ push(
+ @{ $global_config->{$zone_key}->{'BY_NAME'}
+ ->{$zone}->{'__hostclass_order'}
+ ->{$site}
+ },
+ $hostclass
+ );
+ }
+ $zone_part->{$hostclass}
+ ->{ $hostname . '.' . $if2add->{'vlan'} }
+ = "A\t" . $zone_ip;
+ my $shortname_vlan
+ = $host2add->{'dns'}
+ ->{ 'shortname.' . $host_number }
+ || $host2add->{'dns'}->{'shortname'}
+ || "";
+ if ( $shortname_vlan eq $if2add->{'vlan'} ) {
+ push(
+ @{ $zone_part->{$hostclass}->{
+ $shortname . '.' . $if2add->{'vlan'}
+ }
+ },
+ "A\t" . $zone_ip
+ );
+ $zone_part->{$hostclass}->{$shortname}
+ = "CNAME\t"
+ . $shortname . '.'
+ . $if2add->{'vlan'};
+ }
+ foreach my $key ( keys %{ $host2add->{'dns'} } ) {
+ next if ( $key !~ /^alias/ );
+ my ( $key_type, $alias, $host_num )
+ = split( /\./, $key );
+ $host_part->{$alias} = $shortname
+ if ( !defined $host_part->{$alias} );
+ $host_part->{ $alias . $index } = $hostname;
+ if ( $host2add->{'dns'}->{$key} eq
+ $if2add->{'vlan'} )
+ {
+ $zone_part->{$hostclass}->{$alias}
+ = "CNAME\t"
+ . $shortname . '.'
+ . $if2add->{'vlan'};
+ $zone_part->{$hostclass}->{ $alias . $index }
+ = "CNAME\t"
+ . $hostname . '.'
+ . $if2add->{'vlan'};
+
+ }
+ }
+ my $resolver
+ = $host2add->{'dns'}
+ ->{ 'resolver.' . $host_number }
+ || $host2add->{'dns'}->{'resolver'};
+ if ( $if2add->{'vlan'} eq $dhcpvlan ) {
+ $host_part->{$hostname}->{'deployment'}
+ ->{'dhcpvlan'} = $dhcpvlan;
+ if ( !defined $dhcp_part->{$dhcpvlan} ) {
+ $dhcp_part->{$dhcpvlan} = {};
+ $dhcp_part->{$dhcpvlan}->{'subnet'}
+ = $site_part->{'NETWORK'}->{'BY_NAME'}
+ ->{$dhcpvlan}->{ 'network' . $suffix };
+ $dhcp_part->{$dhcpvlan}->{'netmask'}
+ = $site_part->{'NETWORK'}->{'BY_NAME'}
+ ->{$dhcpvlan}->{ 'netmask' . $suffix };
+ if ( $site_part->{'NETWORK'}->{'BY_NAME'}
+ ->{$dhcpvlan}->{ 'gateway' . $suffix } )
+ {
+ $dhcp_part->{$dhcpvlan}->{'routers'}
+ = $site_part->{'NETWORK'}->{'BY_NAME'}
+ ->{$dhcpvlan}
+ ->{ 'gateway' . $suffix };
+ }
+ }
+ $dhcp_part->{$dhcpvlan}->{$hostclass} = {}
+ if ( !defined $dhcp_part->{$dhcpvlan}
+ ->{$hostclass} );
+ my $fixed_addr = $if2add->{$ip_type};
+ $fixed_addr =~ s!/[\d]+$!!;
+ $dhcp_part->{$dhcpvlan}->{$hostclass}->{$hostname}
+ = [
+ 'hardware ethernet ' . $if2add->{'mac'} . ';',
+ 'fixed-address ' . $fixed_addr . ';',
+ 'filename '
+ . $host2add->{'boot'}->{'pxefilename'}
+ . ';',
+ 'option domain-name-servers '
+ . $resolver . ';'
+ ];
+ }
+ }
+ }
+ }
+ }
+ }
}
1;
Modified: branches/next-gen/lib/PFTools/Conf/Network.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Conf/Network.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Conf/Network.pm (original)
+++ branches/next-gen/lib/PFTools/Conf/Network.pm Tue Sep 7 08:54:37 2010
@@ -30,9 +30,9 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Add_network
- Add_site
- Add_zone
+ Add_network
+ Add_site
+ Add_zone
);
our @EXPORT_OK = qw();
@@ -60,25 +60,30 @@
# - $pf_config : hashref where are stored pf-tools configuration
#
sub Add_zone ($$$$$) {
- my ( $netfile, $zone_name, $zone2add, $global_config, $pf_config ) = @_;
-
- foreach my $ip_type ( 'ipv4', 'ipv6' ) {
- next if ( ! $pf_config->{'features'}->{$ip_type} );
- my $zone_key = ( $ip_type eq 'ipv6' ) ? 'ZONE6' : 'ZONE';
- my $zone_part = $global_config->{$zone_key}->{'BY_NAME'};
- if ( defined $zone_part->{$zone_name} ) {
- Warn ( $CODE->{'WARNING'}, "Zone ".$zone_name." from file ".$netfile." already exists : skipping the new definition" );
- return;
- }
- $zone_part->{$zone_name} = {
- 'SOA' => $zone2add,
- 'BY_SITE' => {},
- '__network_order' => {},
- '__hostclass_order' => {}
- };
- $zone_part->{$zone_name}->{'SOA'} = $zone2add;
- $zone_part->{$zone_name}->{'BY_SITE'} = {};
- }
+ my ( $netfile, $zone_name, $zone2add, $global_config, $pf_config ) = @_;
+
+ foreach my $ip_type ( 'ipv4', 'ipv6' ) {
+ next if ( !$pf_config->{'features'}->{$ip_type} );
+ my $zone_key = ( $ip_type eq 'ipv6' ) ? 'ZONE6' : 'ZONE';
+ my $zone_part = $global_config->{$zone_key}->{'BY_NAME'};
+ if ( defined $zone_part->{$zone_name} ) {
+ Warn( $CODE->{'WARNING'},
+ "Zone "
+ . $zone_name
+ . " from file "
+ . $netfile
+ . " already exists : skipping the new definition" );
+ return;
+ }
+ $zone_part->{$zone_name} = {
+ 'SOA' => $zone2add,
+ 'BY_SITE' => {},
+ '__network_order' => {},
+ '__hostclass_order' => {}
+ };
+ $zone_part->{$zone_name}->{'SOA'} = $zone2add;
+ $zone_part->{$zone_name}->{'BY_SITE'} = {};
+ }
}
#########################################################################
@@ -94,56 +99,76 @@
# - $pf_config : hashref where are stored pf-tools configuration
#
sub Add_site ($$$$$) {
- my ( $netfile, $site_name, $site2add, $global_config, $pf_config ) = @_;
-
- my $site_part = $global_config->{'SITE'};
- if ( defined $site_part->{'BY_NAME'}->{$site_name} ) {
- Warn ( $CODE->{'WARNING'}, "Site ".$site_name." from file ".$netfile." already exists : skipping the new definition" );
- return;
- }
- if ( $site2add->{'state'} eq 'ROOT' ) {
- if ( $site_part->{'ROOT'} ) {
- Warn ( $CODE->{'WARNING'}, "Site ".$site_name." from file ".$netfile." cannot be defined as ROOT site : skipping the new definition" );
- }
- else {
- $site_part->{'ROOT'} = $site_name;
- }
- } else {
- push ( @{$site_part->{'EDGE'}}, $site_name );
- }
- $site_part->{'BY_NAME'}->{$site_name} = $site2add;
- $site_part->{'BY_NAME'}->{$site_name}->{'NETWORK'} = {
- 'BY_NAME' => {},
- 'BY_TAG' => {}
- };
- $site_part->{'BY_NAME'}->{$site_name}->{'HOST'} = {
- 'BY_NAME' => {},
- 'BY_MAC' => {}
- };
- $site_part->{'BY_NAME'}->{$site_name}->{'SERVICE'} = {
- 'BY_NAME' => {}
- };
- push ( @{$site_part->{'__site_list'}}, $site_name );
- foreach my $ip_type ( 'ipv4', 'ipv6' ) {
- next if ( ! $pf_config->{'features'}->{$ip_type} );
- my $zone_key = ( $ip_type eq 'ipv6' ) ? 'ZONE6' : 'ZONE';
- my $dhcp_key = ( $ip_type eq 'ipv6' ) ? 'DHCP6' : 'DHCP';
- my $addr_key = ( $ip_type eq 'ipv6' ) ? 'BY_ADDR6' : 'BY_ADDR';
- if ( ! defined $global_config->{$zone_key}->{'BY_NAME'}->{$site2add->{'zone'}} ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Zone ".$site2add->{'zone'}." for site ".$site_name." defined into ".$netfile." doesn't exist in global configuration" );
- }
- $site_part->{'BY_NAME'}->{$site_name}->{'NETWORK'}->{$addr_key} = {};
- $site_part->{'BY_NAME'}->{$site_name}->{'HOST'}->{$addr_key} = {};
- $global_config->{$zone_key}->{'BY_NAME'}->{$site2add->{'zone'}}->{'BY_SITE'}->{$site_name} = {};
- $global_config->{$zone_key}->{'BY_SITE'}->{$site_name} = $site2add->{'zone'};
- $global_config->{$dhcp_key}->{'BY_SITE'}->{$site_name} = {
- $site2add->{'dhcpvlan'} => {
- 'subnet' => '',
- 'netmask' => ''
- }
- };
- }
+ my ( $netfile, $site_name, $site2add, $global_config, $pf_config ) = @_;
+
+ my $site_part = $global_config->{'SITE'};
+ if ( defined $site_part->{'BY_NAME'}->{$site_name} ) {
+ Warn( $CODE->{'WARNING'},
+ "Site "
+ . $site_name
+ . " from file "
+ . $netfile
+ . " already exists : skipping the new definition" );
+ return;
+ }
+ if ( $site2add->{'state'} eq 'ROOT' ) {
+ if ( $site_part->{'ROOT'} ) {
+ Warn( $CODE->{'WARNING'},
+ "Site "
+ . $site_name
+ . " from file "
+ . $netfile
+ . " cannot be defined as ROOT site : skipping the new definition"
+ );
+ }
+ else {
+ $site_part->{'ROOT'} = $site_name;
+ }
+ }
+ else {
+ push( @{ $site_part->{'EDGE'} }, $site_name );
+ }
+ $site_part->{'BY_NAME'}->{$site_name} = $site2add;
+ $site_part->{'BY_NAME'}->{$site_name}->{'NETWORK'} = {
+ 'BY_NAME' => {},
+ 'BY_TAG' => {}
+ };
+ $site_part->{'BY_NAME'}->{$site_name}->{'HOST'} = {
+ 'BY_NAME' => {},
+ 'BY_MAC' => {}
+ };
+ $site_part->{'BY_NAME'}->{$site_name}->{'SERVICE'} = { 'BY_NAME' => {} };
+ push( @{ $site_part->{'__site_list'} }, $site_name );
+ foreach my $ip_type ( 'ipv4', 'ipv6' ) {
+ next if ( !$pf_config->{'features'}->{$ip_type} );
+ my $zone_key = ( $ip_type eq 'ipv6' ) ? 'ZONE6' : 'ZONE';
+ my $dhcp_key = ( $ip_type eq 'ipv6' ) ? 'DHCP6' : 'DHCP';
+ my $addr_key = ( $ip_type eq 'ipv6' ) ? 'BY_ADDR6' : 'BY_ADDR';
+ if ( !defined $global_config->{$zone_key}->{'BY_NAME'}
+ ->{ $site2add->{'zone'} } )
+ {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Zone "
+ . $site2add->{'zone'}
+ . " for site "
+ . $site_name
+ . " defined into "
+ . $netfile
+ . " doesn't exist in global configuration" );
+ }
+ $site_part->{'BY_NAME'}->{$site_name}->{'NETWORK'}->{$addr_key} = {};
+ $site_part->{'BY_NAME'}->{$site_name}->{'HOST'}->{$addr_key} = {};
+ $global_config->{$zone_key}->{'BY_NAME'}->{ $site2add->{'zone'} }
+ ->{'BY_SITE'}->{$site_name} = {};
+ $global_config->{$zone_key}->{'BY_SITE'}->{$site_name}
+ = $site2add->{'zone'};
+ $global_config->{$dhcp_key}->{'BY_SITE'}->{$site_name} = {
+ $site2add->{'dhcpvlan'} => {
+ 'subnet' => '',
+ 'netmask' => ''
+ }
+ };
+ }
}
#########################################################################
@@ -159,85 +184,153 @@
# - $pf_config : hashref where are stored pf-tools configuration datas
#
sub Add_network ($$$$$) {
- my ( $netfile, $net_name, $ref_net, $global_config, $pf_config ) = @_;
- my ( $block, $block6, $site_list, $net_part, $dhcp_part, $net2add, $ip_gw, $ip6_gw );
-
- my $site_part = $global_config->{'SITE'};
- $site_list = Get_site_list ( $ref_net, $global_config );
- $net2add->{'scope'} = $ref_net->{'scope'};
- $net2add->{'comment'} = $ref_net->{'comment'} if ( $ref_net->{'comment'} );
- # Check TAG
- if ( $ref_net->{'tag'} && ( $ref_net->{'tag'} < 0 || $ref_net->{'tag'} > 4095 ) ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Invalid 802.1q tag ".$ref_net->{'tag'}." for file ".$netfile." into ".$net_name." definition" );
- }
- # Check IP values
- foreach my $ip_type ( 'ipv4', 'ipv6' ) {
- next if ( ! $pf_config->{'features'}->{$ip_type} );
- my $suffix = ( $ip_type eq 'ipv6') ? '6' : '';
- my $net_block = Get_netblock_from_vlan ( $ip_type, $ref_net );
- my $zone_key = ( $ip_type eq 'ipv6') ? 'ZONE6' : 'ZONE';
- my $dhcp_key = ( $ip_type eq 'ipv6') ? 'DHCP6' : 'DHCP';
- my $netaddr_key = ( $ip_type eq 'ipv6') ? 'BY_ADDR6' : 'BY_ADDR';
- my $gw_key = ( $ip_type eq 'ipv6') ? 'gateway6' : 'gateway';
- $net2add->{'network'.$suffix} = $net_block->addr();
- $net2add->{'netmask'.$suffix} = $net_block->mask();
- if ( $ref_net->{'gateway'.$suffix} ) {
- $ip_gw = new NetAddr::IP ( $net_block->prefix().$ref_net->{'gateway'}, $net_block->mask() );
- if ( ! defined $ip_gw ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unable to check ".$ip_type." gateway defined from ".$netfile." into ".$net_name." definition" );
- }
- elsif ( ! $net_block->contains ( $ip_gw ) ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Gateway ".$ip_gw." is out of range from network ".$ref_net->{'network'}
- ." from file ".$netfile." into ".$net_name." definition" );
- }
- $net2add->{'gateway'.$suffix} = $ip_gw->addr();
- }
- $net2add->{'tag'} = $ref_net->{'tag'};
- foreach my $site ( @{$site_list} ) {
- $net_part = $site_part->{'BY_NAME'}->{$site}->{'NETWORK'};
- if ( $net_part->{'BY_NAME'}->{$net_name} ) {
- Warn ( $CODE->{'DUPLICATE_VALUE'},
- "Network ".$net_name." from file ".$netfile." is already defined for site ".$site." : skipping declaration" );
- }
- elsif ( $ref_net->{'tag'} && $net_part->{'BY_TAG'}->{$ref_net->{'tag'}} ) {
- Abort ( $CODE->{'DUPLICATE_VALUE'},
- "802.1q tag ".$ref_net->{'tag'}." for network ".$net_name." is already in use on site "
- .$site." for network ".$net_part->{'BY_TAG'}->{$ref_net->{'tag'}} );
- }
- if ( $net_part->{'BY_ADDR'}->{$net_block->cidr()} && $net_part->{'BY_ADDR'}->{$net_block->cidr()} ne $net_name ) {
- Abort ( $CODE->{'DUPLICATE_VALUE'},
- $ip_type." subnet ".$block." for network ".$net_name." from file ".$netfile
- ." is already in use in site ".$site." for network ".$net_part->{'BY_ADDR'}->{$block} );
- }
- # Adding network to the network part of the global structure
- $net_part = $site_part->{'BY_NAME'}->{$site}->{'NETWORK'};
- $dhcp_part = $global_config->{$dhcp_key}->{'BY_SITE'}->{$site};
- $net_part->{'BY_NAME'}->{$net_name} = $net2add;
- $net_part->{$netaddr_key}->{$net_block->cidr()} = $net_name;
- $net_part->{'BY_TAG'}->{$ref_net->{'tag'}} = $net_name if ( $ref_net->{'tag'} );
- # Adding entries for network, netmask, broadcast etc. into the DNS zone
- my $zone = $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'zone'};
- my $zone_part = $global_config->{$zone_key}->{'BY_NAME'}->{$zone};
- push ( @{$zone_part->{'__network_order'}->{$site}}, $net_name );
- $zone_part->{'BY_SITE'}->{$site}->{$net_name} = {};
- # Adding IPv4 entries
- $zone_part->{'BY_SITE'}->{$site}->{$net_name}->{'network'} = "A\t".$net_block->addr();
- $zone_part->{'BY_SITE'}->{$site}->{$net_name}->{'netmask'} = "A\t".$net_block->mask();
- my $broad = $net_block->broadcast(); $broad =~ s/\/.*$//;
- $zone_part->{'BY_SITE'}->{$site}->{$net_name}->{'broadcast'} = "A\t".$broad;
- $zone_part->{'BY_SITE'}->{$site}->{$net_name}->{'gateway'} = "A\t".$net2add->{$gw_key} if ( defined $net2add->{$gw_key} );
- if ( defined $dhcp_part->{$net_name} ) {
- $dhcp_part->{$net_name}->{'subnet'} = $net_block->addr();
- $dhcp_part->{$net_name}->{'netmask'} = $net_block->mask();
- if ( defined $net2add->{'gateway'} ) {
- $dhcp_part->{$net_name}->{'routers'} = $net2add->{'gateway'};
- }
- }
- }
- }
+ my ( $netfile, $net_name, $ref_net, $global_config, $pf_config ) = @_;
+ my ($block, $block6, $site_list, $net_part,
+ $dhcp_part, $net2add, $ip_gw, $ip6_gw
+ );
+
+ my $site_part = $global_config->{'SITE'};
+ $site_list = Get_site_list( $ref_net, $global_config );
+ $net2add->{'scope'} = $ref_net->{'scope'};
+ $net2add->{'comment'} = $ref_net->{'comment'}
+ if ( $ref_net->{'comment'} );
+
+ # Check TAG
+ if ( $ref_net->{'tag'}
+ && ( $ref_net->{'tag'} < 0 || $ref_net->{'tag'} > 4095 ) )
+ {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Invalid 802.1q tag "
+ . $ref_net->{'tag'}
+ . " for file "
+ . $netfile
+ . " into "
+ . $net_name
+ . " definition" );
+ }
+
+ # Check IP values
+ foreach my $ip_type ( 'ipv4', 'ipv6' ) {
+ next if ( !$pf_config->{'features'}->{$ip_type} );
+ my $suffix = ( $ip_type eq 'ipv6' ) ? '6' : '';
+ my $net_block = Get_netblock_from_vlan( $ip_type, $ref_net );
+ my $zone_key = ( $ip_type eq 'ipv6' ) ? 'ZONE6' : 'ZONE';
+ my $dhcp_key = ( $ip_type eq 'ipv6' ) ? 'DHCP6' : 'DHCP';
+ my $netaddr_key = ( $ip_type eq 'ipv6' ) ? 'BY_ADDR6' : 'BY_ADDR';
+ my $gw_key = ( $ip_type eq 'ipv6' ) ? 'gateway6' : 'gateway';
+ $net2add->{ 'network' . $suffix } = $net_block->addr();
+ $net2add->{ 'netmask' . $suffix } = $net_block->mask();
+
+ if ( $ref_net->{ 'gateway' . $suffix } ) {
+ $ip_gw
+ = new NetAddr::IP(
+ $net_block->prefix() . $ref_net->{'gateway'},
+ $net_block->mask() );
+ if ( !defined $ip_gw ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unable to check "
+ . $ip_type
+ . " gateway defined from "
+ . $netfile
+ . " into "
+ . $net_name
+ . " definition" );
+ }
+ elsif ( !$net_block->contains($ip_gw) ) {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Gateway "
+ . $ip_gw
+ . " is out of range from network "
+ . $ref_net->{'network'}
+ . " from file "
+ . $netfile
+ . " into "
+ . $net_name
+ . " definition" );
+ }
+ $net2add->{ 'gateway' . $suffix } = $ip_gw->addr();
+ }
+ $net2add->{'tag'} = $ref_net->{'tag'};
+ foreach my $site ( @{$site_list} ) {
+ $net_part = $site_part->{'BY_NAME'}->{$site}->{'NETWORK'};
+ if ( $net_part->{'BY_NAME'}->{$net_name} ) {
+ Warn( $CODE->{'DUPLICATE_VALUE'},
+ "Network "
+ . $net_name
+ . " from file "
+ . $netfile
+ . " is already defined for site "
+ . $site
+ . " : skipping declaration" );
+ }
+ elsif ($ref_net->{'tag'}
+ && $net_part->{'BY_TAG'}->{ $ref_net->{'tag'} } )
+ {
+ Abort( $CODE->{'DUPLICATE_VALUE'},
+ "802.1q tag "
+ . $ref_net->{'tag'}
+ . " for network "
+ . $net_name
+ . " is already in use on site "
+ . $site
+ . " for network "
+ . $net_part->{'BY_TAG'}->{ $ref_net->{'tag'} } );
+ }
+ if ( $net_part->{'BY_ADDR'}->{ $net_block->cidr() }
+ && $net_part->{'BY_ADDR'}->{ $net_block->cidr() } ne
+ $net_name )
+ {
+ Abort( $CODE->{'DUPLICATE_VALUE'},
+ $ip_type
+ . " subnet "
+ . $block
+ . " for network "
+ . $net_name
+ . " from file "
+ . $netfile
+ . " is already in use in site "
+ . $site
+ . " for network "
+ . $net_part->{'BY_ADDR'}->{$block} );
+ }
+
+ # Adding network to the network part of the global structure
+ $net_part = $site_part->{'BY_NAME'}->{$site}->{'NETWORK'};
+ $dhcp_part = $global_config->{$dhcp_key}->{'BY_SITE'}->{$site};
+ $net_part->{'BY_NAME'}->{$net_name} = $net2add;
+ $net_part->{$netaddr_key}->{ $net_block->cidr() } = $net_name;
+ $net_part->{'BY_TAG'}->{ $ref_net->{'tag'} } = $net_name
+ if ( $ref_net->{'tag'} );
+
+ # Adding entries for network, netmask, broadcast etc. into the DNS zone
+ my $zone
+ = $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'zone'};
+ my $zone_part = $global_config->{$zone_key}->{'BY_NAME'}->{$zone};
+ push( @{ $zone_part->{'__network_order'}->{$site} }, $net_name );
+ $zone_part->{'BY_SITE'}->{$site}->{$net_name} = {};
+
+ # Adding IPv4 entries
+ $zone_part->{'BY_SITE'}->{$site}->{$net_name}->{'network'}
+ = "A\t" . $net_block->addr();
+ $zone_part->{'BY_SITE'}->{$site}->{$net_name}->{'netmask'}
+ = "A\t" . $net_block->mask();
+ my $broad = $net_block->broadcast();
+ $broad =~ s/\/.*$//;
+ $zone_part->{'BY_SITE'}->{$site}->{$net_name}->{'broadcast'}
+ = "A\t" . $broad;
+ $zone_part->{'BY_SITE'}->{$site}->{$net_name}->{'gateway'}
+ = "A\t" . $net2add->{$gw_key}
+ if ( defined $net2add->{$gw_key} );
+ if ( defined $dhcp_part->{$net_name} ) {
+ $dhcp_part->{$net_name}->{'subnet'} = $net_block->addr();
+ $dhcp_part->{$net_name}->{'netmask'} = $net_block->mask();
+ if ( defined $net2add->{'gateway'} ) {
+ $dhcp_part->{$net_name}->{'routers'}
+ = $net2add->{'gateway'};
+ }
+ }
+ }
+ }
}
1;
Modified: branches/next-gen/lib/PFTools/Conf/Syntax.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Conf/Syntax.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Conf/Syntax.pm (original)
+++ branches/next-gen/lib/PFTools/Conf/Syntax.pm Tue Sep 7 08:54:37 2010
@@ -27,13 +27,13 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- $ALLOWED_PARSING_CONTEXT
- $HOST_CONFIG_REGEX
- $HOSTTYPE_CONFIG_REGEX
- $MODEL_CONFIG_REGEX
- $DEPLOY_CONFIG_REGEX
-
- Chk_section_struct
+ $ALLOWED_PARSING_CONTEXT
+ $HOST_CONFIG_REGEX
+ $HOSTTYPE_CONFIG_REGEX
+ $MODEL_CONFIG_REGEX
+ $DEPLOY_CONFIG_REGEX
+
+ Chk_section_struct
);
our @EXPORT_OK = qw();
@@ -42,7 +42,7 @@
# Syntax definitions
our $ALLOWED_PARSING_CONTEXT = '(host|network|config|model)';
-our $HOSTTYPE_CONFIG_REGEX = qr{
+our $HOSTTYPE_CONFIG_REGEX = qr{
\A
(?<HOSTTYPE> # HOSTTYPE
(
@@ -107,258 +107,285 @@
# }
# }
my $DEF_SECTIONS = {
- 'host' => {
- 'interface' => {
- 'MANDATORY_KEYS' => [ 'vlan','ipv4','slaves' ],
- 'mac' => '([0-9a-f]{2}:){5}[0-9a-f]{2}',
- 'vlan' => '[a-z][a-z0-9\-]+[a-z0-9]',
- 'ipv4' => '([\d]{1,3})((\.[\d]{1,3}){1,3})?',
- 'slaves' => 'e(th)?\d+(\s*,\s*e(th)?\d+)+',
- 'ipv6' => 'undefined',
- 'iface_opt' => 'undefined',
- '@route' => 'undefined',
- '@route6' => 'undefined'
- },
- 'deployment' => {
- 'MANDATORY_KEYS' => [ 'arch','mode','distrib' ],
- 'arch' => 'i386|amd64',
- 'mode' => '(debian|ubuntu)',
- 'distrib' => '[a-z]+',
- 'dhcpvlan' => '\w+'
- },
- 'hostgroup' => {
- 'MANDATORY_KEYS' => [ 'number','hostname' ],
- 'site' => '(ALL|[\w\-]+(\s*,\s*[\w\-]+)*)',
- 'model' => 'undefined',
- 'number' => '[\d]+',
- 'order' => '[\d]+',
- 'nodes' => '[\d]+',
- 'prefix' => '(true|false)',
- 'hostname' => $MODEL_CONFIG_REGEX,
- 'hosttype' => $HOSTTYPE_CONFIG_REGEX
- },
- 'boot' => {
- 'MANDATORY_KEYS' => [ 'kernel' ],
- 'pxefilename' => 'undefined',
- 'kernel' => 'undefined',
- 'initrd' => 'undefined',
- 'cmdline' => 'undefined',
- 'console' => '(default|ttyS0,115200n8)'
- },
- 'dns' => {
- 'MANDATORY_KEYS' => [ 'resolver' ],
- 'resolver' => 'undefined',
- 'shortname' => 'undefined',
- 'alias' => 'undefined'
- }
- },
- 'network' => {
- 'zone' => {
- 'MANDATORY_KEYS' => [ 'serial','soa','mail','@ns','@mx' ],
- 'comment' => 'undefined',
- 'serial' => '(AUTO|.+)',
- 'soa' => '[\w\-\.]+',
- 'mail' => 'undefined',
- 'refresh' => '\d+(M|H|D)?(\s*;.*)?',
- 'retry' => '\d+(M|H|D)?(\s*;.*)?',
- 'expire' => '\d+(M|H|D)?(\s*;.*)?',
- 'negttl' => '\d+(M|H|D)?(\s*;.*)?',
- 'ttl' => '\d+(M|H|D)?(\s*;.*)?',
- '@ns' => '[\w\-\.]+',
- '@mx' => '\d+\s+[\w\-\.]+',
- },
- 'site' => {
- 'MANDATORY_KEYS' => [ 'state', 'zone', 'dhcpvlan', 'console' ],
- 'comment' => 'undefined',
- 'location' => 'undefined',
- 'room' => 'undefined',
- 'confdir' => 'undefined',
- 'alias' => '\w+',
- 'zone' => '\w+',
- 'state' => 'ROOT|EDGE',
- 'dhcpvlan' => '[\w\-]+',
- 'prefix' => '\w+',
- 'console' => '(default|ttyS0,115200n8)'
- },
- 'network' => {
- 'MANDATORY_KEYS' => [ 'network', 'site' ],
- 'comment' => 'undefined',
- 'tag' => '\d{1,4}',
- 'network' => '([\d]{1,3}\.){3}[\d]{1,3}(\/\d+)?',
- 'network6' => 'undefined',
- 'netmask' => '(/\d{2}|([\d]{1,3}\.){3}[\d]{1,3})',
- 'netmask6' => 'undefined',
- 'scope' => '(private|public)',
- 'site' => '(ALL|[\w\-]+(\s*,\s*[\w\-]+)*)',
- 'gateway' => '([\d]{1,3})((\.[\d]{1,3}){1,3})?',
- 'gateway6' => 'undefined'
- },
- 'server' => {
- 'MANDATORY_KEYS' => [ 'site', 'number', ],
- 'comment' => 'undefined',
- 'site' => '(ALL|[\w\-]+(\s*,\s*[\w\-]+)*)',
- 'number' => '\d+',
- 'ipv4' => '([\d]{1,3})((\.[\d]{1,3}){1,3})?',
- 'ipv6' => 'undefined',
- 'alias' => '[a-z][a-z0-9\-]+[a-z0-9]',
- 'shortname' => '[a-z][a-z0-9\-]+[a-z0-9]'
- },
- 'service' => {
- 'MANDATORY_KEYS' => [ 'site','@host' ],
- 'comment' => 'undefined',
- '@host' => '[\w\-\:\/]+'
- }
- },
- 'config' => {
- 'addfile' => {
- 'MANDATORY_KEYS' => [ 'source' ],
- 'depends' => 'undefined',
- 'source' => 'undefined',
- 'filter' => 'undefined',
- 'owner' => '([\d]+|[a-z\d\-]+)',
- 'group' => '([\d]+|[a-z\d\-]+)',
- 'mode' => '[0-7]?[0-7]{3}',
- 'on_config' => 'undefined',
- 'before_change' => 'undefined',
- 'on_noaction' => 'undefined',
- 'after_change' => 'undefined'
- },
- 'createfile' => {
- 'depends' => 'undefined',
- 'source' => 'undefined',
- 'filter' => 'undefined',
- 'owner' => '([\d]+|[a-z\d\-]+)',
- 'group' => '([\d]+|[a-z\d\-]+)',
- 'mode' => '[0-7]?[0-7]{3}',
- 'on_config' => 'undefined',
- 'before_change' => 'undefined',
- 'on_noaction' => 'undefined',
- 'after_change' => 'undefined'
- },
- 'removefile' => {
- },
- 'mkdir' => {
- 'owner' => '([\d]+|[a-z\d\-]+)',
- 'group' => '([\d]+|[a-z\d\-]+)',
- 'mode' => '[0-7]?[0-7]{3}',
- 'on_config' => 'undefined',
- 'before_change' => 'undefined',
- 'on_noaction' => 'undefined',
- 'after_change' => 'undefined'
- },
- 'addlink' => {
- 'MANDATORY_KEYS' => [ 'source' ],
- 'source' => 'undefined',
- 'on_config' => 'undefined',
- 'before_change' => 'undefined',
- 'on_noaction' => 'undefined',
- 'after_change' => 'undefined'
- },
- 'addmount' => {
- 'MANDATORY_KEYS' => [ 'source','fstype','options' ],
- 'depends' => 'undefined',
- 'source' => 'undefined',
- 'fstype' => '(nfs|ext[2-4]|btrfs|cifs)',
- 'options' => 'undefined',
- 'mode' => '[0-7]?[0-7]{3}'
- },
- 'installpkg' => {
- 'version' => 'undefined',
- 'on_config' => 'undefined',
- 'before_change' => 'undefined',
- 'on_noaction' => 'undefined',
- 'after_change' => 'undefined'
- },
- 'purgepkg' => {
- 'version' => 'undefined',
- 'on_config' => 'undefined',
- 'before_change' => 'undefined',
- 'on_noaction' => 'undefined',
- 'after_change' => 'undefined'
- },
- 'filter-model' => {
- 'MANDATORY_KEYS' => [ 'filter' ],
- 'filter' => 'undefined'
- },
- 'actiongroup' => {
- 'on_config' => 'undefined',
- 'before_change' => 'undefined',
- 'on_noaction' => 'undefined',
- 'after_change' => 'undefined'
- }
- }
+ 'host' => {
+ 'interface' => {
+ 'MANDATORY_KEYS' => [ 'vlan', 'ipv4', 'slaves' ],
+ 'mac' => '([0-9a-f]{2}:){5}[0-9a-f]{2}',
+ 'vlan' => '[a-z][a-z0-9\-]+[a-z0-9]',
+ 'ipv4' => '([\d]{1,3})((\.[\d]{1,3}){1,3})?',
+ 'slaves' => 'e(th)?\d+(\s*,\s*e(th)?\d+)+',
+ 'ipv6' => 'undefined',
+ 'iface_opt' => 'undefined',
+ '@route' => 'undefined',
+ '@route6' => 'undefined'
+ },
+ 'deployment' => {
+ 'MANDATORY_KEYS' => [ 'arch', 'mode', 'distrib' ],
+ 'arch' => 'i386|amd64',
+ 'mode' => '(debian|ubuntu)',
+ 'distrib' => '[a-z]+',
+ 'dhcpvlan' => '\w+'
+ },
+ 'hostgroup' => {
+ 'MANDATORY_KEYS' => [ 'number', 'hostname' ],
+ 'site' => '(ALL|[\w\-]+(\s*,\s*[\w\-]+)*)',
+ 'model' => 'undefined',
+ 'number' => '[\d]+',
+ 'order' => '[\d]+',
+ 'nodes' => '[\d]+',
+ 'prefix' => '(true|false)',
+ 'hostname' => $MODEL_CONFIG_REGEX,
+ 'hosttype' => $HOSTTYPE_CONFIG_REGEX
+ },
+ 'boot' => {
+ 'MANDATORY_KEYS' => ['kernel'],
+ 'pxefilename' => 'undefined',
+ 'kernel' => 'undefined',
+ 'initrd' => 'undefined',
+ 'cmdline' => 'undefined',
+ 'console' => '(default|ttyS0,115200n8)'
+ },
+ 'dns' => {
+ 'MANDATORY_KEYS' => ['resolver'],
+ 'resolver' => 'undefined',
+ 'shortname' => 'undefined',
+ 'alias' => 'undefined'
+ }
+ },
+ 'network' => {
+ 'zone' => {
+ 'MANDATORY_KEYS' => [ 'serial', 'soa', 'mail', '@ns', '@mx' ],
+ 'comment' => 'undefined',
+ 'serial' => '(AUTO|.+)',
+ 'soa' => '[\w\-\.]+',
+ 'mail' => 'undefined',
+ 'refresh' => '\d+(M|H|D)?(\s*;.*)?',
+ 'retry' => '\d+(M|H|D)?(\s*;.*)?',
+ 'expire' => '\d+(M|H|D)?(\s*;.*)?',
+ 'negttl' => '\d+(M|H|D)?(\s*;.*)?',
+ 'ttl' => '\d+(M|H|D)?(\s*;.*)?',
+ '@ns' => '[\w\-\.]+',
+ '@mx' => '\d+\s+[\w\-\.]+',
+ },
+ 'site' => {
+ 'MANDATORY_KEYS' => [ 'state', 'zone', 'dhcpvlan', 'console' ],
+ 'comment' => 'undefined',
+ 'location' => 'undefined',
+ 'room' => 'undefined',
+ 'confdir' => 'undefined',
+ 'alias' => '\w+',
+ 'zone' => '\w+',
+ 'state' => 'ROOT|EDGE',
+ 'dhcpvlan' => '[\w\-]+',
+ 'prefix' => '\w+',
+ 'console' => '(default|ttyS0,115200n8)'
+ },
+ 'network' => {
+ 'MANDATORY_KEYS' => [ 'network', 'site' ],
+ 'comment' => 'undefined',
+ 'tag' => '\d{1,4}',
+ 'network' => '([\d]{1,3}\.){3}[\d]{1,3}(\/\d+)?',
+ 'network6' => 'undefined',
+ 'netmask' => '(/\d{2}|([\d]{1,3}\.){3}[\d]{1,3})',
+ 'netmask6' => 'undefined',
+ 'scope' => '(private|public)',
+ 'site' => '(ALL|[\w\-]+(\s*,\s*[\w\-]+)*)',
+ 'gateway' => '([\d]{1,3})((\.[\d]{1,3}){1,3})?',
+ 'gateway6' => 'undefined'
+ },
+ 'server' => {
+ 'MANDATORY_KEYS' => [ 'site', 'number', ],
+ 'comment' => 'undefined',
+ 'site' => '(ALL|[\w\-]+(\s*,\s*[\w\-]+)*)',
+ 'number' => '\d+',
+ 'ipv4' => '([\d]{1,3})((\.[\d]{1,3}){1,3})?',
+ 'ipv6' => 'undefined',
+ 'alias' => '[a-z][a-z0-9\-]+[a-z0-9]',
+ 'shortname' => '[a-z][a-z0-9\-]+[a-z0-9]'
+ },
+ 'service' => {
+ 'MANDATORY_KEYS' => [ 'site', '@host' ],
+ 'comment' => 'undefined',
+ '@host' => '[\w\-\:\/]+'
+ }
+ },
+ 'config' => {
+ 'addfile' => {
+ 'MANDATORY_KEYS' => ['source'],
+ 'depends' => 'undefined',
+ 'source' => 'undefined',
+ 'filter' => 'undefined',
+ 'owner' => '([\d]+|[a-z\d\-]+)',
+ 'group' => '([\d]+|[a-z\d\-]+)',
+ 'mode' => '[0-7]?[0-7]{3}',
+ 'on_config' => 'undefined',
+ 'before_change' => 'undefined',
+ 'on_noaction' => 'undefined',
+ 'after_change' => 'undefined'
+ },
+ 'createfile' => {
+ 'depends' => 'undefined',
+ 'source' => 'undefined',
+ 'filter' => 'undefined',
+ 'owner' => '([\d]+|[a-z\d\-]+)',
+ 'group' => '([\d]+|[a-z\d\-]+)',
+ 'mode' => '[0-7]?[0-7]{3}',
+ 'on_config' => 'undefined',
+ 'before_change' => 'undefined',
+ 'on_noaction' => 'undefined',
+ 'after_change' => 'undefined'
+ },
+ 'removefile' => {},
+ 'mkdir' => {
+ 'owner' => '([\d]+|[a-z\d\-]+)',
+ 'group' => '([\d]+|[a-z\d\-]+)',
+ 'mode' => '[0-7]?[0-7]{3}',
+ 'on_config' => 'undefined',
+ 'before_change' => 'undefined',
+ 'on_noaction' => 'undefined',
+ 'after_change' => 'undefined'
+ },
+ 'addlink' => {
+ 'MANDATORY_KEYS' => ['source'],
+ 'source' => 'undefined',
+ 'on_config' => 'undefined',
+ 'before_change' => 'undefined',
+ 'on_noaction' => 'undefined',
+ 'after_change' => 'undefined'
+ },
+ 'addmount' => {
+ 'MANDATORY_KEYS' => [ 'source', 'fstype', 'options' ],
+ 'depends' => 'undefined',
+ 'source' => 'undefined',
+ 'fstype' => '(nfs|ext[2-4]|btrfs|cifs)',
+ 'options' => 'undefined',
+ 'mode' => '[0-7]?[0-7]{3}'
+ },
+ 'installpkg' => {
+ 'version' => 'undefined',
+ 'on_config' => 'undefined',
+ 'before_change' => 'undefined',
+ 'on_noaction' => 'undefined',
+ 'after_change' => 'undefined'
+ },
+ 'purgepkg' => {
+ 'version' => 'undefined',
+ 'on_config' => 'undefined',
+ 'before_change' => 'undefined',
+ 'on_noaction' => 'undefined',
+ 'after_change' => 'undefined'
+ },
+ 'filter-model' => {
+ 'MANDATORY_KEYS' => ['filter'],
+ 'filter' => 'undefined'
+ },
+ 'actiongroup' => {
+ 'on_config' => 'undefined',
+ 'before_change' => 'undefined',
+ 'on_noaction' => 'undefined',
+ 'after_change' => 'undefined'
+ }
+ }
};
-$DEF_SECTIONS->{'config'}->{'apt-get'} = $DEF_SECTIONS->{'config'}->{'installpkg'};
-$DEF_SECTIONS->{'config'}->{'dpkg-purge'} = $DEF_SECTIONS->{'config'}->{'purgepkg'};
+$DEF_SECTIONS->{'config'}->{'apt-get'}
+ = $DEF_SECTIONS->{'config'}->{'installpkg'};
+$DEF_SECTIONS->{'config'}->{'dpkg-purge'}
+ = $DEF_SECTIONS->{'config'}->{'purgepkg'};
sub Chk_section_struct ($$$$) {
- my ( $sect_name, $sect_type, $sect_hash, $context ) = @_;
- my ( $iface_type, $definition, $int_context, $sect_tmp );
-
- $int_context = ( $context eq 'model') ? 'host' : $context;
-
- if ( ! defined $DEF_SECTIONS->{$int_context}->{$sect_type} ) {
- return ( $CODE->{'INVALID_SECTNAME'}, "Invalid section type ".$sect_type );
- }
-
- if ( $context =~ /^(host|model)$/ ) {
- if ( $sect_name =~ /^\Q$sect_type\E(::((eth|bond)[\d]+(\.TAG[\d]+)?))?$/ ) {
- $iface_type = $3;
- }
- else {
- return ( $CODE->{'INVALID_SECTNAME'}, "Invalid section name ".$sect_name )
- }
- # Cleaning key name by removing .default or .%HOSTNUM% suffix
- foreach my $key ( keys %{$sect_hash} ) {
- my $new = $key;
- $new =~ s/\..*$//;
- $sect_tmp->{$new}->{'ORIG_NAME'} = $key;
- $sect_tmp->{$new}->{'VALUE'} = $sect_hash->{$key};
- }
- }
- else {
- $sect_tmp = $sect_hash;
- }
- $definition = $DEF_SECTIONS->{$int_context}->{$sect_type};
-
- # Checking mandatory keys
- foreach my $key ( @{$definition->{'MANDATORY_KEYS'}} ) {
- if ( $sect_type eq 'interface' ) {
- next if ( $iface_type eq 'eth' && $key eq 'slaves' );
- next if ( $key =~ /^ipv/ && $context eq 'model' );
- }
- last if ( $sect_type eq 'hostgroup' && $context eq 'model' );
- return ( $CODE->{'UNDEF_KEY'},
- "Mandatory key ".$key." MUST BE defined on section "
- .$sect_name." in context ".$context ) if ( ! defined ( $sect_tmp->{$key} ) );
- }
- # Checking all keys defined
- foreach my $key ( keys %{$definition} ) {
- next if ( $key eq 'MANDATORY_KEYS'
- || $key =~ /^__/
- || $definition->{$key} eq 'undefined'
- || ! defined $sect_tmp->{$key} );
- my $tab_values = [];
- my $key_name;
- if ( $int_context eq 'host' ) {
- $tab_values = ( $key !~ /^@/ ) ? [ $sect_tmp->{$key}->{'VALUE'} ] : $sect_tmp->{$key}->{'VALUE'};
- $key_name = $sect_tmp->{$key}->{'ORIG_NAME'};
- }
- else {
- $tab_values = ( $key !~ /^@/ ) ? [ $sect_tmp->{$key} ] : $sect_tmp->{$key};
- $key_name = $key;
- }
- foreach my $value ( @{$tab_values} ) {
- # Removing trailing space
- $value =~ s/^\s*//; $value =~ s/\s*$//;
- if ( "$value" !~ /^$definition->{$key}$/ ) {
- return ( $CODE->{'INVALID_VALUE'},
- "Value |".$value."| for key ".$key_name
- ." on section ".$sect_name." doesn't match ".$definition->{$key} );
- }
- }
- }
- return ( $CODE->{'OK'}, "" ) ;
+ my ( $sect_name, $sect_type, $sect_hash, $context ) = @_;
+ my ( $iface_type, $definition, $int_context, $sect_tmp );
+
+ $int_context = ( $context eq 'model' ) ? 'host' : $context;
+
+ if ( !defined $DEF_SECTIONS->{$int_context}->{$sect_type} ) {
+ return ( $CODE->{'INVALID_SECTNAME'},
+ "Invalid section type " . $sect_type );
+ }
+
+ if ( $context =~ /^(host|model)$/ ) {
+ if ( $sect_name
+ =~ /^\Q$sect_type\E(::((eth|bond)[\d]+(\.TAG[\d]+)?))?$/ )
+ {
+ $iface_type = $3;
+ }
+ else {
+ return ( $CODE->{'INVALID_SECTNAME'},
+ "Invalid section name " . $sect_name );
+ }
+
+ # Cleaning key name by removing .default or .%HOSTNUM% suffix
+ foreach my $key ( keys %{$sect_hash} ) {
+ my $new = $key;
+ $new =~ s/\..*$//;
+ $sect_tmp->{$new}->{'ORIG_NAME'} = $key;
+ $sect_tmp->{$new}->{'VALUE'} = $sect_hash->{$key};
+ }
+ }
+ else {
+ $sect_tmp = $sect_hash;
+ }
+ $definition = $DEF_SECTIONS->{$int_context}->{$sect_type};
+
+ # Checking mandatory keys
+ foreach my $key ( @{ $definition->{'MANDATORY_KEYS'} } ) {
+ if ( $sect_type eq 'interface' ) {
+ next if ( $iface_type eq 'eth' && $key eq 'slaves' );
+ next if ( $key =~ /^ipv/ && $context eq 'model' );
+ }
+ last if ( $sect_type eq 'hostgroup' && $context eq 'model' );
+ return ( $CODE->{'UNDEF_KEY'},
+ "Mandatory key "
+ . $key
+ . " MUST BE defined on section "
+ . $sect_name
+ . " in context "
+ . $context )
+ if ( !defined( $sect_tmp->{$key} ) );
+ }
+
+ # Checking all keys defined
+ foreach my $key ( keys %{$definition} ) {
+ next
+ if ( $key eq 'MANDATORY_KEYS'
+ || $key =~ /^__/
+ || $definition->{$key} eq 'undefined'
+ || !defined $sect_tmp->{$key} );
+ my $tab_values = [];
+ my $key_name;
+ if ( $int_context eq 'host' ) {
+ $tab_values
+ = ( $key !~ /^@/ )
+ ? [ $sect_tmp->{$key}->{'VALUE'} ]
+ : $sect_tmp->{$key}->{'VALUE'};
+ $key_name = $sect_tmp->{$key}->{'ORIG_NAME'};
+ }
+ else {
+ $tab_values
+ = ( $key !~ /^@/ )
+ ? [ $sect_tmp->{$key} ]
+ : $sect_tmp->{$key};
+ $key_name = $key;
+ }
+ foreach my $value ( @{$tab_values} ) {
+
+ # Removing trailing space
+ $value =~ s/^\s*//;
+ $value =~ s/\s*$//;
+ if ( "$value" !~ /^$definition->{$key}$/ ) {
+ return ( $CODE->{'INVALID_VALUE'},
+ "Value |"
+ . $value
+ . "| for key "
+ . $key_name
+ . " on section "
+ . $sect_name
+ . " doesn't match "
+ . $definition->{$key} );
+ }
+ }
+ }
+ return ( $CODE->{'OK'}, "" );
}
1;
Modified: branches/next-gen/lib/PFTools/Disk.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Disk.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Disk.pm (original)
+++ branches/next-gen/lib/PFTools/Disk.pm Tue Sep 7 08:54:37 2010
@@ -1,4 +1,4 @@
-package PFTools::Disk ;
+package PFTools::Disk;
##
## $Id$
##
@@ -24,11 +24,11 @@
use Exporter;
-our @ISA = ( 'Exporter' ) ;
+our @ISA = ('Exporter');
our @EXPORT = qw(
- Build_structure_from_fstab
- Build_fstab_from_structure
+ Build_structure_from_fstab
+ Build_fstab_from_structure
);
our @EXPORT_OK = qw();
@@ -38,36 +38,30 @@
######################################
### Constants
-my @FSTAB_FIELDS_ORDER = (
- 'source',
- 'dest',
- 'fstype',
- 'options',
- 'dump',
- 'pass'
-);
+my @FSTAB_FIELDS_ORDER
+ = ( 'source', 'dest', 'fstype', 'options', 'dump', 'pass' );
#
# Global(s) var(s)
#
### Command vars
-my $MDADM = '/sbin/mdadm' ;
-my $DRBDADM = '/sbin/drbdadm' ;
-my $MKFS = '/sbin/mkfs.' ;
-my $FSCK = '/sbin/fsck.' ;
-my $SFDISK = '/sbin/sfdisk' ;
-my $FDISK = '/sbin/fdisk' ;
-my $HALT = '/sbin/halt' ;
-my $ECHO = '/bin/echo' ;
+my $MDADM = '/sbin/mdadm';
+my $DRBDADM = '/sbin/drbdadm';
+my $MKFS = '/sbin/mkfs.';
+my $FSCK = '/sbin/fsck.';
+my $SFDISK = '/sbin/sfdisk';
+my $FDISK = '/sbin/fdisk';
+my $HALT = '/sbin/halt';
+my $ECHO = '/bin/echo';
### Env vars
-our $DEBUG = 0 ;
-my $VERBOSE = 0 ;
-my $FOLLOW = '' ;
-my $SIZE = '' ;
-
-if ( $DEBUG ) { $VERBOSE = 1 ; }
+our $DEBUG = 0;
+my $VERBOSE = 0;
+my $FOLLOW = '';
+my $SIZE = '';
+
+if ($DEBUG) { $VERBOSE = 1; }
# Checking if all commands vars exists
# foreach my $cmd ( $MDADM, $MKFS, $SFDISK, $FDISK, $HALT, $ECHO ) {
@@ -78,106 +72,119 @@
# }
### /proc definitions for different files
-my $PROC_PART = '/proc/partitions' ;
-my $PROC_RAID = '/proc/mdstat' ;
-my $PROC_SCSI = '/proc/scsi/scsi' ;
-my $PROC_DRBD = '/proc/drbd' ;
+my $PROC_PART = '/proc/partitions';
+my $PROC_RAID = '/proc/mdstat';
+my $PROC_SCSI = '/proc/scsi/scsi';
+my $PROC_DRBD = '/proc/drbd';
### Pattern(s) for misc checks
-my $DISK_DEV_PATTERN = '\/dev\/(h|s)d[a-z]([\d]+)?' ;
-my $RAID_DEV_PATTERN = '\/dev\/md([\d]+)' ;
-my $RAID_DEV = 'md0' ;
-my $RAID_DEV_STATUS = '(active sync|removed|faulty)' ;
-my $RAID_DEV_PART = '\/dev\/(h|s)d[a-z]4' ;
-my $RAID_PART_NUM = '4' ;
-my $RAID_PART_TYPE = 'fd' ;
-my $RAID_FS = 'ext3' ;
-my $DRBD_DEV_PATTERN = '\/dev\/drbd' ;
-my $DRBD_DEV = 'drbd0' ;
+my $DISK_DEV_PATTERN = '\/dev\/(h|s)d[a-z]([\d]+)?';
+my $RAID_DEV_PATTERN = '\/dev\/md([\d]+)';
+my $RAID_DEV = 'md0';
+my $RAID_DEV_STATUS = '(active sync|removed|faulty)';
+my $RAID_DEV_PART = '\/dev\/(h|s)d[a-z]4';
+my $RAID_PART_NUM = '4';
+my $RAID_PART_TYPE = 'fd';
+my $RAID_FS = 'ext3';
+my $DRBD_DEV_PATTERN = '\/dev\/drbd';
+my $DRBD_DEV = 'drbd0';
### Misc files
-my $DUMP_PART_FILE = '/tmp/device_part.dmp' ;
-my $TPL_SPARC_PART = '' ;
+my $DUMP_PART_FILE = '/tmp/device_part.dmp';
+my $TPL_SPARC_PART = '';
#
# Misc functions
#
sub Build_structure_from_fstab ($) {
- my ( $fstab_file ) = @_;
- my $struct = {};
-
- if ( ! open ( FSTAB, $fstab_file ) ) {
- Warn ( $CODE->{'OPEN'}, "Unable to open ".$fstab_file );
- return undef;
- }
- my @current_fstab = <FSTAB>;
- close ( FSTAB );
-
- print join @current_fstab;
- foreach my $line ( @current_fstab ) {
- # Skip comments
- next if ( $line =~ /^#/ );
- # Removing trailing spaces
- $line =~ s/^\s*//;
- $line =~ s/\s*$//;
- # Skipping empty lines
- next if ( $line =~ /^$/ );
- my ( $src_mnt, $mnt_pt, $type, $opt_mnt, $dump, $pass ) = split ( /\s+/, $line );
- push ( @{$struct->{'__mnt_order'}}, $mnt_pt );
- $struct->{$mnt_pt} = {
- 'source' => $src_mnt,
- 'dest' => $mnt_pt,
- 'fstype' => $type,
- 'options' => join ( ',', sort split ( ',', $opt_mnt ) ),
- 'dump' => $dump,
- 'pass' => $pass
- }
- }
- return $struct;
+ my ($fstab_file) = @_;
+ my $struct = {};
+
+ if ( !open( FSTAB, $fstab_file ) ) {
+ Warn( $CODE->{'OPEN'}, "Unable to open " . $fstab_file );
+ return undef;
+ }
+ my @current_fstab = <FSTAB>;
+ close(FSTAB);
+
+ print join @current_fstab;
+ foreach my $line (@current_fstab) {
+
+ # Skip comments
+ next if ( $line =~ /^#/ );
+
+ # Removing trailing spaces
+ $line =~ s/^\s*//;
+ $line =~ s/\s*$//;
+
+ # Skipping empty lines
+ next if ( $line =~ /^$/ );
+ my ( $src_mnt, $mnt_pt, $type, $opt_mnt, $dump, $pass )
+ = split( /\s+/, $line );
+ push( @{ $struct->{'__mnt_order'} }, $mnt_pt );
+ $struct->{$mnt_pt} = {
+ 'source' => $src_mnt,
+ 'dest' => $mnt_pt,
+ 'fstype' => $type,
+ 'options' => join( ',', sort split( ',', $opt_mnt ) ),
+ 'dump' => $dump,
+ 'pass' => $pass
+ };
+ }
+ return $struct;
}
sub Build_fstab_from_structure ($) {
- my ( $struct ) = @_;
- my $fstab = [];
-
- push ( @{$fstab}, "###################################################" );
- push ( @{$fstab}, "# Fstab generated by Build_fstab_from_structure" );
- push ( @{$fstab}, "#\n" );
- foreach my $entry ( @{$struct->{'__mnt_order'}} ) {
- my @line;
- foreach my $field ( @FSTAB_FIELDS_ORDER ) {
- push ( @line, $struct->{$entry}->{$field} );
- }
- push ( @{$fstab}, join ( "\t", @line ) );
- }
- push ( @{$fstab}, "" );
- return $fstab
+ my ($struct) = @_;
+ my $fstab = [];
+
+ push( @{$fstab}, "###################################################" );
+ push( @{$fstab}, "# Fstab generated by Build_fstab_from_structure" );
+ push( @{$fstab}, "#\n" );
+ foreach my $entry ( @{ $struct->{'__mnt_order'} } ) {
+ my @line;
+ foreach my $field (@FSTAB_FIELDS_ORDER) {
+ push( @line, $struct->{$entry}->{$field} );
+ }
+ push( @{$fstab}, join( "\t", @line ) );
+ }
+ push( @{$fstab}, "" );
+ return $fstab;
}
sub Exec_cmd ($;$) {
- my ( $cmd, $msg ) = @_ ;
-
- if ( $DEBUG ) {
- print 'Exec :'.$cmd."\n" ;
- } else {
- system ( $cmd ) ;
- if ( $? ) {
- if ( ! defined ( $msg ) ) {
- $msg = "Problem when executing command ".$cmd." with the following error(s)\n" ;
- }
- warn $msg if ( $VERBOSE ) ;
- if ( $? == -1 ) {
- warn "failed to execute: $!\n" if ( $VERBOSE ) ;
- } elsif ( $? & 127 ) {
- printf STDERR "child died with signal %d, %s coredump\n", ( $? & 127 ), ( $? & 128 ) ? 'with' : 'without' if ( $VERBOSE ) ;
- } else {
- printf STDERR "child exited with value %d\n", $? >> 8 if ( $VERBOSE ) ;
- }
- return 0 ;
- }
- }
- return 1 ;
+ my ( $cmd, $msg ) = @_;
+
+ if ($DEBUG) {
+ print 'Exec :' . $cmd . "\n";
+ }
+ else {
+ system($cmd );
+ if ($?) {
+ if ( !defined($msg) ) {
+ $msg
+ = "Problem when executing command "
+ . $cmd
+ . " with the following error(s)\n";
+ }
+ warn $msg if ($VERBOSE);
+ if ( $? == -1 ) {
+ warn "failed to execute: $!\n" if ($VERBOSE);
+ }
+ elsif ( $? & 127 ) {
+ printf STDERR "child died with signal %d, %s coredump\n",
+ ( $? & 127 ), ( $? & 128 ) ? 'with' : 'without'
+ if ($VERBOSE);
+ }
+ else {
+ printf STDERR "child exited with value %d\n", $? >> 8
+ if ($VERBOSE);
+ }
+ return 0;
+ }
+ }
+ return 1;
}
#
@@ -185,283 +192,373 @@
#
sub GetDiskDevice () {
- # Call parameter(s)
-
- # Local(s) var(s)
- my $part ;
- my $result = {};
-
- if ( ! open ( $part, $PROC_PART ) ) {
- warn "GetDiskDevice -- Unable to parse ".$PROC_PART." for analysing disk structures\n" if ( $VERBOSE ) ;
- return undef ;
- } else {
- # Parsing /proc/partitions file
- while ( <$part> ) {
- next if ( /^$/ ) ;
- if ( /^\s*([\d]+)\s+([\d]+)\s+([\d]+)\s+([^\s]+)$/ ) {
- my ( $major, $minor, $block_size, $name ) = ( $1, $2, $3, $4 ) ;
- if ( $name =~ /^$DISK_DEV_PATTERN$/ ) {
- push ( @{$result->{'disk'}}, $name ) ;
- if ( ! defined $result->{$name} ) { $result->{$name} = 0 ; }
- }
- if ( $name =~ /^$DISK_DEV_PATTERN$/ ) { $result->{$name} +=1 }
- if ( $name =~ /^$RAID_DEV_PATTERN$/ ) { push ( @{$result->{'raid'}}, $name ) ; }
- if ( $name =~ /^$DRBD_DEV_PATTERN$/ ) { push ( @{$result->{'drbd'}}, $name ) ; }
- }
- }
- close ( $part ) ;
- }
- return $result ;
+
+ # Call parameter(s)
+
+ # Local(s) var(s)
+ my $part;
+ my $result = {};
+
+ if ( !open( $part, $PROC_PART ) ) {
+ warn "GetDiskDevice -- Unable to parse "
+ . $PROC_PART
+ . " for analysing disk structures\n"
+ if ($VERBOSE);
+ return undef;
+ }
+ else {
+
+ # Parsing /proc/partitions file
+ while (<$part>) {
+ next if (/^$/);
+ if (/^\s*([\d]+)\s+([\d]+)\s+([\d]+)\s+([^\s]+)$/) {
+ my ( $major, $minor, $block_size, $name )
+ = ( $1, $2, $3, $4 );
+ if ( $name =~ /^$DISK_DEV_PATTERN$/ ) {
+ push( @{ $result->{'disk'} }, $name );
+ if ( !defined $result->{$name} ) { $result->{$name} = 0; }
+ }
+ if ( $name =~ /^$DISK_DEV_PATTERN$/ ) {
+ $result->{$name} += 1;
+ }
+ if ( $name =~ /^$RAID_DEV_PATTERN$/ ) {
+ push( @{ $result->{'raid'} }, $name );
+ }
+ if ( $name =~ /^$DRBD_DEV_PATTERN$/ ) {
+ push( @{ $result->{'drbd'} }, $name );
+ }
+ }
+ }
+ close($part);
+ }
+ return $result;
}
sub GetDiskGeometry ($;$) {
- # Call parameter(s)
- my ( $device, $arch ) = @_ ;
- # Local(s) var(s)
- my $geo = {} ;
- my ( $pad, $cyls, $heads, $sectors ) ;
-
- if ( $device !~ /^$DISK_DEV_PATTERN$/ ) {
- warn "GetDiskGeometry -- Wrong device name ".$device." : unable to get geometry\n" if ( $VERBOSE ) ;
- return undef ;
- }
- $geo->{'name'} = $device ;
- if ( ! defined ( $arch ) || $arch eq 'i386' ) {
- # Retrieving geometry by sfdisk command
- my $cmd = $SFDISK.' -f -g '.$device ;
- ( $pad, $cyls, $pad, $heads, $pad, $sectors ) = split ( /\s+/, `$cmd` ) ;
- if ( $cyls == 0 || $heads == 0 || $sectors == 0 ) {
- warn "GetDiskGeometry -- Invalid values retriveved by sfdisk for device ".$device."\n" if ( $VERBOSE ) ;
- return undef ;
- }
- $geo->{'cyls'} = $cyls ;
- $geo->{'heads'} = $heads ;
- $geo->{'sectors'} = $sectors ;
- return $geo ;
- } elsif ( $arch eq 'sparc' ) {
- my $cmd = $FDISK. ' -l /dev/'.$device ;
- # Disk /dev/sda: 160.0 GB, 160041885696 bytes
- # 255 heads, 63 sectors/track, 19457 cylinders
- # Units = cylinders of 16065 * 512 = 8225280 bytes
- # Disk identifier: 0xf98d6e74
-
- if ( ! open ( FDL, $cmd ) ) {
- warn "GetDiskGeometry -- Unable to get geometry with command ".$cmd."\n" if ( $VERBOSE ) ;
- return undef ;
- }
- while ( <FDL> ) {
- if ( /^([\d]+) heads, ([\d]+) sectors\/track, ([\d]+) cylinders$/ ) {
- $geo->{'cyls'} = $3 ;
- $geo->{'heads'} = $1 ;
- $geo->{'sectors'} = $2 ;
- }
- }
- close ( FDL ) ;
- return $geo ;
- } else {
- warn "GetDiskGeometry -- Wrong architecture specified ".$arch." : unable to get geometry\n" if ( $VERBOSE ) ;
- return undef ;
- }
-}
-
+
+ # Call parameter(s)
+ my ( $device, $arch ) = @_;
+
+ # Local(s) var(s)
+ my $geo = {};
+ my ( $pad, $cyls, $heads, $sectors );
+
+ if ( $device !~ /^$DISK_DEV_PATTERN$/ ) {
+ warn "GetDiskGeometry -- Wrong device name "
+ . $device
+ . " : unable to get geometry\n"
+ if ($VERBOSE);
+ return undef;
+ }
+ $geo->{'name'} = $device;
+ if ( !defined($arch) || $arch eq 'i386' ) {
+
+ # Retrieving geometry by sfdisk command
+ my $cmd = $SFDISK . ' -f -g ' . $device;
+ ( $pad, $cyls, $pad, $heads, $pad, $sectors )
+ = split( /\s+/, `$cmd` );
+ if ( $cyls == 0 || $heads == 0 || $sectors == 0 ) {
+ warn
+ "GetDiskGeometry -- Invalid values retriveved by sfdisk for device "
+ . $device . "\n"
+ if ($VERBOSE);
+ return undef;
+ }
+ $geo->{'cyls'} = $cyls;
+ $geo->{'heads'} = $heads;
+ $geo->{'sectors'} = $sectors;
+ return $geo;
+ }
+ elsif ( $arch eq 'sparc' ) {
+ my $cmd = $FDISK . ' -l /dev/' . $device;
+
+ # Disk /dev/sda: 160.0 GB, 160041885696 bytes
+ # 255 heads, 63 sectors/track, 19457 cylinders
+ # Units = cylinders of 16065 * 512 = 8225280 bytes
+ # Disk identifier: 0xf98d6e74
+
+ if ( !open( FDL, $cmd ) ) {
+ warn "GetDiskGeometry -- Unable to get geometry with command "
+ . $cmd . "\n"
+ if ($VERBOSE);
+ return undef;
+ }
+ while (<FDL>) {
+ if (/^([\d]+) heads, ([\d]+) sectors\/track, ([\d]+) cylinders$/)
+ {
+ $geo->{'cyls'} = $3;
+ $geo->{'heads'} = $1;
+ $geo->{'sectors'} = $2;
+ }
+ }
+ close(FDL);
+ return $geo;
+ }
+ else {
+ warn "GetDiskGeometry -- Wrong architecture specified "
+ . $arch
+ . " : unable to get geometry\n"
+ if ($VERBOSE);
+ return undef;
+ }
+}
+
sub GetAllGeometry ($;$) {
- # Call parameter(s)
- my ( $dev_list, $arch ) = @_ ;
- # Local(s) var(s)
- my $geo = {} ;
-
- foreach my $disk ( @{$dev_list->{'disk'}} ) {
- $geo->{$disk} = GetDiskGeometry ( $disk, $arch ) ;
- if ( ! defined ( $geo->{$disk} ) ) {
- warn "GetAllGeometry -- Cannot retrieve geometry for all disks : see message bellow\n" if ( $VERBOSE ) ;
- return undef ;
- }
- }
- return $geo ;
+
+ # Call parameter(s)
+ my ( $dev_list, $arch ) = @_;
+
+ # Local(s) var(s)
+ my $geo = {};
+
+ foreach my $disk ( @{ $dev_list->{'disk'} } ) {
+ $geo->{$disk} = GetDiskGeometry( $disk, $arch );
+ if ( !defined( $geo->{$disk} ) ) {
+ warn
+ "GetAllGeometry -- Cannot retrieve geometry for all disks : see message bellow\n"
+ if ($VERBOSE);
+ return undef;
+ }
+ }
+ return $geo;
}
sub CheckDiskGeometry ($$;$) {
- # Call parameter(s)
- my ( $device, $ref_wanted, $arch ) = @_ ;
- # Local(s) var(s)
- my $ref_geo_device = {} ;
- my ( $check_name, $wanted_name ) ;
-
- if ( ref ( $device ) ne 'HASH' ) {
- # $device is not an HASHREF on disk geometry
- if ( $device !~ /^$DISK_DEV_PATTERN$/ ) {
- warn "CheckDiskGeometry -- Wrong device name ".$device." : unable to check geometry\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- $ref_geo_device = GetDiskGeometry ( $device, $arch ) ;
- if ( ! defined ( $ref_geo_device ) ) {
- warn "CheckDiskGeometry -- Unable to retrive geometry for device ".$device."\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- } else {
- $ref_geo_device = $device ;
- }
- $check_name = $ref_geo_device->{'name'} ;
- $wanted_name = $ref_wanted->{'name'} ;
- foreach my $char ( keys %{$ref_wanted} ) {
- if ( $ref_geo_device->{$char} != $ref_wanted->{$char} ) {
- warn "CheckDiskGeometry -- Device ".$check_name." and reference device ".$wanted_name." have not the same geometry\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- }
- return 1 ;
+
+ # Call parameter(s)
+ my ( $device, $ref_wanted, $arch ) = @_;
+
+ # Local(s) var(s)
+ my $ref_geo_device = {};
+ my ( $check_name, $wanted_name );
+
+ if ( ref($device) ne 'HASH' ) {
+
+ # $device is not an HASHREF on disk geometry
+ if ( $device !~ /^$DISK_DEV_PATTERN$/ ) {
+ warn "CheckDiskGeometry -- Wrong device name "
+ . $device
+ . " : unable to check geometry\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ $ref_geo_device = GetDiskGeometry( $device, $arch );
+ if ( !defined($ref_geo_device) ) {
+ warn "CheckDiskGeometry -- Unable to retrive geometry for device "
+ . $device . "\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ }
+ else {
+ $ref_geo_device = $device;
+ }
+ $check_name = $ref_geo_device->{'name'};
+ $wanted_name = $ref_wanted->{'name'};
+ foreach my $char ( keys %{$ref_wanted} ) {
+ if ( $ref_geo_device->{$char} != $ref_wanted->{$char} ) {
+ warn "CheckDiskGeometry -- Device "
+ . $check_name
+ . " and reference device "
+ . $wanted_name
+ . " have not the same geometry\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ }
+ return 1;
}
sub CheckAllGeometry ($;$) {
- # Call parameter(s)
- my ( $ref_wanted, $arch ) = @_ ;
- # Local(s) var(s)
- my ( $dev_list, $all_geo_dev ) ;
-
- $dev_list = GetDiskDevice () ;
- if ( ! defined ( $dev_list ) ) {
- warn "CheckAllGeometry -- Unable to get devices list on host\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- $all_geo_dev = GetAllGeometry ( $dev_list, $arch ) ;
- if ( ! defined ( $all_geo_dev ) ) {
- warn "CheckAllGeometry -- Unable to retrieve one ore more geometry : see error bellow\n" if ( $VERBOSE ) ;
- return 0 ;
- }
-
- foreach my $disk ( keys %{$all_geo_dev} ) {
- if ( ! CheckDiskGeometry ( $disk, $ref_wanted, $arch ) ) {
- warn "CheckAllGeometry -- One ore more disk(s) has not the same geometry see error bellow\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- }
- return 1 ;
+
+ # Call parameter(s)
+ my ( $ref_wanted, $arch ) = @_;
+
+ # Local(s) var(s)
+ my ( $dev_list, $all_geo_dev );
+
+ $dev_list = GetDiskDevice();
+ if ( !defined($dev_list) ) {
+ warn "CheckAllGeometry -- Unable to get devices list on host\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ $all_geo_dev = GetAllGeometry( $dev_list, $arch );
+ if ( !defined($all_geo_dev) ) {
+ warn
+ "CheckAllGeometry -- Unable to retrieve one ore more geometry : see error bellow\n"
+ if ($VERBOSE);
+ return 0;
+ }
+
+ foreach my $disk ( keys %{$all_geo_dev} ) {
+ if ( !CheckDiskGeometry( $disk, $ref_wanted, $arch ) ) {
+ warn
+ "CheckAllGeometry -- One ore more disk(s) has not the same geometry see error bellow\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ }
+ return 1;
}
sub CheckRaidArray ($) {
- # Call parameter(s)
- my ( $raid_dev ) = @_ ;
- # Local(s) var(s)
- my $part ;
- my $stat = {} ;
-
- if ( ! open ( $part, $MDADM.' -D '.$raid_dev ) ) {
- warn "Unable to analyse raid status for RAID array ".$raid_dev."\n" ;
- return undef ;
- }
- $stat->{'failed'} = 0 ;
- while ( <$part> ) {
- if ( /^\s*Failed Devices : ([\d]+)$/ && $1 > 0 ) {
- $stat->{'failed'} = $1 ;
- } elsif ( $stat->{'failed'} ) {
- if ( /^\s*([\d]+)\s([\d]+)\s*([\d]+)\s*([\d]+)\s*([$RAID_DEV_STATUS])\s*(\Q$RAID_DEV_PART\E)$/ ) {
- my ( $number, $major, $minor, $raid_num, $status, $device ) = ( $1, $2, $3, $4, $5, $6 ) ;
- if ( $status !~ /^fault|failed$/ ) {
- next ;
- } else {
- $device =~ s/[\d]$// ;
- push ( @{$stat->{'failed_dev'}}, $device ) ;
- }
- } elsif ( /^\s*UUID : ([^\s]+)$/ ) {
- $stat->{'uid'} = $1 ;
- }
- }
- }
- close ( $part ) ;
- return $stat ;
+
+ # Call parameter(s)
+ my ($raid_dev) = @_;
+
+ # Local(s) var(s)
+ my $part;
+ my $stat = {};
+
+ if ( !open( $part, $MDADM . ' -D ' . $raid_dev ) ) {
+ warn "Unable to analyse raid status for RAID array "
+ . $raid_dev . "\n";
+ return undef;
+ }
+ $stat->{'failed'} = 0;
+ while (<$part>) {
+ if ( /^\s*Failed Devices : ([\d]+)$/ && $1 > 0 ) {
+ $stat->{'failed'} = $1;
+ }
+ elsif ( $stat->{'failed'} ) {
+ if (/^\s*([\d]+)\s([\d]+)\s*([\d]+)\s*([\d]+)\s*([$RAID_DEV_STATUS])\s*(\Q$RAID_DEV_PART\E)$/
+ )
+ {
+ my ( $number, $major, $minor, $raid_num, $status, $device )
+ = ( $1, $2, $3, $4, $5, $6 );
+ if ( $status !~ /^fault|failed$/ ) {
+ next;
+ }
+ else {
+ $device =~ s/[\d]$//;
+ push( @{ $stat->{'failed_dev'} }, $device );
+ }
+ }
+ elsif (/^\s*UUID : ([^\s]+)$/) {
+ $stat->{'uid'} = $1;
+ }
+ }
+ }
+ close($part);
+ return $stat;
}
sub CheckArrayRecovery ($) {
- # Call parameter(s)
- my ( $raid_dev ) = @_ ;
- # Local(s) var(s)
- my ( $proc, $build, $active, $check, $fail, $last_size ) ;
-
- $active = $fail = $last_size = $check = 0 ;
- $build = 1 ;
- while ( ! $active ) {
- if ( ! open ( $proc, $PROC_RAID ) ) {
- warn "Unable to open proc file ".$PROC_RAID." for checking Raid ARRAY status\n" ;
- return 0 ;
- }
- # [>....................] recovery = 0.1% (90880/56998528) finish=93.9min speed=10097K/sec
- while ( <$proc> ) {
- if ( /^$raid_dev : .*$/) { $check = 1 ; }
- if ( /^\s*(\[[^\]]+\])\s*recovery =\s*([\d]+.[\d+]%) \(([\d]+)\/[\d]+\).+$/ && $check ) {
- if ( ! $last_size ) {
- $last_size = $3 ;
- } elsif ( $last_size == $3 ) {
- if ( $fail == 3 ) {
- warn "Failure during array RAID operation\n" ;
- return 0 ;
- } else {
- $fail += 1 ;
- }
- } else {
- $fail = 0 ;
- }
- print $1.' '.$2."\r" ;
- sleep 1 ;
- $build = 1 ;
- }
- if ( /^unused devices: .*$/ && $build ){
- $build = 0 ;
- } else {
- $active = 1 ;
- }
- }
- }
- return 1 ;
+
+ # Call parameter(s)
+ my ($raid_dev) = @_;
+
+ # Local(s) var(s)
+ my ( $proc, $build, $active, $check, $fail, $last_size );
+
+ $active = $fail = $last_size = $check = 0;
+ $build = 1;
+ while ( !$active ) {
+ if ( !open( $proc, $PROC_RAID ) ) {
+ warn "Unable to open proc file "
+ . $PROC_RAID
+ . " for checking Raid ARRAY status\n";
+ return 0;
+ }
+
+# [>....................] recovery = 0.1% (90880/56998528) finish=93.9min speed=10097K/sec
+ while (<$proc>) {
+ if (/^$raid_dev : .*$/) { $check = 1; }
+ if (/^\s*(\[[^\]]+\])\s*recovery =\s*([\d]+.[\d+]%) \(([\d]+)\/[\d]+\).+$/
+ && $check )
+ {
+ if ( !$last_size ) {
+ $last_size = $3;
+ }
+ elsif ( $last_size == $3 ) {
+ if ( $fail == 3 ) {
+ warn "Failure during array RAID operation\n";
+ return 0;
+ }
+ else {
+ $fail += 1;
+ }
+ }
+ else {
+ $fail = 0;
+ }
+ print $1. ' ' . $2 . "\r";
+ sleep 1;
+ $build = 1;
+ }
+ if ( /^unused devices: .*$/ && $build ) {
+ $build = 0;
+ }
+ else {
+ $active = 1;
+ }
+ }
+ }
+ return 1;
}
sub CheckDrbdSyncer ($) {
- # Call parameter(s)
- my ( $drbd_dev ) = @_ ;
- # Local(s) var(s)
- my ( $proc, $num_drbd, $build, $active, $check, $fail, $last_size ) ;
-
- $drbd_dev =~ /^$DRBD_DEV_PATTERN([\d])$/ ;
-
- $num_drbd = $1 ;
- $active = $fail = $last_size = $check = 0 ;
- $build = 1 ;
- while ( ! $active ) {
- if ( ! open ( $proc, $PROC_DRBD ) ) {
- warn "Unable to open file ".$PROC_DRBD." for checking DRBD syncer status\n" ;
- return 0 ;
- }
- # 0: cs:SyncSource st:Primary/Secondary ld:Consistent
- # ns:38460 nr:0 dw:0 dr:38460 al:0 bm:10431 lo:0 pe:18 ua:0 ap:0
- # [>...................] sync'ed: 0.1% (166822/166859)M
- # finish: 4:56:34 speed: 9,596 (9,596) K/sec
- while ( <$proc> ) {
- if ( /^\s([\d]): cs:([^\s]+) st:([^\/]+)\/([^\s]+) ld:([^\s]+)$/ ) {
- next if ( $1 != $num_drbd ) ;
- if ( $2 eq 'SyncSource' ) {
- $check = 1 ;
- } elsif ( $2 eq 'Connected' ) {
- $active = 1 ;
- }
- } elsif ( /^\s*(\[[^\]]+\]) sync'ed: ([\d]+\.[\d]+\%) \(([\d]+)\/[\d]+\)+$/ && $check ) {
- if ( ! $last_size ) {
- $last_size = $3 ;
- } elsif ( $last_size == $3 ) {
- if ( $fail == 3 ) {
- print STDERR "Failure during array RAID operation\n" ;
- return 0 ;
- } else {
- $fail += 1 ;
- }
- } else {
- $fail = 0 ;
- }
- print $1.' '.$2."\r" ;
- $check = 0 ;
- sleep 1 ;
- }
- }
- }
- return 1 ;
+
+ # Call parameter(s)
+ my ($drbd_dev) = @_;
+
+ # Local(s) var(s)
+ my ( $proc, $num_drbd, $build, $active, $check, $fail, $last_size );
+
+ $drbd_dev =~ /^$DRBD_DEV_PATTERN([\d])$/;
+
+ $num_drbd = $1;
+ $active = $fail = $last_size = $check = 0;
+ $build = 1;
+ while ( !$active ) {
+ if ( !open( $proc, $PROC_DRBD ) ) {
+ warn "Unable to open file "
+ . $PROC_DRBD
+ . " for checking DRBD syncer status\n";
+ return 0;
+ }
+
+ # 0: cs:SyncSource st:Primary/Secondary ld:Consistent
+ # ns:38460 nr:0 dw:0 dr:38460 al:0 bm:10431 lo:0 pe:18 ua:0 ap:0
+ # [>...................] sync'ed: 0.1% (166822/166859)M
+ # finish: 4:56:34 speed: 9,596 (9,596) K/sec
+ while (<$proc>) {
+ if (/^\s([\d]): cs:([^\s]+) st:([^\/]+)\/([^\s]+) ld:([^\s]+)$/) {
+ next if ( $1 != $num_drbd );
+ if ( $2 eq 'SyncSource' ) {
+ $check = 1;
+ }
+ elsif ( $2 eq 'Connected' ) {
+ $active = 1;
+ }
+ }
+ elsif (
+ /^\s*(\[[^\]]+\]) sync'ed: ([\d]+\.[\d]+\%) \(([\d]+)\/[\d]+\)+$/
+ && $check )
+ {
+ if ( !$last_size ) {
+ $last_size = $3;
+ }
+ elsif ( $last_size == $3 ) {
+ if ( $fail == 3 ) {
+ print STDERR "Failure during array RAID operation\n";
+ return 0;
+ }
+ else {
+ $fail += 1;
+ }
+ }
+ else {
+ $fail = 0;
+ }
+ print $1. ' ' . $2 . "\r";
+ $check = 0;
+ sleep 1;
+ }
+ }
+ }
+ return 1;
}
#
@@ -469,25 +566,43 @@
#
sub ManageScsiDevice ($$) {
- # Call parameter(s)
- my ( $ref_device, $action ) = @_ ;
- # Local(s) var(s)
- my $cmd ;
-
- if ( ref ( $ref_device ) ne 'ARRAY' ) {
- warn "ManageScsiDevice -- Wrong device definition for managing SCSI channel(s)\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- if ( $action eq 'add' ) {
- $cmd = $ECHO.' "scsi add-single-device '.join ( " ", @{$ref_device} ).'" > '.$PROC_SCSI ;
- } elsif ( $action eq 'mod' ) {
- $cmd = $ECHO.' "scsi remove-single-device '.join ( " ", @{$ref_device} ).'" > '.$PROC_SCSI ;
- } else {
- warn "ManageScsiDevice -- Wrong action parameter ".$action."\n" if ( $VERBOSE ) ;
- return 0 ;
- }
-
- return Exec_cmd ( $cmd, "Problem when managing SCSI device with command ".$cmd." and with the following error(s)\n" ) ;
+
+ # Call parameter(s)
+ my ( $ref_device, $action ) = @_;
+
+ # Local(s) var(s)
+ my $cmd;
+
+ if ( ref($ref_device) ne 'ARRAY' ) {
+ warn
+ "ManageScsiDevice -- Wrong device definition for managing SCSI channel(s)\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ if ( $action eq 'add' ) {
+ $cmd
+ = $ECHO
+ . ' "scsi add-single-device '
+ . join( " ", @{$ref_device} ) . '" > '
+ . $PROC_SCSI;
+ }
+ elsif ( $action eq 'mod' ) {
+ $cmd
+ = $ECHO
+ . ' "scsi remove-single-device '
+ . join( " ", @{$ref_device} ) . '" > '
+ . $PROC_SCSI;
+ }
+ else {
+ warn "ManageScsiDevice -- Wrong action parameter " . $action . "\n"
+ if ($VERBOSE);
+ return 0;
+ }
+
+ return Exec_cmd( $cmd,
+ "Problem when managing SCSI device with command "
+ . $cmd
+ . " and with the following error(s)\n" );
}
#
@@ -495,152 +610,233 @@
#
sub AddRaidPartition ($;$) {
- # Call parameter(s)
- my ( $device, $arch ) = @_ ;
- # Local(s) var(s)
- my $cmd ;
-
- if ( ! defined ( $arch ) || $arch eq 'i386' ) {
- $cmd = $SFDISK.' -f '.$device.' << EOF '.$FOLLOW.','.$SIZE.','.$RAID_PART_TYPE.' EOF' ;
- return Exec_cmd ( $cmd, "Unable to add raid partition on device ".$device." with command ".$cmd." and with the following error(s)\n" ) ;
- } elsif ( $arch eq 'sparc' ) {
- if ( ! open ( CMD, "| ".$FDISK." ".$device ) ) {
- warn "Unable to add raid partition on device ".$device." with fdisk command\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- print CMD "n\n4\n\n\nt\n4\n$RAID_PART_TYPE\nw\n" ;
- close ( CMD ) ;
+
+ # Call parameter(s)
+ my ( $device, $arch ) = @_;
+
+ # Local(s) var(s)
+ my $cmd;
+
+ if ( !defined($arch) || $arch eq 'i386' ) {
+ $cmd
+ = $SFDISK . ' -f '
+ . $device
+ . ' << EOF '
+ . $FOLLOW . ','
+ . $SIZE . ','
+ . $RAID_PART_TYPE . ' EOF';
+ return Exec_cmd( $cmd,
+ "Unable to add raid partition on device "
+ . $device
+ . " with command "
+ . $cmd
+ . " and with the following error(s)\n" );
+ }
+ elsif ( $arch eq 'sparc' ) {
+ if ( !open( CMD, "| " . $FDISK . " " . $device ) ) {
+ warn "Unable to add raid partition on device "
+ . $device
+ . " with fdisk command\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ print CMD "n\n4\n\n\nt\n4\n$RAID_PART_TYPE\nw\n";
+ close(CMD);
+
# $cmd = "echo \"n\\n4t\\n4\\n$RAID_PART_TYPE\\nw\\n\" | ".$FDISK." ".$device. ;
- } else {
- warn "Invalid architecture for platform : unable to add raid partition on device ".$device."\n" if ( $VERBOSE ) ;
- return 0 ;
- }
-
- return Exec_cmd ( $cmd, "Unable to add raid partition on device ".$device." with command ".$cmd." and with the following error(s)\n" ) ;
+ }
+ else {
+ warn
+ "Invalid architecture for platform : unable to add raid partition on device "
+ . $device . "\n"
+ if ($VERBOSE);
+ return 0;
+ }
+
+ return Exec_cmd( $cmd,
+ "Unable to add raid partition on device "
+ . $device
+ . " with command "
+ . $cmd
+ . " and with the following error(s)\n" );
}
# This function must be used with sparc architecture
sub EraseAllpartitions ($;$) {
- # Call parameter(s)
- my ( $device, $arch ) = @_ ;
- # Local(s) var(s)
- my $cmd ;
- my @actions = () ;
-
- my $disk_list = GetDiskDevice () ;
- if ( ! defined ( $disk_list ) ) {
- warn "Unable to retrieve partitions for device ".$device."\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- foreach my $part ( @{$disk_list->{'disk'}} ) {
- next if ( $part !~ /^\Q$device\E[\d]+$/ ) ;
- $part =~ /^\Q$device\E([\d]+)$/ ;
- push ( @actions, "d\n$1\n" ) ;
- }
- push ( @actions, "w\n" ) ;
- if ( ! open ( ERASE, "|".$FDISK." ".$device ) ) {
- warn "Unable to erase partition table for device ".$device."\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- foreach my $action ( @actions ) {
- print ERASE $action ;
- }
- close ( ERASE ) ;
- return 1 ;
+
+ # Call parameter(s)
+ my ( $device, $arch ) = @_;
+
+ # Local(s) var(s)
+ my $cmd;
+ my @actions = ();
+
+ my $disk_list = GetDiskDevice();
+ if ( !defined($disk_list) ) {
+ warn "Unable to retrieve partitions for device " . $device . "\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ foreach my $part ( @{ $disk_list->{'disk'} } ) {
+ next if ( $part !~ /^\Q$device\E[\d]+$/ );
+ $part =~ /^\Q$device\E([\d]+)$/;
+ push( @actions, "d\n$1\n" );
+ }
+ push( @actions, "w\n" );
+ if ( !open( ERASE, "|" . $FDISK . " " . $device ) ) {
+ warn "Unable to erase partition table for device " . $device . "\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ foreach my $action (@actions) {
+ print ERASE $action;
+ }
+ close(ERASE);
+ return 1;
}
sub DumpAllPartitions ($;$) {
- # Call parameter(s)
- my ( $device, $arch ) = @_ ;
- # Local(s) var(s)
- my $cmd ;
-
- if ( ! defined ( $arch ) || $arch eq 'i386' ) {
- $cmd = $SFDISK.' -d '.$device.' > '.$DUMP_PART_FILE ;
- return Exec_cmd ( $cmd, "Unable to dump partiotion table from device ".$device." with command ".$cmd." and with the following error(s)\n" ) ;
- } elsif ( $arch eq 'sparc' ) {
- my @actions = () ;
- # Dumping partition via command $cmd
- $cmd = $FDISK.' -l '.$device ;
- # Device Boot Start End Blocks Id System
- # /dev/sda1 1 893 7168000 1c Hidden W95 FAT32 (LBA)
- # Partition 1 does not end on cylinder boundary.
- # /dev/sda2 * 894 4717 30716280 7 HPFS/NTFS
- # /dev/sda3 4718 7149 19535040 83 Linux
- # /dev/sda4 7150 19457 98864010 5 Extended
- # /dev/sda5 7150 7392 1951866 82 Linux swap / Solaris
- # /dev/sda6 7393 19457 96912081 83 Linux
- if ( ! open ( DUMP, $cmd."|" ) ) {
- warn "Unable to dump partitions table for device ".$device."\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- push ( @actions, "n\n3\n\nt\n3\n5\n" ) ;
- while ( <DUMP> ) {
- my ( $part, $bootable, $first, $last, $type, $type_name ) ;
- next if ( /\Q$device\E\3.*Whole disk.*$/ ) ;
- # Fetching partition description line(s)
- if ( /^$device([\d]+)\s*(\*)?\s*([\d]+)\s*([\d+])\s*[\d]+([^\s]+)\s*(.)*$/ ) {
- ( $part, $bootable, $first, $last, $type, $type_name ) = ( $1, $2, $3, $4, $5, $6 ) ;
- }
- # Create the actions to do with fdisk command for creating partition which is parsed on this line
- push ( @actions, "n\n$part\n$first\n$last\nt\n$part\n$type\n" ) ;
- }
- close ( DUMP ) ;
- # Command for writing changes to disk and exit
- push ( @actions, "w\n" ) ;
- # Initialize dumpfile with sparc template ;
- if ( ! open ( TPL, $TPL_SPARC_PART ) ) {
- warn "Unable to initialize dump file for sparc device ".$device."\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- @actions = <TPL> ;
- close ( TPL ) ;
- # Adding partitions retrieved by command $cmd
- if ( ! open ( DUMP, ">".$DUMP_PART_FILE ) ) {
- warn "Unable to write dump partition for device ".$device." on file ".$DUMP_PART_FILE."\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- foreach my $action ( @actions ) {
- print DUMP $action ;
- }
- close ( DUMP ) ;
- } else {
- warn "Invalid architecture for platform : unable to dump partition table for device ".$device."\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- return 1 ;
+
+ # Call parameter(s)
+ my ( $device, $arch ) = @_;
+
+ # Local(s) var(s)
+ my $cmd;
+
+ if ( !defined($arch) || $arch eq 'i386' ) {
+ $cmd = $SFDISK . ' -d ' . $device . ' > ' . $DUMP_PART_FILE;
+ return Exec_cmd( $cmd,
+ "Unable to dump partiotion table from device "
+ . $device
+ . " with command "
+ . $cmd
+ . " and with the following error(s)\n" );
+ }
+ elsif ( $arch eq 'sparc' ) {
+ my @actions = ();
+
+ # Dumping partition via command $cmd
+ $cmd = $FDISK . ' -l ' . $device;
+
+# Device Boot Start End Blocks Id System
+# /dev/sda1 1 893 7168000 1c Hidden W95 FAT32 (LBA)
+# Partition 1 does not end on cylinder boundary.
+# /dev/sda2 * 894 4717 30716280 7 HPFS/NTFS
+# /dev/sda3 4718 7149 19535040 83 Linux
+# /dev/sda4 7150 19457 98864010 5 Extended
+# /dev/sda5 7150 7392 1951866 82 Linux swap / Solaris
+# /dev/sda6 7393 19457 96912081 83 Linux
+ if ( !open( DUMP, $cmd . "|" ) ) {
+ warn "Unable to dump partitions table for device "
+ . $device . "\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ push( @actions, "n\n3\n\nt\n3\n5\n" );
+ while (<DUMP>) {
+ my ( $part, $bootable, $first, $last, $type, $type_name );
+ next if (/\Q$device\E\3.*Whole disk.*$/);
+
+ # Fetching partition description line(s)
+ if (/^$device([\d]+)\s*(\*)?\s*([\d]+)\s*([\d+])\s*[\d]+([^\s]+)\s*(.)*$/
+ )
+ {
+ ( $part, $bootable, $first, $last, $type, $type_name )
+ = ( $1, $2, $3, $4, $5, $6 );
+ }
+
+# Create the actions to do with fdisk command for creating partition which is parsed on this line
+ push( @actions, "n\n$part\n$first\n$last\nt\n$part\n$type\n" );
+ }
+ close(DUMP);
+
+ # Command for writing changes to disk and exit
+ push( @actions, "w\n" );
+
+ # Initialize dumpfile with sparc template ;
+ if ( !open( TPL, $TPL_SPARC_PART ) ) {
+ warn "Unable to initialize dump file for sparc device "
+ . $device . "\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ @actions = <TPL>;
+ close(TPL);
+
+ # Adding partitions retrieved by command $cmd
+ if ( !open( DUMP, ">" . $DUMP_PART_FILE ) ) {
+ warn "Unable to write dump partition for device "
+ . $device
+ . " on file "
+ . $DUMP_PART_FILE . "\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ foreach my $action (@actions) {
+ print DUMP $action;
+ }
+ close(DUMP);
+ }
+ else {
+ warn
+ "Invalid architecture for platform : unable to dump partition table for device "
+ . $device . "\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ return 1;
}
sub RestoreAllPartitions ($;$$) {
- # Call parameter(s)
- my ( $device, $dumpfile, $arch ) = @_ ;
- # Local(s) var(s)
- my $cmd ;
-
- if ( ! defined ( $dumpfile ) ) {
- $dumpfile = $DUMP_PART_FILE ;
- }
- if ( ! -e $dumpfile ) {
- warn "Dump file for partition table ".$dumpfile." doesn't exist\n" if ( $VERBOSE ) ;
- return 0 ;
- } elsif ( -z $dumpfile ) {
- warn "Dump file for partition table ".$dumpfile." is an empty file\n" if ( $VERBOSE ) ;
- return 0 ;
- }
-
- if ( ! defined ( $arch ) || $arch eq 'i386' ) {
- $cmd = $SFDISK.' '.$device.' < '.$dumpfile ;
- } elsif ( $arch eq 'sparc' ) {
- if ( ! Erase_disk_partition ( $device ) ) {
- warn "Unable to erase partition table before restoring from dump file ".$dumpfile."\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- $cmd = $FDISK.' '.$device.' < '.$dumpfile ;
- } else {
- warn "Invalid architecture for platform : unable to restore partition table for device ".$device."\n" if ( $VERBOSE ) ;
- return 0 ;
- }
- return Exec_cmd ( $cmd, "Unable to restore partition table for ".$device." with command ".$cmd." and with the following error(s)\n" ) ;
+
+ # Call parameter(s)
+ my ( $device, $dumpfile, $arch ) = @_;
+
+ # Local(s) var(s)
+ my $cmd;
+
+ if ( !defined($dumpfile) ) {
+ $dumpfile = $DUMP_PART_FILE;
+ }
+ if ( !-e $dumpfile ) {
+ warn "Dump file for partition table " . $dumpfile . " doesn't exist\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ elsif ( -z $dumpfile ) {
+ warn "Dump file for partition table "
+ . $dumpfile
+ . " is an empty file\n"
+ if ($VERBOSE);
+ return 0;
+ }
+
+ if ( !defined($arch) || $arch eq 'i386' ) {
+ $cmd = $SFDISK . ' ' . $device . ' < ' . $dumpfile;
+ }
+ elsif ( $arch eq 'sparc' ) {
+ if ( !Erase_disk_partition($device) ) {
+ warn
+ "Unable to erase partition table before restoring from dump file "
+ . $dumpfile . "\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ $cmd = $FDISK . ' ' . $device . ' < ' . $dumpfile;
+ }
+ else {
+ warn
+ "Invalid architecture for platform : unable to restore partition table for device "
+ . $device . "\n"
+ if ($VERBOSE);
+ return 0;
+ }
+ return Exec_cmd( $cmd,
+ "Unable to restore partition table for "
+ . $device
+ . " with command "
+ . $cmd
+ . " and with the following error(s)\n" );
}
#
@@ -648,52 +844,95 @@
#
sub MakeRaidArray ($$$) {
- my ( $raid_dev, $raid_level, $dev_list ) = @_ ;
-
- my ( $cmd, $stat ) ;
- $cmd = $MDADM.' -C '.$raid_dev.' -l '.$raid_level.' -n '.scalar ( @{$dev_list} ).' '.join ( " ", @{$dev_list} ) ;
- if ( $DEBUG ) {
- print 'Exec : '.$cmd."\n" ;
- } else {
- if ( ! Exec_cmd ( $cmd, "Unable to create RAID array level ".$raid_level." with command ".$cmd." and with the following error(s)\n" ) ) {
- return 0 ;
- }
- }
- return CheckArrayRecovery ( $raid_dev ) ;
+ my ( $raid_dev, $raid_level, $dev_list ) = @_;
+
+ my ( $cmd, $stat );
+ $cmd
+ = $MDADM . ' -C '
+ . $raid_dev . ' -l '
+ . $raid_level . ' -n '
+ . scalar( @{$dev_list} ) . ' '
+ . join( " ", @{$dev_list} );
+ if ($DEBUG) {
+ print 'Exec : ' . $cmd . "\n";
+ }
+ else {
+ if (!Exec_cmd(
+ $cmd,
+ "Unable to create RAID array level "
+ . $raid_level
+ . " with command "
+ . $cmd
+ . " and with the following error(s)\n"
+ )
+ )
+ {
+ return 0;
+ }
+ }
+ return CheckArrayRecovery($raid_dev);
}
sub AddDeviceOnArray ($$) {
- # Variables en parametres d'appel
- my ( $raid_dev, $device ) = @_ ;
- # Variables locales a la fonction
- my $cmd ;
-
- $cmd = $MDADM.' '.$raid_dev.' -a '.$device ;
- if ( $DEBUG ) {
- print 'Exec : '.$cmd."\n" ;
- } else {
- if ( ! Exec_cmd ( $cmd, "Problem when adding device ".$device." on ARRAY ".$raid_dev." with command ".$cmd." and with the following error(s)\n" ) ) {
- return 0 ;
- }
- }
- return CheckArrayRecovery ( $raid_dev ) ;
+
+ # Variables en parametres d'appel
+ my ( $raid_dev, $device ) = @_;
+
+ # Variables locales a la fonction
+ my $cmd;
+
+ $cmd = $MDADM . ' ' . $raid_dev . ' -a ' . $device;
+ if ($DEBUG) {
+ print 'Exec : ' . $cmd . "\n";
+ }
+ else {
+ if (!Exec_cmd(
+ $cmd,
+ "Problem when adding device "
+ . $device
+ . " on ARRAY "
+ . $raid_dev
+ . " with command "
+ . $cmd
+ . " and with the following error(s)\n"
+ )
+ )
+ {
+ return 0;
+ }
+ }
+ return CheckArrayRecovery($raid_dev);
}
sub DelDeviceOnArray ($$) {
- # Variables en parametres d'appel
- my ( $raid_dev, $device ) = @_ ;
- # Variables locales a la fonction
- my $cmd ;
-
- $cmd = $MDADM.' '.$raid_dev.' -r '.$device ;
- if ( $DEBUG ) {
- print 'Exec : '.$cmd."\n" ;
- } else {
- if ( ! Exec_cmd ( $cmd, "Problem when deleting device ".$device." on ARRAY ".$raid_dev." with command ".$cmd." and with the following error(s)\n" ) ) {
- return 0 ;
- }
- }
- return 1 ;
+
+ # Variables en parametres d'appel
+ my ( $raid_dev, $device ) = @_;
+
+ # Variables locales a la fonction
+ my $cmd;
+
+ $cmd = $MDADM . ' ' . $raid_dev . ' -r ' . $device;
+ if ($DEBUG) {
+ print 'Exec : ' . $cmd . "\n";
+ }
+ else {
+ if (!Exec_cmd(
+ $cmd,
+ "Problem when deleting device "
+ . $device
+ . " on ARRAY "
+ . $raid_dev
+ . " with command "
+ . $cmd
+ . " and with the following error(s)\n"
+ )
+ )
+ {
+ return 0;
+ }
+ }
+ return 1;
}
#
@@ -705,24 +944,33 @@
#
sub ManageFilesystem ($$) {
- # Variables en parametres d'appel
- my ( $device, $fs_type, $action ) = @_ ;
- # Variables locales a la fonction
- my $cmd ;
-
- if ( $action eq 'make' ) {
- $cmd = $MKFS.$fs_type.' '.$device ;
- } elsif ( $action eq 'check' ) {
- $cmd = $FSCK.$fs_type.' -y '.$device ;
- } else {
- warn "ManageFilesystem -- Unknown action ".$action." : allowed actions are make and check\n" ;
- return 0 ;
- }
- if ( $DEBUG ) {
- print 'Exec : '.$cmd."\n" ;
- } else {
- return Exec_cmd ( $cmd, "Unable to manage filesystem with command ".$cmd." and with the following error(s)\n" ) ;
- }
+
+ # Variables en parametres d'appel
+ my ( $device, $fs_type, $action ) = @_;
+
+ # Variables locales a la fonction
+ my $cmd;
+
+ if ( $action eq 'make' ) {
+ $cmd = $MKFS . $fs_type . ' ' . $device;
+ }
+ elsif ( $action eq 'check' ) {
+ $cmd = $FSCK . $fs_type . ' -y ' . $device;
+ }
+ else {
+ warn "ManageFilesystem -- Unknown action " . $action
+ . " : allowed actions are make and check\n";
+ return 0;
+ }
+ if ($DEBUG) {
+ print 'Exec : ' . $cmd . "\n";
+ }
+ else {
+ return Exec_cmd( $cmd,
+ "Unable to manage filesystem with command "
+ . $cmd
+ . " and with the following error(s)\n" );
+ }
}
1;
Modified: branches/next-gen/lib/PFTools/Logger.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Logger.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Logger.pm (original)
+++ branches/next-gen/lib/PFTools/Logger.pm Tue Sep 7 08:54:37 2010
@@ -27,45 +27,44 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- $DEFERREDLOG
- $CODE
-
- deferredlogsystem
- deferredlogpipe
-
- Set_deferredlog
- Unset_deferredlog
- FlushLog
- DelLog
- Abort
- Warn
- Debug
- Log
+ $DEFERREDLOG
+ $CODE
+
+ deferredlogsystem
+ deferredlogpipe
+
+ Set_deferredlog
+ Unset_deferredlog
+ FlushLog
+ DelLog
+ Abort
+ Warn
+ Debug
+ Log
);
our @EXPORT_OK = qw();
-
my $DEFERREDLOG = 0;
# Error code and error messages
-our $CODE = {};
-$CODE->{'OK'} = 0;
-$CODE->{'WARNING'} = 1;
-$CODE->{'OPEN'} = 2;
-$CODE->{'SYNTAX'} = 3;
-$CODE->{'RIGHTS'} = 4;
-$CODE->{'UNLINK'} = 5;
-$CODE->{'EXEC'} = 6;
-$CODE->{'BIND_QUERY'} = 7;
-
-$CODE->{'INVALID_CONTEXT'} = 10;
-$CODE->{'INVALID_SECTNAME'} = 11;
-$CODE->{'INVALID_VALUE'} = 12;
-
-$CODE->{'UNDEF_KEY'} = 20;
-$CODE->{'DUPLICATE_VALUE'} = 21;
+our $CODE = {};
+$CODE->{'OK'} = 0;
+$CODE->{'WARNING'} = 1;
+$CODE->{'OPEN'} = 2;
+$CODE->{'SYNTAX'} = 3;
+$CODE->{'RIGHTS'} = 4;
+$CODE->{'UNLINK'} = 5;
+$CODE->{'EXEC'} = 6;
+$CODE->{'BIND_QUERY'} = 7;
+
+$CODE->{'INVALID_CONTEXT'} = 10;
+$CODE->{'INVALID_SECTNAME'} = 11;
+$CODE->{'INVALID_VALUE'} = 12;
+
+$CODE->{'UNDEF_KEY'} = 20;
+$CODE->{'DUPLICATE_VALUE'} = 21;
# Vars needed by pf-launch
my $sortie;
@@ -79,15 +78,15 @@
sub RotateCursor {
print STDERR $rotatecursortemplate[$rotatecursorcount], "\r";
$rotatecursorcount
- = ( $rotatecursorcount + 1 ) % ( $#rotatecursortemplate + 1 );
+ = ( $rotatecursorcount + 1 ) % ( $#rotatecursortemplate + 1 );
}
sub Set_deferredlog () {
- $DEFERREDLOG = 1;
+ $DEFERREDLOG = 1;
}
sub Unset_deferredlog () {
- $DEFERREDLOG = 0;
+ $DEFERREDLOG = 0;
}
sub DeferOutput {
@@ -122,18 +121,18 @@
$deferbuffer = <STDOUT>;
if ( defined( $sortie->{'_stdout'} ) ) {
- local *REAL_STDOUT;
- *REAL_STDOUT = $sortie->{'_stdout'};
- open( STDOUT, ">&REAL_STDOUT" ) or warn "Can't restore STDOUT: $!
+ local *REAL_STDOUT;
+ *REAL_STDOUT = $sortie->{'_stdout'};
+ open( STDOUT, ">&REAL_STDOUT" ) or warn "Can't restore STDOUT: $!
+";
- undef( $sortie->{'_stdout'} );
+ undef( $sortie->{'_stdout'} );
}
if ( defined( $sortie->{'_stderr'} ) ) {
- local *REAL_STDERR;
- *REAL_STDERR = $sortie->{'_stderr'};
- open( STDERR, ">&REAL_STDERR" ) or warn "Can't restore STDERR: $!
+ local *REAL_STDERR;
+ *REAL_STDERR = $sortie->{'_stderr'};
+ open( STDERR, ">&REAL_STDERR" ) or warn "Can't restore STDERR: $!
+";
- undef( $sortie->{'_stderr'} );
+ undef( $sortie->{'_stderr'} );
}
select STDERR;
$| = 1;
@@ -144,52 +143,52 @@
# Returns undef on error
sub deferredlogpipe ($;$) {
- my ( $pipe_cmd, $deferredlog ) = @_;
- my $ret = '';
-
- DeferOutput() if ( $deferredlog || $DEFERREDLOG );
-
- unless ( open DEFERREDLOGPIPE, '-|', $pipe_cmd ) {
- Warn( $CODE->{'OPEN'}, "Unable to open pipe $pipe_cmd : $!" );
- return;
- }
-
- while (<DEFERREDLOGPIPE>) {
- chomp;
- $ret .= $_;
- }
- close DEFERREDLOGPIPE;
-
- UndeferOutput() if ( $deferredlog || $DEFERREDLOG );
-
- if ($deferbuffer) {
- $deferredlogbuffer .= $deferbuffer;
- $deferbuffer = undef;
- }
-
- RotateCursor() if $deferredlog;
-
- return $ret;
-}
-
-sub deferredlogsystem ($;$){
- my ( $system_cmd, $deferredlog ) = @_;
- my $ret;
-
- DeferOutput() if ( $deferredlog || $DEFERREDLOG );
-
- $ret = system ( $system_cmd );
-
- UndeferOutput() if ( $deferredlog || $DEFERREDLOG );
-
- if ( defined $deferbuffer && $deferbuffer ne '' ) {
- $deferredlogbuffer .= $deferbuffer;
- $deferbuffer = undef;
- }
-
- RotateCursor() if ( $deferredlog );
-
- return $ret;
+ my ( $pipe_cmd, $deferredlog ) = @_;
+ my $ret = '';
+
+ DeferOutput() if ( $deferredlog || $DEFERREDLOG );
+
+ unless ( open DEFERREDLOGPIPE, '-|', $pipe_cmd ) {
+ Warn( $CODE->{'OPEN'}, "Unable to open pipe $pipe_cmd : $!" );
+ return;
+ }
+
+ while (<DEFERREDLOGPIPE>) {
+ chomp;
+ $ret .= $_;
+ }
+ close DEFERREDLOGPIPE;
+
+ UndeferOutput() if ( $deferredlog || $DEFERREDLOG );
+
+ if ($deferbuffer) {
+ $deferredlogbuffer .= $deferbuffer;
+ $deferbuffer = undef;
+ }
+
+ RotateCursor() if $deferredlog;
+
+ return $ret;
+}
+
+sub deferredlogsystem ($;$) {
+ my ( $system_cmd, $deferredlog ) = @_;
+ my $ret;
+
+ DeferOutput() if ( $deferredlog || $DEFERREDLOG );
+
+ $ret = system($system_cmd );
+
+ UndeferOutput() if ( $deferredlog || $DEFERREDLOG );
+
+ if ( defined $deferbuffer && $deferbuffer ne '' ) {
+ $deferredlogbuffer .= $deferbuffer;
+ $deferbuffer = undef;
+ }
+
+ RotateCursor() if ($deferredlog);
+
+ return $ret;
}
sub DelLog () {
@@ -201,44 +200,43 @@
DelLog();
}
-
# Log
sub Log (@) {
- my ( @msg ) = @_;
-
- my @words = split( /\s+/, join ( "", @msg ) );
- my $col = 0;
- my $sup = "";
- my $word;
-
- foreach $word (@words) {
- my $len = length($word);
- if ( defined($word) && $len > 0 ) {
- if ( $col != 0 ) {
- $sup = " ";
- }
- if ( $word eq "\n" || $word eq "\r" ) {
- $deferredlogbuffer .= "\n";
- $col = 0;
- }
- elsif ( $col + $len + length($sup) < 80 ) {
- $deferredlogbuffer .= $sup . $word;
- $col = $col + length($sup) + $len;
- }
- else {
- $deferredlogbuffer .= "\n... " . $word;
- $col = 4 + $len;
- }
- }
+ my (@msg) = @_;
+
+ my @words = split( /\s+/, join( "", @msg ) );
+ my $col = 0;
+ my $sup = "";
+ my $word;
+
+ foreach $word (@words) {
+ my $len = length($word);
+ if ( defined($word) && $len > 0 ) {
+ if ( $col != 0 ) {
+ $sup = " ";
+ }
+ if ( $word eq "\n" || $word eq "\r" ) {
+ $deferredlogbuffer .= "\n";
+ $col = 0;
+ }
+ elsif ( $col + $len + length($sup) < 80 ) {
+ $deferredlogbuffer .= $sup . $word;
+ $col = $col + length($sup) + $len;
+ }
+ else {
+ $deferredlogbuffer .= "\n... " . $word;
+ $col = 4 + $len;
+ }
+ }
}
$deferredlogbuffer .= "\n";
- if ( ! $DEFERREDLOG ) {
- FlushLog();
+ if ( !$DEFERREDLOG ) {
+ FlushLog();
}
else {
- RotateCursor();
+ RotateCursor();
}
}
@@ -273,4 +271,4 @@
exit $err;
}
-1;
+1;
Modified: branches/next-gen/lib/PFTools/Net.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Net.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Net.pm (original)
+++ branches/next-gen/lib/PFTools/Net.pm Tue Sep 7 08:54:37 2010
@@ -30,8 +30,8 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Get_netblock_from_vlan
- Resolv_hostname_from_DNS
+ Get_netblock_from_vlan
+ Resolv_hostname_from_DNS
);
our @EXPORT_OK = qw();
@@ -61,48 +61,67 @@
# Return a NetAddr::IP object containing the netblock for a specifed network definition
#
sub Get_netblock_from_vlan ($$) {
- my ( $type, $net_hash ) = @_;
-
- my $suffix = ( $type eq 'ipv6' ) ? '6' : '';
- my @net_def; my $msg;
- if ( $net_hash->{'network'.$suffix} =~ /\/\d+$/ ) {
- @net_def = ( $net_hash->{'network'.$suffix} );
- $msg = "Invalid network ".$net_hash->{'network'.$suffix}." ".$type." defintion";
- }
- elsif ( $net_hash->{'netmask'.$suffix} =~/^\// ) {
- @net_def = ( $net_hash->{'network'.$suffix}.$net_hash->{'netmask'.$suffix} );
- $msg = "Invalid network ".$net_hash->{'network'.$suffix}.$net_hash->{'netmask'.$suffix}." ".$type." defintion";
- }
- else {
- @net_def = ( $net_hash->{'network'.$suffix}, $net_hash->{'netmask'.$suffix} );
- $msg = "Invalid network ".$net_hash->{'network'.$suffix}." and/or netmask ".$net_hash->{'netmask'.$suffix}." ".$type." defintion";
- }
- my $block = new NetAddr::IP ( @net_def );
- if ( ! defined $block ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- $msg );
- }
- return $block;
+ my ( $type, $net_hash ) = @_;
+
+ my $suffix = ( $type eq 'ipv6' ) ? '6' : '';
+ my @net_def;
+ my $msg;
+ if ( $net_hash->{ 'network' . $suffix } =~ /\/\d+$/ ) {
+ @net_def = ( $net_hash->{ 'network' . $suffix } );
+ $msg
+ = "Invalid network "
+ . $net_hash->{ 'network' . $suffix } . " "
+ . $type
+ . " defintion";
+ }
+ elsif ( $net_hash->{ 'netmask' . $suffix } =~ /^\// ) {
+ @net_def = ( $net_hash->{ 'network' . $suffix }
+ . $net_hash->{ 'netmask' . $suffix } );
+ $msg
+ = "Invalid network "
+ . $net_hash->{ 'network' . $suffix }
+ . $net_hash->{ 'netmask' . $suffix } . " "
+ . $type
+ . " defintion";
+ }
+ else {
+ @net_def = (
+ $net_hash->{ 'network' . $suffix },
+ $net_hash->{ 'netmask' . $suffix }
+ );
+ $msg
+ = "Invalid network "
+ . $net_hash->{ 'network' . $suffix }
+ . " and/or netmask "
+ . $net_hash->{ 'netmask' . $suffix } . " "
+ . $type
+ . " defintion";
+ }
+ my $block = new NetAddr::IP(@net_def);
+ if ( !defined $block ) {
+ Abort( $CODE->{'UNDEF_KEY'}, $msg );
+ }
+ return $block;
}
sub Resolv_hostname_from_DNS ($) {
- my ( $hostname ) = @_;
- my $resolved = [];
+ my ($hostname) = @_;
+ my $resolved = [];
- my $res = Net::DNS::Resolver->new;
- my $query = $res->search( $hostname );
+ my $res = Net::DNS::Resolver->new;
+ my $query = $res->search($hostname);
- if ($query) {
- foreach my $rr ( $query->answer ) {
- next unless $rr->type eq "A";
- push ( @{$resolved}, $rr->address );
- }
- } else {
- Warn ( $CODE->{'BIND_QUERY'},
- "Query failed: ".$res->errorstring );
- return undef;
- }
- return $resolved;
+ if ($query) {
+ foreach my $rr ( $query->answer ) {
+ next unless $rr->type eq "A";
+ push( @{$resolved}, $rr->address );
+ }
+ }
+ else {
+ Warn( $CODE->{'BIND_QUERY'}, "Query failed: " . $res->errorstring );
+ return undef;
+ }
+ return $resolved;
}
1;
Modified: branches/next-gen/lib/PFTools/Packages.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Packages.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Packages.pm (original)
+++ branches/next-gen/lib/PFTools/Packages.pm Tue Sep 7 08:54:37 2010
@@ -27,239 +27,314 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Cmp_pkg_version
- Get_pkg_depends
- Get_pkg_policy
- Get_pkg_status
- Install_pkg
- Purge_pkg
- Update_pkg_repository
+ Cmp_pkg_version
+ Get_pkg_depends
+ Get_pkg_policy
+ Get_pkg_status
+ Install_pkg
+ Purge_pkg
+ Update_pkg_repository
);
our @EXPORT_OK = qw();
use PFTools::Logger;
-my $PKG_CMD = {} ;
-$PKG_CMD->{'deb'}->{'status'} = 'LANG=C LC_ALL=C /usr/bin/dpkg -s' ;
-$PKG_CMD->{'deb'}->{'update'} = 'LANG=C LC_ALL=C /usr/bin/apt-get -y --force-yes update' ;
-$PKG_CMD->{'deb'}->{'depends'} = 'LANG=C LC_ALL=C /usr/bin/apt-cache show' ;
-$PKG_CMD->{'deb'}->{'install'} = 'LANG=C LC_ALL=C /usr/bin/apt-get -y --force-yes install' ;
-$PKG_CMD->{'deb'}->{'purge'} = 'LANG=C LC_ALL=C /usr/bin/dpkg --purge' ;
-$PKG_CMD->{'deb'}->{'policy'} = 'LANG=C LC_ALL=C /usr/bin/apt-cache policy' ;
-$PKG_CMD->{'deb'}->{'compare'} = 'LANG=C LC_ALL=C /usr/bin/dpkg --compare-versions' ;
-$PKG_CMD->{'rpm'} = 'TODO' ;
-
-my $VERBOSE = 0 ;
+my $PKG_CMD = {};
+$PKG_CMD->{'deb'}->{'status'} = 'LANG=C LC_ALL=C /usr/bin/dpkg -s';
+$PKG_CMD->{'deb'}->{'update'}
+ = 'LANG=C LC_ALL=C /usr/bin/apt-get -y --force-yes update';
+$PKG_CMD->{'deb'}->{'depends'} = 'LANG=C LC_ALL=C /usr/bin/apt-cache show';
+$PKG_CMD->{'deb'}->{'install'}
+ = 'LANG=C LC_ALL=C /usr/bin/apt-get -y --force-yes install';
+$PKG_CMD->{'deb'}->{'purge'} = 'LANG=C LC_ALL=C /usr/bin/dpkg --purge';
+$PKG_CMD->{'deb'}->{'policy'} = 'LANG=C LC_ALL=C /usr/bin/apt-cache policy';
+$PKG_CMD->{'deb'}->{'compare'}
+ = 'LANG=C LC_ALL=C /usr/bin/dpkg --compare-versions';
+$PKG_CMD->{'rpm'} = 'TODO';
+
+my $VERBOSE = 0;
sub Get_pkg_status ($$) {
- my ( $pkg_type, $pkg_name ) = @_ ;
-
- my $result = {} ;
- if ( ! defined $PKG_CMD->{$pkg_type} ) {
- Warn ( $CODE->{'OPEN'}, "Unknown package type ".$pkg_type ) if ( $VERBOSE );
- return undef ;
- }
- elsif ( $pkg_type eq 'rpm' ) {
- #TODO
- Warn ( $CODE->{'OPEN'}, "Need to implement the RPM handler" ) if ( $VERBOSE );
- return undef ;
- }
- elsif ( $pkg_type eq 'deb' ) {
- unless ( open ( PKG, $PKG_CMD->{$pkg_type}->{'status'}.' '.$pkg_name.' 2>/dev/null |' ) ) {
- Warn ( $CODE->{'OPEN'}, "Unable to retrieve status for package ".$pkg_name ) if ( $VERBOSE );
- return undef ;
- }
- while ( <PKG>) {
- if ( /^Status:\s+/ ) {
- if ( !/^Status:\s+install\s+ok\s+installed\s*$/ ) {
- $result->{'installed'} = 0 ;
- }
- else {
- $result->{'installed'} = 1 ;
- }
- }
- if ( /^Version:\s+(.+)\s*$/ ) {
- $result->{'version'} = $1 ;
- last ;
- }
- }
- close ( PKG ) ;
- }
- return $result ;
+ my ( $pkg_type, $pkg_name ) = @_;
+
+ my $result = {};
+ if ( !defined $PKG_CMD->{$pkg_type} ) {
+ Warn( $CODE->{'OPEN'}, "Unknown package type " . $pkg_type )
+ if ($VERBOSE);
+ return undef;
+ }
+ elsif ( $pkg_type eq 'rpm' ) {
+
+ #TODO
+ Warn( $CODE->{'OPEN'}, "Need to implement the RPM handler" )
+ if ($VERBOSE);
+ return undef;
+ }
+ elsif ( $pkg_type eq 'deb' ) {
+ unless (
+ open( PKG,
+ $PKG_CMD->{$pkg_type}->{'status'} . ' '
+ . $pkg_name
+ . ' 2>/dev/null |'
+ )
+ )
+ {
+ Warn( $CODE->{'OPEN'},
+ "Unable to retrieve status for package " . $pkg_name )
+ if ($VERBOSE);
+ return undef;
+ }
+ while (<PKG>) {
+ if (/^Status:\s+/) {
+ if ( !/^Status:\s+install\s+ok\s+installed\s*$/ ) {
+ $result->{'installed'} = 0;
+ }
+ else {
+ $result->{'installed'} = 1;
+ }
+ }
+ if (/^Version:\s+(.+)\s*$/) {
+ $result->{'version'} = $1;
+ last;
+ }
+ }
+ close(PKG);
+ }
+ return $result;
}
sub Update_pkg_repository ($) {
- my ( $pkg_type ) = @_ ;
-
- if ( ! defined $PKG_CMD->{$pkg_type} ) {
- Warn ( $CODE->{'OPEN'}, "Unknown package type ".$pkg_type ) if ( $VERBOSE );
- return 0 ;
- }
- elsif ( $pkg_type eq 'rpm' ) {
- #TODO
- Warn ( $CODE->{'OPEN'}, "Need to implement the RPM handler" ) if ( $VERBOSE );
- return 0 ;
- }
- elsif ( $pkg_type eq 'deb' ) {
- if ( deferredlogsystem( $PKG_CMD->{$pkg_type}->{'update'} ) ) {
- Warn( $CODE->{'OPEN'}, "Updating repository failed !" ) if ( $VERBOSE );
- return 0 ;
- }
- }
- return 1 ;
+ my ($pkg_type) = @_;
+
+ if ( !defined $PKG_CMD->{$pkg_type} ) {
+ Warn( $CODE->{'OPEN'}, "Unknown package type " . $pkg_type )
+ if ($VERBOSE);
+ return 0;
+ }
+ elsif ( $pkg_type eq 'rpm' ) {
+
+ #TODO
+ Warn( $CODE->{'OPEN'}, "Need to implement the RPM handler" )
+ if ($VERBOSE);
+ return 0;
+ }
+ elsif ( $pkg_type eq 'deb' ) {
+ if ( deferredlogsystem( $PKG_CMD->{$pkg_type}->{'update'} ) ) {
+ Warn( $CODE->{'OPEN'}, "Updating repository failed !" )
+ if ($VERBOSE);
+ return 0;
+ }
+ }
+ return 1;
}
sub Purge_pkg ($$) {
- my ( $pkg_type, $pkg_name ) = @_ ;
-
- if ( ! defined $PKG_CMD->{$pkg_type} ) {
- Warn ( $CODE->{'OPEN'}, "Unknown package type ".$pkg_type ) if ( $VERBOSE );
- return 0 ;
- }
- elsif ( $pkg_type eq 'rpm' ) {
- #TODO
- Warn ( $CODE->{'OPEN'}, "Need to implement the RPM handler" ) if ( $VERBOSE );
- return 0 ;
- }
- elsif ( $pkg_type eq 'deb' ) {
- if ( deferredlogsystem ( $PKG_CMD->{$pkg_type}->{'purge'}." '".$pkg_name."'" ) ) {
- Warn( $CODE->{'OPEN'}, "Unable to purge ".$pkg_name ) if ( $VERBOSE );
- return 0 ;
- }
- }
- return 1 ;
+ my ( $pkg_type, $pkg_name ) = @_;
+
+ if ( !defined $PKG_CMD->{$pkg_type} ) {
+ Warn( $CODE->{'OPEN'}, "Unknown package type " . $pkg_type )
+ if ($VERBOSE);
+ return 0;
+ }
+ elsif ( $pkg_type eq 'rpm' ) {
+
+ #TODO
+ Warn( $CODE->{'OPEN'}, "Need to implement the RPM handler" )
+ if ($VERBOSE);
+ return 0;
+ }
+ elsif ( $pkg_type eq 'deb' ) {
+ if (deferredlogsystem(
+ $PKG_CMD->{$pkg_type}->{'purge'} . " '" . $pkg_name . "'"
+ )
+ )
+ {
+ Warn( $CODE->{'OPEN'}, "Unable to purge " . $pkg_name )
+ if ($VERBOSE);
+ return 0;
+ }
+ }
+ return 1;
}
sub Get_pkg_depends ($$) {
- my ( $pkg_type, $pkg_name ) = @_ ;
- my $dep_list ;
-
- if ( ! defined $PKG_CMD->{$pkg_type} ) {
- Warn ( $CODE->{'OPEN'}, "Unknown package type ".$pkg_type ) if ( $VERBOSE );
- return undef ;
- }
- elsif ( $pkg_type eq 'rpm' ) {
- #TODO
- Warn ( $CODE->{'OPEN'}, "Need to implement the RPM handler" ) if ( $VERBOSE );
- return undef ;
- }
- elsif ( $pkg_type eq 'deb' ) {
- unless ( open( APTDEP, $PKG_CMD->{$pkg_type}->{'depends'}.' '.$pkg_name.' 2>/dev/null |' ) ) {
- Warn ( $CODE->{'OPEN'}, "Unable to get depends for package ".$pkg_name ) if ( $VERBOSE );
- return undef ;
- }
- while (<APTDEP>) {
- if (m/^Depends: (.*)$/) {
- foreach my $pkg ( split ( /,/, $1 ) ) {
- if ( $pkg =~ /|/ ) {
- $pkg =~ s/\([^\)]+\)//g ;
- $pkg =~ s/\s+//g ;
- foreach my $possible_pkg ( split ( /\|/, $pkg ) ) {
- if ( $possible_pkg ne $pkg_name ) {
- $dep_list .= " ".$possible_pkg ;
- }
- }
- }
- elsif ( $pkg ne $pkg_name ) {
- $dep_list .= " ".$pkg ;
- }
- }
- }
- }
- close ( APTDEP ) ;
- }
- $dep_list =~ s/^\s*// ;
- return $dep_list ;
+ my ( $pkg_type, $pkg_name ) = @_;
+ my $dep_list;
+
+ if ( !defined $PKG_CMD->{$pkg_type} ) {
+ Warn( $CODE->{'OPEN'}, "Unknown package type " . $pkg_type )
+ if ($VERBOSE);
+ return undef;
+ }
+ elsif ( $pkg_type eq 'rpm' ) {
+
+ #TODO
+ Warn( $CODE->{'OPEN'}, "Need to implement the RPM handler" )
+ if ($VERBOSE);
+ return undef;
+ }
+ elsif ( $pkg_type eq 'deb' ) {
+ unless (
+ open( APTDEP,
+ $PKG_CMD->{$pkg_type}->{'depends'} . ' '
+ . $pkg_name
+ . ' 2>/dev/null |'
+ )
+ )
+ {
+ Warn( $CODE->{'OPEN'},
+ "Unable to get depends for package " . $pkg_name )
+ if ($VERBOSE);
+ return undef;
+ }
+ while (<APTDEP>) {
+ if (m/^Depends: (.*)$/) {
+ foreach my $pkg ( split( /,/, $1 ) ) {
+ if ( $pkg =~ /|/ ) {
+ $pkg =~ s/\([^\)]+\)//g;
+ $pkg =~ s/\s+//g;
+ foreach my $possible_pkg ( split( /\|/, $pkg ) ) {
+ if ( $possible_pkg ne $pkg_name ) {
+ $dep_list .= " " . $possible_pkg;
+ }
+ }
+ }
+ elsif ( $pkg ne $pkg_name ) {
+ $dep_list .= " " . $pkg;
+ }
+ }
+ }
+ }
+ close(APTDEP);
+ }
+ $dep_list =~ s/^\s*//;
+ return $dep_list;
}
sub Get_pkg_policy ($$$) {
- my ( $pkg_type, $pkg_name, $version ) = @_ ;
- my ( $installed, $available, $specified_version ) ;
-
- $specified_version = 0 ;
- if ( ! defined $PKG_CMD->{$pkg_type} ) {
- Warn ( $CODE->{'OPEN'}, "Unknown package type ".$pkg_type ) if ( $VERBOSE );
- return undef ;
- }
- elsif ( $pkg_type eq 'rpm' ) {
- #TODO
- Warn ( $CODE->{'OPEN'}, "Need to implement the RPM handler" ) if ( $VERBOSE );
- return undef ;
- }
- elsif ( $pkg_type eq 'deb' ) {
- unless ( open( APTPOLICY, $PKG_CMD->{$pkg_type}->{'policy'}.' '.$pkg_name.' 2>/dev/null |' ) ) {
- Warn ( $CODE->{'OPEN'}, "Unable to get policy for package ".$pkg_name ) if ( $VERBOSE );
- return undef ;
- }
- while ( <APTPOLICY> ) {
- if (m/^ Installed: (.*)$/) {
- $installed = $1;
- undef $installed if ( $installed eq '' || $installed eq "(none)" ) ;
- }
- elsif (m/^ Candidate: (.*)$/) {
- $available = $1;
- }
- elsif ( defined $version && /\Q$version\E/ ) {
- $specified_version = 1 ;
- }
- }
- close(APTPOLICY);
- return ( $installed, $available, $specified_version ) ;
- }
+ my ( $pkg_type, $pkg_name, $version ) = @_;
+ my ( $installed, $available, $specified_version );
+
+ $specified_version = 0;
+ if ( !defined $PKG_CMD->{$pkg_type} ) {
+ Warn( $CODE->{'OPEN'}, "Unknown package type " . $pkg_type )
+ if ($VERBOSE);
+ return undef;
+ }
+ elsif ( $pkg_type eq 'rpm' ) {
+
+ #TODO
+ Warn( $CODE->{'OPEN'}, "Need to implement the RPM handler" )
+ if ($VERBOSE);
+ return undef;
+ }
+ elsif ( $pkg_type eq 'deb' ) {
+ unless (
+ open( APTPOLICY,
+ $PKG_CMD->{$pkg_type}->{'policy'} . ' '
+ . $pkg_name
+ . ' 2>/dev/null |'
+ )
+ )
+ {
+ Warn( $CODE->{'OPEN'},
+ "Unable to get policy for package " . $pkg_name )
+ if ($VERBOSE);
+ return undef;
+ }
+ while (<APTPOLICY>) {
+ if (m/^ Installed: (.*)$/) {
+ $installed = $1;
+ undef $installed
+ if ( $installed eq '' || $installed eq "(none)" );
+ }
+ elsif (m/^ Candidate: (.*)$/) {
+ $available = $1;
+ }
+ elsif ( defined $version && /\Q$version\E/ ) {
+ $specified_version = 1;
+ }
+ }
+ close(APTPOLICY);
+ return ( $installed, $available, $specified_version );
+ }
}
sub Cmp_pkg_version ($$$$) {
- my ( $pkg_type, $pkg_name, $version1, $version2 ) = @_ ;
-
- if ( ! defined $PKG_CMD->{$pkg_type} ) {
- Warn ( $CODE->{'OPEN'}, "Unknown package type ".$pkg_type ) if ( $VERBOSE );
- return undef ;
- }
- elsif ( $pkg_type eq 'rpm' ) {
- #TODO
- Warn ( $CODE->{'OPEN'}, "Need to implement the RPM handler" ) if ( $VERBOSE );
- return undef ;
- }
- else {
- if ( $pkg_type eq 'deb' ) {
- if ( ! deferredlogsystem ( $PKG_CMD->{$pkg_type}->{'compare'}.' '.$version1.' lt '.$version2 ) ) {
- return -1 ;
- }
- elsif ( ! deferredlogsystem ( $PKG_CMD->{$pkg_type}->{'compare'}.' '.$version1.' eq '.$version2 ) ) {
- return 0 ;
- }
- else {
- return 1 ;
- }
- }
- }
+ my ( $pkg_type, $pkg_name, $version1, $version2 ) = @_;
+
+ if ( !defined $PKG_CMD->{$pkg_type} ) {
+ Warn( $CODE->{'OPEN'}, "Unknown package type " . $pkg_type )
+ if ($VERBOSE);
+ return undef;
+ }
+ elsif ( $pkg_type eq 'rpm' ) {
+
+ #TODO
+ Warn( $CODE->{'OPEN'}, "Need to implement the RPM handler" )
+ if ($VERBOSE);
+ return undef;
+ }
+ else {
+ if ( $pkg_type eq 'deb' ) {
+ if (!deferredlogsystem(
+ $PKG_CMD->{$pkg_type}->{'compare'} . ' '
+ . $version1 . ' lt '
+ . $version2
+ )
+ )
+ {
+ return -1;
+ }
+ elsif (
+ !deferredlogsystem(
+ $PKG_CMD->{$pkg_type}->{'compare'} . ' '
+ . $version1 . ' eq '
+ . $version2
+ )
+ )
+ {
+ return 0;
+ }
+ else {
+ return 1;
+ }
+ }
+ }
}
sub Install_pkg ($$;$) {
- my ( $pkg_type, $pkg_name, $version ) = @_ ;
-
- if ( ! defined $PKG_CMD->{$pkg_type} ) {
- Warn ( $CODE->{'OPEN'}, "Unknown package type ".$pkg_type ) if ( $VERBOSE );
- return undef ;
- }
- elsif ( $pkg_type eq 'rpm' ) {
- #TODO
- Warn ( $CODE->{'OPEN'}, "Need to implement the RPM handler" ) if ( $VERBOSE );
- return undef ;
- }
- else {
- if ( $pkg_type eq 'deb' ) {
- my $install_cmd = $PKG_CMD->{$pkg_type}->{'install'}." '".$pkg_name."'" ;
- if ( defined $version ) {
- $install_cmd = $PKG_CMD->{$pkg_type}->{'install'}." '".$pkg_name."=".$version."'" ;
- }
- if ( deferredlogsystem ( $install_cmd ) ) {
- return 0 ;
- }
- return 1 ;
- }
- }
-}
-
-1;
+ my ( $pkg_type, $pkg_name, $version ) = @_;
+
+ if ( !defined $PKG_CMD->{$pkg_type} ) {
+ Warn( $CODE->{'OPEN'}, "Unknown package type " . $pkg_type )
+ if ($VERBOSE);
+ return undef;
+ }
+ elsif ( $pkg_type eq 'rpm' ) {
+
+ #TODO
+ Warn( $CODE->{'OPEN'}, "Need to implement the RPM handler" )
+ if ($VERBOSE);
+ return undef;
+ }
+ else {
+ if ( $pkg_type eq 'deb' ) {
+ my $install_cmd
+ = $PKG_CMD->{$pkg_type}->{'install'} . " '" . $pkg_name . "'";
+ if ( defined $version ) {
+ $install_cmd
+ = $PKG_CMD->{$pkg_type}->{'install'} . " '"
+ . $pkg_name . "="
+ . $version . "'";
+ }
+ if ( deferredlogsystem($install_cmd) ) {
+ return 0;
+ }
+ return 1;
+ }
+ }
+}
+
+1;
Modified: branches/next-gen/lib/PFTools/Parser.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Parser.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Parser.pm (original)
+++ branches/next-gen/lib/PFTools/Parser.pm Tue Sep 7 08:54:37 2010
@@ -27,7 +27,7 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Parser_ini
+ Parser_ini
);
our @EXPORT_OK = qw();
@@ -41,28 +41,34 @@
my $DEBUG = 0;
sub Parser_ini ($) {
- my ( $file ) = @_;
-
- my $parse = new Config::IniFiles ( -file => $file, -allowcontinue => 1 );
- if ( ! defined ( $parse ) ) {
- if ( $DEBUG ) {
- warn "Unable to parse file ".$file." with the following errors\n" ;
- warn join ( "\n", @Config::IniFiles::errors ) ;
- }
- return undef ;
- }
- my $refined = $parse->{'v'};
- foreach my $sect ( keys %{$refined} ) {
- foreach my $key ( keys %{$refined->{$sect}} ) {
- if ( ref ( $refined->{$sect}->{$key} ) eq 'ARRAY' && $key !~ /^@/ ) {
- $refined->{$sect}->{$key} = pop ( @{$refined->{$sect}->{$key}} ) ;
- } elsif ( $key =~ /^@/ && ref ( $refined->{$sect}->{$key} ) ne 'ARRAY' ) {
- $refined->{$sect}->{$key} = [ $refined->{$sect}->{$key} ] ;
- }
- }
- }
- $refined->{'__sections_order'} = $parse->{'mysects'};
- return $refined;
+ my ($file) = @_;
+
+ my $parse = new Config::IniFiles( -file => $file, -allowcontinue => 1 );
+ if ( !defined($parse) ) {
+ if ($DEBUG) {
+ warn "Unable to parse file " . $file
+ . " with the following errors\n";
+ warn join( "\n", @Config::IniFiles::errors );
+ }
+ return undef;
+ }
+ my $refined = $parse->{'v'};
+ foreach my $sect ( keys %{$refined} ) {
+ foreach my $key ( keys %{ $refined->{$sect} } ) {
+ if ( ref( $refined->{$sect}->{$key} ) eq 'ARRAY' && $key !~ /^@/ )
+ {
+ $refined->{$sect}->{$key}
+ = pop( @{ $refined->{$sect}->{$key} } );
+ }
+ elsif ( $key =~ /^@/
+ && ref( $refined->{$sect}->{$key} ) ne 'ARRAY' )
+ {
+ $refined->{$sect}->{$key} = [ $refined->{$sect}->{$key} ];
+ }
+ }
+ }
+ $refined->{'__sections_order'} = $parse->{'mysects'};
+ return $refined;
}
-1;
+1;
Modified: branches/next-gen/lib/PFTools/Structqueries.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Structqueries.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Structqueries.pm (original)
+++ branches/next-gen/lib/PFTools/Structqueries.pm Tue Sep 7 08:54:37 2010
@@ -33,18 +33,18 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Get_zone_from_hostname
- Get_zone_from_site_GLOBAL
- Get_hosttype_from_hostname
- Get_iface_vlan_from_hostname
- Get_site_from_hostname
- Get_site_list
- Get_cmdline_from_hostprops
- Get_distrib_from_hostprops
- Get_mode_from_hostprops
- Get_pkgtype_from_hostname
- Get_host_config_from_CONFIG
- Resolv_hostname_from_GLOBAL
+ Get_zone_from_hostname
+ Get_zone_from_site_GLOBAL
+ Get_hosttype_from_hostname
+ Get_iface_vlan_from_hostname
+ Get_site_from_hostname
+ Get_site_list
+ Get_cmdline_from_hostprops
+ Get_distrib_from_hostprops
+ Get_mode_from_hostprops
+ Get_pkgtype_from_hostname
+ Get_host_config_from_CONFIG
+ Resolv_hostname_from_GLOBAL
);
our @EXPORT_OK = qw ();
@@ -67,25 +67,30 @@
# Return a string containing the zone name for the specified site.
#
sub Get_zone_from_hostname ($$;$) {
- my ( $hostname, $global_config, $site ) = @_;
-
- if ( ! defined $site ) {
- my $ref_list = Get_site_from_hostname ( $hostname, $global_config );
- if ( ! defined $ref_list ) {
- Warn ( $CODE->{'UNDEF_KEY'},
- "Hostname ".$hostname." is not defined into global configuration" );
- return undef;
- }
- elsif ( scalar @{$ref_list} > 1 ) {
- Warn ( $CODE->{'DUPLICATE_VALUE'},
- "Hostname ".$hostname." is defined on multiple sites into global configuration" );
- return undef;
- }
- else {
- ( $site ) = @{$ref_list};
- }
- }
- return $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'zone'};
+ my ( $hostname, $global_config, $site ) = @_;
+
+ if ( !defined $site ) {
+ my $ref_list = Get_site_from_hostname( $hostname, $global_config );
+ if ( !defined $ref_list ) {
+ Warn( $CODE->{'UNDEF_KEY'},
+ "Hostname "
+ . $hostname
+ . " is not defined into global configuration" );
+ return undef;
+ }
+ elsif ( scalar @{$ref_list} > 1 ) {
+ Warn( $CODE->{'DUPLICATE_VALUE'},
+ "Hostname "
+ . $hostname
+ . " is defined on multiple sites into global configuration"
+ );
+ return undef;
+ }
+ else {
+ ($site) = @{$ref_list};
+ }
+ }
+ return $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'zone'};
}
#########################################################################
@@ -102,26 +107,28 @@
# Returns a string containing the hosttype or undef if hostname doesn't exist
#
sub Get_hosttype_from_hostname ($$;$) {
- my ( $hostname, $global_config, $site ) = @_;
- my $site_list;
-
- if ( ! defined $site ) {
- $site_list = $global_config->{'SITE'}->{'__site_list'};
- }
- else {
- $site_list = [ $site ];
- }
-
- foreach my $site ( @{$site_list} ) {
- my $host_part = $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'HOST'}->{'BY_NAME'};
- foreach my $hostclass ( keys %{$host_part} ) {
- return $hostclass if ( $hostclass eq $hostname );
- foreach my $host ( keys %{$host_part->{$hostclass}} ) {
- return $hostclass if ( $host eq $hostname );
- }
- }
- }
- return undef;
+ my ( $hostname, $global_config, $site ) = @_;
+ my $site_list;
+
+ if ( !defined $site ) {
+ $site_list = $global_config->{'SITE'}->{'__site_list'};
+ }
+ else {
+ $site_list = [$site];
+ }
+
+ foreach my $site ( @{$site_list} ) {
+ my $host_part
+ = $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'HOST'}
+ ->{'BY_NAME'};
+ foreach my $hostclass ( keys %{$host_part} ) {
+ return $hostclass if ( $hostclass eq $hostname );
+ foreach my $host ( keys %{ $host_part->{$hostclass} } ) {
+ return $hostclass if ( $host eq $hostname );
+ }
+ }
+ }
+ return undef;
}
#########################################################################
@@ -137,12 +144,13 @@
# Returns a string containing the interface or undef
#
sub Get_iface_vlan_from_hostname ($$) {
- my ( $vlan, $ref_host ) = @_;
-
- foreach my $iface ( keys %{$ref_host->{'interfaces'}} ) {
- return $iface if ( $ref_host->{'interfaces'}->{$iface}->{'vlan'} eq $vlan );
- }
- return undef;
+ my ( $vlan, $ref_host ) = @_;
+
+ foreach my $iface ( keys %{ $ref_host->{'interfaces'} } ) {
+ return $iface
+ if ( $ref_host->{'interfaces'}->{$iface}->{'vlan'} eq $vlan );
+ }
+ return undef;
}
#########################################################################
@@ -158,29 +166,38 @@
# Returns a string containing the hosttype or undef if hostname doesn't exist
#
sub Get_hostname_model_from_hostname ($$) {
- my ( $hostname, $global_config ) = @_;
-
- my $hostclass = Get_hosttype_from_hostname ( $hostname, $global_config );
- if ( ! defined $hostclass ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unable to get hosttype from hostname ".$hostname." : unexistant hostname" );
- }
- my $site_list = Get_site_from_hostname ( $hostname, $global_config );
- if ( ! defined $site_list ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unable to get site list from hostname ".$hostname." : unexistant hostname" );
- }
- else {
- if ( scalar @{$site_list} > 1 ) {
- Warn ( $CODE->{'DUPLICATE_VALUE'},
- "Hostname ".$hostname." is defined on multiple sites : unable to choose the right one" );
- return undef;
- }
- else {
- my ( $site ) = @{$site_list};
- return $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'HOST'}->{'BY_NAME'}->{$hostclass}->{'deployment'}->{'hostname_model'};
- }
- }
+ my ( $hostname, $global_config ) = @_;
+
+ my $hostclass = Get_hosttype_from_hostname( $hostname, $global_config );
+ if ( !defined $hostclass ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unable to get hosttype from hostname "
+ . $hostname
+ . " : unexistant hostname" );
+ }
+ my $site_list = Get_site_from_hostname( $hostname, $global_config );
+ if ( !defined $site_list ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unable to get site list from hostname "
+ . $hostname
+ . " : unexistant hostname" );
+ }
+ else {
+ if ( scalar @{$site_list} > 1 ) {
+ Warn( $CODE->{'DUPLICATE_VALUE'},
+ "Hostname "
+ . $hostname
+ . " is defined on multiple sites : unable to choose the right one"
+ );
+ return undef;
+ }
+ else {
+ my ($site) = @{$site_list};
+ return $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'HOST'}
+ ->{'BY_NAME'}->{$hostclass}->{'deployment'}
+ ->{'hostname_model'};
+ }
+ }
}
#########################################################################
@@ -196,31 +213,35 @@
# Returns an array ref containing the sites list or undef if hostname doesn't exist
#
sub Get_site_from_hostname ($$) {
- my ( $hostname, $global_config ) = @_;
- my $site_list;
-
- foreach my $site ( @{$global_config->{'SITE'}->{'__site_list'}} ) {
- my $host_part = $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'HOST'}->{'BY_NAME'};
- foreach my $hostclass ( keys %{$host_part} ) {
- if ( $hostclass eq $hostname ) {
- push ( @{$site_list}, $site ) if ( ! grep ( /^$site$/, @{$site_list} ) );
- next;
- }
- foreach my $host ( keys %{$host_part->{$hostclass}} ) {
- if ( $host eq $hostname ) {
- push ( @{$site_list}, $site ) if ( ! grep ( /^$site$/, @{$site_list} ) );
- last;
- }
- }
- }
- }
- return $site_list;
+ my ( $hostname, $global_config ) = @_;
+ my $site_list;
+
+ foreach my $site ( @{ $global_config->{'SITE'}->{'__site_list'} } ) {
+ my $host_part
+ = $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'HOST'}
+ ->{'BY_NAME'};
+ foreach my $hostclass ( keys %{$host_part} ) {
+ if ( $hostclass eq $hostname ) {
+ push( @{$site_list}, $site )
+ if ( !grep ( /^$site$/, @{$site_list} ) );
+ next;
+ }
+ foreach my $host ( keys %{ $host_part->{$hostclass} } ) {
+ if ( $host eq $hostname ) {
+ push( @{$site_list}, $site )
+ if ( !grep ( /^$site$/, @{$site_list} ) );
+ last;
+ }
+ }
+ }
+ }
+ return $site_list;
}
sub Get_zone_from_site_GLOBAL ($$) {
- my ( $site, $global_config ) = @_;
-
- return $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'zone'};
+ my ( $site, $global_config ) = @_;
+
+ return $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'zone'};
}
#########################################################################
@@ -236,16 +257,16 @@
# Return an array reference containing the built site list.
#
sub Get_site_list ($$) {
- my ( $sect_hash, $global_config ) = @_;
- my $ref_list;
-
- if ( $sect_hash->{'site'} eq 'ALL' ) {
- return $global_config->{'SITE'}->{'__site_list'};
- }
- else {
- @{$ref_list} = split ( /\s*\,\s*/, $sect_hash->{'site'} );
- return $ref_list;
- }
+ my ( $sect_hash, $global_config ) = @_;
+ my $ref_list;
+
+ if ( $sect_hash->{'site'} eq 'ALL' ) {
+ return $global_config->{'SITE'}->{'__site_list'};
+ }
+ else {
+ @{$ref_list} = split( /\s*\,\s*/, $sect_hash->{'site'} );
+ return $ref_list;
+ }
}
#########################################################################
@@ -260,111 +281,130 @@
# - $site : define here the site where hostname is defined (optional)
#
sub Get_host_config_from_CONFIG ($$;$) {
- my ( $hostname, $global_config, $site ) = @_ ;
-
- if ( ! defined $site ) {
- my $site_list = Get_site_from_hostname ( $hostname, $global_config );
- if ( ! defined $site_list ) {
- Warn ( $CODE->{'UNDEF_KEY'},
- "Unable to retrieve site for hostname ".$hostname." : hostname not defined" );
- }
- elsif ( scalar @{$site_list} > 1 ) {
- Warn ( $CODE->{'UNDEF_KEY'},
- "Unable to retrieve site for hostname ".$hostname." : hostname appeared in multiple sites : "
- .join ( ",", @{$site_list} ) );
- }
- else {
- ( $site ) = @{$site_list};
- }
- }
- my $site_part = $global_config->{'SITE'}->{'BY_NAME'}->{$site};
- my $zone = $site_part->{'zone'};
- $hostname =~ /^([^.]+)(\.([^.]+))?(\.$zone)?$/ ;
- my ( $hostshort, $hostvlan ) = ( $1, $3 ) ;
- my $hosttype = Get_hosttype_from_hostname ( $hostname, $global_config );
- return $site_part->{'HOST'}->{'BY_NAME'}->{$hosttype}->{$hostshort} ;
+ my ( $hostname, $global_config, $site ) = @_;
+
+ if ( !defined $site ) {
+ my $site_list = Get_site_from_hostname( $hostname, $global_config );
+ if ( !defined $site_list ) {
+ Warn( $CODE->{'UNDEF_KEY'},
+ "Unable to retrieve site for hostname "
+ . $hostname
+ . " : hostname not defined" );
+ }
+ elsif ( scalar @{$site_list} > 1 ) {
+ Warn( $CODE->{'UNDEF_KEY'},
+ "Unable to retrieve site for hostname "
+ . $hostname
+ . " : hostname appeared in multiple sites : "
+ . join( ",", @{$site_list} ) );
+ }
+ else {
+ ($site) = @{$site_list};
+ }
+ }
+ my $site_part = $global_config->{'SITE'}->{'BY_NAME'}->{$site};
+ my $zone = $site_part->{'zone'};
+ $hostname =~ /^([^.]+)(\.([^.]+))?(\.$zone)?$/;
+ my ( $hostshort, $hostvlan ) = ( $1, $3 );
+ my $hosttype = Get_hosttype_from_hostname( $hostname, $global_config );
+ return $site_part->{'HOST'}->{'BY_NAME'}->{$hosttype}->{$hostshort};
}
sub Get_pkgtype_from_hostname ($$;$) {
- my ( $hostname, $global_config, $site ) = @_;
-
- my $host_props = Get_host_config_from_CONFIG ( $hostname, $global_config, $site );
- return undef if ( ! defined $host_props );
- my $mode = $host_props->{'deployment'}->{'mode'};
- if ( $mode =~ /^(debian|ubuntu)$/ ) {
- return 'deb';
- }
- else {
- Warn ( $CODE->{'UNDEF_KEY'},
- "Unknown mode ".$mode." of deployment : cannot retrieve package type for this one" );
- return undef;
- }
+ my ( $hostname, $global_config, $site ) = @_;
+
+ my $host_props
+ = Get_host_config_from_CONFIG( $hostname, $global_config, $site );
+ return undef if ( !defined $host_props );
+ my $mode = $host_props->{'deployment'}->{'mode'};
+ if ( $mode =~ /^(debian|ubuntu)$/ ) {
+ return 'deb';
+ }
+ else {
+ Warn( $CODE->{'UNDEF_KEY'},
+ "Unknown mode "
+ . $mode
+ . " of deployment : cannot retrieve package type for this one"
+ );
+ return undef;
+ }
}
sub Get_cmdline_from_hostprops ($) {
- my ( $host_props ) = @_;
- my ( $bond_cmdline, $cmdline );
-
- $cmdline = $host_props->{'boot'}->{'cmdline'};
- foreach my $iface ( sort keys %{$host_props->{'interfaces'}} ) {
- next if ( $iface !~ /^bond/ );
- $bond_cmdline = "bonding.mode=".$host_props->{'interfaces'}->{$iface}->{'mode'}." ";
- foreach my $opt ( split ( /\s*,\s*/, $host_props->{'interfaces'}->{$iface}->{'options'} ) ) {
- $bond_cmdline .= "bonding.".$opt." ";
- }
- $bond_cmdline =~ s/\s*$//;
- last;
- }
- return ( $cmdline, $bond_cmdline );
+ my ($host_props) = @_;
+ my ( $bond_cmdline, $cmdline );
+
+ $cmdline = $host_props->{'boot'}->{'cmdline'};
+ foreach my $iface ( sort keys %{ $host_props->{'interfaces'} } ) {
+ next if ( $iface !~ /^bond/ );
+ $bond_cmdline = "bonding.mode="
+ . $host_props->{'interfaces'}->{$iface}->{'mode'} . " ";
+ foreach my $opt (
+ split(
+ /\s*,\s*/, $host_props->{'interfaces'}->{$iface}->{'options'}
+ )
+ )
+ {
+ $bond_cmdline .= "bonding." . $opt . " ";
+ }
+ $bond_cmdline =~ s/\s*$//;
+ last;
+ }
+ return ( $cmdline, $bond_cmdline );
}
sub Get_distrib_from_hostprops ($) {
- my ( $host_props ) = @_;
-
- return $host_props->{'deployment'}->{'distrib'};
+ my ($host_props) = @_;
+
+ return $host_props->{'deployment'}->{'distrib'};
}
sub Get_mode_from_hostprops ($) {
- my ( $host_props ) = @_;
-
- return $host_props->{'deployment'}->{'mode'};
+ my ($host_props) = @_;
+
+ return $host_props->{'deployment'}->{'mode'};
}
sub Resolv_hostname_from_GLOBAL ($$$$$) {
- my ( $hostname, $global_config, $site, $zone, $hosttype ) = @_;
- my $resolved = [];
-
- $hostname =~ /^([^.]+)(\.([^.]+))?$/;
- my ( $hostshort, $hostvlan ) = ( $1, $3 );
- my $zone_part = $global_config->{'ZONE'}->{'BY_NAME'}->{$zone}->{'BY_SITE'}->{$site};
- if ( $hostname =~ /^(network|netmask|broadcast|gateway)/ ) {
- return undef if ( $hostvlan && ! defined $zone_part->{$hostvlan} );
- my ( $type, $field ) = split ( /\s+/, $zone_part->{$hostvlan}->{$hostshort} );
- push ( @{$resolved}, $field );
- }
- else {
- foreach my $entry ( keys %{$zone_part->{$hosttype}} ) {
- next if ( $entry !~ /^$hostname$/ );
- my @fields;
- if ( ref ( $zone_part->{$hosttype}->{$entry} ) eq 'ARRAY' ) {
- @fields = @{$zone_part->{$hosttype}->{$entry}}
- }
- else {
- @fields = ( $zone_part->{$hosttype}->{$entry} );
- }
- foreach my $line ( @fields ) {
- my ( $type, $field ) = split ( /\s+/, $line );
- if ( $type eq 'A' ) {
- push ( @{$resolved}, $field );
- }
- elsif ( $type eq 'CNAME' ) {
- my $cname_resolved = Resolv_hostname_from_GLOBAL ( $field, $global_config, $site, $zone, $hosttype );
- push ( @{$resolved}, @{$cname_resolved} );
- }
- }
- }
- }
- return $resolved;
+ my ( $hostname, $global_config, $site, $zone, $hosttype ) = @_;
+ my $resolved = [];
+
+ $hostname =~ /^([^.]+)(\.([^.]+))?$/;
+ my ( $hostshort, $hostvlan ) = ( $1, $3 );
+ my $zone_part
+ = $global_config->{'ZONE'}->{'BY_NAME'}->{$zone}->{'BY_SITE'}
+ ->{$site};
+ if ( $hostname =~ /^(network|netmask|broadcast|gateway)/ ) {
+ return undef if ( $hostvlan && !defined $zone_part->{$hostvlan} );
+ my ( $type, $field )
+ = split( /\s+/, $zone_part->{$hostvlan}->{$hostshort} );
+ push( @{$resolved}, $field );
+ }
+ else {
+ foreach my $entry ( keys %{ $zone_part->{$hosttype} } ) {
+ next if ( $entry !~ /^$hostname$/ );
+ my @fields;
+ if ( ref( $zone_part->{$hosttype}->{$entry} ) eq 'ARRAY' ) {
+ @fields = @{ $zone_part->{$hosttype}->{$entry} };
+ }
+ else {
+ @fields = ( $zone_part->{$hosttype}->{$entry} );
+ }
+ foreach my $line (@fields) {
+ my ( $type, $field ) = split( /\s+/, $line );
+ if ( $type eq 'A' ) {
+ push( @{$resolved}, $field );
+ }
+ elsif ( $type eq 'CNAME' ) {
+ my $cname_resolved
+ = Resolv_hostname_from_GLOBAL( $field, $global_config,
+ $site, $zone, $hosttype );
+ push( @{$resolved}, @{$cname_resolved} );
+ }
+ }
+ }
+ }
+ return $resolved;
}
1;
Modified: branches/next-gen/lib/PFTools/Update.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Update.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Update.pm (original)
+++ branches/next-gen/lib/PFTools/Update.pm Tue Sep 7 08:54:37 2010
@@ -31,9 +31,9 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Get_depends_for_action
- Exec_action
- Sort_config_sections
+ Get_depends_for_action
+ Exec_action
+ Sort_config_sections
);
our @EXPORT_OK = qw();
@@ -54,90 +54,110 @@
###########################################
# Global vars
-my $STARTTIME = time();
-my $APT_UPDATE = 1;
+my $STARTTIME = time();
+my $APT_UPDATE = 1;
sub Get_depends_for_action ($$$$) {
- my ( $action, $ref_section, $dest, $options ) = @_;
+ my ( $action, $ref_section, $dest, $options ) = @_;
- if ( $action eq "addfile" ) {
- Addfile_depends ( $ref_section, $dest, $options );
- }
- elsif ( $action eq "apt-get" || $action eq "installpkg" ) {
- Installpkg_depends ( $ref_section, $dest, $options );
- }
- elsif ( $action eq "mkdir" ) {
- Mkdir_depends ( $ref_section, $dest, $options );
- }
- 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 );
- }
+ if ( $action eq "addfile" ) {
+ Addfile_depends( $ref_section, $dest, $options );
+ }
+ elsif ( $action eq "apt-get" || $action eq "installpkg" ) {
+ Installpkg_depends( $ref_section, $dest, $options );
+ }
+ elsif ( $action eq "mkdir" ) {
+ Mkdir_depends( $ref_section, $dest, $options );
+ }
+ 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 );
+ }
}
sub Exec_action ($$$$$$) {
- my ( $action, $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
+ my ( $action, $ref_section, $dest, $options, $hash_subst, $global_config )
+ = @_;
- # 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" );
- 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;
- }
- $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" );
+ # 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" );
+ 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;
+ }
+ $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" );
}
sub __Sort_depends_prio ($$) {
- my ( $action, $section ) = @_;
+ my ( $action, $section ) = @_;
- my $prio = 0;
+ my $prio = 0;
- # First : authentication parts
- return $prio if ( $section eq "/etc/passwd" );
- $prio++;
- return $prio if ( $section eq "/etc/group" );
- $prio++;
- return $prio if ( $section eq "/etc/shadow" );
- $prio++;
- return $prio if ( $section eq "/etc/gshadow" );
- $prio++;
+ # First : authentication parts
+ return $prio if ( $section eq "/etc/passwd" );
+ $prio++;
+ return $prio if ( $section eq "/etc/group" );
+ $prio++;
+ return $prio if ( $section eq "/etc/shadow" );
+ $prio++;
+ return $prio if ( $section eq "/etc/gshadow" );
+ $prio++;
- # Second : directory and mount points
- return $prio if ( $action eq 'mkdir' );
- $prio++;
- return $prio if ( $action eq 'addmount' );
- $prio++;
+ # Second : directory and mount points
+ return $prio if ( $action eq 'mkdir' );
+ $prio++;
+ return $prio if ( $action eq 'addmount' );
+ $prio++;
- # Third : Packaging infra and packages
- return $prio if ( $section =~ /^\/etc\/apt\// );
- $prio++;
- return $prio if ( $section eq "pf-tools" );
- $prio++;
- return $prio if ( $action eq "dpkg-purge" || $action eq "purgepkg" );
+ # Third : Packaging infra and packages
+ return $prio if ( $section =~ /^\/etc\/apt\// );
+ $prio++;
+ return $prio if ( $section eq "pf-tools" );
+ $prio++;
+ return $prio if ( $action eq "dpkg-purge" || $action eq "purgepkg" );
$prio++;
return $prio if ( $action eq "apt-get" || $action eq "installpkg" );
$prio++;
- # Fourth : creations and adds for files and links
+ # Fourth : creations and adds for files and links
return $prio if ( $action eq 'createfile' );
$prio++;
return $prio if ( $action eq 'addfile' );
@@ -145,10 +165,10 @@
return $prio if ( $action eq 'addlink' );
$prio++;
- # Fifth : removing files and dirs
+ # Fifth : removing files and dirs
return $prio if ( $action =~ /^remove/ );
$prio++;
-
+
# Last : other elements
return $prio;
}
@@ -156,15 +176,16 @@
sub Sort_config_sections ($$$) {
my ( $host_config, $a, $b ) = @_;
- my $prioa = __Sort_depends_prio ( $host_config->{$a}->{'action'}, $a );
- my $priob = __Sort_depends_prio ( $host_config->{$b}->{'action'}, $b );
+ my $prioa = __Sort_depends_prio( $host_config->{$a}->{'action'}, $a );
+ my $priob = __Sort_depends_prio( $host_config->{$b}->{'action'}, $b );
if ( $prioa != $priob ) {
- return $prioa <=> $priob;
+ return $prioa <=> $priob;
}
-# else {
-# return $a cmp $b;
-# }
+
+ # else {
+ # return $a cmp $b;
+ # }
}
1;
Modified: branches/next-gen/lib/PFTools/Update/Addfile.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Update/Addfile.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Update/Addfile.pm (original)
+++ branches/next-gen/lib/PFTools/Update/Addfile.pm Tue Sep 7 08:54:37 2010
@@ -27,8 +27,8 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Addfile_depends
- Addfile_action
+ Addfile_depends
+ Addfile_action
);
our @EXPORT_OK = qw();
@@ -44,99 +44,113 @@
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;
+ 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 ( $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 ( Subst_vars ( $splitsource, $hash_subst ), $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( Subst_vars( $ref_section->{'source'}, $hash_subst ), $options->{'host'}, $hash_subst );
- }
+ 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( Subst_vars( $splitsource, $hash_subst ),
+ $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( Subst_vars( $ref_section->{'source'}, $hash_subst ),
+ $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 ( !-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;
- }
+ 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;
Modified: branches/next-gen/lib/PFTools/Update/Addlink.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Update/Addlink.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Update/Addlink.pm (original)
+++ branches/next-gen/lib/PFTools/Update/Addlink.pm Tue Sep 7 08:54:37 2010
@@ -27,8 +27,8 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Addlink_depends
- Addlink_action
+ Addlink_depends
+ Addlink_action
);
our @EXPORT_OK = qw();
@@ -38,51 +38,52 @@
use PFTools::Update::Common;
sub Addlink_depends ($$$) {
- my ( $ref_section, $dest, $options ) = @_;
+ my ( $ref_section, $dest, $options ) = @_;
- while ( $dest ne "/" && $dest ne "." ) {
- $ref_section->{'depends'} .= " " . dirname($dest);
- $dest = dirname($dest);
- }
+ 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 ) = @_;
+ 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;
+ $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;
Modified: branches/next-gen/lib/PFTools/Update/Addmount.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Update/Addmount.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Update/Addmount.pm (original)
+++ branches/next-gen/lib/PFTools/Update/Addmount.pm Tue Sep 7 08:54:37 2010
@@ -27,8 +27,8 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Addmount_depends
- Addmount_action
+ Addmount_depends
+ Addmount_action
);
our @EXPORT_OK = qw();
@@ -48,252 +48,308 @@
###############################################
# Constants
-my $DEFAULT_FSTYPE = 'nfs';
-my $DEFAULT_OPTIONS = 'defaults,noexec,nosuid,nodev,hard,intr';
-
+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 );
- }
+ 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
+ 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;
+ 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;
+ 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");
- unless ( open ( NEWFSTAB, ">".$tmp ) ) {
- Warn( $CODE->{'OPEN'}, "Unable to create tmp dest " . $tmp );
- return 1;
- }
- my $new_fstab = Build_fstab_from_structure ( $current_fstab );
- print NEWFSTAB join ( "\n", @{$new_fstab} );
- close ( NEWFSTAB );
- 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;
+ 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");
+ unless ( open( NEWFSTAB, ">" . $tmp ) ) {
+ Warn( $CODE->{'OPEN'}, "Unable to create tmp dest " . $tmp );
+ return 1;
+ }
+ my $new_fstab = Build_fstab_from_structure($current_fstab);
+ print NEWFSTAB join( "\n", @{$new_fstab} );
+ close(NEWFSTAB);
+ 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;
}
Modified: branches/next-gen/lib/PFTools/Update/Common.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Update/Common.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Update/Common.pm (original)
+++ branches/next-gen/lib/PFTools/Update/Common.pm Tue Sep 7 08:54:37 2010
@@ -27,18 +27,18 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Do_on_config
- Do_on_noaction
- Do_before_change
- Do_after_change
- Do_chownmod
- Do_moveold
- Exec_cmd
- Mk_dest_dir
- Get_tmp_dest
- dirname
- isipaddr
- ln_sfn
+ Do_on_config
+ Do_on_noaction
+ Do_before_change
+ Do_after_change
+ Do_chownmod
+ Do_moveold
+ Exec_cmd
+ Mk_dest_dir
+ Get_tmp_dest
+ dirname
+ isipaddr
+ ln_sfn
);
our @EXPORT_OK = qw();
@@ -51,11 +51,11 @@
###########################################
### Constants
-my $DEFAULT_MODE = '0640';
-my $DEFAULT_DIRMODE = '0750';
-my $DEFAULT_OWNER = 'root';
-my $DEFAULT_GROUP = 'root';
-my $STARTTIME = time();
+my $DEFAULT_MODE = '0640';
+my $DEFAULT_DIRMODE = '0750';
+my $DEFAULT_OWNER = 'root';
+my $DEFAULT_GROUP = 'root';
+my $STARTTIME = time();
# my $DEFAULT_FSTYPE = 'nfs';
# my $DEFAULT_OPTIONS = 'defaults,noexec,nosuid,nodev,hard,intr';
@@ -66,64 +66,63 @@
###
sub isipaddr ($) {
- my ($ip) = @_;
-
- my @sub = split( '\.', $ip );
- return 0 if ( $#sub != 3 );
-
- foreach my $octet ( 0 .. 3 ) {
- return 0 if ( $sub[$octet] < 0 || $sub[$octet] > 255 );
- }
+ my ($ip) = @_;
+
+ my @sub = split( '\.', $ip );
+ return 0 if ( $#sub != 3 );
+
+ foreach my $octet ( 0 .. 3 ) {
+ return 0 if ( $sub[$octet] < 0 || $sub[$octet] > 255 );
+ }
return 1;
}
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);
- if ( $type eq 'chown' ) {
- my $newuid = getpwnam ($right1);
- my $newgid = getgrnam ($right2);
- if (
- ( defined($uid) && $uid == $newuid )
- && ( defined($gid) && $gid == $newgid )
- ) {
- return 0;
- }
- return ! chown ( $newuid, $newgid, $dest );
- }
- elsif ( $type eq 'chmod' ) {
- if ( defined($mode) && ( $mode & 07777 ) == $right1 ) {
- return 0;
- }
- return ! chmod ( $right1, $dest );
- }
-}
+ 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);
+ if ( $type eq 'chown' ) {
+ my $newuid = getpwnam($right1);
+ my $newgid = getgrnam($right2);
+ if ( ( defined($uid) && $uid == $newuid )
+ && ( defined($gid) && $gid == $newgid ) )
+ {
+ return 0;
+ }
+ return !chown( $newuid, $newgid, $dest );
+ }
+ elsif ( $type eq 'chmod' ) {
+ if ( defined($mode) && ( $mode & 07777 ) == $right1 ) {
+ return 0;
+ }
+ return !chmod( $right1, $dest );
+ }
+}
sub fullchown ($$$$) {
- my ( $owner, $group, $dest, $options ) = @_;
-
- return __full_rights ( 'chown', $dest, $options, $owner, $group );
+ my ( $owner, $group, $dest, $options ) = @_;
+
+ return __full_rights( 'chown', $dest, $options, $owner, $group );
}
sub fullchmod ($$$) {
- my ( $newmode, $dest, $options ) = @_;
-
- return __full_rights ( 'chmod', $dest, $options, $newmode );
+ my ( $newmode, $dest, $options ) = @_;
+
+ return __full_rights( 'chmod', $dest, $options, $newmode );
}
sub ln_sfn ($$) {
my ( $source, $dest ) = @_;
- unlink ( $dest );
- rmdir ( $dest );
- return ! symlink ( $source, $dest ) ;
+ unlink($dest);
+ rmdir($dest);
+ return !symlink( $source, $dest );
}
sub dirname {
@@ -132,11 +131,11 @@
$file =~ s://:/:g;
if ( $file =~ m|/| ) {
- $file =~ s|^(.*)/[^/]+/?$|$1|;
- $file = "." if ( $file =~ /^\s*$/ );
+ $file =~ s|^(.*)/[^/]+/?$|$1|;
+ $file = "." if ( $file =~ /^\s*$/ );
}
else {
- $file = '.';
+ $file = '.';
}
return $file;
@@ -145,144 +144,163 @@
sub Do_moveold ($$) {
my ( $dest, $options ) = @_;
- my $pf_config = Init_PF_CONFIG ();
- 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 )
- }
- }
+ my $pf_config = Init_PF_CONFIG();
+ 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 );
+ }
+ }
}
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;
-
- 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;
- }
-
- my $mode = defined( $ref_section->{'mode'} )
- ? $ref_section->{'mode'}
- : ( ( -d $dest ) ? $DEFAULT_DIRMODE : $DEFAULT_MODE );
- $mode =~ s/^[^0]/0$&/;
-
- if ( fullchmod( eval($mode), $dest, $options ) ) {
- Warn( $CODE->{'OPEN'},
- "unable to change rights to ".$mode." for file ".$dest );
- return 1;
+ 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;
+
+ 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;
+ }
+
+ my $mode
+ = defined( $ref_section->{'mode'} )
+ ? $ref_section->{'mode'}
+ : ( ( -d $dest ) ? $DEFAULT_DIRMODE : $DEFAULT_MODE );
+ $mode =~ s/^[^0]/0$&/;
+
+ if ( fullchmod( eval($mode), $dest, $options ) ) {
+ Warn( $CODE->{'OPEN'},
+ "unable to change rights to " . $mode . " for file " . $dest );
+ return 1;
}
return 0;
}
sub Exec_cmd ($) {
- my ( $cmd ) = @_;
-
- if ( deferredlogsystem ( $cmd ) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to execute [".$cmd."]" );
- return 1;
- }
- return 0;
+ my ($cmd) = @_;
+
+ if ( deferredlogsystem($cmd) ) {
+ Warn( $CODE->{'OPEN'}, "Unable to execute [" . $cmd . "]" );
+ return 1;
+ }
+ return 0;
}
sub Do_on_config ($$$) {
my ( $ref_section, $options, $hash_subst ) = @_;
- if ( $ref_section->{'actiongroup'} ) {
- Log ( "Triggering actiongroup ".$ref_section->{'actiongroup'} ) if ( $options->{'verbose'} );
- return 0;
- }
- if ( ! $options->{'simul'}
- && defined ( $ref_section->{'on_config'} )
- ) {
- return Exec_cmd ( Subst_vars ( $ref_section->{'on_config'}, $hash_subst ) );
- }
+ if ( $ref_section->{'actiongroup'} ) {
+ Log( "Triggering actiongroup " . $ref_section->{'actiongroup'} )
+ if ( $options->{'verbose'} );
+ return 0;
+ }
+ if ( !$options->{'simul'}
+ && defined( $ref_section->{'on_config'} ) )
+ {
+ return Exec_cmd(
+ Subst_vars( $ref_section->{'on_config'}, $hash_subst ) );
+ }
}
sub Do_before_change ($$$) {
my ( $ref_section, $options, $hash_subst ) = @_;
- if ( $ref_section->{'actiongroup'} ) {
- Log ( "Triggering actiongroup ".$ref_section->{'actiongroup'} ) if ( $options->{'verbose'} );
- return 0;
- }
- if ( ! $options->{'simul'}
- && ! $options->{'noaction'}
- && defined ( $ref_section->{'before_change'} )
- ) {
- return Exec_cmd ( Subst_vars ( $ref_section->{'before_change'}, $hash_subst ) );
- }
+ if ( $ref_section->{'actiongroup'} ) {
+ Log( "Triggering actiongroup " . $ref_section->{'actiongroup'} )
+ if ( $options->{'verbose'} );
+ return 0;
+ }
+ if ( !$options->{'simul'}
+ && !$options->{'noaction'}
+ && defined( $ref_section->{'before_change'} ) )
+ {
+ return Exec_cmd(
+ Subst_vars( $ref_section->{'before_change'}, $hash_subst ) );
+ }
}
sub Do_after_change ($$$) {
- my ( $ref_section, $options, $hash_subst ) = @_;
-
- if ( $ref_section->{'actiongroup'} ) {
- Log ( "Triggering actiongroup ".$ref_section->{'actiongroup'} ) if ( $options->{'verbose'} );
- return 0;
- }
- if ( !$options->{'simul'}
- && defined ( $ref_section->{'after_change'} )
- && !$options->{'noaction'}
- ) {
- return Exec_cmd ( Subst_vars ( $ref_section->{'after_change'}, $hash_subst ) );
+ my ( $ref_section, $options, $hash_subst ) = @_;
+
+ if ( $ref_section->{'actiongroup'} ) {
+ Log( "Triggering actiongroup " . $ref_section->{'actiongroup'} )
+ if ( $options->{'verbose'} );
+ return 0;
+ }
+ if ( !$options->{'simul'}
+ && defined( $ref_section->{'after_change'} )
+ && !$options->{'noaction'} )
+ {
+ return Exec_cmd(
+ Subst_vars( $ref_section->{'after_change'}, $hash_subst ) );
}
}
sub Do_on_noaction ($$$) {
- my ( $ref_section, $options, $hash_subst ) = @_;
-
- if ( $ref_section->{'actiongroup'} ) {
- Log ( "Triggering actiongroup ".$ref_section->{'actiongroup'} ) if ( $options->{'verbose'} );
- return 0;
- }
- if ( ! $options->{'simul'}
- && defined ( $ref_section->{'on_noaction'} )
- && $options->{'noaction'}
- ) {
- return Exec_cmd ( Subst_vars ( $ref_section->{'on_noaction'}, $hash_subst ) );
+ my ( $ref_section, $options, $hash_subst ) = @_;
+
+ if ( $ref_section->{'actiongroup'} ) {
+ Log( "Triggering actiongroup " . $ref_section->{'actiongroup'} )
+ if ( $options->{'verbose'} );
+ return 0;
+ }
+ if ( !$options->{'simul'}
+ && defined( $ref_section->{'on_noaction'} )
+ && $options->{'noaction'} )
+ {
+ return Exec_cmd(
+ Subst_vars( $ref_section->{'on_noaction'}, $hash_subst ) );
}
}
sub Mk_dest_dir ($) {
- my ( $dir ) = @_;
-
- $dir =~ s://:/:g; # supprimer // sinon ca marche moins bien
- $dir =~ s:/[^/]+/*$::;
- my $dir2 = $dir;
- while ( $dir2 ne "" && !-e $dir2 ) {
- $dir2 =~ s:/[^/]+/*$::;
- }
- if ( $dir2 ne "" && -e $dir2 && !-d $dir2 ) {
- unlink($dir2);
- }
- $dir && return system( "/bin/mkdir -p '" . $dir . "' >/dev/null 2>&1" );
+ my ($dir) = @_;
+
+ $dir =~ s://:/:g; # supprimer // sinon ca marche moins bien
+ $dir =~ s:/[^/]+/*$::;
+ my $dir2 = $dir;
+ while ( $dir2 ne "" && !-e $dir2 ) {
+ $dir2 =~ s:/[^/]+/*$::;
+ }
+ if ( $dir2 ne "" && -e $dir2 && !-d $dir2 ) {
+ unlink($dir2);
+ }
+ $dir && return system( "/bin/mkdir -p '" . $dir . "' >/dev/null 2>&1" );
}
sub Get_tmp_dest ($) {
- my ( $dest ) = @_;
-
- my $pf_config = Init_PF_CONFIG ();
- my $tmp = $pf_config->{'path'}->{'checkout_dir'} . "/tmp/" . $dest;
- Mk_dest_dir ( $tmp );
- if ( -d $tmp ) {
- rmdir( $tmp );
- }
- elsif ( -e $tmp ) {
- unlink ( $tmp );
- }
- return $tmp;
-}
-
+ my ($dest) = @_;
+
+ my $pf_config = Init_PF_CONFIG();
+ my $tmp = $pf_config->{'path'}->{'checkout_dir'} . "/tmp/" . $dest;
+ Mk_dest_dir($tmp);
+ if ( -d $tmp ) {
+ rmdir($tmp);
+ }
+ elsif ( -e $tmp ) {
+ unlink($tmp);
+ }
+ return $tmp;
+}
1;
Modified: branches/next-gen/lib/PFTools/Update/Createfile.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Update/Createfile.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Update/Createfile.pm (original)
+++ branches/next-gen/lib/PFTools/Update/Createfile.pm Tue Sep 7 08:54:37 2010
@@ -27,8 +27,8 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Createfile_depends
- Createfile_action
+ Createfile_depends
+ Createfile_action
);
our @EXPORT_OK = qw();
@@ -38,86 +38,93 @@
use PFTools::Conf;
use PFTools::Update::Common;
+sub Createfile_depends ($$$) {
+ my ( $ref_section, $dest, $options ) = @_;
-sub Createfile_depends ($$$) {
- my ( $ref_section, $dest, $options ) = @_;
-
- while ( $dest ne "/" && $dest ne "." ) {
- $ref_section->{'depends'} .= " " . dirname($dest);
- $dest = dirname($dest);
- }
+ 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 ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
- my $cmp = 0;
+ 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;
- }
- }
- }
+ 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( Subst_vars( $ref_section->{'source'}, $hash_subst ), $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;
+ my $source
+ = Get_source( Subst_vars( $ref_section->{'source'}, $hash_subst ),
+ $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;
Modified: branches/next-gen/lib/PFTools/Update/Installpkg.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Update/Installpkg.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Update/Installpkg.pm (original)
+++ branches/next-gen/lib/PFTools/Update/Installpkg.pm Tue Sep 7 08:54:37 2010
@@ -27,8 +27,8 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Installpkg_depends
- Installpkg_action
+ Installpkg_depends
+ Installpkg_action
);
our @EXPORT_OK = qw();
@@ -37,6 +37,7 @@
use PFTools::Conf;
use PFTools::Packages;
use PFTools::Update::Common;
+
#Librairies Debconf
use Debconf::Db;
use Debconf::Template;
@@ -48,127 +49,152 @@
$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 ;
- }
+ $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;
+ $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;
Modified: branches/next-gen/lib/PFTools/Update/Mkdir.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Update/Mkdir.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Update/Mkdir.pm (original)
+++ branches/next-gen/lib/PFTools/Update/Mkdir.pm Tue Sep 7 08:54:37 2010
@@ -27,8 +27,8 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Mkdir_depends
- Mkdir_action
+ Mkdir_depends
+ Mkdir_action
);
our @EXPORT_OK = qw();
@@ -40,45 +40,45 @@
use PFTools::Conf;
use PFTools::Update::Common;
+sub Mkdir_depends ($$$) {
+ my ( $ref_section, $dest, $options ) = @_;
-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;
- }
+ 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 ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
- my $cmp = 0;
+ 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 );
- if ( deferredlogsystem( "/bin/mkdir -p '" . $dest . "'" ) ) {
- Warn( $CODE->{'OPEN'},
- "Unable to create directory ".$dest );
- 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;
+ $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 );
+ if ( deferredlogsystem( "/bin/mkdir -p '" . $dest . "'" ) ) {
+ Warn( $CODE->{'OPEN'},
+ "Unable to create directory " . $dest );
+ 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;
Modified: branches/next-gen/lib/PFTools/Update/Purgepkg.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Update/Purgepkg.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Update/Purgepkg.pm (original)
+++ branches/next-gen/lib/PFTools/Update/Purgepkg.pm Tue Sep 7 08:54:37 2010
@@ -27,7 +27,7 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Purgepkg_action
+ Purgepkg_action
);
our @EXPORT_OK = qw();
@@ -40,44 +40,49 @@
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;
- }
+ $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;
+ 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;
-};
+ 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;
Modified: branches/next-gen/lib/PFTools/Update/Removedir.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Update/Removedir.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Update/Removedir.pm (original)
+++ branches/next-gen/lib/PFTools/Update/Removedir.pm Tue Sep 7 08:54:37 2010
@@ -27,7 +27,7 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Removedir_action
+ Removedir_action
);
our @EXPORT_OK = qw();
@@ -40,27 +40,27 @@
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;
+ 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;
Modified: branches/next-gen/lib/PFTools/Update/Removefile.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Update/Removefile.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Update/Removefile.pm (original)
+++ branches/next-gen/lib/PFTools/Update/Removefile.pm Tue Sep 7 08:54:37 2010
@@ -27,7 +27,7 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Removefile_action
+ Removefile_action
);
our @EXPORT_OK = qw();
@@ -36,32 +36,30 @@
use PFTools::Conf;
use PFTools::Update::Common;
+sub Removefile_action ($$$$$) {
+ my ( $ref_section, $dest, $options, $hash_subst, $global_config ) = @_;
-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;
+ 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;
Modified: branches/next-gen/lib/PFTools/Utils.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/Utils.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/Utils.pm (original)
+++ branches/next-gen/lib/PFTools/Utils.pm Tue Sep 7 08:54:37 2010
@@ -27,21 +27,21 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- Init_TOOLS
-
- Do_update_from_GLOBAL
- Fix_hosts
- Mk_dhcp
- Mk_interfaces
- Mk_PXE_bootfile
- Mk_sourceslist
- Mk_resolvconf
- Mk_zone_for_site
- Change_kopt_for_hostname
-
- Resolv_hostname_from_DNS
- Resolv_hostname_from_GLOBAL
- Search_and_replace
+ Init_TOOLS
+
+ Do_update_from_GLOBAL
+ Fix_hosts
+ Mk_dhcp
+ Mk_interfaces
+ Mk_PXE_bootfile
+ Mk_sourceslist
+ Mk_resolvconf
+ Mk_zone_for_site
+ Change_kopt_for_hostname
+
+ Resolv_hostname_from_DNS
+ Resolv_hostname_from_GLOBAL
+ Search_and_replace
);
use PFTools::Logger;
@@ -58,8 +58,6 @@
our @EXPORT_OK = qw();
-
-
#########################################################################
# Prototypes : needed by recursive calls
@@ -69,631 +67,798 @@
# Functions
sub Init_TOOLS ($;$$$) {
- my ( $hostname, $pf_config_file, $global_store_file, $reload ) = @_;
- my ( $pf_config, $global_struct );
-
- if ( $pf_config_file && $pf_config_file ne '' ) {
- if ( ! -e $pf_config_file ) {
- Abort ( $CODE->{'OPEN'},
- "Unable to open configuration file ".$pf_config_file." : no such file or directory" );
- }
- $pf_config = Init_PF_CONFIG ( $pf_config_file );
- }
- elsif ( -e '/etc/pf-tools.conf' ) {
- $pf_config = Init_PF_CONFIG ( '/etc/pf-tools.conf' );
- }
- else {
- $pf_config = Init_PF_CONFIG ();
- }
-
- $global_store_file = $pf_config->{'path'}->{'global_struct'} if ( $global_store_file eq '' );
- if ( ! -e $global_store_file || ( defined $reload && $reload ) ) {
-# print "Forcing reload or no storable available\n";
- my $source = Get_source ( 'COMMON:/'.$pf_config->{'path'}->{'start_file'}, $hostname, {}, $pf_config );
- if ( ! -e $source ) {
- Set_deferredlog ();
- if ( ! VCS_update ( $hostname, $pf_config, {} ) ) {
- Abort ( $CODE->{'EXEC'},
- "Unable to checkout configuration from VCS system" );
- }
- Unset_deferredlog ();
- }
- $global_struct = Init_GLOBAL_NETCONFIG ( $source, $hostname, $pf_config );
- Flush2disk_GLOBAL ( $global_struct, $pf_config );
- }
- else {
- $global_struct = Retrieve_GLOBAL ( $global_store_file );
- if ( ! defined $global_struct ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "An error occured during retrieve from the storable file ".$global_store_file );
- }
- }
- return ( $pf_config, $global_struct );
+ my ( $hostname, $pf_config_file, $global_store_file, $reload ) = @_;
+ my ( $pf_config, $global_struct );
+
+ if ( $pf_config_file && $pf_config_file ne '' ) {
+ if ( !-e $pf_config_file ) {
+ Abort( $CODE->{'OPEN'},
+ "Unable to open configuration file "
+ . $pf_config_file
+ . " : no such file or directory" );
+ }
+ $pf_config = Init_PF_CONFIG($pf_config_file);
+ }
+ elsif ( -e '/etc/pf-tools.conf' ) {
+ $pf_config = Init_PF_CONFIG('/etc/pf-tools.conf');
+ }
+ else {
+ $pf_config = Init_PF_CONFIG();
+ }
+
+ $global_store_file = $pf_config->{'path'}->{'global_struct'}
+ if ( $global_store_file eq '' );
+ if ( !-e $global_store_file || ( defined $reload && $reload ) ) {
+
+ # print "Forcing reload or no storable available\n";
+ my $source
+ = Get_source( 'COMMON:/' . $pf_config->{'path'}->{'start_file'},
+ $hostname, {}, $pf_config );
+ if ( !-e $source ) {
+ Set_deferredlog();
+ if ( !VCS_update( $hostname, $pf_config, {} ) ) {
+ Abort( $CODE->{'EXEC'},
+ "Unable to checkout configuration from VCS system" );
+ }
+ Unset_deferredlog();
+ }
+ $global_struct
+ = Init_GLOBAL_NETCONFIG( $source, $hostname, $pf_config );
+ Flush2disk_GLOBAL( $global_struct, $pf_config );
+ }
+ else {
+ $global_struct = Retrieve_GLOBAL($global_store_file);
+ if ( !defined $global_struct ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "An error occured during retrieve from the storable file "
+ . $global_store_file );
+ }
+ }
+ return ( $pf_config, $global_struct );
}
sub Get_kpkg_from_kernel ($$) {
- my ( $pxefilename, $deploymode ) = @_ ;
-
- if ( $deploymode =~ /^ubuntu/ ) {
- $pxefilename =~ /vmlinuz-(.+)$/;
- return "linux-image-".$1;
- }
- else {
- if ( $pxefilename =~ /pxe/ ) {
- my ( $vm, $type, $pxe, $version, @append ) = split ( /-/, $pxefilename ) ;
- return "linux-image-".$version."-".$type."-".join ( "-", @append )."-grsec" ;
- }
- else {
- my ( $vm, $version, $type, $append_version ) = split ( /-/, $pxefilename ) ;
- return "linux-image-".$version."-".$type."-".$append_version."-grsec" ;
- }
- }
+ my ( $pxefilename, $deploymode ) = @_;
+
+ if ( $deploymode =~ /^ubuntu/ ) {
+ $pxefilename =~ /vmlinuz-(.+)$/;
+ return "linux-image-" . $1;
+ }
+ else {
+ if ( $pxefilename =~ /pxe/ ) {
+ my ( $vm, $type, $pxe, $version, @append )
+ = split( /-/, $pxefilename );
+ return
+ "linux-image-"
+ . $version . "-"
+ . $type . "-"
+ . join( "-", @append )
+ . "-grsec";
+ }
+ else {
+ my ( $vm, $version, $type, $append_version )
+ = split( /-/, $pxefilename );
+ return
+ "linux-image-"
+ . $version . "-"
+ . $type . "-"
+ . $append_version
+ . "-grsec";
+ }
+ }
}
sub Build_preseed_filename ($$$$$$) {
- my ( $srv_name, $preseed_tpl, $host_props, $default_preseed, $pf_script, $pf_config ) = @_ ;
-
- if ( ! open ( PRESEED_TPL, $preseed_tpl ) ) {
- Warn ( $CODE->{'OPEN'},
- "Unable to get preseed template from file ".$preseed_tpl );
- return $default_preseed ;
- }
- my $preseed_content = join '', <PRESEED_TPL> ;
- close ( PRESEED_TPL ) ;
- my $kernel_pkg = Get_kpkg_from_kernel ( $host_props->{'boot'}->{'kernel'}, $host_props->{'deployment'}->{'mode'} );
- my $tpl = Template::Tiny->new ( TRIM => 1 );
- my $preseed_subst = {
- 'kernelpkg' => $kernel_pkg,
- 'mode' => $host_props->{'deployment'}->{'mode'},
- 'distrib' => $host_props->{'deployment'}->{'distrib'},
- 'config_script' => $pf_script
- };
- $preseed_content = $tpl->process ( \$preseed_content, $preseed_subst );
-
- if ( ! open ( DST_PRESEED, ">/tmp/tmp_preseed" ) ) {
- Warn ( $CODE->{'OPEN'},
- "Unable to create preseed file /tmp_preseed" );
- return $default_preseed ;
- }
- print DST_PRESEED $preseed_content ;
- close ( DST_PRESEED ) ;
- my $src = "/tmp/tmp_preseed" ;
- my $dst = $pf_config->{'path'}->{'preseed_dir'}."/preseed_".$srv_name ;
- if ( compare ( $src, $dst ) ) {
- move ($src, $dst) ;
- } else {
- if ( ! unlink ( $src ) ) {
- Warn ( $CODE->{'UNLINK'},
- "Unable to unlink source file ".$src );
- }
- }
- return "preseed_".$srv_name ;
+ my ($srv_name, $preseed_tpl, $host_props,
+ $default_preseed, $pf_script, $pf_config
+ ) = @_;
+
+ if ( !open( PRESEED_TPL, $preseed_tpl ) ) {
+ Warn( $CODE->{'OPEN'},
+ "Unable to get preseed template from file " . $preseed_tpl );
+ return $default_preseed;
+ }
+ my $preseed_content = join '', <PRESEED_TPL>;
+ close(PRESEED_TPL);
+ my $kernel_pkg = Get_kpkg_from_kernel(
+ $host_props->{'boot'}->{'kernel'},
+ $host_props->{'deployment'}->{'mode'}
+ );
+ my $tpl = Template::Tiny->new( TRIM => 1 );
+ my $preseed_subst = {
+ 'kernelpkg' => $kernel_pkg,
+ 'mode' => $host_props->{'deployment'}->{'mode'},
+ 'distrib' => $host_props->{'deployment'}->{'distrib'},
+ 'config_script' => $pf_script
+ };
+ $preseed_content = $tpl->process( \$preseed_content, $preseed_subst );
+
+ if ( !open( DST_PRESEED, ">/tmp/tmp_preseed" ) ) {
+ Warn( $CODE->{'OPEN'}, "Unable to create preseed file /tmp_preseed" );
+ return $default_preseed;
+ }
+ print DST_PRESEED $preseed_content;
+ close(DST_PRESEED);
+ my $src = "/tmp/tmp_preseed";
+ my $dst = $pf_config->{'path'}->{'preseed_dir'} . "/preseed_" . $srv_name;
+ if ( compare( $src, $dst ) ) {
+ move( $src, $dst );
+ }
+ else {
+ if ( !unlink($src) ) {
+ Warn( $CODE->{'UNLINK'}, "Unable to unlink source file " . $src );
+ }
+ }
+ return "preseed_" . $srv_name;
}
sub Get_MD5SUM_for_preseedfile ($$) {
- my ( $filename, $pf_config ) = @_;
- my ( $md5, $hdl );
-
- $md5 = Digest::MD5->new;
- open $hdl, $pf_config->{'path'}->{'preseed_dir'}."/".$filename || return undef;
- $md5->addfile ( $hdl );
- my $md5sum = $md5->hexdigest;
- close ( $hdl );
- return $md5sum;
+ my ( $filename, $pf_config ) = @_;
+ my ( $md5, $hdl );
+
+ $md5 = Digest::MD5->new;
+ open $hdl, $pf_config->{'path'}->{'preseed_dir'} . "/" . $filename
+ || return undef;
+ $md5->addfile($hdl);
+ my $md5sum = $md5->hexdigest;
+ close($hdl);
+ return $md5sum;
}
sub Mk_PXE_bootfile ($$$$$$$) {
- my ( $hostname, $host_props, $pxe_tpl, $preseed_tpl, $default_preseed, $pf_script, $pf_config ) = @_;
-
- my $iface = Get_iface_vlan_from_hostname ( $host_props->{'deployment'}->{'dhcpvlan'}, $host_props );
- my $mac = $host_props->{'interfaces'}->{$iface}->{'mac'};
- my $pxe_boot_file = $mac;
- $pxe_boot_file =~ s/\:/\-/g;
-
- if ( ! -e $pxe_tpl ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unable to open PXE template file ".$pxe_tpl." : no such file or directory" );
- }
- elsif ( ! open ( PXETPL, $pxe_tpl ) ) {
- Abort ( $CODE->{'OPEN'},
- "Unable to open PXE template file ".$pxe_tpl );
- }
- my $content_pxe = join ( "", <PXETPL> );
- close ( PXETPL );
- my $preseed = Build_preseed_filename ( $hostname, $preseed_tpl, $host_props, $default_preseed, $pf_script, $pf_config );
- my $preseed_md5 = Get_MD5SUM_for_preseedfile ( $preseed, $pf_config );
- my $tpl = Template::Tiny->new ( TRIM => 1 );
- my $pxe_subst = {
- 'iface' => $iface,
- 'mode' => $host_props->{'deployment'}->{'mode'}.'-installer',
- 'arch' => $host_props->{'deployment'}->{'arch'},
- 'distrib' => $host_props->{'deployment'}->{'distrib'},
- 'serial_speed' => '115200',
- 'preseed_url' => $preseed,
- 'preseed_md5' => $preseed_md5,
- 'console' => $host_props->{'boot'}->{'console'},
- 'install_cmdline' => $host_props->{'boot'}->{'cmdline'},
- 'cmdline' => join ( " ", Get_cmdline_from_hostprops ( $host_props ) ),
- 'kernel' => $host_props->{'boot'}->{'kernel'}
- };
- if ( $host_props->{'boot'}->{'initrd'} ) {
- $pxe_subst->{'initrd'} = $host_props->{'boot'}->{'initrd'};
- }
- else {
- $content_pxe =~ s/initrd=(([^\/]+\/)+)?\[%\s*initrd\s*%\]//gs ;
- }
- $content_pxe = $tpl->process ( \$content_pxe, $pxe_subst );
- if ( ! open ( PXETMP, ">/tmp/tmp_pxe" ) ) {
- Warn ( $CODE->{'OPEN'},
- "Unable to open temporary PXE file /tmp/tmp_pxe" );
- return undef;
- }
- print PXETMP $content_pxe;
- close ( PXETMP );
- my $src = "/tmp/tmp_pxe" ;
- my $dst = $pf_config->{'path'}->{'pxefiles_dir'}."/".$pxe_boot_file ;
- if ( compare ( $src, $dst ) ) {
- move ($src, $dst) ;
- } else {
- if ( ! unlink ( $src ) ) {
- Warn ( $CODE->{'UNLINK'},
- "Unable to unlink source file ".$src );
- }
- }
- return $pxe_boot_file;
+ my ( $hostname, $host_props, $pxe_tpl, $preseed_tpl, $default_preseed,
+ $pf_script, $pf_config )
+ = @_;
+
+ my $iface = Get_iface_vlan_from_hostname(
+ $host_props->{'deployment'}->{'dhcpvlan'}, $host_props );
+ my $mac = $host_props->{'interfaces'}->{$iface}->{'mac'};
+ my $pxe_boot_file = $mac;
+ $pxe_boot_file =~ s/\:/\-/g;
+
+ if ( !-e $pxe_tpl ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unable to open PXE template file "
+ . $pxe_tpl
+ . " : no such file or directory" );
+ }
+ elsif ( !open( PXETPL, $pxe_tpl ) ) {
+ Abort( $CODE->{'OPEN'},
+ "Unable to open PXE template file " . $pxe_tpl );
+ }
+ my $content_pxe = join( "", <PXETPL> );
+ close(PXETPL);
+ my $preseed = Build_preseed_filename(
+ $hostname, $preseed_tpl, $host_props,
+ $default_preseed, $pf_script, $pf_config
+ );
+ my $preseed_md5 = Get_MD5SUM_for_preseedfile( $preseed, $pf_config );
+ my $tpl = Template::Tiny->new( TRIM => 1 );
+ my $pxe_subst = {
+ 'iface' => $iface,
+ 'mode' => $host_props->{'deployment'}->{'mode'} . '-installer',
+ 'arch' => $host_props->{'deployment'}->{'arch'},
+ 'distrib' => $host_props->{'deployment'}->{'distrib'},
+ 'serial_speed' => '115200',
+ 'preseed_url' => $preseed,
+ 'preseed_md5' => $preseed_md5,
+ 'console' => $host_props->{'boot'}->{'console'},
+ 'install_cmdline' => $host_props->{'boot'}->{'cmdline'},
+ 'cmdline' => join( " ", Get_cmdline_from_hostprops($host_props) ),
+ 'kernel' => $host_props->{'boot'}->{'kernel'}
+ };
+ if ( $host_props->{'boot'}->{'initrd'} ) {
+ $pxe_subst->{'initrd'} = $host_props->{'boot'}->{'initrd'};
+ }
+ else {
+ $content_pxe =~ s/initrd=(([^\/]+\/)+)?\[%\s*initrd\s*%\]//gs;
+ }
+ $content_pxe = $tpl->process( \$content_pxe, $pxe_subst );
+ if ( !open( PXETMP, ">/tmp/tmp_pxe" ) ) {
+ Warn( $CODE->{'OPEN'},
+ "Unable to open temporary PXE file /tmp/tmp_pxe" );
+ return undef;
+ }
+ print PXETMP $content_pxe;
+ close(PXETMP);
+ my $src = "/tmp/tmp_pxe";
+ my $dst = $pf_config->{'path'}->{'pxefiles_dir'} . "/" . $pxe_boot_file;
+ if ( compare( $src, $dst ) ) {
+ move( $src, $dst );
+ }
+ else {
+ if ( !unlink($src) ) {
+ Warn( $CODE->{'UNLINK'}, "Unable to unlink source file " . $src );
+ }
+ }
+ return $pxe_boot_file;
}
###############################################################
### Building zone file for IPv4 entries
sub __Mk_zoneheader ($$$) {
- my ( $zone_name, $zone_site, $zone_part ) = @_;
- my $zone_result = [];
-
- # SOA
- push ( @{$zone_result}, ";;" );
- push ( @{$zone_result}, ";; BIND configuration file for zone : ".$zone_name );
- push ( @{$zone_result}, ";; Site : ".$zone_site );
- push ( @{$zone_result}, ";;" );
- push ( @{$zone_result}, ";; ".$zone_part->{'SOA'}->{'comment'} );
- push ( @{$zone_result}, ";;============================================================================\n" );
- push ( @{$zone_result}, sprintf ( "\$TTL %s", $zone_part->{'SOA'}->{'ttl'} ) );
- push ( @{$zone_result}, sprintf ( "%-29s IN SOA\t%s %s (", '@', $zone_part->{'SOA'}->{'soa'}, $zone_part->{'SOA'}->{'mail'} ) );
- my $serial = ( $zone_part->{'SOA'}->{'serial'} eq 'AUTO' ) ? time."\t; Serial" : $zone_part->{'SOA'}->{'serial'};
- push ( @{$zone_result}, sprintf ( "%-30s%s", '', $serial ) );
- foreach my $spec ( 'refresh', 'retry', 'expire', 'negttl' ) {
- push ( @{$zone_result}, sprintf ( "%-30s%s", '', $zone_part->{'SOA'}->{$spec} ));
- }
- push ( @{$zone_result}, sprintf "%-30s%s\n", '', ')' );
- # NS fields
- foreach my $nameserver ( @{ $zone_part->{'SOA'}->{'@ns'} } ) {
- push ( @{$zone_result}, sprintf ( "%-29s IN NS\t%s", '', $nameserver ) );
- }
- push ( @{$zone_result}, "" );
- # MX fields
- foreach my $mx ( @{ $zone_part->{'SOA'}->{'@mx'} } ) {
- push ( @{$zone_result}, sprintf ( "%-29s IN MX\t%s", '', $mx ) );
- }
- push ( @{$zone_result}, "\n" );
- return $zone_result;
+ my ( $zone_name, $zone_site, $zone_part ) = @_;
+ my $zone_result = [];
+
+ # SOA
+ push( @{$zone_result}, ";;" );
+ push(
+ @{$zone_result},
+ ";; BIND configuration file for zone : " . $zone_name
+ );
+ push( @{$zone_result}, ";; Site : " . $zone_site );
+ push( @{$zone_result}, ";;" );
+ push( @{$zone_result}, ";; " . $zone_part->{'SOA'}->{'comment'} );
+ push(
+ @{$zone_result},
+ ";;============================================================================\n"
+ );
+ push(
+ @{$zone_result},
+ sprintf( "\$TTL %s", $zone_part->{'SOA'}->{'ttl'} )
+ );
+ push(
+ @{$zone_result},
+ sprintf(
+ "%-29s IN SOA\t%s %s (",
+ '@', $zone_part->{'SOA'}->{'soa'},
+ $zone_part->{'SOA'}->{'mail'}
+ )
+ );
+ my $serial
+ = ( $zone_part->{'SOA'}->{'serial'} eq 'AUTO' )
+ ? time . "\t; Serial"
+ : $zone_part->{'SOA'}->{'serial'};
+ push( @{$zone_result}, sprintf( "%-30s%s", '', $serial ) );
+
+ foreach my $spec ( 'refresh', 'retry', 'expire', 'negttl' ) {
+ push(
+ @{$zone_result},
+ sprintf( "%-30s%s", '', $zone_part->{'SOA'}->{$spec} )
+ );
+ }
+ push( @{$zone_result}, sprintf "%-30s%s\n", '', ')' );
+
+ # NS fields
+ foreach my $nameserver ( @{ $zone_part->{'SOA'}->{'@ns'} } ) {
+ push( @{$zone_result},
+ sprintf( "%-29s IN NS\t%s", '', $nameserver ) );
+ }
+ push( @{$zone_result}, "" );
+
+ # MX fields
+ foreach my $mx ( @{ $zone_part->{'SOA'}->{'@mx'} } ) {
+ push( @{$zone_result}, sprintf( "%-29s IN MX\t%s", '', $mx ) );
+ }
+ push( @{$zone_result}, "\n" );
+ return $zone_result;
}
sub Mk_zone_for_site ($$$) {
my ( $zone_name, $zone_site, $global_config ) = @_;
- my $zone_result = [];
-
- # Building Header (SOA, NS an MX fileds)
- $zone_result = __Mk_zoneheader( $zone_name, $zone_site, $global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name} );
- my $zone_part = $global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name}->{'BY_SITE'}->{$zone_site};
-
- ### Building Networks part
- push ( @{$zone_result}, ";;" );
- push ( @{$zone_result}, ";; Networks" );
- push ( @{$zone_result}, ";;============================================================================\n" );
-
- foreach my $network ( @{$global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name}->{'__network_order'}->{$zone_site}} ) {
- my $head = $network;
- $head .= " : ".$zone_part->{$network}->{'comment'} if ( $zone_part->{$network}->{'comment'} );
- push ( @{$zone_result}, "; ".$head );
- push ( @{$zone_result}, ";----------------------------------------------------------------------------" );
- foreach my $spec ( 'network', 'netmask', 'broadcast', 'gateway' ) {
- next if ( ! defined $zone_part->{$network}->{$spec} );
- push ( @{$zone_result}, sprintf ( "%-29s IN %s", $spec.".".$network, $zone_part->{$network}->{$spec} ) );
- }
- push ( @{$zone_result}, "" );
- }
-
- ### Servers
- push ( @{$zone_result}, "\n\n;;" );
- push ( @{$zone_result}, ";; Servers" );
- push ( @{$zone_result}, ";;============================================================================\n" );
-
- foreach my $server ( @{$global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name}->{'__hostclass_order'}->{$zone_site}} ) {
- my $head = $server;
- $head .= " : ".$zone_part->{$server}->{'comment'} if ( $zone_part->{$server}->{'comment'} );
- push ( @{$zone_result}, "; ".$head );
- push ( @{$zone_result}, ";----------------------------------------------------------------------------" );
- foreach my $field ( sort keys %{$zone_part->{$server}} ) {
- next if ( $field eq 'comment' );
- if ( ref $zone_part->{$server}->{$field} eq 'ARRAY' ) {
- foreach my $elt ( @{$zone_part->{$server}->{$field}} ) {
- push ( @{$zone_result}, sprintf ( "%-29s IN %s", $field, $elt ) );
- }
- }
- else {
- push ( @{$zone_result}, sprintf ( "%-29s IN %s", $field, $zone_part->{$server}->{$field} ) );
- }
- }
- push ( @{$zone_result}, "" );
- }
- return $zone_result;
+ my $zone_result = [];
+
+ # Building Header (SOA, NS an MX fileds)
+ $zone_result = __Mk_zoneheader( $zone_name, $zone_site,
+ $global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name} );
+ my $zone_part
+ = $global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name}->{'BY_SITE'}
+ ->{$zone_site};
+
+ ### Building Networks part
+ push( @{$zone_result}, ";;" );
+ push( @{$zone_result}, ";; Networks" );
+ push(
+ @{$zone_result},
+ ";;============================================================================\n"
+ );
+
+ foreach my $network (
+ @{ $global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name}
+ ->{'__network_order'}->{$zone_site}
+ }
+ )
+ {
+ my $head = $network;
+ $head .= " : " . $zone_part->{$network}->{'comment'}
+ if ( $zone_part->{$network}->{'comment'} );
+ push( @{$zone_result}, "; " . $head );
+ push(
+ @{$zone_result},
+ ";----------------------------------------------------------------------------"
+ );
+ foreach my $spec ( 'network', 'netmask', 'broadcast', 'gateway' ) {
+ next if ( !defined $zone_part->{$network}->{$spec} );
+ push(
+ @{$zone_result},
+ sprintf( "%-29s IN %s",
+ $spec . "." . $network,
+ $zone_part->{$network}->{$spec} )
+ );
+ }
+ push( @{$zone_result}, "" );
+ }
+
+ ### Servers
+ push( @{$zone_result}, "\n\n;;" );
+ push( @{$zone_result}, ";; Servers" );
+ push(
+ @{$zone_result},
+ ";;============================================================================\n"
+ );
+
+ foreach my $server (
+ @{ $global_config->{'ZONE'}->{'BY_NAME'}->{$zone_name}
+ ->{'__hostclass_order'}->{$zone_site}
+ }
+ )
+ {
+ my $head = $server;
+ $head .= " : " . $zone_part->{$server}->{'comment'}
+ if ( $zone_part->{$server}->{'comment'} );
+ push( @{$zone_result}, "; " . $head );
+ push(
+ @{$zone_result},
+ ";----------------------------------------------------------------------------"
+ );
+ foreach my $field ( sort keys %{ $zone_part->{$server} } ) {
+ next if ( $field eq 'comment' );
+ if ( ref $zone_part->{$server}->{$field} eq 'ARRAY' ) {
+ foreach my $elt ( @{ $zone_part->{$server}->{$field} } ) {
+ push(
+ @{$zone_result},
+ sprintf( "%-29s IN %s", $field, $elt )
+ );
+ }
+ }
+ else {
+ push(
+ @{$zone_result},
+ sprintf( "%-29s IN %s",
+ $field, $zone_part->{$server}->{$field} )
+ );
+ }
+ }
+ push( @{$zone_result}, "" );
+ }
+ return $zone_result;
}
sub Mk_resolvconf ($$$$) {
- my ( $hostname, $global_config, $site, $output ) = @_;
-
- my $host_props = Get_host_config_from_CONFIG ( $hostname, $global_config, $site );
- if ( ! defined $host_props ) {
- Warn ( $CODE->{'UNDEF_KEY'},
- "Unable to find hostname ".$hostname." on site ".$site." : no such host definition" );
- return 0;
- }
- my $domain = Get_zone_from_hostname ( $hostname, $global_config, $site );
- if ( ! defined $domain ) {
- Warn ( $CODE->{'UNDEF_KEY'},
- "Unable to get domain from hostname ".$domain );
- return 0;
- }
-
- my @dns = split ( /\s*,\s*/, $host_props->{'dns'}->{'resolver'} );
-
- unless ( open ( OUTPUT, ">".$output ) ) {
- Warn ( $CODE->{'OPEN'},
- "Unable to open output file ".$output );
- return 0;
- }
- print OUTPUT "###############################################\n";
- print OUTPUT "# This file was auto-genrated by mk_resolvconf\n";
- print OUTPUT "\n";
- print OUTPUT "search ".$domain."\n";
- foreach my $dns (@dns) {
- my $resolved = Resolv ( 'cnf', $dns, $global_config, $site );
- foreach my $ip ( @{$resolved} ) {
- print OUTPUT "nameserver ".$ip."\n";
- }
- }
- close ( OUTPUT );
- return 1;
+ my ( $hostname, $global_config, $site, $output ) = @_;
+
+ my $host_props
+ = Get_host_config_from_CONFIG( $hostname, $global_config, $site );
+ if ( !defined $host_props ) {
+ Warn( $CODE->{'UNDEF_KEY'},
+ "Unable to find hostname "
+ . $hostname
+ . " on site "
+ . $site
+ . " : no such host definition" );
+ return 0;
+ }
+ my $domain = Get_zone_from_hostname( $hostname, $global_config, $site );
+ if ( !defined $domain ) {
+ Warn( $CODE->{'UNDEF_KEY'},
+ "Unable to get domain from hostname " . $domain );
+ return 0;
+ }
+
+ my @dns = split( /\s*,\s*/, $host_props->{'dns'}->{'resolver'} );
+
+ unless ( open( OUTPUT, ">" . $output ) ) {
+ Warn( $CODE->{'OPEN'}, "Unable to open output file " . $output );
+ return 0;
+ }
+ print OUTPUT "###############################################\n";
+ print OUTPUT "# This file was auto-genrated by mk_resolvconf\n";
+ print OUTPUT "\n";
+ print OUTPUT "search " . $domain . "\n";
+ foreach my $dns (@dns) {
+ my $resolved = Resolv( 'cnf', $dns, $global_config, $site );
+ foreach my $ip ( @{$resolved} ) {
+ print OUTPUT "nameserver " . $ip . "\n";
+ }
+ }
+ close(OUTPUT);
+ return 1;
}
sub Resolv ($$;$$$) {
- my ( $type_resolve, $hostname, $global_config, $site, $hosttype ) = @_;
-
- if ( $type_resolve eq 'cnf' ) {
- if ( ! defined $site ) {
- my $ref_site_list = Get_site_from_hostname ( $hostname, $global_config );
- if ( ! defined $ref_site_list ) {
- Warn ( $CODE->{'UNDEF_KEY'},
- "Hostname ".$hostname." is not defined into the global configuration" );
- return undef;
- }
- elsif ( scalar @{$ref_site_list} > 1 ) {
- Warn ( $CODE->{'DUPLICATE_VALUE'},
- "Hostname ".$hostname." is defined into multiple sites : unable to choose the right one" );
- }
- else {
- ( $site ) = @{$ref_site_list};
- }
- }
- my $zone = Get_zone_from_hostname ( $hostname, $global_config, $site );
- $hostname =~ s/\.$zone$//;
- $hostname =~ /^([^.]+)(\.([^.]+))?$/;
- my ( $hostshort, $hostvlan ) = ( $1, $3 );
- if ( ! defined $hosttype && $hostname !~ /^(network|netmask|broadcast|gateway)/ ) {
- $hosttype = Get_hosttype_from_hostname ( $hostshort, $global_config, $site );
- return undef if ( ! defined $hosttype );
- }
- return Resolv_hostname_from_GLOBAL ( $hostname, $global_config, $site, $zone, $hosttype );
- }
- else {
- return Resolv_hostname_from_DNS ( $hostname );
- }
+ my ( $type_resolve, $hostname, $global_config, $site, $hosttype ) = @_;
+
+ if ( $type_resolve eq 'cnf' ) {
+ if ( !defined $site ) {
+ my $ref_site_list
+ = Get_site_from_hostname( $hostname, $global_config );
+ if ( !defined $ref_site_list ) {
+ Warn( $CODE->{'UNDEF_KEY'},
+ "Hostname "
+ . $hostname
+ . " is not defined into the global configuration" );
+ return undef;
+ }
+ elsif ( scalar @{$ref_site_list} > 1 ) {
+ Warn( $CODE->{'DUPLICATE_VALUE'},
+ "Hostname "
+ . $hostname
+ . " is defined into multiple sites : unable to choose the right one"
+ );
+ }
+ else {
+ ($site) = @{$ref_site_list};
+ }
+ }
+ my $zone = Get_zone_from_hostname( $hostname, $global_config, $site );
+ $hostname =~ s/\.$zone$//;
+ $hostname =~ /^([^.]+)(\.([^.]+))?$/;
+ my ( $hostshort, $hostvlan ) = ( $1, $3 );
+ if ( !defined $hosttype
+ && $hostname !~ /^(network|netmask|broadcast|gateway)/ )
+ {
+ $hosttype
+ = Get_hosttype_from_hostname( $hostshort, $global_config,
+ $site );
+ return undef if ( !defined $hosttype );
+ }
+ return Resolv_hostname_from_GLOBAL( $hostname, $global_config, $site,
+ $zone, $hosttype );
+ }
+ else {
+ return Resolv_hostname_from_DNS($hostname);
+ }
}
sub __Search_and_resolve_IP ($$$$$$$) {
- my ( $hostname, $site, $line, $separator, $type_resolve, $hash_subst, $global_config ) = @_;
-
- my $zone = $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'zone'};
- my $pos = length $line;
- while (
- substr( $line, 0, $pos ) =~ m/^(.*[^A-Za-z0-9.-])?([A-Za-z0-9.-]+)(\\?)(\.$zone)([^A-Za-z0-9.-].*)?$/
- ) {
- my $before = $1;
- my $back = $3;
- my $match = $2 . $3 . $4;
- my $matchback = $2 . $4;
- my $after = $5;
- my $lengthbefore = defined $before ? length $before : 0;
- if ( $back ne "\\\\" ) {
- my $match2 = $match;
- $match2 =~ s/HOSTNAME/$hostname/;
- $match2 =~ s/POPNAME/$hash_subst->{'POPNAME'}/g;
- my $resolved = Resolv ( $type_resolve, $match2, $global_config, $site );
- if ( scalar $resolved ) {
- if ( $separator eq "DUPLICATE" ) {
- my $templine = "";
- my $templine2;
- foreach my $res ( @{$resolved} ) {
- $templine2 = $line;
- substr ( $templine2, $lengthbefore, length $match ) = $res;
- $templine .= $templine2;
- }
- $line = $templine;
- }
- else {
- substr( $line, $lengthbefore, length $match ) = join( $separator, @{$resolved} );
- }
- $pos = $lengthbefore;
- }
- else {
- $pos = $lengthbefore;
- }
- }
- else {
- substr( $line, $lengthbefore, length $match ) = $matchback;
- $pos = $lengthbefore;
- }
- }
- return $line;
+ my ( $hostname, $site, $line, $separator, $type_resolve, $hash_subst,
+ $global_config )
+ = @_;
+
+ my $zone = $global_config->{'SITE'}->{'BY_NAME'}->{$site}->{'zone'};
+ my $pos = length $line;
+ while (
+ substr( $line, 0, $pos )
+ =~ m/^(.*[^A-Za-z0-9.-])?([A-Za-z0-9.-]+)(\\?)(\.$zone)([^A-Za-z0-9.-].*)?$/
+ )
+ {
+ my $before = $1;
+ my $back = $3;
+ my $match = $2 . $3 . $4;
+ my $matchback = $2 . $4;
+ my $after = $5;
+ my $lengthbefore = defined $before ? length $before : 0;
+ if ( $back ne "\\\\" ) {
+ my $match2 = $match;
+ $match2 =~ s/HOSTNAME/$hostname/;
+ $match2 =~ s/POPNAME/$hash_subst->{'POPNAME'}/g;
+ my $resolved
+ = Resolv( $type_resolve, $match2, $global_config, $site );
+ if ( scalar $resolved ) {
+ if ( $separator eq "DUPLICATE" ) {
+ my $templine = "";
+ my $templine2;
+ foreach my $res ( @{$resolved} ) {
+ $templine2 = $line;
+ substr( $templine2, $lengthbefore, length $match )
+ = $res;
+ $templine .= $templine2;
+ }
+ $line = $templine;
+ }
+ else {
+ substr( $line, $lengthbefore, length $match )
+ = join( $separator, @{$resolved} );
+ }
+ $pos = $lengthbefore;
+ }
+ else {
+ $pos = $lengthbefore;
+ }
+ }
+ else {
+ substr( $line, $lengthbefore, length $match ) = $matchback;
+ $pos = $lengthbefore;
+ }
+ }
+ return $line;
}
sub __Search_and_resolve_IFACE ($$$) {
- my ( $line, $host_props, $hash_subst ) = @_;
-
- my $pos = length $line;
- while (
- substr( $line, 0, $pos )
- =~ m/^(.*[^A-Za-z0-9.-])?(eth([-.:])([A-Za-z0-9-]+))([^A-Za-z0-9.-].*)?$/
- ) {
- my $before = $1;
- my $match = $2;
- my $type = $3;
- my $vlan = $4;
- my $after = $5;
-
- my $lengthbefore = defined $before ? length $before : 0;
-
- my $vlan2 = $vlan;
- $vlan2 =~ s/POPNAME/$hash_subst->{'POPNAME'}/;
-
- my $eth = Get_iface_vlan_from_hostname ( $vlan2, $host_props );
-
- if ( defined $eth ) {
- my $neweth = $eth;
- if ( $type eq "." ) {
- $neweth =~ s/:.*$//;
- }
- elsif ( $type eq "-" ) {
- $neweth =~ s/[.:].*$//;
- }
- substr( $line, $lengthbefore, length $match ) = $neweth;
- $pos = $lengthbefore;
- }
- else {
- $pos = $lengthbefore;
- }
- }
- return $line;
+ my ( $line, $host_props, $hash_subst ) = @_;
+
+ my $pos = length $line;
+ while (
+ substr( $line, 0, $pos )
+ =~ m/^(.*[^A-Za-z0-9.-])?(eth([-.:])([A-Za-z0-9-]+))([^A-Za-z0-9.-].*)?$/
+ )
+ {
+ my $before = $1;
+ my $match = $2;
+ my $type = $3;
+ my $vlan = $4;
+ my $after = $5;
+
+ my $lengthbefore = defined $before ? length $before : 0;
+
+ my $vlan2 = $vlan;
+ $vlan2 =~ s/POPNAME/$hash_subst->{'POPNAME'}/;
+
+ my $eth = Get_iface_vlan_from_hostname( $vlan2, $host_props );
+
+ if ( defined $eth ) {
+ my $neweth = $eth;
+ if ( $type eq "." ) {
+ $neweth =~ s/:.*$//;
+ }
+ elsif ( $type eq "-" ) {
+ $neweth =~ s/[.:].*$//;
+ }
+ substr( $line, $lengthbefore, length $match ) = $neweth;
+ $pos = $lengthbefore;
+ }
+ else {
+ $pos = $lengthbefore;
+ }
+ }
+ return $line;
}
sub Search_and_replace ($$$$$$$;$) {
- my ( $hostname, $site, $input_file, $type_replace, $pf_config, $separator, $global_config, $type_resolve ) = @_;
- my $result = [];
-
- if ( $type_resolve && $type_resolve eq 'cnf' && ! defined $global_config ) {
- Warn ( $CODE->{'UNDEF_KEY'},
- "Unable top resolve from configuration structure which is not defined" );
- return undef;
- }
- my $hosttype = Get_hosttype_from_hostname ( $hostname, $global_config, $site );
- my $subst = Init_SUBST ( $hostname, $hosttype, $pf_config );
- my $host_props = Get_host_config_from_CONFIG ( $hostname, $global_config, $site );
-
- unless ( open ( SRC, $input_file ) ) {
- Warn ( $CODE->{'OPEN'},
- "Unable top open file ".$input_file." : $!" );
- return 0;
- }
- my @src = <SRC>;
- close ( SRC );
-
- foreach my $line ( @src ) {
- if ( $type_replace eq 'resolver' ) {
- $line = __Search_and_resolve_IP ( $hostname, $site, $line, $separator, $type_resolve, $subst, $global_config );
- }
- elsif ( $type_replace eq 'iface' ) {
- $line = __Search_and_resolve_IFACE ( $line, $host_props, $subst );
- }
- elsif ( $type_replace eq 'distrib' ) {
- $line =~ s/%DISTSRC%/$host_props->{'deployment'}->{'mode'}/gs ;
- $line =~ s/%DISTRIB%/$host_props->{'deployment'}->{'distrib'}/gs ;
- }
- push ( @{$result}, $line );
- }
- return $result;
+ my ( $hostname, $site, $input_file, $type_replace, $pf_config, $separator,
+ $global_config, $type_resolve )
+ = @_;
+ my $result = [];
+
+ if ( $type_resolve && $type_resolve eq 'cnf' && !defined $global_config )
+ {
+ Warn( $CODE->{'UNDEF_KEY'},
+ "Unable top resolve from configuration structure which is not defined"
+ );
+ return undef;
+ }
+ my $hosttype
+ = Get_hosttype_from_hostname( $hostname, $global_config, $site );
+ my $subst = Init_SUBST( $hostname, $hosttype, $pf_config );
+ my $host_props
+ = Get_host_config_from_CONFIG( $hostname, $global_config, $site );
+
+ unless ( open( SRC, $input_file ) ) {
+ Warn( $CODE->{'OPEN'},
+ "Unable top open file " . $input_file . " : $!" );
+ return 0;
+ }
+ my @src = <SRC>;
+ close(SRC);
+
+ foreach my $line (@src) {
+ if ( $type_replace eq 'resolver' ) {
+ $line = __Search_and_resolve_IP( $hostname, $site, $line,
+ $separator, $type_resolve, $subst, $global_config );
+ }
+ elsif ( $type_replace eq 'iface' ) {
+ $line = __Search_and_resolve_IFACE( $line, $host_props, $subst );
+ }
+ elsif ( $type_replace eq 'distrib' ) {
+ $line =~ s/%DISTSRC%/$host_props->{'deployment'}->{'mode'}/gs;
+ $line =~ s/%DISTRIB%/$host_props->{'deployment'}->{'distrib'}/gs;
+ }
+ push( @{$result}, $line );
+ }
+ return $result;
}
sub Fix_hosts ($$$$$$) {
- my ( $hostname, $input_file, $site, $ip_type, $global_config, $pf_config ) = @_ ;
- my $tmp_hosts = [];
-
- if ( $ip_type !~ /^ipv4$/ ) {
- Warn ( $CODE->{'INVALID_VALUE'},
- $ip_type." is not implemented for fixing ".$input_file );
- return undef;
- }
- unless ( open ( HOSTS, $input_file ) ) {
- Warn ( $CODE->{'OPEN'},
- "Unable top open ".$input_file."\n" );
- return 0 ;
- }
- @{$tmp_hosts} = <HOSTS> ;
- close ( HOSTS );
-
- my $host_props = Get_host_config_from_CONFIG ( $hostname, $global_config, $site );
- my $iface_dhcpvlan = Get_iface_vlan_from_hostname ( $host_props->{'deployment'}->{'dhcpvlan'}, $host_props );
- my $ip_deploy = $host_props->{'interfaces'}->{$iface_dhcpvlan}->{'ipv4'};
- $ip_deploy =~ s/\/[\d]+$//;
- foreach ( @{$tmp_hosts} ) {
- next if ( ! /$hostname/ ) ;
- s/^127.0.([\d]{1,3}\.[\d]{1,3})/$ip_deploy/ ;
- }
- return $tmp_hosts;
+ my ( $hostname, $input_file, $site, $ip_type, $global_config, $pf_config )
+ = @_;
+ my $tmp_hosts = [];
+
+ if ( $ip_type !~ /^ipv4$/ ) {
+ Warn( $CODE->{'INVALID_VALUE'},
+ $ip_type . " is not implemented for fixing " . $input_file );
+ return undef;
+ }
+ unless ( open( HOSTS, $input_file ) ) {
+ Warn( $CODE->{'OPEN'}, "Unable top open " . $input_file . "\n" );
+ return 0;
+ }
+ @{$tmp_hosts} = <HOSTS>;
+ close(HOSTS);
+
+ my $host_props
+ = Get_host_config_from_CONFIG( $hostname, $global_config, $site );
+ my $iface_dhcpvlan = Get_iface_vlan_from_hostname(
+ $host_props->{'deployment'}->{'dhcpvlan'}, $host_props );
+ my $ip_deploy = $host_props->{'interfaces'}->{$iface_dhcpvlan}->{'ipv4'};
+ $ip_deploy =~ s/\/[\d]+$//;
+ foreach ( @{$tmp_hosts} ) {
+ next if ( !/$hostname/ );
+ s/^127.0.([\d]{1,3}\.[\d]{1,3})/$ip_deploy/;
+ }
+ return $tmp_hosts;
}
sub Mk_dhcp ($$) {
- my ( $header_file, $site_part ) = @_;
- my $dhcp = [];
-
- if ( $header_file ne '' ) {
- if ( ! -e $header_file ) {
- Abort ( $CODE->{'OPEN'},
- "Unable to open DHCP header file ".$header_file." : no such file or directory" );
- }
- elsif ( ! open ( HEAD, $header_file ) ) {
- Abort ( $CODE->{'OPEN'},
- "Unable to open DHCP header file ".$header_file );
- }
- foreach ( <HEAD> ) {
- chomp;
- push ( @{$dhcp}, $_ );
- }
- close ( HEAD );
- }
-
- foreach my $vlan ( keys %{$site_part} ) {
- push ( @{$dhcp}, "subnet ".$site_part->{$vlan}->{'subnet'}
- ." netmask ".$site_part->{$vlan}->{'netmask'}." {" );
- if ( $site_part->{$vlan}->{'routers'} ) {
- push ( @{$dhcp}, "\toption routers ".$site_part->{$vlan}->{'routers'}.";", '' );
- }
- foreach my $hostclass ( keys %{$site_part->{$vlan}} ) {
- next if ( $hostclass =~ /^(subnet|netmask|routers)$/);
- my $host_part = $site_part->{$vlan}->{$hostclass};
- foreach my $host ( keys %{$host_part} ) {
- push ( @{$dhcp}, "\thost ".$host." {");
- foreach my $def ( @{$host_part->{$host}} ) {
- push ( @{$dhcp}, "\t\t".$def );
- }
- push ( @{$dhcp}, "\t}" );
- }
- }
- push ( @{$dhcp}, "}", '' );
- }
- return $dhcp;
+ my ( $header_file, $site_part ) = @_;
+ my $dhcp = [];
+
+ if ( $header_file ne '' ) {
+ if ( !-e $header_file ) {
+ Abort( $CODE->{'OPEN'},
+ "Unable to open DHCP header file "
+ . $header_file
+ . " : no such file or directory" );
+ }
+ elsif ( !open( HEAD, $header_file ) ) {
+ Abort( $CODE->{'OPEN'},
+ "Unable to open DHCP header file " . $header_file );
+ }
+ foreach (<HEAD>) {
+ chomp;
+ push( @{$dhcp}, $_ );
+ }
+ close(HEAD);
+ }
+
+ foreach my $vlan ( keys %{$site_part} ) {
+ push(
+ @{$dhcp},
+ "subnet "
+ . $site_part->{$vlan}->{'subnet'}
+ . " netmask "
+ . $site_part->{$vlan}->{'netmask'} . " {"
+ );
+ if ( $site_part->{$vlan}->{'routers'} ) {
+ push(
+ @{$dhcp},
+ "\toption routers " . $site_part->{$vlan}->{'routers'} . ";",
+ ''
+ );
+ }
+ foreach my $hostclass ( keys %{ $site_part->{$vlan} } ) {
+ next if ( $hostclass =~ /^(subnet|netmask|routers)$/ );
+ my $host_part = $site_part->{$vlan}->{$hostclass};
+ foreach my $host ( keys %{$host_part} ) {
+ push( @{$dhcp}, "\thost " . $host . " {" );
+ foreach my $def ( @{ $host_part->{$host} } ) {
+ push( @{$dhcp}, "\t\t" . $def );
+ }
+ push( @{$dhcp}, "\t}" );
+ }
+ }
+ push( @{$dhcp}, "}", '' );
+ }
+ return $dhcp;
}
sub Mk_sourceslist ($$$$$$$$) {
- my ( $hostname, $site, $dst, $sections, $template, $backports, $global_config, $pf_config ) = @_ ;
-
- my $host_props = Get_host_config_from_CONFIG ( $hostname, $global_config, $site );
- if ( ! defined $host_props ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unable to find hostname ".$hostname." on site ".$site." : no such host definition" );
- }
- my $tpl = Template::Tiny->new ( TRIM => 1 );
- my $mode = $host_props->{'deployment'}->{'mode'};
- if ( $template eq "" ) {
- $template = $pf_config->{'path'}->{'templates_dir'}.'/'.$pf_config->{$mode}->{'sources_list'};
- }
-
- if ( ! open ( SOURCESTPL, $template ) ) {
- Abort ( $CODE->{'OPEN'},
- "Unable to get sources.list template from file ".$template );
- return 1 ;
- }
- my $sources_content = join '', <SOURCESTPL>;
- close ( SOURCESTPL );
-
- my $sources_subst = {
- 'mode' => $host_props->{'deployment'}->{'mode'},
- 'distrib' => $host_props->{'deployment'}->{'distrib'},
- 'default_sections' => $pf_config->{$mode}->{'default_sections'},
- 'custom_sections' => $sections
- };
- $sources_content = $tpl->process ( \$sources_content, $sources_subst );
-
- if ( $backports ) {
- my $back_src = ( $mode eq 'debian' )
- ? $mode."-backports"
- : $mode;
- $sources_content .=
- "\ndeb http://mirrors.private/".$back_src." ".$host_props->{'deployment'}->{'distrib'}."-backports ".$pf_config->{$mode}->{'default_sections'}."\n" ;
- }
-
- if ( ! open ( DST, ">".$dst ) ) {
- warn "Unable to open destination's sources.list ".$dst."\n" ;
- return 1 ;
- }
- print DST $sources_content ;
- close ( DST ) ;
- return 0 ;
+ my ( $hostname, $site, $dst, $sections, $template, $backports,
+ $global_config, $pf_config )
+ = @_;
+
+ my $host_props
+ = Get_host_config_from_CONFIG( $hostname, $global_config, $site );
+ if ( !defined $host_props ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unable to find hostname "
+ . $hostname
+ . " on site "
+ . $site
+ . " : no such host definition" );
+ }
+ my $tpl = Template::Tiny->new( TRIM => 1 );
+ my $mode = $host_props->{'deployment'}->{'mode'};
+ if ( $template eq "" ) {
+ $template = $pf_config->{'path'}->{'templates_dir'} . '/'
+ . $pf_config->{$mode}->{'sources_list'};
+ }
+
+ if ( !open( SOURCESTPL, $template ) ) {
+ Abort( $CODE->{'OPEN'},
+ "Unable to get sources.list template from file " . $template );
+ return 1;
+ }
+ my $sources_content = join '', <SOURCESTPL>;
+ close(SOURCESTPL);
+
+ my $sources_subst = {
+ 'mode' => $host_props->{'deployment'}->{'mode'},
+ 'distrib' => $host_props->{'deployment'}->{'distrib'},
+ 'default_sections' => $pf_config->{$mode}->{'default_sections'},
+ 'custom_sections' => $sections
+ };
+ $sources_content = $tpl->process( \$sources_content, $sources_subst );
+
+ if ($backports) {
+ my $back_src
+ = ( $mode eq 'debian' )
+ ? $mode . "-backports"
+ : $mode;
+ $sources_content
+ .= "\ndeb http://mirrors.private/"
+ . $back_src . " "
+ . $host_props->{'deployment'}->{'distrib'}
+ . "-backports "
+ . $pf_config->{$mode}->{'default_sections'} . "\n";
+ }
+
+ if ( !open( DST, ">" . $dst ) ) {
+ warn "Unable to open destination's sources.list " . $dst . "\n";
+ return 1;
+ }
+ print DST $sources_content;
+ close(DST);
+ return 0;
}
sub Change_kopt_for_hostname ($$$$$$$) {
- my ( $hostname, $site, $grub_src, $dst, $grub_version, $global_config, $pf_config ) = @_;
- my $tmp_grub = [];
- my ( $cmd_line );
-
- my $host_props = Get_host_config_from_CONFIG ( $hostname, $global_config, $site );
- if ( ! defined $host_props ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unable to find hostname ".$hostname." on site ".$site." : no such host definition" );
- }
- my $mode = $host_props->{'deployment'}->{'mode'};
- my ( $cmdline, $bond_cmdline ) = Get_cmdline_from_hostprops ( $host_props );
- $grub_version = "" if ( $grub_version == 1 );
-
- $grub_src = $pf_config->{$mode}->{'grub'.$grub_version} if ( $grub_src eq '' );
- if ( ! -e $grub_src ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unable to modify GRUB option(s) on file ".$grub_src." : no such file or directory" );
- }
-
-
- unless ( open ( MENU, $grub_src ) ) {
- Warn ( $CODE->{'OPEN'},
- "Unable to open current file ".$grub_src." for modifying GRUB option(s)" );
- return 0 ;
- }
- @{$tmp_grub} = <MENU> ;
- close ( MENU );
-
- foreach ( @{$tmp_grub} ) {
- chomp ;
- next if ( $grub_version == 2 && ! /^GRUB_CMDLINE_LINUX_DEFAULT=".*"$/ ) ;
- next if ( $grub_version == 1 && ! /^\# kopt=.*$/ ) ;
- s/\"$/ $cmd_line\"/ if ( defined $cmd_line && ! /\Q$cmd_line\E\"$/ ) ;
- }
- my $tmp_dst = ( $dst eq "-" ) ? $dst : "/tmp/menulst";
- unless ( open ( TMPDST, ">".$tmp_dst ) ) {
- Warn ( $CODE->{'OPEN'},
- "Unable to open temporary destination file /tmp/menulst" );
- return 0 ;
- }
- print TMPDST join ( "\n", @{$tmp_grub} );
- close ( TMPDST ) ;
- if ( $tmp_dst ne "-" ) {
- if ( compare ( $tmp_dst, $dst ) ) {
- return move ( $tmp_dst, $dst) ;
- } else {
- if ( ! unlink ( $tmp_dst ) ) {
- Warn ( $CODE->{'UNLINK'},
- "Unable to unlink source file ".$tmp_dst );
- }
- return 1 ;
- }
- }
+ my ( $hostname, $site, $grub_src, $dst, $grub_version, $global_config,
+ $pf_config )
+ = @_;
+ my $tmp_grub = [];
+ my ($cmd_line);
+
+ my $host_props
+ = Get_host_config_from_CONFIG( $hostname, $global_config, $site );
+ if ( !defined $host_props ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unable to find hostname "
+ . $hostname
+ . " on site "
+ . $site
+ . " : no such host definition" );
+ }
+ my $mode = $host_props->{'deployment'}->{'mode'};
+ my ( $cmdline, $bond_cmdline ) = Get_cmdline_from_hostprops($host_props);
+ $grub_version = "" if ( $grub_version == 1 );
+
+ $grub_src = $pf_config->{$mode}->{ 'grub' . $grub_version }
+ if ( $grub_src eq '' );
+ if ( !-e $grub_src ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unable to modify GRUB option(s) on file "
+ . $grub_src
+ . " : no such file or directory" );
+ }
+
+ unless ( open( MENU, $grub_src ) ) {
+ Warn( $CODE->{'OPEN'},
+ "Unable to open current file "
+ . $grub_src
+ . " for modifying GRUB option(s)" );
+ return 0;
+ }
+ @{$tmp_grub} = <MENU>;
+ close(MENU);
+
+ foreach ( @{$tmp_grub} ) {
+ chomp;
+ next
+ if ( $grub_version == 2 && !/^GRUB_CMDLINE_LINUX_DEFAULT=".*"$/ );
+ next if ( $grub_version == 1 && !/^\# kopt=.*$/ );
+ s/\"$/ $cmd_line\"/ if ( defined $cmd_line && !/\Q$cmd_line\E\"$/ );
+ }
+ my $tmp_dst = ( $dst eq "-" ) ? $dst : "/tmp/menulst";
+ unless ( open( TMPDST, ">" . $tmp_dst ) ) {
+ Warn( $CODE->{'OPEN'},
+ "Unable to open temporary destination file /tmp/menulst" );
+ return 0;
+ }
+ print TMPDST join( "\n", @{$tmp_grub} );
+ close(TMPDST);
+ if ( $tmp_dst ne "-" ) {
+ if ( compare( $tmp_dst, $dst ) ) {
+ return move( $tmp_dst, $dst );
+ }
+ else {
+ if ( !unlink($tmp_dst) ) {
+ Warn( $CODE->{'UNLINK'},
+ "Unable to unlink source file " . $tmp_dst );
+ }
+ return 1;
+ }
+ }
}
#
@@ -703,201 +868,296 @@
# machine $host a partir des informations contenues dans la structure $Z
#
#======================================================================================
-sub Mk_interfaces ($$$;$){
+sub Mk_interfaces ($$$;$) {
my ( $hostname, $global_config, $pf_config, $site ) = @_;
- my $resolve = 0;
- my $properties = Get_host_config_from_CONFIG ( $hostname, $global_config, $site );
- if ( ! defined $properties ) {
- Warn ( $CODE->{'UNDEF_KEY'},
- "Unable to find hostname ".$hostname." on site ".$site." : no such host definition" );
- return undef;
- }
- my $hostclass = $properties->{'deployment'}->{'hosttype'};
- my $interfaces = {};
- my $routes = {};
-
- foreach my $iface ( 'lo', sort keys %{$properties->{'interfaces'}} ) {
- push ( @{$interfaces->{'__order'}}, $iface );
- my $if_part = $properties->{'interfaces'}->{$iface} if ( defined $properties->{'interfaces'}->{$iface});
- push ( @{$interfaces->{$iface}}, "auto ".$iface );
- if ( $if_part->{'method'} ) {
- push ( @{$interfaces->{$iface}}, "iface ".$iface." inet ".$if_part->{'method'} );
- }
- elsif ( $iface eq 'lo' ) {
- push ( @{$interfaces->{$iface}}, "iface ".$iface." inet loopback" );
- }
- else {
- push ( @{$interfaces->{$iface}}, "iface ".$iface." inet static" );
- }
- next if ( ( $if_part->{'method'} && $if_part->{'method'} eq 'dhcp' ) || $iface eq 'lo' );
- foreach my $ip_type ( 'ipv4', 'ipv6' ) {
- next if ( ! $pf_config->{'features'}->{$ip_type} );
- my $suffix = ( $ip_type eq 'ipv6' ) ? '6' : '';
- my $ip = new NetAddr::IP ( $if_part->{$ip_type} );
- push ( @{$interfaces->{$iface}}, "\tslaves\t\t".$if_part->{'slaves'} ) if ( $if_part->{'slaves'} );
- push ( @{$interfaces->{$iface}}, "\taddress\t\t".$ip->addr() );
- push ( @{$interfaces->{$iface}}, "\tnetmask\t\t".$ip->mask() );
- my $net = $ip->network(); push ( @{$interfaces->{$iface}}, "\tnetwork\t\t".$net->addr() );
- my $broad = $ip->broadcast(); push ( @{$interfaces->{$iface}}, "\tbroadcast\t".$broad->addr() );
- foreach my $route ( @{$if_part->{'@route'.$suffix}} ) {
- $route =~ /^([^\s]+)\s*(via ([^\s]+))?$/;
- push ( @{$routes->{$1}}, $iface." ".$route );
- }
- if ( $iface =~ /^([^\.]+)\.\d+$/ ) {
- push ( @{$interfaces->{$iface}}, "\tvlan_raw_device\t".$1 );
- if ( $if_part->{'iface_opt'} && $if_part->{'iface_opt'} !~ /mtu/ ) {
- $if_part->{'iface_opt'} .= ",mtu 1496";
- }
- else {
- $if_part->{'iface_opt'} = "mtu 1496";
- }
- }
- if ( defined $if_part->{'iface_opt'} ) {
- foreach my $option ( split ( /\s*,\s*/, $if_part->{'iface_opt'} ) ) {
- push ( @{$interfaces->{$iface}}, "\tup\t\t/sbin/ip link set ".$iface." ".$option );
- }
- }
-
- }
- }
- foreach my $dest ( keys %{$routes} ) {
- if ( scalar @{$routes->{$dest}} > 1 ) {
- foreach my $entry ( @{$routes->{$dest}} ) {
- my ( $if, $dst, $via, $gw ) = split ( /\s+/, $entry );
- if ( ! defined $gw ) {
- Warn ( $CODE->{'UNDEF_KEY'},
- "Unable to add a route for destination ".$dst." with multiple gateway without gateway definition"
- ." on hostname ".$hostname );
- last;
- }
- push ( @{$interfaces->{$if}}, "\tup\t\t/sbin/ip route add ".$dst." scope global via ".$gw." dev ".$if );
- }
- }
- else {
- my ( $entry ) = @{$routes->{$dest}};
- my ( $if, $dst, $via, $gw ) = split ( /\s+/, $entry );
- if ( $dst eq 'default' ) {
- if ( ! defined $gw ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unable to define default route without gateway defined for interface ".$if." on hostname ".$hostname );
- }
- push ( @{$interfaces->{$if}}, "\tgateway\t\t$gw" );
- }
- else {
- push ( @{$interfaces->{$if}}, "\tup\t\t/sbin/ip route add ".$entry." dev ".$if );
- }
- }
- }
- return $interfaces;
+ my $resolve = 0;
+ my $properties
+ = Get_host_config_from_CONFIG( $hostname, $global_config, $site );
+ if ( !defined $properties ) {
+ Warn( $CODE->{'UNDEF_KEY'},
+ "Unable to find hostname "
+ . $hostname
+ . " on site "
+ . $site
+ . " : no such host definition" );
+ return undef;
+ }
+ my $hostclass = $properties->{'deployment'}->{'hosttype'};
+ my $interfaces = {};
+ my $routes = {};
+
+ foreach my $iface ( 'lo', sort keys %{ $properties->{'interfaces'} } ) {
+ push( @{ $interfaces->{'__order'} }, $iface );
+ my $if_part = $properties->{'interfaces'}->{$iface}
+ if ( defined $properties->{'interfaces'}->{$iface} );
+ push( @{ $interfaces->{$iface} }, "auto " . $iface );
+ if ( $if_part->{'method'} ) {
+ push(
+ @{ $interfaces->{$iface} },
+ "iface " . $iface . " inet " . $if_part->{'method'}
+ );
+ }
+ elsif ( $iface eq 'lo' ) {
+ push(
+ @{ $interfaces->{$iface} },
+ "iface " . $iface . " inet loopback"
+ );
+ }
+ else {
+ push(
+ @{ $interfaces->{$iface} },
+ "iface " . $iface . " inet static"
+ );
+ }
+ next
+ if ( ( $if_part->{'method'} && $if_part->{'method'} eq 'dhcp' )
+ || $iface eq 'lo' );
+ foreach my $ip_type ( 'ipv4', 'ipv6' ) {
+ next if ( !$pf_config->{'features'}->{$ip_type} );
+ my $suffix = ( $ip_type eq 'ipv6' ) ? '6' : '';
+ my $ip = new NetAddr::IP( $if_part->{$ip_type} );
+ push(
+ @{ $interfaces->{$iface} },
+ "\tslaves\t\t" . $if_part->{'slaves'}
+ ) if ( $if_part->{'slaves'} );
+ push( @{ $interfaces->{$iface} }, "\taddress\t\t" . $ip->addr() );
+ push( @{ $interfaces->{$iface} }, "\tnetmask\t\t" . $ip->mask() );
+ my $net = $ip->network();
+ push( @{ $interfaces->{$iface} },
+ "\tnetwork\t\t" . $net->addr() );
+ my $broad = $ip->broadcast();
+ push(
+ @{ $interfaces->{$iface} },
+ "\tbroadcast\t" . $broad->addr()
+ );
+
+ foreach my $route ( @{ $if_part->{ '@route' . $suffix } } ) {
+ $route =~ /^([^\s]+)\s*(via ([^\s]+))?$/;
+ push( @{ $routes->{$1} }, $iface . " " . $route );
+ }
+ if ( $iface =~ /^([^\.]+)\.\d+$/ ) {
+ push( @{ $interfaces->{$iface} },
+ "\tvlan_raw_device\t" . $1 );
+ if ( $if_part->{'iface_opt'}
+ && $if_part->{'iface_opt'} !~ /mtu/ )
+ {
+ $if_part->{'iface_opt'} .= ",mtu 1496";
+ }
+ else {
+ $if_part->{'iface_opt'} = "mtu 1496";
+ }
+ }
+ if ( defined $if_part->{'iface_opt'} ) {
+ foreach
+ my $option ( split( /\s*,\s*/, $if_part->{'iface_opt'} ) )
+ {
+ push(
+ @{ $interfaces->{$iface} },
+ "\tup\t\t/sbin/ip link set " . $iface . " " . $option
+ );
+ }
+ }
+
+ }
+ }
+ foreach my $dest ( keys %{$routes} ) {
+ if ( scalar @{ $routes->{$dest} } > 1 ) {
+ foreach my $entry ( @{ $routes->{$dest} } ) {
+ my ( $if, $dst, $via, $gw ) = split( /\s+/, $entry );
+ if ( !defined $gw ) {
+ Warn( $CODE->{'UNDEF_KEY'},
+ "Unable to add a route for destination "
+ . $dst
+ . " with multiple gateway without gateway definition"
+ . " on hostname "
+ . $hostname );
+ last;
+ }
+ push(
+ @{ $interfaces->{$if} },
+ "\tup\t\t/sbin/ip route add "
+ . $dst
+ . " scope global via "
+ . $gw . " dev "
+ . $if
+ );
+ }
+ }
+ else {
+ my ($entry) = @{ $routes->{$dest} };
+ my ( $if, $dst, $via, $gw ) = split( /\s+/, $entry );
+ if ( $dst eq 'default' ) {
+ if ( !defined $gw ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unable to define default route without gateway defined for interface "
+ . $if
+ . " on hostname "
+ . $hostname );
+ }
+ push( @{ $interfaces->{$if} }, "\tgateway\t\t$gw" );
+ }
+ else {
+ push(
+ @{ $interfaces->{$if} },
+ "\tup\t\t/sbin/ip route add " . $entry . " dev " . $if
+ );
+ }
+ }
+ }
+ return $interfaces;
}
sub __Do_updateloop ($$$$$) {
- my ( $host_config, $options, $hash_subst, $global_config, $sortedkeys ) = @_;
+ my ( $host_config, $options, $hash_subst, $global_config, $sortedkeys )
+ = @_;
my $errorcount = 0;
- foreach my $section (@{$sortedkeys}) {
- next if ( $host_config->{$section}->{'action'} eq 'actiongroup' );
-# if (
+ foreach my $section ( @{$sortedkeys} ) {
+ next if ( $host_config->{$section}->{'action'} eq 'actiongroup' );
+
+# if (
# $host_config->{$section}->{'actiongroup'}
# && ! defined $host_config->{$host_config->{$section}->{'actiongroup'}}
# ) {
# Abort ( $CODE->{'UNDEF_KEY'},
# "Unable to trigger an actiongroup which is not defined into configuration" );
# }
- if (
- ! defined( $host_config->{$section}->{'doing'} )
- && ! defined( $host_config->{$section}->{'done'} )
- ) {
- $host_config->{$section}->{'doing'} = 1;
- Get_depends_for_action ( $host_config->{$section}->{'action'}, $host_config->{$section}, $section, $options );
- if ( defined( $host_config->{$section}->{'depends'} ) && $host_config->{$section}->{'depends'} =~ /\S+/ ) {
- my $depends = [];
- my @dependsraw = split( /\s+/, $host_config->{$section}->{'depends'} );
- foreach my $depend (@dependsraw) {
- next if ( $depend eq "." );
- if ( defined($depend) && $depend ne "" && defined( $host_config->{$depend} ) ) {
- if ( $depend eq $section ) {
- Warn ( $CODE->{'SYNTAX'},
- "[".$section."] circular dependancy detected, skipping this depend" );
- FlushLog();
- next;
- }
- push @{$depends}, $depend;
- if ( $host_config->{$depend}->{'action'} eq 'addmount' ) {
- Warn( $CODE->{'OPEN'},
- "[".$section."] depends on addmount [".$depend."], it may not work during install!" );
- FlushLog();
- }
- }
-# else {
-# Abort ( $CODE->{'UNDEF_KEY'},
-# "[".$section."] depends on [".$depend."] which is not defined" );
-# }
- }
- if ( scalar @{$depends} ) {
- Log ( "<".$section."> ".join( ' ', @{$depends} ) );
- $errorcount += __Do_updateloop( $host_config, $options, $hash_subst, $global_config, $depends );
- }
- }
- Log( "[".$section."]" );
- if ( Exec_action ( $host_config->{$section}->{'action'}, $host_config->{$section}, $section, $options, $hash_subst, $global_config ) ) {
- FlushLog();
- $errorcount++;
- }
- else {
- DelLog();
- }
- $host_config->{$section}->{'done'} = 1;
- }
- }
- return $errorcount;
+ if ( !defined( $host_config->{$section}->{'doing'} )
+ && !defined( $host_config->{$section}->{'done'} ) )
+ {
+ $host_config->{$section}->{'doing'} = 1;
+ Get_depends_for_action(
+ $host_config->{$section}->{'action'},
+ $host_config->{$section},
+ $section, $options
+ );
+ if ( defined( $host_config->{$section}->{'depends'} )
+ && $host_config->{$section}->{'depends'} =~ /\S+/ )
+ {
+ my $depends = [];
+ my @dependsraw
+ = split( /\s+/, $host_config->{$section}->{'depends'} );
+ foreach my $depend (@dependsraw) {
+ next if ( $depend eq "." );
+ if ( defined($depend)
+ && $depend ne ""
+ && defined( $host_config->{$depend} ) )
+ {
+ if ( $depend eq $section ) {
+ Warn( $CODE->{'SYNTAX'},
+ "["
+ . $section
+ . "] circular dependancy detected, skipping this depend"
+ );
+ FlushLog();
+ next;
+ }
+ push @{$depends}, $depend;
+ if ( $host_config->{$depend}->{'action'} eq
+ 'addmount' )
+ {
+ Warn( $CODE->{'OPEN'},
+ "["
+ . $section
+ . "] depends on addmount ["
+ . $depend
+ . "], it may not work during install!" );
+ FlushLog();
+ }
+ }
+
+ # else {
+ # Abort ( $CODE->{'UNDEF_KEY'},
+ # "[".$section."] depends on [".$depend."] which is not defined" );
+ # }
+ }
+ if ( scalar @{$depends} ) {
+ Log( "<" . $section . "> " . join( ' ', @{$depends} ) );
+ $errorcount += __Do_updateloop( $host_config, $options,
+ $hash_subst, $global_config, $depends );
+ }
+ }
+ Log( "[" . $section . "]" );
+ if (Exec_action(
+ $host_config->{$section}->{'action'},
+ $host_config->{$section},
+ $section,
+ $options,
+ $hash_subst,
+ $global_config
+ )
+ )
+ {
+ FlushLog();
+ $errorcount++;
+ }
+ else {
+ DelLog();
+ }
+ $host_config->{$section}->{'done'} = 1;
+ }
+ }
+ return $errorcount;
}
sub Do_update_from_GLOBAL ($$$$$) {
- my ( $hostname, $site, $options, $global_config, $pf_config ) = @_;
- my $errorcount = 0;
-
- Set_deferredlog ();
- if ( ! VCS_update ( $hostname, $pf_config, $options ) ) {
- Abort ( $CODE->{'EXEC'},
- "Unable to checkout configuration from VCS system" );
- }
- Unset_deferredlog ();
- my $hosttype = Get_hosttype_from_hostname ( $hostname, $global_config, $site );
- my $hash_subst = Init_SUBST ( $hostname, $hosttype, $pf_config );
- my $host_props = Get_host_config_from_CONFIG ( $hostname, $global_config, $site );
- if ( ! defined $host_props ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unable to retrieve host properties from hostname ".$hostname );
- }
- $hash_subst->{'DISTRIB'} = Get_distrib_from_hostprops ( $host_props );
- $hash_subst->{'MODE'} = Get_mode_from_hostprops ( $host_props );
- if ( ! defined $options->{'pkg_type'} ) {
- unless ( $options->{'pkg_type'} = Get_pkgtype_from_hostname ( $hostname, $global_config, $site ) ) {
- Abort ( $CODE->{'INVALID_VALUE'},
- "Unable to retrieve package type from hostname ".$hostname );
- }
- }
- my $host_config = Get_config_for_hostname_on_site ( $hostname, $site, $hash_subst, $global_config, $pf_config );
- if ( ! defined $host_config ) {
- Abort( $CODE->{'OPEN'},
- "Unable to parse configuration for hostname ".$hostname." in site ".$site );
- }
-
- if ( ! $pf_config->{'features'}->{'update'} ) {
- Abort( $CODE->{'OPEN'},
- "Unable to update configuration : update feature is deactivated in pf-tools configuration file" );
- }
-
- my $sortedkeys;
- @{$sortedkeys} = sort { Sort_config_sections ( $host_config, $a, $b ) } @{$host_config->{'__sections_order'}};
-
- $| = 1;
- $errorcount = __Do_updateloop ( $host_config, $options, $hash_subst, $global_config, $sortedkeys );
-
- Log( $errorcount . " error(s) detected." );
- FlushLog();
+ my ( $hostname, $site, $options, $global_config, $pf_config ) = @_;
+ my $errorcount = 0;
+
+ Set_deferredlog();
+ if ( !VCS_update( $hostname, $pf_config, $options ) ) {
+ Abort( $CODE->{'EXEC'},
+ "Unable to checkout configuration from VCS system" );
+ }
+ Unset_deferredlog();
+ my $hosttype
+ = Get_hosttype_from_hostname( $hostname, $global_config, $site );
+ my $hash_subst = Init_SUBST( $hostname, $hosttype, $pf_config );
+ my $host_props
+ = Get_host_config_from_CONFIG( $hostname, $global_config, $site );
+ if ( !defined $host_props ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unable to retrieve host properties from hostname " . $hostname );
+ }
+ $hash_subst->{'DISTRIB'} = Get_distrib_from_hostprops($host_props);
+ $hash_subst->{'MODE'} = Get_mode_from_hostprops($host_props);
+ if ( !defined $options->{'pkg_type'} ) {
+ unless ( $options->{'pkg_type'}
+ = Get_pkgtype_from_hostname( $hostname, $global_config, $site ) )
+ {
+ Abort( $CODE->{'INVALID_VALUE'},
+ "Unable to retrieve package type from hostname "
+ . $hostname );
+ }
+ }
+ my $host_config
+ = Get_config_for_hostname_on_site( $hostname, $site, $hash_subst,
+ $global_config, $pf_config );
+ if ( !defined $host_config ) {
+ Abort( $CODE->{'OPEN'},
+ "Unable to parse configuration for hostname "
+ . $hostname
+ . " in site "
+ . $site );
+ }
+
+ if ( !$pf_config->{'features'}->{'update'} ) {
+ Abort( $CODE->{'OPEN'},
+ "Unable to update configuration : update feature is deactivated in pf-tools configuration file"
+ );
+ }
+
+ my $sortedkeys;
+ @{$sortedkeys} = sort { Sort_config_sections( $host_config, $a, $b ) }
+ @{ $host_config->{'__sections_order'} };
+
+ $| = 1;
+ $errorcount = __Do_updateloop( $host_config, $options, $hash_subst,
+ $global_config, $sortedkeys );
+
+ Log( $errorcount . " error(s) detected." );
+ FlushLog();
}
1;
Modified: branches/next-gen/lib/PFTools/VCS.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/lib/PFTools/VCS.pm?rev=879&op=diff
==============================================================================
--- branches/next-gen/lib/PFTools/VCS.pm (original)
+++ branches/next-gen/lib/PFTools/VCS.pm Tue Sep 7 08:54:37 2010
@@ -32,127 +32,143 @@
our @ISA = ('Exporter');
our @EXPORT = qw(
- VCS_update
+ VCS_update
);
# Updating CVS repository
sub __CVS_update ($$$) {
- my ( $hostname, $pf_config, $options ) = @_;
- my $cvs_cmd = $pf_config->{'vcs'}->{'command'};
+ my ( $hostname, $pf_config, $options ) = @_;
+ my $cvs_cmd = $pf_config->{'vcs'}->{'command'};
- if ( defined $options->{'branch'} && $options->{'branch'} ne '' ) {
- if ( $cvs_cmd ne '' ) {
- Warn ( $CODE->{'DUPLICATE_VALUE'},
- "Ignoring CVS command ".$cvs_cmd." for using branche ".$options->{'branch'} );
- }
- }
- elsif ( $pf_config->{'vcs'}->{'branch'} ) {
- $options->{'branch'} = $pf_config->{'vcs'}->{'branch'};
- }
- else {
- $options->{'branch'} = "";
- }
+ if ( defined $options->{'branch'} && $options->{'branch'} ne '' ) {
+ if ( $cvs_cmd ne '' ) {
+ Warn( $CODE->{'DUPLICATE_VALUE'},
+ "Ignoring CVS command "
+ . $cvs_cmd
+ . " for using branche "
+ . $options->{'branch'} );
+ }
+ }
+ elsif ( $pf_config->{'vcs'}->{'branch'} ) {
+ $options->{'branch'} = $pf_config->{'vcs'}->{'branch'};
+ }
+ else {
+ $options->{'branch'} = "";
+ }
- my $ret;
- my $umask = umask ( $pf_config->{'vcs'}->{'umask'} );
+ my $ret;
+ my $umask = umask( $pf_config->{'vcs'}->{'umask'} );
- $ENV{'CVS_RSH'} = $pf_config->{'vcs'}->{'rsh'} if ( $pf_config->{'vcs'}->{'method'} eq 'rsh' );
+ $ENV{'CVS_RSH'} = $pf_config->{'vcs'}->{'rsh'}
+ if ( $pf_config->{'vcs'}->{'method'} eq 'rsh' );
- unless ( $cvs_cmd ne "" ) {
- if ( $hostname =~ /^$pf_config->{'regex'}->{'deploy_hosts'}/ ) {
- $cvs_cmd = "/usr/bin/cvs -R -d '";
- }
- else {
- print $hostname." doesn't match ".$pf_config->{'regex'}->{'deploy_hosts'}."\n" if ( $options->{'verbose'} );
- $cvs_cmd = "/usr/bin/cvs -d ':ext:"
- .$pf_config->{'vcs'}->{'user'}.'@'
- .$pf_config->{'vcs'}->{'server'}
- }
- $cvs_cmd .= $pf_config->{'vcs'}->{'vcsroot'}."' checkout ";
- $cvs_cmd .= ' -r '.$options->{'branch'} if ( $options->{'branch'} ne "" );
- $cvs_cmd .= $pf_config->{'vcs'}->{'module'};
- }
- print $cvs_cmd."\n" if ( $options->{'debug'} || $options->{'verbose'} );
+ unless ( $cvs_cmd ne "" ) {
+ if ( $hostname =~ /^$pf_config->{'regex'}->{'deploy_hosts'}/ ) {
+ $cvs_cmd = "/usr/bin/cvs -R -d '";
+ }
+ else {
+ print $hostname
+ . " doesn't match "
+ . $pf_config->{'regex'}->{'deploy_hosts'} . "\n"
+ if ( $options->{'verbose'} );
+ $cvs_cmd
+ = "/usr/bin/cvs -d ':ext:"
+ . $pf_config->{'vcs'}->{'user'} . '@'
+ . $pf_config->{'vcs'}->{'server'};
+ }
+ $cvs_cmd .= $pf_config->{'vcs'}->{'vcsroot'} . "' checkout ";
+ $cvs_cmd .= ' -r ' . $options->{'branch'}
+ if ( $options->{'branch'} ne "" );
+ $cvs_cmd .= $pf_config->{'vcs'}->{'module'};
+ }
+ print $cvs_cmd. "\n" if ( $options->{'debug'} || $options->{'verbose'} );
- my $co_dir = $pf_config->{'path'}->{'checkout_dir'};
- if ( ! -d $co_dir ) {
- system ( "/bin/mkdir -p '".$co_dir. "' 2>/dev/null" );
- }
-
- $ret = deferredlogsystem ( "cd '".$co_dir."';".$cvs_cmd );
- if ($ret) {
- FlushLog();
- }
- else {
- DelLog();
- }
- umask($umask);
- return $ret;
+ my $co_dir = $pf_config->{'path'}->{'checkout_dir'};
+ if ( !-d $co_dir ) {
+ system( "/bin/mkdir -p '" . $co_dir . "' 2>/dev/null" );
+ }
+
+ $ret = deferredlogsystem( "cd '" . $co_dir . "';" . $cvs_cmd );
+ if ($ret) {
+ FlushLog();
+ }
+ else {
+ DelLog();
+ }
+ umask($umask);
+ return $ret;
}
sub __SVN_update ($$$) {
- my ( $hostname, $pf_config, $options ) = @_;
- my $svn_cmd = $pf_config->{'vcs'}->{'command'};
+ my ( $hostname, $pf_config, $options ) = @_;
+ my $svn_cmd = $pf_config->{'vcs'}->{'command'};
- if ( defined $options->{'branch'} && $options->{'branch'} ne '' ) {
- if ( $svn_cmd ne '' ) {
- Warn ( $CODE->{'DUPLICATE_VALUE'},
- "Ignoring SVN command ".$svn_cmd." for using branche ".$options->{'branch'} );
- }
- }
- elsif ( $pf_config->{'vcs'}->{'branch'} ) {
- $options->{'branch'} = $pf_config->{'vcs'}->{'branch'};
- }
- else {
- $options->{'branch'} = "";
- }
+ if ( defined $options->{'branch'} && $options->{'branch'} ne '' ) {
+ if ( $svn_cmd ne '' ) {
+ Warn( $CODE->{'DUPLICATE_VALUE'},
+ "Ignoring SVN command "
+ . $svn_cmd
+ . " for using branche "
+ . $options->{'branch'} );
+ }
+ }
+ elsif ( $pf_config->{'vcs'}->{'branch'} ) {
+ $options->{'branch'} = $pf_config->{'vcs'}->{'branch'};
+ }
+ else {
+ $options->{'branch'} = "";
+ }
- my $ret;
- my $umask = umask ( $pf_config->{'vcs'}->{'umask'} );
+ my $ret;
+ my $umask = umask( $pf_config->{'vcs'}->{'umask'} );
- unless ( $svn_cmd ne "" ) {
- $svn_cmd = "svn checkout "
- .$pf_config->{'vcs'}->{'method'}."://".$pf_config->{'vcs'}->{'server'}."/"
- .$pf_config->{'vcs'}->{'module'}
- ." --username ".$pf_config->{'vcs'}->{'user'}." --password ".$pf_config->{'vcs'}->{'password'};
- }
- print $svn_cmd."\n" if ( $options->{'debug'} || $options->{'verbose'} );
+ unless ( $svn_cmd ne "" ) {
+ $svn_cmd
+ = "svn checkout "
+ . $pf_config->{'vcs'}->{'method'} . "://"
+ . $pf_config->{'vcs'}->{'server'} . "/"
+ . $pf_config->{'vcs'}->{'module'}
+ . " --username "
+ . $pf_config->{'vcs'}->{'user'}
+ . " --password "
+ . $pf_config->{'vcs'}->{'password'};
+ }
+ print $svn_cmd. "\n" if ( $options->{'debug'} || $options->{'verbose'} );
- my $co_dir = $pf_config->{'path'}->{'checkout_dir'};
- if ( ! -d $co_dir ) {
- system ( "/bin/mkdir -p '".$co_dir. "' 2>/dev/null" );
- }
-
- $ret = deferredlogsystem ( "cd '".$co_dir."';".$svn_cmd );
- if ($ret) {
- FlushLog();
- }
- else {
- DelLog();
- }
- umask($umask);
- return $ret;
+ my $co_dir = $pf_config->{'path'}->{'checkout_dir'};
+ if ( !-d $co_dir ) {
+ system( "/bin/mkdir -p '" . $co_dir . "' 2>/dev/null" );
+ }
+
+ $ret = deferredlogsystem( "cd '" . $co_dir . "';" . $svn_cmd );
+ if ($ret) {
+ FlushLog();
+ }
+ else {
+ DelLog();
+ }
+ umask($umask);
+ return $ret;
}
sub VCS_update ($$$) {
- my ( $hostname, $pf_config, $options ) = @_;
+ my ( $hostname, $pf_config, $options ) = @_;
- if ( $pf_config->{'vcs'}->{'type'} eq 'cvs' ) {
- if ( __CVS_update ( $hostname, $pf_config, $options ) ) {
- return 0;
- }
- }
- elsif ( $pf_config->{'vcs'}->{'type'} eq 'svn' ) {
- if ( __SVN_update ( $hostname, $pf_config, $options ) ) {
- return 0;
- }
- }
- else {
- Warn ( $CODE->{'UNDEF_KEY'},
- "Unkown type of VCS system" );
- return 0;
- }
- return 1;
+ if ( $pf_config->{'vcs'}->{'type'} eq 'cvs' ) {
+ if ( __CVS_update( $hostname, $pf_config, $options ) ) {
+ return 0;
+ }
+ }
+ elsif ( $pf_config->{'vcs'}->{'type'} eq 'svn' ) {
+ if ( __SVN_update( $hostname, $pf_config, $options ) ) {
+ return 0;
+ }
+ }
+ else {
+ Warn( $CODE->{'UNDEF_KEY'}, "Unkown type of VCS system" );
+ return 0;
+ }
+ return 1;
}
1;
More information about the pf-tools-commits
mailing list