pf-tools commit: r539 [parmelan-guest] - in /trunk: ./ debian/ filters/ lib/PFTools/ sbin/ tools/
parmelan-guest at users.alioth.debian.org
parmelan-guest at users.alioth.debian.org
Mon Aug 27 14:48:04 UTC 2007
Author: parmelan-guest
Date: Mon Aug 27 14:48:03 2007
New Revision: 539
URL: http://svn.debian.org/wsvn/pf-tools/?sc=1&rev=539
Log:
* Miscellaneous tiny source improvements (perltidy, perl style...)
* Correct the copyright information based on the biggest contributors and
their periods of activity on each file. Feel free to correct this if I
made mistakes...
* Update my email address.
Modified:
trunk/README.contributors
trunk/TODO
trunk/debian/changelog
trunk/debian/copyright
trunk/filters/filter_filename
trunk/filters/filter_privateresolve
trunk/filters/filter_vlan2if
trunk/lib/PFTools/Conf.pm
trunk/lib/PFTools/Disk.pm
trunk/lib/PFTools/Net.pm
trunk/lib/PFTools/Update.pm
trunk/sbin/mk_dhcp
trunk/sbin/mk_interfaces
trunk/sbin/mk_packages
trunk/sbin/mk_privatezone
trunk/sbin/mk_pxelinuxcfg
trunk/sbin/mk_resolvconf
trunk/sbin/update-config
trunk/tools/bridge.sh
trunk/tools/dumpiplist.pl
trunk/tools/pflaunch
trunk/tools/umlaunch
trunk/tools/xenlaunch
Modified: trunk/README.contributors
URL: http://svn.debian.org/wsvn/pf-tools/trunk/README.contributors?rev=539&op=diff
==============================================================================
--- trunk/README.contributors (original)
+++ trunk/README.contributors Mon Aug 27 14:48:03 2007
@@ -8,6 +8,6 @@
Gonéri Le Bouder
Jérémie Le Hen
Olivier Molteni
-Thomas Parmelan
+Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
Stéphane Pontier
Modified: trunk/TODO
URL: http://svn.debian.org/wsvn/pf-tools/trunk/TODO?rev=539&op=diff
==============================================================================
--- trunk/TODO (original)
+++ trunk/TODO Mon Aug 27 14:48:03 2007
@@ -1,11 +1,11 @@
/--Priority: Low/Medium/Urgent
|/-Difficulty: Easy/Medium/Hard
||
-UM convert lib-* to real packages; use strict and use warnings everywhere
+UM [WIP] convert lib-* to real packages; use strict and use warnings everywhere
UE check that all mandatory entries are defined (ie: tag)
UM use Net::IP for ipstart.* and check it is ok wrt the subnet declaration
MM source = CVS:config/%HOST_TYPE%/%SECTIONNAME%
-LE Install everything in the correct directories (and ln -s for compatibility)
+LE Obsolete mk_packages and update-links (just have to be sure no one uses them anymore)
UH br0/trunk sur uml (2e couche bridge?)
NM Pouvoir spécifier si console série ou non dans private-network (ou ailleurs ?) (umlaunch + PXE)
Modified: trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pf-tools/trunk/debian/changelog?rev=539&op=diff
==============================================================================
--- trunk/debian/changelog (original)
+++ trunk/debian/changelog Mon Aug 27 14:48:03 2007
@@ -11,8 +11,13 @@
[ Thomas Parmelan ]
* lib-net: if no comment is specified in a zone, network or server
declaration, forge a default comment to prevent a few Perl warnings.
-
- -- Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org> Thu, 15 Mar 2007 17:47:23 +0100
+ * Miscellaneous tiny source improvements (perltidy, perl style...)
+ * Correct the copyright information based on the biggest contributors and
+ their periods of activity on each file. Feel free to correct this if I
+ made mistakes...
+ * Update my email address.
+
+ -- Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org> Mon, 27 Aug 2007 16:39:01 +0200
pf-tools (0.32.46-1) unstable; urgency=low
Modified: trunk/debian/copyright
URL: http://svn.debian.org/wsvn/pf-tools/trunk/debian/copyright?rev=539&op=diff
==============================================================================
--- trunk/debian/copyright (original)
+++ trunk/debian/copyright Mon Aug 27 14:48:03 2007
@@ -4,7 +4,8 @@
Authors:
The original code was written by Olivier Molteni and Damien Clermonte.
- The current maintainer is Damien Clermonte <damien at sitadelle.com>.
+ The current maintainers are Thomas Parmelan and Christophe Caillet.
+ More detailed copyright information can be found in the source files.
Copyright and licensing terms:
Modified: trunk/filters/filter_filename
URL: http://svn.debian.org/wsvn/pf-tools/trunk/filters/filter_filename?rev=539&op=diff
==============================================================================
--- trunk/filters/filter_filename (original)
+++ trunk/filters/filter_filename Mon Aug 27 14:48:03 2007
@@ -2,7 +2,7 @@
##
## $Id$
##
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+## Copyright (C) 2004 Damien Clermonte <damien at sitadelle.com>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -22,27 +22,18 @@
use strict;
use warnings;
-use PFTools::Net ;
-use PFTools::Update ;
+use PFTools::Net;
+use PFTools::Update;
my ( $src, $host, $dst ) = @ARGV;
-
-if ( !defined $src || !defined $host || !defined $dst ) {
- print STDERR "Usage: $0 src host dst\n";
- exit 1;
+unless ( $src and $host and $dst ) {
+ die "Usage: $0 src host dst\n";
}
my $Z = Init_lib_net( Get_source($src) );
+open DEST, ">$dst" or die "open: $dst: $!\n";
-open( DEST, ">$dst" ) || die "write open failed on $dst";
+my $filename = Get_Active_Filename( $Z, $host ) || '';
+print DEST "$filename\n";
+close DEST;
-my $filename = Get_Active_Filename( $Z, $host );
-
-if ( defined $filename ) {
- print DEST $filename;
-}
-
-print DEST "\n";
-
-close(DEST);
-
Modified: trunk/filters/filter_privateresolve
URL: http://svn.debian.org/wsvn/pf-tools/trunk/filters/filter_privateresolve?rev=539&op=diff
==============================================================================
--- trunk/filters/filter_privateresolve (original)
+++ trunk/filters/filter_privateresolve Mon Aug 27 14:48:03 2007
@@ -2,7 +2,8 @@
##
## $Id$
##
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -22,77 +23,74 @@
use strict;
use warnings;
-use PFTools::Net ;
-use PFTools::Update ;
+use PFTools::Net;
+use PFTools::Update;
my ( $src, $host, $dst, $sep ) = @ARGV;
-
-if ( !defined $sep ) {
- $sep = ' ';
+unless ( $src and $host and $dst ) {
+ die "Usage: $0 src host dst [sep]\n";
}
-if ( !defined $src || !defined $host || !defined $dst ) {
- print STDERR "Usage: $0 src host dst [sep]\n";
- exit 1;
-}
+$sep = ' ' unless defined $sep;
my $Z = Init_lib_net( Get_source("GLOBAL:private-network") );
-open( SRC, "<$src" ) || die "read open failed on $src";
-open( DEST, ">$dst" ) || die "write open failed on $dst";
+open SRC, "<$src" or die "open: $src: $!\n";
+open DST, ">$dst" or die "open: $dst: $!\n";
while (<SRC>) {
my $line = $_;
- my $pos = length($line);
+ my $pos = length $line;
while (
- substr( $line, 0, $pos ) =~
-m/^(.*[^A-Za-z0-9.-])?([A-Za-z0-9.-]+)(\\?)(\.$Z->{SOA}->{name})([^A-Za-z0-9.-].*)?$/
- )
+ substr( $line, 0, $pos )
+ =~ m/^(.*[^A-Za-z0-9.-])?([A-Za-z0-9.-]+)(\\?)(\.$Z->{SOA}->{name})([^A-Za-z0-9.-].*)?$/
+ )
{
- my $before = $1;
- my $back = $3;
- my $match = $2 . $3 . $4;
- my $matchback = $2 . $4;
- my $after = $5;
+ 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;
+ my $lengthbefore = defined $before ? length $before : 0;
- if ( $back ne '\\' ) {
+ if ( $back ne '\\' ) {
- my $match2 = $match;
- $match2 =~ s/HOSTNAME/$host/;
+ my $match2 = $match;
+ $match2 =~ s/HOSTNAME/$host/;
- my @resolved = Resolv( $match2, $Z );
+ my @resolved = Resolv( $match2, $Z );
- if ( @resolved && defined( $resolved[0] ) && $#resolved >= 0 ) {
- if ( $sep 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 ( $sep, @resolved );
- }
- $pos = $lengthbefore;
- }
- else {
- $pos = $lengthbefore;
- }
- }
- else {
- substr( $line, $lengthbefore, length($match) ) = $matchback;
- $pos = $lengthbefore;
- }
+ if ( @resolved and defined $resolved[0] ) {
+ if ( $sep 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( $sep, @resolved );
+ }
+ $pos = $lengthbefore;
+ }
+ else {
+ $pos = $lengthbefore;
+ }
+ }
+ else {
+ substr( $line, $lengthbefore, length $match ) = $matchback;
+ $pos = $lengthbefore;
+ }
}
- print DEST $line;
+ print DST $line;
}
-close(DEST);
-close(SRC);
+close DST;
+close SRC;
+
Modified: trunk/filters/filter_vlan2if
URL: http://svn.debian.org/wsvn/pf-tools/trunk/filters/filter_vlan2if?rev=539&op=diff
==============================================================================
--- trunk/filters/filter_vlan2if (original)
+++ trunk/filters/filter_vlan2if Mon Aug 27 14:48:03 2007
@@ -1,13 +1,9 @@
#!/usr/bin/perl
-
-# eth:vlan -> ethx.y:z
-# eth.vlan -> ethx.y
-# eth-vlan -> ethx
-
##
## $Id$
##
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -24,59 +20,64 @@
## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
##
+# eth:vlan -> ethx.y:z
+# eth.vlan -> ethx.y
+# eth-vlan -> ethx
+
use strict;
use warnings;
-use PFTools::Net ;
-use PFTools::Update ;
+use PFTools::Net;
+use PFTools::Update;
my ( $src, $host, $dst ) = @ARGV;
-if ( !defined $src || !defined $host || !defined $dst ) {
- print STDERR "Usage: $0 src host dst\n";
- exit 1;
+unless ( $src and $host and $dst ) {
+ die "Usage: $0 src host dst\n";
}
my $Z = Init_lib_net( Get_source("GLOBAL:private-network") );
-open( SRC, "<$src" ) || die "read open failed on $src";
-open( DEST, ">$dst" ) || die "write open failed on $dst";
+open SRC, "<$src" or die "open: $src: $!\n";
+open DST, ">$dst" or die "open: $dst: $!\n";
while (<SRC>) {
my $line = $_;
- my $pos = length($line);
+ my $pos = length $line;
while (
- substr( $line, 0, $pos ) =~
- m/^(.*[^A-Za-z0-9.-])?(eth([-.:])([a-z0-9-]+))([^A-Za-z0-9.-].*)?$/ )
+ substr( $line, 0, $pos )
+ =~ m/^(.*[^A-Za-z0-9.-])?(eth([-.:])([a-z0-9-]+))([^A-Za-z0-9.-].*)?$/
+ )
{
- my $before = $1;
- my $match = $2;
- my $type = $3;
- my $vlan = $4;
- my $after = $5;
+ my $before = $1;
+ my $match = $2;
+ my $type = $3;
+ my $vlan = $4;
+ my $after = $5;
- my $lengthbefore = ( defined($before) ) ? length($before) : 0;
+ my $lengthbefore = defined $before ? length $before : 0;
- my $eth = Get_If( $Z, $host, $vlan );
+ my $eth = Get_If( $Z, $host, $vlan );
- if ( defined $eth ) {
- my $neweth = $eth;
- if ( $type eq "." ) {
- $neweth =~ s/:.*$//;
- }
- elsif ( $type eq "-" ) {
- $neweth =~ s/[.:].*$//;
- }
+ 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;
- }
+ substr( $line, $lengthbefore, length $match ) = $neweth;
+ $pos = $lengthbefore;
+ }
+ else {
+ $pos = $lengthbefore;
+ }
}
- print DEST $line;
+ print DST $line;
}
-close(DEST);
-close(SRC);
+close DST;
+close SRC;
+
Modified: trunk/lib/PFTools/Conf.pm
URL: http://svn.debian.org/wsvn/pf-tools/trunk/lib/PFTools/Conf.pm?rev=539&op=diff
==============================================================================
--- trunk/lib/PFTools/Conf.pm (original)
+++ trunk/lib/PFTools/Conf.pm Mon Aug 27 14:48:03 2007
@@ -1,8 +1,11 @@
-package PFTools::Conf ;
+package PFTools::Conf;
##
## $Id$
##
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+## Copyright (C) 2007 Christophe Caillet <tof at sitadelle.com>
+## Copyright (C) 2005-2007 Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
+## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -24,62 +27,61 @@
use Exporter;
-our @ISA = ( 'Exporter' ) ;
+our @ISA = ('Exporter');
our @EXPORT = qw(
- $DEFERREDLOG
- %SUBST
-
- Load_conf
+ $DEFERREDLOG
+ %SUBST
+
+ Load_conf
);
our @EXPORT_OK = qw();
-
# Error code
-my $ERR_OPEN = 1 ;
-my $ERR_SYNTAX = 2 ;
+my $ERR_OPEN = 1;
+my $ERR_SYNTAX = 2;
# Vars needed by pf-launch
-my $sortie ;
-my $tmpfile = "/tmp/update-config.log" ;
+my $sortie;
+my $tmpfile = "/tmp/update-config.log";
# Table de substitution globale
-our %SUBST ;
-
-my $FAKEHOSTNAME ;
-my $FAKEDOMAINNAME ;
-our $DEFERREDLOG = 0 ;
-
-if ( defined ( $FAKEHOSTNAME ) ) {
- $SUBST{'HOSTNAME'} = $FAKEHOSTNAME ;
+our %SUBST;
+
+my $FAKEHOSTNAME;
+my $FAKEDOMAINNAME;
+our $DEFERREDLOG = 0;
+
+if ( defined($FAKEHOSTNAME) ) {
+ $SUBST{'HOSTNAME'} = $FAKEHOSTNAME;
}
else {
- chomp ( $SUBST{'HOSTNAME'} = `/bin/hostname -s 2>>/dev/null` ) ;
-}
-
-if ( defined ( $FAKEDOMAINNAME ) ) {
- $SUBST{'DOMAINNAME'} = $FAKEDOMAINNAME ;
+ chomp( $SUBST{'HOSTNAME'} = `/bin/hostname -s 2>>/dev/null` );
+}
+
+if ( defined($FAKEDOMAINNAME) ) {
+ $SUBST{'DOMAINNAME'} = $FAKEDOMAINNAME;
}
else {
if ( -x "/bin/domainname" ) {
- chomp ( $SUBST{'DOMAINNAME'} = `/bin/domainname 2>>/dev/null` ) ;
+ chomp( $SUBST{'DOMAINNAME'} = `/bin/domainname 2>>/dev/null` );
}
elsif ( -x "/bin/dnsdomainname" ) {
- chomp ( $SUBST{'DOMAINNAME'} = `/bin/dnsdomainname 2>>/dev/null` ) ;
+ chomp( $SUBST{'DOMAINNAME'} = `/bin/dnsdomainname 2>>/dev/null` );
}
else {
- $SUBST{'DOMAINNAME'} = "" ;
- }
-}
-
-chomp ( $SUBST{'OS_RELEASE'} = `/bin/uname -r` ) ;
-
-$SUBST{'HOSTNAME'} =~ m/^(.*?)(\d*)([a-z]*)$/ ;
-
-$SUBST{'HOSTTYPE'} = $1;
-$SUBST{'HOSTDIGITS'} = $2;
-$SUBST{'HOSTCLUSTER'} = $1.$2;
+ $SUBST{'DOMAINNAME'} = "";
+ }
+}
+
+chomp( $SUBST{'OS_RELEASE'} = `/bin/uname -r` );
+
+$SUBST{'HOSTNAME'} =~ m/^(.*?)(\d*)([a-z]*)$/;
+
+$SUBST{'HOSTTYPE'} = $1;
+$SUBST{'HOSTDIGITS'} = $2;
+$SUBST{'HOSTCLUSTER'} = $1 . $2;
$SUBST{'HOSTNODEINDEX'} = $3;
$SUBST{'HOSTNUM'} = $SUBST{'HOSTDIGITS'};
@@ -100,72 +102,68 @@
return ($str);
}
-my $deferbuffer ;
+my $deferbuffer;
my $deferredlogbuffer = '';
my @rotatecursortemplate = ( '-', '\\', '|', '/' );
my $rotatecursorcount = 0;
sub RotateCursor {
print STDERR $rotatecursortemplate[$rotatecursorcount], "\r";
- $rotatecursorcount =
- ( $rotatecursorcount + 1 ) % ( $#rotatecursortemplate + 1 );
+ $rotatecursorcount
+ = ( $rotatecursorcount + 1 ) % ( $#rotatecursortemplate + 1 );
}
sub DeferOutput {
- local *REAL_STDOUT;
- local *REAL_STDERR;
-
- open(REAL_STDOUT, ">&STDOUT");
- open(REAL_STDERR, ">&STDERR");
-
- close STDOUT;
- close STDERR;
-
- $sortie->{'_stdout'} = *REAL_STDOUT;
- $sortie->{'_stderr'} = *REAL_STDERR;
-
- open(STDOUT, "+>$tmpfile") or warn "Can't open tmp file for stdout";
- open(STDERR, ">&STDOUT") or warn "Can't open tmp file for stderr";
- unlink $tmpfile;
-
- select STDERR;
- $| = 1;
- select STDOUT;
- $| = 1;
+ local *REAL_STDOUT;
+ local *REAL_STDERR;
+
+ open( REAL_STDOUT, ">&STDOUT" );
+ open( REAL_STDERR, ">&STDERR" );
+
+ close STDOUT;
+ close STDERR;
+
+ $sortie->{'_stdout'} = *REAL_STDOUT;
+ $sortie->{'_stderr'} = *REAL_STDERR;
+
+ open( STDOUT, "+>$tmpfile" ) or warn "Can't open tmp file for stdout";
+ open( STDERR, ">&STDOUT" ) or warn "Can't open tmp file for stderr";
+ unlink $tmpfile;
+
+ select STDERR;
+ $| = 1;
+ select STDOUT;
+ $| = 1;
}
sub UndeferOutput {
- seek( STDOUT, 0, 0 );
- local $/;
- $deferbuffer = <STDOUT>;
-
-
- if(defined($sortie->{'_stdout'}))
- {
- local *REAL_STDOUT;
- *REAL_STDOUT = $sortie->{'_stdout'};
- open(STDOUT, ">&REAL_STDOUT") or warn "Can't restore STDOUT: $!
+ seek( STDOUT, 0, 0 );
+ local $/;
+ $deferbuffer = <STDOUT>;
+
+ if ( defined( $sortie->{'_stdout'} ) ) {
+ local *REAL_STDOUT;
+ *REAL_STDOUT = $sortie->{'_stdout'};
+ open( STDOUT, ">&REAL_STDOUT" ) or warn "Can't restore 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: $!
+ undef( $sortie->{'_stdout'} );
+ }
+ if ( defined( $sortie->{'_stderr'} ) ) {
+ local *REAL_STDERR;
+ *REAL_STDERR = $sortie->{'_stderr'};
+ open( STDERR, ">&REAL_STDERR" ) or warn "Can't restore STDERR: $!
+";
- undef($sortie->{'_stderr'});
- }
- select STDERR;
- $| = 1;
- select STDOUT;
- $| = 1;
-
-}
-
+ undef( $sortie->{'_stderr'} );
+ }
+ select STDERR;
+ $| = 1;
+ select STDOUT;
+ $| = 1;
+
+}
# Returns undef on error
sub deferredlogpipe {
@@ -173,8 +171,8 @@
DeferOutput() if $DEFERREDLOG;
- unless (open DEFERREDLOGPIPE, '-|', @_) {
- Warn($ERR_OPEN, "Unable to open pipe @_: $!");
+ unless ( open DEFERREDLOGPIPE, '-|', @_ ) {
+ Warn( $ERR_OPEN, "Unable to open pipe @_: $!" );
return;
}
@@ -187,15 +185,14 @@
UndeferOutput() if $DEFERREDLOG;
if ($deferbuffer) {
- $deferredlogbuffer .= $deferbuffer;
- $deferbuffer = undef;
+ $deferredlogbuffer .= $deferbuffer;
+ $deferbuffer = undef;
}
RotateCursor() if $DEFERREDLOG;
return $ret;
}
-
sub deferredlogsystem {
my $ret;
@@ -207,8 +204,8 @@
UndeferOutput() if ($DEFERREDLOG);
if ( defined $deferbuffer && $deferbuffer ne '' ) {
- $deferredlogbuffer .= $deferbuffer;
- $deferbuffer = undef;
+ $deferredlogbuffer .= $deferbuffer;
+ $deferbuffer = undef;
}
RotateCursor() if ($DEFERREDLOG);
@@ -227,59 +224,58 @@
# Log
sub Log {
- my @words = split ( /\s+/, join ( '', @_ ) );
+ my @words = split( /\s+/, join( '', @_ ) );
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 $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();
+ FlushLog();
}
else {
- RotateCursor();
- }
-}
-
+ RotateCursor();
+ }
+}
# Debug
sub Debug ($) {
my (@msg) = @_;
- my $basename = ( split ( '/', $0 ) )[-1]; # FIXME �faire une bonne fois pour toutes !
+ # FIXME à faire une bonne fois pour toutes !
+ my $basename = ( split( '/', $0 ) )[-1];
Log( $basename . ": DEBUG: ", @msg );
}
-
# Warn
sub Warn {
my ( $err, @msg ) = @_;
my $basename;
- $basename = ( split ( '/', $0 ) )[-1];
+ $basename = ( split( '/', $0 ) )[-1];
Log( $basename . ": WARN: ", @msg );
}
@@ -289,7 +285,7 @@
my ( $err, @msg ) = @_;
my $basename;
- $basename = ( split ( '/', $0 ) )[-1];
+ $basename = ( split( '/', $0 ) )[-1];
Log( $basename . ": ERR: ", @msg );
FlushLog();
@@ -298,7 +294,7 @@
# Load_conf
sub Load_conf {
- my ($fic_conf, $substdestvars) = @_;
+ my ( $fic_conf, $substdestvars ) = @_;
my $CONF = {};
my $current = ']';
@@ -309,216 +305,231 @@
unshift @FIC_CONF, $fic_conf;
unshift @line, 0;
open( $FIC_CONF[0], $FIC_CONF[0] )
- || Abort( $ERR_OPEN, "Impossible d'ouvrir " . $FIC_CONF[0] );
+ || Abort( $ERR_OPEN, "Impossible d'ouvrir " . $FIC_CONF[0] );
while ( $#FIC_CONF >= 0 ) {
- my $fh = $FIC_CONF[0]; # Perl gruik, ne pas simplifier!!!
- LOADCONFLINE: while (<$fh>) {
-
- # 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( $ERR_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( $ERR_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( eval $$2 ) ) {
- unshift @cond, ( $#cond > 0 && !$cond[1] ) ? 0 : 1;
- }
- else {
- unshift @cond, 0;
- }
- next;
- }
- elsif ( $1 eq "ifndef" ) {
- if ( not defined( eval $$2 ) ) {
- unshift @cond, 0;
- }
- else {
- unshift @cond, ( $#cond > 0 && !$cond[1] ) ? 0 : 1;
- }
- next;
- }
- elsif ( $1 eq "if" ) {
- if ( eval $$2 ) {
- unshift @cond, ( $#cond > 0 && !$cond[1] ) ? 0 : 1;
- }
- else {
- unshift @cond, 0;
- }
- next;
- }
- elsif ( $1 eq "ifnot" ) {
- if ( !eval $$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" ) {
- my $fic_conf = $2;
- my $oldficconf;
-
- if ( $fic_conf =~ m|/| ) {
- Abort( $ERR_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 (@FIC_CONF) {
- if ( $fic_conf eq $oldficconf ) {
- Warn( $ERR_OPEN,
- $FIC_CONF[0] . ":"
- . $line[0] . ": "
- . $fic_conf
- . " deja inclus" );
- next LOADCONFLINE;
- }
- }
-
- unshift @FIC_CONF, $fic_conf;
- unshift @line, 0;
- open( $FIC_CONF[0], $FIC_CONF[0] )
- || Abort( $ERR_OPEN,
- $FIC_CONF[1] . ":"
- . $line[1]
- . ": Impossible d'inclure "
- . $FIC_CONF[0] );
- $fh = $FIC_CONF[0]; # Perl gruik, ne pas simplifier!!!
- }
- elsif ( $1 eq "define" ) {
- if ( defined( eval $$2 ) ) {
- Warn( $ERR_OPEN,
- $FIC_CONF[0] . ":"
- . $line[0] . ": " . $2
- . " deja defini" );
- }
- else {
- eval( $$2 = 1 );
- }
- }
- elsif ( $1 eq "undef" ) {
- if ( not defined( eval $$2 ) ) {
- Warn( $ERR_OPEN,
- $FIC_CONF[0] . ":"
- . $line[0] . ": " . $2
- . " deja non defini" );
- }
- else {
- eval undef $$2;
- }
- }
- else {
- Abort( $ERR_SYNTAX,
- $FIC_CONF[0] . ":"
- . $line[0]
- . ": Directive " . $1
- . " inconnue" );
- }
- next;
- }
-
- # Detection des sections
- if (/^\[([^\]]+)\]$/) {
- if ( defined $substdestvars && $substdestvars ) {
- $current = Subst_vars( $1 );
- } else {
- $current = $1;
- }
- if ( defined( $CONF->{$current} ) ) {
- Abort( $ERR_SYNTAX,
- $FIC_CONF[0] . ":"
- . $line[0] . ": [" . $current
- . "] dupliquee (precedente a "
- . $CONF->{$current}->{_location} . ")" );
- }
- else {
- $CONF->{$current} = {};
- $CONF->{$current}->{_location} =
- $FIC_CONF[0] . ":" . $line[0];
- }
- next;
- }
-
- # Traitement des variables
- if (/^([^\s]+)\s*=\s*(.+)$/) {
- if ( defined( $CONF->{$current}->{$1} ) ) {
- Abort( $ERR_SYNTAX,
- $FIC_CONF[0] . ":"
- . $line[0] . ": " . $1
- . " dupliquee (precedente a "
- . $CONF->{$current}->{$1}->{_location} . ")" );
- }
- else {
-
- if ( Add_var( $CONF->{$current}, $1, $2 ) == $ERR_SYNTAX ) {
- Abort( $ERR_SYNTAX,
- $FIC_CONF[0] . ":"
- . $line[0] . ": " . $1
- . " dupliquee (precedente a "
- . $CONF->{$current}->{$1}->{_location} . ")" );
- }
- $CONF->{$current}->{$1}->{_location} =
- $FIC_CONF[0] . ":" . $line[0];
- }
- }
- else {
- Abort( $ERR_SYNTAX,
- $FIC_CONF[0] . ":" . $line[0] . ": Erreur de syntaxe" );
- }
- }
- close( $FIC_CONF[0] );
- shift @line;
- shift @FIC_CONF;
+ my $fh = $FIC_CONF[0]; # Perl gruik, ne pas simplifier!!!
+ LOADCONFLINE: while (<$fh>) {
+
+ # 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( $ERR_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( $ERR_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( eval $$2 ) ) {
+ unshift @cond, ( $#cond > 0 && !$cond[1] ) ? 0 : 1;
+ }
+ else {
+ unshift @cond, 0;
+ }
+ next;
+ }
+ elsif ( $1 eq "ifndef" ) {
+ if ( not defined( eval $$2 ) ) {
+ unshift @cond, 0;
+ }
+ else {
+ unshift @cond, ( $#cond > 0 && !$cond[1] ) ? 0 : 1;
+ }
+ next;
+ }
+ elsif ( $1 eq "if" ) {
+ if ( eval $$2 ) {
+ unshift @cond, ( $#cond > 0 && !$cond[1] ) ? 0 : 1;
+ }
+ else {
+ unshift @cond, 0;
+ }
+ next;
+ }
+ elsif ( $1 eq "ifnot" ) {
+ if ( !eval $$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" ) {
+ my $fic_conf = $2;
+ my $oldficconf;
+
+ if ( $fic_conf =~ m|/| ) {
+ Abort( $ERR_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 (@FIC_CONF) {
+ if ( $fic_conf eq $oldficconf ) {
+ Warn( $ERR_OPEN,
+ $FIC_CONF[0] . ":"
+ . $line[0] . ": "
+ . $fic_conf
+ . " deja inclus" );
+ next LOADCONFLINE;
+ }
+ }
+
+ unshift @FIC_CONF, $fic_conf;
+ unshift @line, 0;
+ open( $FIC_CONF[0], $FIC_CONF[0] )
+ || Abort( $ERR_OPEN,
+ $FIC_CONF[1] . ":"
+ . $line[1]
+ . ": Impossible d'inclure "
+ . $FIC_CONF[0] );
+ $fh = $FIC_CONF[0]; # Perl gruik, ne pas simplifier!!!
+ }
+ elsif ( $1 eq "define" ) {
+ if ( defined( eval $$2 ) ) {
+ Warn( $ERR_OPEN,
+ $FIC_CONF[0] . ":"
+ . $line[0] . ": "
+ . $2
+ . " deja defini" );
+ }
+ else {
+ eval( $$2 = 1 );
+ }
+ }
+ elsif ( $1 eq "undef" ) {
+ if ( not defined( eval $$2 ) ) {
+ Warn( $ERR_OPEN,
+ $FIC_CONF[0] . ":"
+ . $line[0] . ": "
+ . $2
+ . " deja non defini" );
+ }
+ else {
+ eval undef $$2;
+ }
+ }
+ else {
+ Abort( $ERR_SYNTAX,
+ $FIC_CONF[0] . ":"
+ . $line[0]
+ . ": Directive "
+ . $1
+ . " inconnue" );
+ }
+ next;
+ }
+
+ # Detection des sections
+ if (/^\[([^\]]+)\]$/) {
+ if ( defined $substdestvars && $substdestvars ) {
+ $current = Subst_vars($1);
+ }
+ else {
+ $current = $1;
+ }
+ if ( defined( $CONF->{$current} ) ) {
+ Abort( $ERR_SYNTAX,
+ $FIC_CONF[0] . ":"
+ . $line[0] . ": ["
+ . $current
+ . "] dupliquee (precedente a "
+ . $CONF->{$current}->{_location}
+ . ")" );
+ }
+ else {
+ $CONF->{$current} = {};
+ $CONF->{$current}->{_location}
+ = $FIC_CONF[0] . ":" . $line[0];
+ }
+ next;
+ }
+
+ # Traitement des variables
+ if (/^([^\s]+)\s*=\s*(.+)$/) {
+ if ( defined( $CONF->{$current}->{$1} ) ) {
+ Abort( $ERR_SYNTAX,
+ $FIC_CONF[0] . ":"
+ . $line[0] . ": "
+ . $1
+ . " dupliquee (precedente a "
+ . $CONF->{$current}->{$1}->{_location}
+ . ")" );
+ }
+ else {
+
+ if ( Add_var( $CONF->{$current}, $1, $2 ) == $ERR_SYNTAX )
+ {
+ Abort( $ERR_SYNTAX,
+ $FIC_CONF[0] . ":"
+ . $line[0] . ": "
+ . $1
+ . " dupliquee (precedente a "
+ . $CONF->{$current}->{$1}->{_location}
+ . ")" );
+ }
+ $CONF->{$current}->{$1}->{_location}
+ = $FIC_CONF[0] . ":" . $line[0];
+ }
+ }
+ else {
+ Abort( $ERR_SYNTAX,
+ $FIC_CONF[0] . ":" . $line[0] . ": Erreur de syntaxe" );
+ }
+ }
+ close( $FIC_CONF[0] );
+ shift @line;
+ shift @FIC_CONF;
}
# Conditions non fermees
if ( $#cond >= 0 ) {
- Abort( $ERR_SYNTAX, "EOC: endif manquant" );
+ Abort( $ERR_SYNTAX, "EOC: endif manquant" );
}
return ($CONF);
@@ -529,24 +540,24 @@
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 ($ERR_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 ($ERR_SYNTAX);
+ }
+ Add_var( $V->{$esc1}, $quote, $val );
}
else {
- $var =~ s/\\\././g;
- if ( defined( $V->{$var} ) ) {
- return ($ERR_SYNTAX);
- }
- $V->{$var} = $val;
- return (0);
+ $var =~ s/\\\././g;
+ if ( defined( $V->{$var} ) ) {
+ return ($ERR_SYNTAX);
+ }
+ $V->{$var} = $val;
+ return (0);
}
}
@@ -558,9 +569,9 @@
my $v;
foreach $s ( keys %$C ) {
- print "[" . $s . "]\n";
- Print_v( $C->{$s}, "" );
- print "\n";
+ print "[" . $s . "]\n";
+ Print_v( $C->{$s}, "" );
+ print "\n";
}
}
@@ -569,12 +580,12 @@
my $v;
foreach $v ( keys %$o ) {
- if ( ref( $o->{$v} ) ) {
- Print_v( $o->{$v}, $var . $v . "." );
- }
- else {
- print $var. $v . " = ", $o->{$v}, "\n";
- }
+ if ( ref( $o->{$v} ) ) {
+ Print_v( $o->{$v}, $var . $v . "." );
+ }
+ else {
+ print $var. $v . " = ", $o->{$v}, "\n";
+ }
}
}
Modified: trunk/lib/PFTools/Disk.pm
URL: http://svn.debian.org/wsvn/pf-tools/trunk/lib/PFTools/Disk.pm?rev=539&op=diff
==============================================================================
--- trunk/lib/PFTools/Disk.pm (original)
+++ trunk/lib/PFTools/Disk.pm Mon Aug 27 14:48:03 2007
@@ -2,7 +2,7 @@
##
## $Id: Conf.pm 459 2007-03-07 15:16:32Z ccaillet-guest $
##
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+## Copyright (C) 2007 Christophe Caillet <tof at sitadelle.com>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -378,4 +378,4 @@
#
# Managing DRBD cluster(s)
-#
+#
Modified: trunk/lib/PFTools/Net.pm
URL: http://svn.debian.org/wsvn/pf-tools/trunk/lib/PFTools/Net.pm?rev=539&op=diff
==============================================================================
--- trunk/lib/PFTools/Net.pm (original)
+++ trunk/lib/PFTools/Net.pm Mon Aug 27 14:48:03 2007
@@ -1,8 +1,11 @@
-package PFTools::Net ;
+package PFTools::Net;
##
## $Id$
##
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+## Copyright (C) 2007 Christophe Caillet <tof at sitadelle.com>
+## Copyright (C) 2005-2007 Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
+## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -22,25 +25,24 @@
use strict;
use warnings;
-use Exporter ;
-
-our @ISA = ( 'Exporter' ) ;
+use Exporter;
+
+our @ISA = ('Exporter');
our @EXPORT = qw(
- Init_lib_net
-
- Get_Active_Filename
- Get_dns_from_hostname
- Get_If
-
- Mk_dhcp
- Mk_pxelinuxcfg
- Mk_interfaces
- Mk_zone
+ Init_lib_net
+
+ Get_Active_Filename
+ Get_dns_from_hostname
+ Get_If
+
+ Mk_dhcp
+ Mk_pxelinuxcfg
+ Mk_interfaces
+ Mk_zone
);
our @EXPORT_OK = qw();
-
use Fcntl ':mode';
use POSIX qw(ceil floor);
@@ -62,8 +64,8 @@
my $NOETH3 = 0;
# Error code
-my $ERR_OPEN = 1 ;
-my $ERR_SYNTAX = 2 ;
+my $ERR_OPEN = 1;
+my $ERR_SYNTAX = 2;
#=======================================================#
# #
@@ -82,12 +84,12 @@
my $index = '';
while ( $node > 0 ) {
- $index = chr( ord('a') + $node % 26 ) . $index;
- $node = floor( $node / 26 );
+ $index = chr( ord('a') + $node % 26 ) . $index;
+ $node = floor( $node / 26 );
}
if ( defined $pad && $pad > length($index) ) {
- $index .= 'a' x ( $pad - length($index) );
+ $index .= 'a' x ( $pad - length($index) );
}
return ($index);
@@ -97,8 +99,8 @@
my ( $array, $num ) = @_;
while ( $num > 0 ) {
- push @{$array}, shift @{$array};
- $num--;
+ push @{$array}, shift @{$array};
+ $num--;
}
return @{$array};
@@ -117,17 +119,17 @@
$an = $av = $aa = -1;
if ( $a =~ m/([^:.\d]+)(\d+)?(\.(\d+))?(:(\d+))?/ ) {
- $ai = $1;
- if ( defined $2 ) { $an = $2 }
- if ( defined $4 ) { $av = $4 }
- if ( defined $6 ) { $aa = $6 }
+ $ai = $1;
+ if ( defined $2 ) { $an = $2 }
+ if ( defined $4 ) { $av = $4 }
+ if ( defined $6 ) { $aa = $6 }
}
$bn = $bv = $ba = -1;
if ( $b =~ m/([^:.\d]+)(\d+)?(\.(\d+))?(:(\d+))?/ ) {
- $bi = $1;
- if ( defined $2 ) { $bn = $2 }
- if ( defined $4 ) { $bv = $4 }
- if ( defined $6 ) { $ba = $6 }
+ $bi = $1;
+ if ( defined $2 ) { $bn = $2 }
+ if ( defined $4 ) { $bv = $4 }
+ if ( defined $6 ) { $ba = $6 }
}
( $ai cmp $bi ) || ( $an <=> $bn ) || ( $av <=> $bv ) || ( $aa <=> $ba );
}
@@ -135,18 +137,18 @@
sub isipaddr {
my ($ip) = @_;
- my @sub = split ( '\.', $ip );
+ my @sub = split( '\.', $ip );
if ( $#sub != 3 ) {
- return 0;
+ return 0;
}
my $i;
foreach $i ( 0 .. 3 ) {
- if ( $sub[$i] < 0 || $sub[$i] > 255 ) {
- return 0;
- }
+ if ( $sub[$i] < 0 || $sub[$i] > 255 ) {
+ return 0;
+ }
}
return -1;
@@ -157,13 +159,13 @@
my $prefix = 32;
- my @netmask = split ( '\.', $netmask );
- my $raw =
- $netmask[0] << 24 | $netmask[1] << 16 | $netmask[2] << 8 | $netmask[3];
+ my @netmask = split( '\.', $netmask );
+ my $raw = $netmask[0] << 24 | $netmask[1] << 16 | $netmask[2] << 8
+ | $netmask[3];
while ( ( $raw & 1 ) == 0 && $prefix > 0 ) {
- $raw = $raw >> 1;
- $prefix--;
+ $raw = $raw >> 1;
+ $prefix--;
}
return $prefix;
@@ -183,7 +185,7 @@
my $M = $N->{'SRVLIST'}->{$hostshort};
if ( !defined($M) ) {
- Abort( $ERR_SYNTAX, "Get_If: " . $host . " not found" );
+ Abort( $ERR_SYNTAX, "Get_If: " . $host . " not found" );
}
return ( $M->{'ifup'}->{ $host . "." . $vlan } );
@@ -193,7 +195,8 @@
sub Get_Dhcp_Infos {
my ( $Z, $host ) = @_;
- my $dhcpvlanregex = '^(' . join ( '|', @{ $Z->{'SOA'}->{'dhcpvlan'} } ) . ')$';
+ my $dhcpvlanregex
+ = '^(' . join( '|', @{ $Z->{'SOA'}->{'dhcpvlan'} } ) . ')$';
my $host2 = $host;
$host2 =~ s/^(.+)\.$Z->{'SOA'}->{'name'}$/$1/;
@@ -205,22 +208,26 @@
my $M = $N->{'SRVLIST'}->{$hostshort};
if ( !defined($M) ) {
- Abort( $ERR_SYNTAX, "Get_Dhcp_Infos: " . $host . " not found" );
- }
-
- foreach my $nam ( sort { cmpif( $M->{'ifup'}->{$a}, $M->{'ifup'}->{$b} ) }
- keys %{ $M->{'ifup'} } )
+ Abort( $ERR_SYNTAX, "Get_Dhcp_Infos: " . $host . " not found" );
+ }
+
+ foreach my $nam (
+ sort { cmpif( $M->{'ifup'}->{$a}, $M->{'ifup'}->{$b} ) }
+ keys %{ $M->{'ifup'} }
+ )
{
- my $net = $nam;
- $net =~ s/^[^\.]+\.//;
- if ( $net =~ /$dhcpvlanregex/ ) {
- if ( defined $M->{'zone'}->{$nam}->{'ether'} ) {
- return ( $M->{'ifup'}->{$nam}, $M->{'zone'}->{$nam}->{'ether'} );
- }
- else {
- return ( $M->{'ifup'}->{$nam}, $M->{'zone'}->{$nam}->{'vmether'} );
- }
- }
+ my $net = $nam;
+ $net =~ s/^[^\.]+\.//;
+ if ( $net =~ /$dhcpvlanregex/ ) {
+ if ( defined $M->{'zone'}->{$nam}->{'ether'} ) {
+ return ( $M->{'ifup'}->{$nam},
+ $M->{'zone'}->{$nam}->{'ether'} );
+ }
+ else {
+ return ( $M->{'ifup'}->{$nam},
+ $M->{'zone'}->{$nam}->{'vmether'} );
+ }
+ }
}
return undef;
@@ -232,27 +239,30 @@
my @list;
my $class;
- foreach $class ( sort {
- my $i = $Z->{'SERVERS'}->{'BY_NAME'}->{$a}->{'order'};
- my $j = $Z->{'SERVERS'}->{'BY_NAME'}->{$b}->{'order'};
- if ( !defined $i ) { $i = 9999; }
- if ( !defined $j ) { $j = 9999; }
- if ( $i == $j ) { return ( $a cmp $b ); }
- $i <=> $j;
- } keys %{ $Z->{'SERVERS'}->{'BY_NAME'} }
- )
+ foreach $class (
+ sort {
+ my $i = $Z->{'SERVERS'}->{'BY_NAME'}->{$a}->{'order'};
+ my $j = $Z->{'SERVERS'}->{'BY_NAME'}->{$b}->{'order'};
+ if ( !defined $i ) { $i = 9999; }
+ if ( !defined $j ) { $j = 9999; }
+ if ( $i == $j ) { return ( $a cmp $b ); }
+ $i <=> $j;
+ } keys %{ $Z->{'SERVERS'}->{'BY_NAME'} }
+ )
{
- my $hostfilter;
- foreach $hostfilter (@hostsfilter) {
- my $host;
- foreach $host (
- sort keys %{ $Z->{'SERVERS'}->{'BY_NAME'}->{$class}->{'SRVLIST'} } )
- {
- if ( $class =~ /$hostfilter/ || $host =~ /$hostfilter/ ) {
- push @list, $host;
- }
- }
- }
+ my $hostfilter;
+ foreach $hostfilter (@hostsfilter) {
+ my $host;
+ foreach $host (
+ sort
+ keys %{ $Z->{'SERVERS'}->{'BY_NAME'}->{$class}->{'SRVLIST'} }
+ )
+ {
+ if ( $class =~ /$hostfilter/ || $host =~ /$hostfilter/ ) {
+ push @list, $host;
+ }
+ }
+ }
}
return @list;
@@ -274,49 +284,53 @@
my $M = $N->{'SRVLIST'}->{$hostshort};
if ( !defined($M) ) {
- Abort( $ERR_SYNTAX, "Get_Dhcp_Infos: " . $host . " not found" );
- }
-
- foreach my $nam ( sort { cmpif( $M->{'ifup'}->{$a}, $M->{'ifup'}->{$b} ) }
- keys %{ $M->{'ifup'} } )
+ Abort( $ERR_SYNTAX, "Get_Dhcp_Infos: " . $host . " not found" );
+ }
+
+ foreach my $nam (
+ sort { cmpif( $M->{'ifup'}->{$a}, $M->{'ifup'}->{$b} ) }
+ keys %{ $M->{'ifup'} }
+ )
{
- my $net = $nam;
- $net =~ s/^[^\.]+\.//;
- my $NET = $Z->{'NETWORK'}->{'BY_NAME'}->{$net};
-
- if ( $M->{'ifup'}->{$nam} =~ m/([^:.\d]+)(\d+)?(\.(\d+))?(:(\d+))?/ ) {
- my $ai;
- my $an;
- my $av;
- my $aa;
-
- $ai = $1;
- if ( defined $2 ) { $an = $2 }
- if ( defined $4 ) { $av = $4 }
- if ( defined $6 ) { $aa = $6 }
-
- my $vlan_raw_device = $ai . ( ( defined $an ) ? $an : '' );
-
- if ( defined( $umif->{$vlan_raw_device} )
- && ( $umif->{$vlan_raw_device} ne 'TRUNK' || !defined $av )
- && $umif->{$vlan_raw_device} ne $NET->{'tag'} )
- {
- Abort( $ERR_SYNTAX,
- "Get_UM_If[" . $host . "]: "
- . $M->{'ifup'}->{$nam}
- . " hasn't been remapped properly" );
- }
-
- if ( defined $av ) {
- $umif->{$vlan_raw_device} = 'TRUNK';
- }
- else {
- $umif->{$vlan_raw_device} = $NET->{'tag'};
- }
- }
- else {
- $umif->{ $M->{'ifup'}->{$nam} } = $NET->{'tag'};
- }
+ my $net = $nam;
+ $net =~ s/^[^\.]+\.//;
+ my $NET = $Z->{'NETWORK'}->{'BY_NAME'}->{$net};
+
+ if ( $M->{'ifup'}->{$nam} =~ m/([^:.\d]+)(\d+)?(\.(\d+))?(:(\d+))?/ )
+ {
+ my $ai;
+ my $an;
+ my $av;
+ my $aa;
+
+ $ai = $1;
+ if ( defined $2 ) { $an = $2 }
+ if ( defined $4 ) { $av = $4 }
+ if ( defined $6 ) { $aa = $6 }
+
+ my $vlan_raw_device = $ai . ( ( defined $an ) ? $an : '' );
+
+ if ( defined( $umif->{$vlan_raw_device} )
+ && ( $umif->{$vlan_raw_device} ne 'TRUNK' || !defined $av )
+ && $umif->{$vlan_raw_device} ne $NET->{'tag'} )
+ {
+ Abort( $ERR_SYNTAX,
+ "Get_UM_If["
+ . $host . "]: "
+ . $M->{'ifup'}->{$nam}
+ . " hasn't been remapped properly" );
+ }
+
+ if ( defined $av ) {
+ $umif->{$vlan_raw_device} = 'TRUNK';
+ }
+ else {
+ $umif->{$vlan_raw_device} = $NET->{'tag'};
+ }
+ }
+ else {
+ $umif->{ $M->{'ifup'}->{$nam} } = $NET->{'tag'};
+ }
}
return $umif;
}
@@ -343,114 +357,127 @@
my $M = $N->{'SRVLIST'}->{$hostshort};
if ( !defined($M) ) {
- Abort( $ERR_SYNTAX, "UMRemap_If: " . $host . " not found" );
- }
-
- foreach my $nam ( sort { cmpif( $M->{'ifup'}->{$a}, $M->{'ifup'}->{$b} ) }
- keys %{ $M->{'ifup'} } )
+ Abort( $ERR_SYNTAX, "UMRemap_If: " . $host . " not found" );
+ }
+
+ foreach my $nam (
+ sort { cmpif( $M->{'ifup'}->{$a}, $M->{'ifup'}->{$b} ) }
+ keys %{ $M->{'ifup'} }
+ )
{
- my $net = $nam;
- $net =~ s/^[^\.]+\.//;
- my $NET = $Z->{'NETWORK'}->{'BY_NAME'}->{$net};
-
- if ( !defined( $NET->{'tag'} ) ) {
- Abort( $ERR_SYNTAX, "UMRemap_If[" . $host . "]: " . $net
- . ": cannot wire, tag unknown" );
- exit 1;
- }
+ my $net = $nam;
+ $net =~ s/^[^\.]+\.//;
+ my $NET = $Z->{'NETWORK'}->{'BY_NAME'}->{$net};
+
+ if ( !defined( $NET->{'tag'} ) ) {
+ Abort( $ERR_SYNTAX,
+ "UMRemap_If["
+ . $host . "]: "
+ . $net
+ . ": cannot wire, tag unknown" );
+ exit 1;
+ }
#Debug "IF '$M->{ifup}->{$nam}' -> NET '$net' -> TAG '" . (defined $NET->{tag} ? $NET->{tag} : '?') . "'\n";
- if ( $M->{'ifup'}->{$nam} =~ m/([^:.\d]+)(\d+)?(\.(\d+))?(:(\d+))?/ ) {
- my $ai;
- my $an;
- my $av;
- my $aa;
-
- $ai = $1;
- if ( defined $2 ) { $an = $2 }
- if ( defined $4 ) { $av = $4 }
- if ( defined $6 ) { $aa = $6 }
-
- if ( $ai eq 'eth' && $lastused < $an ) {
- $lastused = $an;
- }
-
- if ( defined $av && defined $NET->{'tag'} && $av != $NET->{'tag'} ) {
- Abort( $ERR_SYNTAX,
- "UMRemap_If[" . $host . "]: "
- . "IF TAG " . $av
- . " != NET TAG "
- . $NET->{'tag'} );
- exit 1;
- }
-
- my $vlan_raw_device = $ai . ( ( defined $an ) ? $an : '' );
-
- # Interface deja connectee?
- if ( defined( $umif{$vlan_raw_device} ) ) {
- if ( defined($av)
- && $umif{$vlan_raw_device} ne 'TRUNK'
- && $UMLTRUNKINGWORKS )
- {
-
- if ( !defined $umvlan{'TRUNK'} || !$UMLTRUNKFACTORIZE ) {
+ if ( $M->{'ifup'}->{$nam} =~ m/([^:.\d]+)(\d+)?(\.(\d+))?(:(\d+))?/ )
+ {
+ my $ai;
+ my $an;
+ my $av;
+ my $aa;
+
+ $ai = $1;
+ if ( defined $2 ) { $an = $2 }
+ if ( defined $4 ) { $av = $4 }
+ if ( defined $6 ) { $aa = $6 }
+
+ if ( $ai eq 'eth' && $lastused < $an ) {
+ $lastused = $an;
+ }
+
+ if ( defined $av
+ && defined $NET->{'tag'}
+ && $av != $NET->{'tag'} )
+ {
+ Abort( $ERR_SYNTAX,
+ "UMRemap_If["
+ . $host . "]: "
+ . "IF TAG "
+ . $av
+ . " != NET TAG "
+ . $NET->{'tag'} );
+ exit 1;
+ }
+
+ my $vlan_raw_device = $ai . ( ( defined $an ) ? $an : '' );
+
+ # Interface deja connectee?
+ if ( defined( $umif{$vlan_raw_device} ) ) {
+ if ( defined($av)
+ && $umif{$vlan_raw_device} ne 'TRUNK'
+ && $UMLTRUNKINGWORKS )
+ {
+
+ if ( !defined $umvlan{'TRUNK'} || !$UMLTRUNKFACTORIZE ) {
#Debug "$vlan_raw_device promoted to TRUNK, needs new UNTAGGED $umif{$vlan_raw_device}\n";
- delete $umvlan{ $umif{$vlan_raw_device} };
- push @{ $iforphan{ $umif{$vlan_raw_device} } },
- $vlan_raw_device;
- $umif{$vlan_raw_device} = 'TRUNK';
- if ( !defined $umvlan{'TRUNK'} ) {
- $umvlan{'TRUNK'} = $vlan_raw_device;
- }
- }
- else {
+ delete $umvlan{ $umif{$vlan_raw_device} };
+ push @{ $iforphan{ $umif{$vlan_raw_device} } },
+ $vlan_raw_device;
+ $umif{$vlan_raw_device} = 'TRUNK';
+ if ( !defined $umvlan{'TRUNK'} ) {
+ $umvlan{'TRUNK'} = $vlan_raw_device;
+ }
+ }
+ else {
#Debug "$umvlan{'TRUNK'} is already connected to TRUNK, using it for $M->{ifup}->{$nam}\n";
- $ifmap{ $M->{'ifup'}->{$nam} } = $umvlan{'TRUNK'};
- }
- }
- elsif ( $umif{$vlan_raw_device} ne 'TRUNK'
- && $umif{$vlan_raw_device} != $NET->{'tag'} )
- {
+ $ifmap{ $M->{'ifup'}->{$nam} } = $umvlan{'TRUNK'};
+ }
+ }
+ elsif ($umif{$vlan_raw_device} ne 'TRUNK'
+ && $umif{$vlan_raw_device} != $NET->{'tag'} )
+ {
#Debug "$vlan_raw_device already connected to UNTAGGED $umif{$vlan_raw_device}, new one needed for UNTAGGED $NET->{tag}\n";
- delete $umvlan{ $NET->{'tag'} };
- push @{ $iforphan{ $NET->{'tag'} } }, $M->{'ifup'}->{$nam};
- }
- }
- else {
- if ( !defined $av ) {
- $umif{$vlan_raw_device} = $NET->{'tag'};
- if ( !defined $umvlan{ $NET->{'tag'} } ) {
- $umvlan{ $NET->{'tag'} } = $vlan_raw_device;
- }
- }
- else {
- $umif{$vlan_raw_device} = 'TRUNK';
- if ( !defined $umvlan{'TRUNK'} ) {
- $umvlan{'TRUNK'} = $vlan_raw_device;
- }
- }
- }
-
- if ( defined $umif{$vlan_raw_device}
- && defined $umvlan{ $umif{$vlan_raw_device} }
- && $umvlan{ $umif{$vlan_raw_device} } ne $vlan_raw_device )
- {
+ delete $umvlan{ $NET->{'tag'} };
+ push @{ $iforphan{ $NET->{'tag'} } },
+ $M->{'ifup'}->{$nam};
+ }
+ }
+ else {
+ if ( !defined $av ) {
+ $umif{$vlan_raw_device} = $NET->{'tag'};
+ if ( !defined $umvlan{ $NET->{'tag'} } ) {
+ $umvlan{ $NET->{'tag'} } = $vlan_raw_device;
+ }
+ }
+ else {
+ $umif{$vlan_raw_device} = 'TRUNK';
+ if ( !defined $umvlan{'TRUNK'} ) {
+ $umvlan{'TRUNK'} = $vlan_raw_device;
+ }
+ }
+ }
+
+ if ( defined $umif{$vlan_raw_device}
+ && defined $umvlan{ $umif{$vlan_raw_device} }
+ && $umvlan{ $umif{$vlan_raw_device} } ne $vlan_raw_device )
+ {
#Debug "TAG $umif{$vlan_raw_device} already connected to IF $umvlan{ $umif{$vlan_raw_device} }\n";
- $ifmap{$vlan_raw_device} = $umvlan{ $umif{$vlan_raw_device} };
- delete $umif{$vlan_raw_device};
- }
- }
- else {
- Warn( $ERR_SYNTAX,
- "UMRemap_If[" . $host
- . "]: Can't parse interface name "
- . $M->{'ifup'}->{$nam}
- . ", skipped" );
- }
+ $ifmap{$vlan_raw_device} = $umvlan{ $umif{$vlan_raw_device} };
+ delete $umif{$vlan_raw_device};
+ }
+ }
+ else {
+ Warn( $ERR_SYNTAX,
+ "UMRemap_If["
+ . $host
+ . "]: Can't parse interface name "
+ . $M->{'ifup'}->{$nam}
+ . ", skipped" );
+ }
}
#if ( scalar( keys %ifmap ) != 0 || scalar( keys %iforphan ) != 0 ) {
@@ -458,80 +485,84 @@
# . "]: Automatic remapping, config may not work!" );
#}
- #
- # Exemple de %iforphan nouvelle formule :
- # (
- # '6' => [ 'eth2:5', 'eth2:6' ],
- # '7' => [ 'eth2:1' ],
- # '8' => [ 'eth2:2' ],
- # '4' => [ 'eth2:7' ],
- # '5' => [ 'eth2:3', 'eth2:4' ]
- # )
- #
+#
+# Exemple de %iforphan nouvelle formule :
+# (
+# '6' => [ 'eth2:5', 'eth2:6' ],
+# '7' => [ 'eth2:1' ],
+# '8' => [ 'eth2:2' ],
+# '4' => [ 'eth2:7' ],
+# '5' => [ 'eth2:3', 'eth2:4' ]
+# )
+#
# FIXME le double foreach et double sort c'est douteux, mais c'�ait le moins invasif.
- #
+#
#Debug "iforphan : "; warn Dumper(\%iforphan); Debug "ifmap : "; warn Dumper(\%ifmap);
my %tmpindexes;
foreach my $nam (
- sort { cmpif( $iforphan{$a}[0], $iforphan{$b}[0] ) || $a <=> $b }
- keys %iforphan )
+ sort { cmpif( $iforphan{$a}[0], $iforphan{$b}[0] ) || $a <=> $b }
+ keys %iforphan
+ )
{
- foreach my $namidx (
- sort {
- cmpif( $iforphan{$nam}[$a], $iforphan{$nam}[$b] ) || $a <=> $b;
- } 0 .. @{ $iforphan{$nam} } - 1
- )
- {
- if ( !defined $umvlan{$nam} ) {
- $lastused++;
+ foreach my $namidx (
+ sort {
+ cmpif( $iforphan{$nam}[$a], $iforphan{$nam}[$b] )
+ || $a <=> $b;
+ } 0 .. @{ $iforphan{$nam} } - 1
+ )
+ {
+ if ( !defined $umvlan{$nam} ) {
+ $lastused++;
# Debug "orphan UNTAGGED $nam (was $iforphan{$nam}[$namidx]) allocated to eth$lastused\n";
- $ifmap{ $iforphan{$nam}[$namidx] } = "eth" . $lastused;
- $umvlan{$nam} = "eth" . $lastused;
- $umif{ "eth" . $lastused } = $nam;
- $tmpindexes{ $umvlan{$nam} } = 0;
- }
- else {
+ $ifmap{ $iforphan{$nam}[$namidx] } = "eth" . $lastused;
+ $umvlan{$nam} = "eth" . $lastused;
+ $umif{ "eth" . $lastused } = $nam;
+ $tmpindexes{ $umvlan{$nam} } = 0;
+ }
+ else {
#Debug "false orphan UNTAGGED $nam (was $iforphan{$nam}[$namidx]) merged with $umvlan{$nam}\n";
- $ifmap{ $iforphan{$nam}[$namidx] } = $umvlan{$nam};
- if ( defined $tmpindexes{ $umvlan{$nam} } ) {
- $ifmap{ $iforphan{$nam}[$namidx] } .=
- ':' . $tmpindexes{ $umvlan{$nam} }++;
- }
- }
+ $ifmap{ $iforphan{$nam}[$namidx] } = $umvlan{$nam};
+ if ( defined $tmpindexes{ $umvlan{$nam} } ) {
+ $ifmap{ $iforphan{$nam}[$namidx] }
+ .= ':' . $tmpindexes{ $umvlan{$nam} }++;
+ }
+ }
# Debug "iforphan : "; warn Dumper(\%iforphan); Debug "ifmap : "; warn Dumper(\%ifmap);
- }
- }
-
- foreach my $nam ( sort { cmpif( $M->{'ifup'}->{$a}, $M->{'ifup'}->{$b} ) }
- keys %{ $M->{'ifup'} } )
+ }
+ }
+
+ foreach my $nam (
+ sort { cmpif( $M->{'ifup'}->{$a}, $M->{'ifup'}->{$b} ) }
+ keys %{ $M->{'ifup'} }
+ )
{
- if ( !defined $ifmap{ $M->{ifup}->{$nam} } ) {
- $M->{'ifupremapped'}->{$nam} = $M->{'ifup'}->{$nam};
- if ( defined $M->{'route'}->{ $M->{'ifup'}->{$nam} } ) {
- $M->{'routeremapped'}->{ $M->{'ifup'}->{$nam} } =
- $M->{route}->{ $M->{'ifup'}->{$nam} };
- }
- if ( defined $M->{'delroute'}->{ $M->{'ifup'}->{$nam} } ) {
- $M->{'delrouteremapped'}->{ $M->{'ifup'}->{$nam} } =
- $M->{'delroute'}->{ $M->{'ifup'}->{$nam} };
- }
- }
- else {
- $M->{'ifupremapped'}->{$nam} = $ifmap{ $M->{'ifup'}->{$nam} };
- if ( defined $M->{'route'}->{ $M->{ifup}->{$nam} } ) {
- $M->{'routeremapped'}->{ $ifmap{ $M->{'ifup'}->{$nam} } } =
- $M->{'route'}->{ $M->{'ifup'}->{$nam} };
- }
- if ( defined $M->{'delroute'}->{ $M->{'ifup'}->{$nam} } ) {
- $M->{'delrouteremapped'}->{ $ifmap{ $M->{'ifup'}->{$nam} } } =
- $M->{'delroute'}->{ $M->{'ifup'}->{$nam} };
- }
- }
+ if ( !defined $ifmap{ $M->{ifup}->{$nam} } ) {
+ $M->{'ifupremapped'}->{$nam} = $M->{'ifup'}->{$nam};
+ if ( defined $M->{'route'}->{ $M->{'ifup'}->{$nam} } ) {
+ $M->{'routeremapped'}->{ $M->{'ifup'}->{$nam} }
+ = $M->{route}->{ $M->{'ifup'}->{$nam} };
+ }
+ if ( defined $M->{'delroute'}->{ $M->{'ifup'}->{$nam} } ) {
+ $M->{'delrouteremapped'}->{ $M->{'ifup'}->{$nam} }
+ = $M->{'delroute'}->{ $M->{'ifup'}->{$nam} };
+ }
+ }
+ else {
+ $M->{'ifupremapped'}->{$nam} = $ifmap{ $M->{'ifup'}->{$nam} };
+ if ( defined $M->{'route'}->{ $M->{ifup}->{$nam} } ) {
+ $M->{'routeremapped'}->{ $ifmap{ $M->{'ifup'}->{$nam} } }
+ = $M->{'route'}->{ $M->{'ifup'}->{$nam} };
+ }
+ if ( defined $M->{'delroute'}->{ $M->{'ifup'}->{$nam} } ) {
+ $M->{'delrouteremapped'}->{ $ifmap{ $M->{'ifup'}->{$nam} } }
+ = $M->{'delroute'}->{ $M->{'ifup'}->{$nam} };
+ }
+ }
}
delete $M->{'ifup'};
@@ -555,15 +586,15 @@
my $hostvlan = $3;
if ( !defined $hostshort ) {
- return undef;
+ return undef;
}
my $hostclass = Host_class( $hostshort, $Z );
- my $N = $Z->{'SERVERS'}->{'BY_NAME'}->{$hostclass};
- my $M = $N->{'SRVLIST'}->{$hostshort};
+ my $N = $Z->{'SERVERS'}->{'BY_NAME'}->{$hostclass};
+ my $M = $N->{'SRVLIST'}->{$hostshort};
if ( !defined($M) ) {
- return undef;
+ return undef;
}
return ( $M->{'umlfilename'} );
@@ -580,15 +611,15 @@
my $hostvlan = $3;
if ( !defined $hostshort ) {
- return undef;
+ return undef;
}
my $hostclass = Host_class( $hostshort, $Z );
- my $N = $Z->{'SERVERS'}->{'BY_NAME'}->{$hostclass};
- my $M = $N->{'SRVLIST'}->{$hostshort};
+ my $N = $Z->{'SERVERS'}->{'BY_NAME'}->{$hostclass};
+ my $M = $N->{'SRVLIST'}->{$hostshort};
if ( !defined($M) ) {
- return undef;
+ return undef;
}
return ( $M->{'initrd'} );
@@ -600,8 +631,8 @@
# On ne peut pas utiliser File::stat sans perturber lib-update etc.
my @st_initrd = stat $initrd;
- unless (@st_initrd and $st_initrd[2] & S_IFREG) {
- Abort( $ERR_OPEN, "Impossible de stat($initrd): $!");
+ unless ( @st_initrd and $st_initrd[2] & S_IFREG ) {
+ Abort( $ERR_OPEN, "Impossible de stat($initrd): $!" );
}
return $st_initrd[7] / 1024;
@@ -617,15 +648,15 @@
my $hostvlan = $3;
if ( !defined $hostshort ) {
- return undef;
+ return undef;
}
my $hostclass = Host_class( $hostshort, $Z );
- my $N = $Z->{'SERVERS'}->{'BY_NAME'}->{$hostclass};
- my $M = $N->{'SRVLIST'}->{$hostshort};
+ my $N = $Z->{'SERVERS'}->{'BY_NAME'}->{$hostclass};
+ my $M = $N->{'SRVLIST'}->{$hostshort};
if ( !defined($M) ) {
- return undef;
+ return undef;
}
return ( $M->{'cmdline'} );
@@ -641,15 +672,15 @@
my $hostvlan = $3;
if ( !defined $hostshort ) {
- return undef;
+ return undef;
}
my $hostclass = Host_class( $hostshort, $Z );
- my $N = $Z->{'SERVERS'}->{'BY_NAME'}->{$hostclass};
- my $M = $N->{'SRVLIST'}->{$hostshort};
+ my $N = $Z->{'SERVERS'}->{'BY_NAME'}->{$hostclass};
+ my $M = $N->{'SRVLIST'}->{$hostshort};
if ( !defined($M) ) {
- return undef;
+ return undef;
}
return ( $M->{'umlfilename'} ) if ($UML);
@@ -670,16 +701,16 @@
$hostnum =~ s/^.*?(\d*)[a-z]*$/$1/;
$hostnum =~ s/^0*//;
if ( $hostnum eq "" ) {
- $hostnum = 0;
+ $hostnum = 0;
}
if ( !defined $hostshort ) {
- return undef;
+ return undef;
}
my $hostclass = Host_class( $hostshort, $Z );
- my $N = $Z->{'SERVERS'}->{'BY_NAME'}->{$hostclass};
- my $M = $N->{'SRVLIST'}->{$hostshort};
+ my $N = $Z->{'SERVERS'}->{'BY_NAME'}->{$hostclass};
+ my $M = $N->{'SRVLIST'}->{$hostshort};
return Get_dns_from_zone( $Z, $M, $hostnum );
}
@@ -688,27 +719,27 @@
my ( $Z, $M, $hostnum ) = @_;
if ( !defined($M) ) {
- return undef;
+ return undef;
}
my $rawdns;
if ( defined $M->{'dns'} && $M->{'dns'} ne "" ) {
- $rawdns = $M->{'dns'};
+ $rawdns = $M->{'dns'};
}
else {
- $rawdns = join ( ", ", @{ $Z->{'NS'} } );
+ $rawdns = join( ", ", @{ $Z->{'NS'} } );
}
my @dns;
- foreach my $dns ( split ( /[,\s]+/, $rawdns ) ) {
- my @resolved = Resolv( $dns, $Z );
- if ( $#resolved >= 0 && defined $resolved[0] ) {
- @resolved = sort @resolved;
- push @dns, rotate( \@resolved, $hostnum );
- }
- else {
- push @dns, $dns;
- }
+ foreach my $dns ( split( /[,\s]+/, $rawdns ) ) {
+ my @resolved = Resolv( $dns, $Z );
+ if ( $#resolved >= 0 && defined $resolved[0] ) {
+ @resolved = sort @resolved;
+ push @dns, rotate( \@resolved, $hostnum );
+ }
+ else {
+ push @dns, $dns;
+ }
}
return @dns;
}
@@ -741,23 +772,23 @@
# Calcul de la conf reseau et de la zone
foreach $s ( keys %$C ) {
- if ( $C->{$s}->{'type'} =~ /network$/ ) {
- Add_network( $Z, $C->{$s}, $s );
- }
-
- # Prise en compte de la zone
- if ( $C->{$s}->{'type'} =~ /zone$/ ) {
- Add_zone( $Z, $C->{$s}, $s );
- }
+ if ( $C->{$s}->{'type'} =~ /network$/ ) {
+ Add_network( $Z, $C->{$s}, $s );
+ }
+
+ # Prise en compte de la zone
+ if ( $C->{$s}->{'type'} =~ /zone$/ ) {
+ Add_zone( $Z, $C->{$s}, $s );
+ }
}
# Calcul de la conf serveur
# (Il doit obligatoirement etre fait en seconde passe
# il utilise les donnees reseau et zone)
foreach $s ( keys %$C ) {
- if ( $C->{$s}->{'type'} =~ /server$/ ) {
- Add_server( $Z, $C->{$s}, $s );
- }
+ if ( $C->{$s}->{'type'} =~ /server$/ ) {
+ Add_server( $Z, $C->{$s}, $s );
+ }
}
# Retour de la structure de donnees
@@ -779,19 +810,19 @@
# Calcul de la plage d'adresse alouee et du nombre de serveurs a definir
if ( !defined( $S->{'nodes'} ) ) {
- $S->{'nodes'} = 1;
+ $S->{'nodes'} = 1;
}
my $nodeslast = $S->{'nodes'} - 1;
if ( $nodeslast < 0 ) {
- $nodeslast = 0;
+ $nodeslast = 0;
}
if ( !defined( $S->{'number'} ) ) {
- $S->{'number'} = 1;
+ $S->{'number'} = 1;
}
my $last = $S->{'number'} - 1;
if ( $last < 0 ) {
- $last = 0;
+ $last = 0;
}
$srv =~ s/(_*)$//;
@@ -801,37 +832,42 @@
# Pas de nodes et plusieurs nodes
if ( $nodeslast > 0 && ( !defined($nodes) || $nodes <= 0 ) ) {
- Abort( $ERR_SYNTAX,
- "Plusieurs nodes " . $srv . " et pas de place pour l'index!" );
+ Abort( $ERR_SYNTAX,
+ "Plusieurs nodes " . $srv . " et pas de place pour l'index!" );
}
# Pas assez de nodes pour le nombre de nodes
if ( $nodeslast > 1 && ceil( log($nodeslast) / log(26) ) > $nodes ) {
- Warn( $ERR_SYNTAX,
- "Dernier node " . $srv . " = "
- . $nodeslast
- . " et pas assez de place (" . $nodes
- . ") pour l'index!" );
+ Warn( $ERR_SYNTAX,
+ "Dernier node "
+ . $srv . " = "
+ . $nodeslast
+ . " et pas assez de place ("
+ . $nodes
+ . ") pour l'index!" );
}
# Pas de digits et plusieurs machines
if ( $last > 0 && ( !defined($digit) || $digit <= 0 ) ) {
- Abort( $ERR_SYNTAX,
- "Plusieurs " . $srv . " et pas de place pour le numero!" );
+ Abort( $ERR_SYNTAX,
+ "Plusieurs " . $srv . " et pas de place pour le numero!" );
}
# Pas assez de digits pour le nombre de machines
if ( $last > 1 && length( sprintf( "%s", $last ) ) > $digit ) {
- Warn( $ERR_SYNTAX,
- "Dernier " . $srv . " = " . $last
- . " et pas assez de place (" . $digit
- . ") pour le numero!" );
+ Warn( $ERR_SYNTAX,
+ "Dernier "
+ . $srv . " = "
+ . $last
+ . " et pas assez de place ("
+ . $digit
+ . ") pour le numero!" );
}
# Initialisation de la structure pour ces serveurs
my $N = {};
$N->{'comment'} = $S->{'comment'} || "Server $srv <no comment specified>";
- $N->{'type'} = $S->{'type'};
+ $N->{'type'} = $S->{'type'};
#$N->{range} = $S->{range};
$N->{'number'} = $S->{'number'};
@@ -843,92 +879,95 @@
my $ipincrement = 1;
if ( defined $S->{'ipincrement'} ) {
- $ipincrement = $S->{'ipincrement'};
+ $ipincrement = $S->{'ipincrement'};
}
# Traitement de chaque occurence
my $ipindex = -$ipincrement;
foreach $s ( 0 .. $last ) {
- for my $n ( 0 .. $nodeslast ) {
- my $M = {};
- my $i;
- my $j;
- my $mnam;
-
- $ipindex += $ipincrement;
-
- # Definition du nom
- my $cnamindex = "";
- my $cnamindexnum = "";
- if ( defined($digit) && $digit > 0 ) {
- $cnamindex .= sprintf( "%0" . $digit . "s", $s );
- $cnamindexnum .= sprintf( "%s", $s );
- }
- my $mnamindex = $cnamindex;
- my $mnamindexnum = $cnamindexnum;
- if ( defined($nodes) && $nodes > 0 ) {
- $mnamindex = $cnamindex
- . sprintf( "%0" . $nodes . "s", node2index( $n, $nodes ) );
- $mnamindexnum =
- $cnamindexnum
- . sprintf( "%0" . $nodes . "s", node2index( $n, $nodes ) );
- }
-
- $mnam = $srv . $mnamindex;
- if ( $cnamindexnum eq "" ) {
- $cnamindexnum = "0";
- }
- if ( $mnamindexnum eq "" ) {
- $mnamindexnum = "0";
- }
-
- $M->{'name'} = $mnam;
- $M->{'zone'} = {};
- $M->{'ifup'} = {};
- $M->{'route'} = {};
- $M->{'delroute'} = {};
-
- if ( defined( $S->{'filename'}->{$mnamindexnum} ) ) {
- $M->{'filename'} = $S->{'filename'}->{$mnamindexnum};
- }
- elsif ( defined( $S->{'filename'}->{'default'} ) ) {
- $M->{'filename'} = $S->{'filename'}->{'default'};
- }
-
- if ( defined( $S->{'pxefilename'}->{$mnamindexnum} ) ) {
- $M->{'pxefilename'} = $S->{'pxefilename'}->{$mnamindexnum};
- }
- elsif ( defined( $S->{'pxefilename'}->{'default'} ) ) {
- $M->{'pxefilename'} = $S->{'pxefilename'}->{'default'};
- }
-
- if ( defined( $S->{'umlfilename'}->{$mnamindexnum} ) ) {
- $M->{'umlfilename'} = $S->{'umlfilename'}->{$mnamindexnum};
- }
- elsif ( defined( $S->{'umlfilename'}->{'default'} ) ) {
- $M->{'umlfilename'} = $S->{'umlfilename'}->{'default'};
- }
-
- if ( defined( $S->{'vmwfilename'}->{$mnamindexnum} ) ) {
- $M->{'vmwfilename'} = $S->{'vmwfilename'}->{$mnamindexnum};
- }
- elsif ( defined( $S->{'vmwfilename'}->{'default'} ) ) {
- $M->{'vmwfilename'} = $S->{'vmwfilename'}->{'default'};
- }
-
- if ( defined( $S->{'pxelinuxconf'}->{$mnamindexnum} ) ) {
- $M->{'pxelinuxconf'} = $S->{'pxelinuxconf'}->{$mnamindexnum};
- }
- elsif ( defined( $S->{'pxelinuxconf'}->{'default'} ) ) {
- $M->{'pxelinuxconf'} = $S->{'pxelinuxconf'}->{'default'};
- }
-
- if ( defined( $S->{'dns'}->{$mnamindexnum} ) ) {
- $M->{'dns'} = $S->{'dns'}->{$mnamindexnum};
- }
- elsif ( defined( $S->{'dns'}->{'default'} ) ) {
- $M->{'dns'} = $S->{'dns'}->{'default'};
- }
+ for my $n ( 0 .. $nodeslast ) {
+ my $M = {};
+ my $i;
+ my $j;
+ my $mnam;
+
+ $ipindex += $ipincrement;
+
+ # Definition du nom
+ my $cnamindex = "";
+ my $cnamindexnum = "";
+ if ( defined($digit) && $digit > 0 ) {
+ $cnamindex .= sprintf( "%0" . $digit . "s", $s );
+ $cnamindexnum .= sprintf( "%s", $s );
+ }
+ my $mnamindex = $cnamindex;
+ my $mnamindexnum = $cnamindexnum;
+ if ( defined($nodes) && $nodes > 0 ) {
+ $mnamindex
+ = $cnamindex
+ . sprintf( "%0" . $nodes . "s",
+ node2index( $n, $nodes ) );
+ $mnamindexnum
+ = $cnamindexnum
+ . sprintf( "%0" . $nodes . "s",
+ node2index( $n, $nodes ) );
+ }
+
+ $mnam = $srv . $mnamindex;
+ if ( $cnamindexnum eq "" ) {
+ $cnamindexnum = "0";
+ }
+ if ( $mnamindexnum eq "" ) {
+ $mnamindexnum = "0";
+ }
+
+ $M->{'name'} = $mnam;
+ $M->{'zone'} = {};
+ $M->{'ifup'} = {};
+ $M->{'route'} = {};
+ $M->{'delroute'} = {};
+
+ if ( defined( $S->{'filename'}->{$mnamindexnum} ) ) {
+ $M->{'filename'} = $S->{'filename'}->{$mnamindexnum};
+ }
+ elsif ( defined( $S->{'filename'}->{'default'} ) ) {
+ $M->{'filename'} = $S->{'filename'}->{'default'};
+ }
+
+ if ( defined( $S->{'pxefilename'}->{$mnamindexnum} ) ) {
+ $M->{'pxefilename'} = $S->{'pxefilename'}->{$mnamindexnum};
+ }
+ elsif ( defined( $S->{'pxefilename'}->{'default'} ) ) {
+ $M->{'pxefilename'} = $S->{'pxefilename'}->{'default'};
+ }
+
+ if ( defined( $S->{'umlfilename'}->{$mnamindexnum} ) ) {
+ $M->{'umlfilename'} = $S->{'umlfilename'}->{$mnamindexnum};
+ }
+ elsif ( defined( $S->{'umlfilename'}->{'default'} ) ) {
+ $M->{'umlfilename'} = $S->{'umlfilename'}->{'default'};
+ }
+
+ if ( defined( $S->{'vmwfilename'}->{$mnamindexnum} ) ) {
+ $M->{'vmwfilename'} = $S->{'vmwfilename'}->{$mnamindexnum};
+ }
+ elsif ( defined( $S->{'vmwfilename'}->{'default'} ) ) {
+ $M->{'vmwfilename'} = $S->{'vmwfilename'}->{'default'};
+ }
+
+ if ( defined( $S->{'pxelinuxconf'}->{$mnamindexnum} ) ) {
+ $M->{'pxelinuxconf'} = $S->{'pxelinuxconf'}->{$mnamindexnum};
+ }
+ elsif ( defined( $S->{'pxelinuxconf'}->{'default'} ) ) {
+ $M->{'pxelinuxconf'} = $S->{'pxelinuxconf'}->{'default'};
+ }
+
+ if ( defined( $S->{'dns'}->{$mnamindexnum} ) ) {
+ $M->{'dns'} = $S->{'dns'}->{$mnamindexnum};
+ }
+ elsif ( defined( $S->{'dns'}->{'default'} ) ) {
+ $M->{'dns'} = $S->{'dns'}->{'default'};
+ }
if ( defined( $S->{'initrd'}->{$mnamindexnum} ) ) {
$M->{'initrd'} = $S->{'initrd'}->{$mnamindexnum};
@@ -937,7 +976,8 @@
$M->{'initrd'} = $S->{'initrd'}->{'default'};
}
else {
- # pour ne pas �re oblig�d'ajouter "initrd.default = initrd" � # toutes les d�larations de serveurs dans private-network
+
+# pour ne pas �re oblig�d'ajouter "initrd.default = initrd" � # toutes les d�larations de serveurs dans private-network
$M->{'initrd'} = 'initrd';
}
@@ -948,226 +988,243 @@
$M->{'cmdline'} = $S->{'cmdline'}->{'default'};
}
- # vrrp?
- my $vrrp;
- foreach $j ( keys %{ $S->{'vrrp'} } ) {
- if ( $S->{'vrrp'}->{$j} eq $s
- || ( $S->{'vrrp'}->{$j} eq "last" && $s == $last ) )
- {
- $vrrp = $j;
- $mnam = $j;
- }
- }
-
- my $goteth1 = 0;
-
- # Traitement de chaque interface (ou reseau)
- foreach $i ( sort { cmpif( $a, $b ) } keys %{ $S->{'interface'} } ) {
- my $nam;
-
- if ( $i eq 'eth1' ) {
- $goteth1 = 1;
- }
-
- $j = $i;
- if ( $j =~ m/^eth3/ && $NOETH3 ) {
- if ($goteth1) {
- $j = 'eth1' . $' . ':9999';
- }
- else {
- $j = 'eth1' . $';
- }
- }
-
- # Definition de l'entree DNS pour cette interface
- my $lan = $S->{'interface'}->{$i};
-
- $nam = $mnam . "." . $lan;
-
- my $addr = $Z->{'NETWORK'}->{'BY_NAME'}->{$lan}->{'network'};
-
- if ( defined $S->{'ipstart'}->{$lan} ) {
- $start = $S->{'ipstart'}->{$lan};
- }
- elsif ( defined $S->{'ipstart'}->{'default'} ) {
- $start = $S->{'ipstart'}->{'default'};
- }
- else {
- $start = $S->{'ipstart'}->{ $S->{'shortname'} };
- }
-
- if ( !defined $start ) {
- Abort( $ERR_SYNTAX, "No ipstart for " . $nam );
- }
-
- $M->{'zone'}->{$nam} = {};
- $M->{'zone'}->{$nam}->{'FIELD'} =
- Address( $addr, $start, $ipindex );
- $M->{'zone'}->{$nam}->{'TYPE'} = 'A';
-
- # Adresse ethernet (pas forcement avec dhcp, eg tftp)
- if ( defined( $S->{'ether'}->{$mnamindexnum} ) ) {
- $M->{'zone'}->{$nam}->{'ether'} = $S->{'ether'}->{$mnamindexnum};
- }
-
- if ( defined( $S->{'vmether'}->{$mnamindexnum} ) ) {
- $M->{'zone'}->{$nam}->{'vmether'} =
- $S->{'vmether'}->{$mnamindexnum};
- }
- elsif ( defined( $S->{'ether'}->{$mnamindexnum} ) ) {
- $M->{'zone'}->{$nam}->{'vmether'} = '00:50:56:' . sprintf(
- "%02x:%02x:%02x",
- unpack( "L", $mnam ) % 255, # L : long unsigned,
- unpack( "L", reverse $mnam ) % 255,
- $start + $ipindex
- );
- }
-
- # Definition de l'alias DNS principal
- if ( $S->{'shortname'} eq $lan ) {
- $M->{'zone'}->{$mnam} = {};
- $M->{'zone'}->{$mnam}->{'FIELD'} = $nam;
- $M->{'zone'}->{$mnam}->{'TYPE'} = 'CNAME';
- }
-
- # Alias de vlan pour la classe
- if ( !defined( $Z->{'ALIAS'}->{ $srv . '.' . $lan } ) ) {
- $Z->{'ALIAS'}->{ $srv . '.' . $lan } = [];
- }
- if (
- scalar( grep( /^$nam$/, $Z->{'ALIAS'}->{ $srv . '.' . $lan } )
- ) == 0 )
- {
- push ( @{ $Z->{'ALIAS'}->{ $srv . '.' . $lan } },
- $M->{'zone'}->{$nam}->{'FIELD'} );
- }
-
- # Alias de vlan pour le cluster
- if ( $nodeslast > 0 ) {
- if ( !defined
- ( $Z->{'ALIAS'}->{ $srv . $cnamindex . '.' . $lan } ) )
- {
- $Z->{'ALIAS'}->{ $srv . $cnamindex . '.' . $lan } = [];
- }
- if (
- scalar(
- grep( /^$nam$/,
- $Z->{'ALIAS'}->{ $srv . $cnamindex . '.' . $lan } ) ) ==
- 0 )
- {
- push ( @{ $Z->{'ALIAS'}->{ $srv
- . $cnamindex . '.'
- . $lan } }, $M->{'zone'}->{$nam}->{'FIELD'} );
- }
- }
-
- # Definition de l'entree dans /etc/network/interface
- if ( defined( $S->{'dhcp'} ) && $i eq $S->{'dhcp'} ) {
- $M->{'ifup'}->{'dhcp'} = $j;
- }
- else {
- $M->{'ifup'}->{$nam} = $j;
- }
-
- # Traitement des routes
- my $r;
- foreach $r ( keys %{ $S->{$i} } ) {
- if ( $r =~ m/^route/ ) {
- $M->{'route'}->{$j}->{$r} = $S->{$i}->{$r};
- }
- }
-
- # Traitement des suppressions de routes
- my $dr;
- foreach $dr ( keys %{ $S->{$i} } ) {
- if ( $dr =~ m/^delroute/ ) {
- $M->{'delroute'}->{$j}->{$dr} = $S->{$i}->{$dr};
- }
- }
-
- # Traitement des mtu
- if ( defined( $S->{$i}->{'mtu'} ) ) {
- $M->{'mtu'}->{$j} = $S->{$i}->{'mtu'};
- }
-
- # Traitement des media
- if ( defined( $S->{$i}->{'media'} ) ) {
- $M->{'media'}->{$j} = $S->{$i}->{'media'};
- }
-
- # Traitement des noarp
- if ( defined( $S->{$i}->{'noarp'} ) ) {
- $M->{'noarp'}->{$j} = $S->{$i}->{'noarp'};
- }
- }
-
- # Definition des alias DNS
- foreach $j ( keys %{ $S->{'alias'} } ) {
- my $lan;
- my $nam;
- my $addr;
-
- # Alias par machine
- $lan = $S->{'alias'}->{$j};
- $nam = $j . $mnamindex;
-
- # ne pas ecraser si shortname deja existant
- if ( !defined $M->{'zone'}->{$nam} ) {
- $M->{'zone'}->{$nam} = {};
- $M->{'zone'}->{$nam}->{'FIELD'} = $mnam . "." . $lan;
- $M->{'zone'}->{$nam}->{'TYPE'} = 'CNAME';
- }
-
-# Alias "round robin" pour l'ensemble de cette classe de serveurs
- $nam = $mnam . "." . $lan;
-
- #if ( !defined( $Z->{ALIAS}->{$j} ) ) {
- # $Z->{ALIAS}->{$j} = [];
- #}
- #push ( @{ $Z->{ALIAS}->{$j} }, $M->{zone}->{$nam}->{FIELD} );
- if ( $s == 0 && $n == 0 && !defined $M->{'zone'}->{$j} ) {
- $M->{'zone'}->{$j} = {};
- $M->{'zone'}->{$j}->{'FIELD'} = $srv . "." . $lan;
- $M->{'zone'}->{$j}->{'TYPE'} = 'CNAME';
- }
- if ( $nodeslast > 0
- && $s == 0
- && $n == 0
- && !defined $M->{'zone'}->{ $j . $cnamindex } )
- {
- $M->{'zone'}->{ $j . $cnamindex } = {};
- $M->{'zone'}->{ $j . $cnamindex }->{'FIELD'} =
- $srv . $cnamindex . "." . $lan;
- $M->{'zone'}->{ $j . $cnamindex }->{'TYPE'} = 'CNAME';
- }
- }
-
- # Insertion du serveur dans sa classe
- $N->{'SRVLIST'}->{$mnam} = $M;
- }
-
- # Vips du cluster
+ # vrrp?
+ my $vrrp;
+ foreach $j ( keys %{ $S->{'vrrp'} } ) {
+ if ( $S->{'vrrp'}->{$j} eq $s
+ || ( $S->{'vrrp'}->{$j} eq "last" && $s == $last ) )
+ {
+ $vrrp = $j;
+ $mnam = $j;
+ }
+ }
+
+ my $goteth1 = 0;
+
+ # Traitement de chaque interface (ou reseau)
+ foreach $i ( sort { cmpif( $a, $b ) }
+ keys %{ $S->{'interface'} } )
+ {
+ my $nam;
+
+ if ( $i eq 'eth1' ) {
+ $goteth1 = 1;
+ }
+
+ $j = $i;
+ if ( $j =~ m/^eth3/ && $NOETH3 ) {
+ if ($goteth1) {
+ $j = 'eth1' . $' . ':9999';
+ }
+ else {
+ $j = 'eth1' . $';
+ }
+ }
+
+ # Definition de l'entree DNS pour cette interface
+ my $lan = $S->{'interface'}->{$i};
+
+ $nam = $mnam . "." . $lan;
+
+ my $addr = $Z->{'NETWORK'}->{'BY_NAME'}->{$lan}->{'network'};
+
+ if ( defined $S->{'ipstart'}->{$lan} ) {
+ $start = $S->{'ipstart'}->{$lan};
+ }
+ elsif ( defined $S->{'ipstart'}->{'default'} ) {
+ $start = $S->{'ipstart'}->{'default'};
+ }
+ else {
+ $start = $S->{'ipstart'}->{ $S->{'shortname'} };
+ }
+
+ if ( !defined $start ) {
+ Abort( $ERR_SYNTAX, "No ipstart for " . $nam );
+ }
+
+ $M->{'zone'}->{$nam} = {};
+ $M->{'zone'}->{$nam}->{'FIELD'}
+ = Address( $addr, $start, $ipindex );
+ $M->{'zone'}->{$nam}->{'TYPE'} = 'A';
+
+ # Adresse ethernet (pas forcement avec dhcp, eg tftp)
+ if ( defined( $S->{'ether'}->{$mnamindexnum} ) ) {
+ $M->{'zone'}->{$nam}->{'ether'}
+ = $S->{'ether'}->{$mnamindexnum};
+ }
+
+ if ( defined( $S->{'vmether'}->{$mnamindexnum} ) ) {
+ $M->{'zone'}->{$nam}->{'vmether'}
+ = $S->{'vmether'}->{$mnamindexnum};
+ }
+ elsif ( defined( $S->{'ether'}->{$mnamindexnum} ) ) {
+ $M->{'zone'}->{$nam}->{'vmether'} = '00:50:56:' . sprintf(
+ "%02x:%02x:%02x",
+ unpack( "L", $mnam ) % 255, # L : long unsigned,
+ unpack( "L", reverse $mnam ) % 255,
+ $start + $ipindex
+ );
+ }
+
+ # Definition de l'alias DNS principal
+ if ( $S->{'shortname'} eq $lan ) {
+ $M->{'zone'}->{$mnam} = {};
+ $M->{'zone'}->{$mnam}->{'FIELD'} = $nam;
+ $M->{'zone'}->{$mnam}->{'TYPE'} = 'CNAME';
+ }
+
+ # Alias de vlan pour la classe
+ if ( !defined( $Z->{'ALIAS'}->{ $srv . '.' . $lan } ) ) {
+ $Z->{'ALIAS'}->{ $srv . '.' . $lan } = [];
+ }
+ if (scalar(
+ grep( /^$nam$/, $Z->{'ALIAS'}->{ $srv . '.' . $lan } )
+ ) == 0
+ )
+ {
+ push(
+ @{ $Z->{'ALIAS'}->{ $srv . '.' . $lan } },
+ $M->{'zone'}->{$nam}->{'FIELD'}
+ );
+ }
+
+ # Alias de vlan pour le cluster
+ if ( $nodeslast > 0 ) {
+ if (!defined(
+ $Z->{'ALIAS'}->{ $srv . $cnamindex . '.' . $lan }
+ )
+ )
+ {
+ $Z->{'ALIAS'}->{ $srv . $cnamindex . '.' . $lan }
+ = [];
+ }
+ if (scalar(
+ grep( /^$nam$/,
+ $Z->{'ALIAS'}
+ ->{ $srv . $cnamindex . '.' . $lan } )
+ ) == 0
+ )
+ {
+ push(
+ @{ $Z->{'ALIAS'}
+ ->{ $srv . $cnamindex . '.' . $lan }
+ },
+ $M->{'zone'}->{$nam}->{'FIELD'}
+ );
+ }
+ }
+
+ # Definition de l'entree dans /etc/network/interface
+ if ( defined( $S->{'dhcp'} ) && $i eq $S->{'dhcp'} ) {
+ $M->{'ifup'}->{'dhcp'} = $j;
+ }
+ else {
+ $M->{'ifup'}->{$nam} = $j;
+ }
+
+ # Traitement des routes
+ my $r;
+ foreach $r ( keys %{ $S->{$i} } ) {
+ if ( $r =~ m/^route/ ) {
+ $M->{'route'}->{$j}->{$r} = $S->{$i}->{$r};
+ }
+ }
+
+ # Traitement des suppressions de routes
+ my $dr;
+ foreach $dr ( keys %{ $S->{$i} } ) {
+ if ( $dr =~ m/^delroute/ ) {
+ $M->{'delroute'}->{$j}->{$dr} = $S->{$i}->{$dr};
+ }
+ }
+
+ # Traitement des mtu
+ if ( defined( $S->{$i}->{'mtu'} ) ) {
+ $M->{'mtu'}->{$j} = $S->{$i}->{'mtu'};
+ }
+
+ # Traitement des media
+ if ( defined( $S->{$i}->{'media'} ) ) {
+ $M->{'media'}->{$j} = $S->{$i}->{'media'};
+ }
+
+ # Traitement des noarp
+ if ( defined( $S->{$i}->{'noarp'} ) ) {
+ $M->{'noarp'}->{$j} = $S->{$i}->{'noarp'};
+ }
+ }
+
+ # Definition des alias DNS
+ foreach $j ( keys %{ $S->{'alias'} } ) {
+ my $lan;
+ my $nam;
+ my $addr;
+
+ # Alias par machine
+ $lan = $S->{'alias'}->{$j};
+ $nam = $j . $mnamindex;
+
+ # ne pas ecraser si shortname deja existant
+ if ( !defined $M->{'zone'}->{$nam} ) {
+ $M->{'zone'}->{$nam} = {};
+ $M->{'zone'}->{$nam}->{'FIELD'} = $mnam . "." . $lan;
+ $M->{'zone'}->{$nam}->{'TYPE'} = 'CNAME';
+ }
+
+ # Alias "round robin" pour l'ensemble de cette classe de serveurs
+ $nam = $mnam . "." . $lan;
+
+ #if ( !defined( $Z->{ALIAS}->{$j} ) ) {
+ # $Z->{ALIAS}->{$j} = [];
+ #}
+ #push ( @{ $Z->{ALIAS}->{$j} }, $M->{zone}->{$nam}->{FIELD} );
+ if ( $s == 0 && $n == 0 && !defined $M->{'zone'}->{$j} ) {
+ $M->{'zone'}->{$j} = {};
+ $M->{'zone'}->{$j}->{'FIELD'} = $srv . "." . $lan;
+ $M->{'zone'}->{$j}->{'TYPE'} = 'CNAME';
+ }
+ if ( $nodeslast > 0
+ && $s == 0
+ && $n == 0
+ && !defined $M->{'zone'}->{ $j . $cnamindex } )
+ {
+ $M->{'zone'}->{ $j . $cnamindex } = {};
+ $M->{'zone'}->{ $j . $cnamindex }->{'FIELD'}
+ = $srv . $cnamindex . "." . $lan;
+ $M->{'zone'}->{ $j . $cnamindex }->{'TYPE'} = 'CNAME';
+ }
+ }
+
+ # Insertion du serveur dans sa classe
+ $N->{'SRVLIST'}->{$mnam} = $M;
+ }
+
+ # Vips du cluster
}
# Insertion de la classe de serveurs dans la structure principale
if ( defined $S->{'ipstart'}->{ $S->{'shortname'} } ) {
- $start = $S->{'ipstart'}->{ $S->{'shortname'} };
+ $start = $S->{'ipstart'}->{ $S->{'shortname'} };
}
else {
- $start = $S->{'ipstart'}->{'default'};
- }
-
- $Z->{'SERVERS'}->{'BY_ADDR'}
- ->{ Address( $Z->{'NETWORK'}->{'BY_NAME'}->{ $S->{'shortname'} }->{'network'},
- $start, 0 ) } = $N;
+ $start = $S->{'ipstart'}->{'default'};
+ }
+
+ $Z->{'SERVERS'}->{'BY_ADDR'}->{
+ Address(
+ $Z->{'NETWORK'}->{'BY_NAME'}->{ $S->{'shortname'} }->{'network'},
+ $start, 0
+ )
+ }
+ = $N;
$Z->{'SERVERS'}->{'BY_NAME'}->{$srv} = $N;
# Remapping UM
if ($UML) {
- my $mnam;
- foreach $mnam ( keys %{ $N->{'SRVLIST'} } ) {
- UMRemap_If( $Z, $mnam );
- }
+ my $mnam;
+ foreach $mnam ( keys %{ $N->{'SRVLIST'} } ) {
+ UMRemap_If( $Z, $mnam );
+ }
}
}
@@ -1190,9 +1247,12 @@
# Verification de l'unicite de la declaration
if ( defined( $Z->{'SOA'}->{'name'} ) ) {
- Abort( $ERR_SYNTAX,
- "Declaration zone dupliquee ("
- . $Z->{'SOA'}->{'name'} . ") et (" . $zone . ")" );
+ Abort( $ERR_SYNTAX,
+ "Declaration zone dupliquee ("
+ . $Z->{'SOA'}->{'name'}
+ . ") et ("
+ . $zone
+ . ")" );
}
# Ajout des informations SOA
@@ -1212,17 +1272,19 @@
$soa =~ s/([^\.])$/$1./;
if ( defined $S->{'serial'} && $S->{'serial'} =~ m|([\d.]+)| ) {
- my $rev = $1;
-
- $rev =~ s/\.//g;
-
- $Z->{'SOA'}->{'serial'} = $rev . "\t; Serial (" . $S->{'serial'} . ")";
+ my $rev = $1;
+
+ $rev =~ s/\.//g;
+
+ $Z->{'SOA'}->{'serial'}
+ = $rev . "\t; Serial (" . $S->{'serial'} . ")";
}
else {
- $Z->{'SOA'}->{'serial'} = $t_secs . "\t; Serial (" . $t_text . ")";
+ $Z->{'SOA'}->{'serial'} = $t_secs . "\t; Serial (" . $t_text . ")";
}
$Z->{'SOA'}->{'name'} = $zone;
- $Z->{'SOA'}->{'comment'} = $S->{'comment'} || "Zone $zone <no comment specified>";
+ $Z->{'SOA'}->{'comment'} = $S->{'comment'}
+ || "Zone $zone <no comment specified>";
$Z->{'SOA'}->{'soa'} = $soa;
$Z->{'SOA'}->{'mail'} = $mail;
$Z->{'SOA'}->{'refresh'} = $S->{'refresh'};
@@ -1232,20 +1294,20 @@
$Z->{'SOA'}->{'ttl'} = $S->{'ttl'};
if ( defined $S->{'dhcpvlan'} ) {
- @{ $Z->{'SOA'}->{'dhcpvlan'} } = split ( /[,\s]+/, $S->{'dhcpvlan'} );
+ @{ $Z->{'SOA'}->{'dhcpvlan'} } = split( /[,\s]+/, $S->{'dhcpvlan'} );
}
else {
- @{ $Z->{SOA}->{'dhcpvlan'} } = @DEFAULTDHCPVLAN;
+ @{ $Z->{SOA}->{'dhcpvlan'} } = @DEFAULTDHCPVLAN;
}
# Ajout des champs NS
foreach $c ( sort ( keys %{ $S->{'ns'} } ) ) {
- push ( @{ $Z->{'NS'} }, $S->{'ns'}->{$c} );
+ push( @{ $Z->{'NS'} }, $S->{'ns'}->{$c} );
}
# Ajout des champs MX
foreach $c ( sort ( keys %{ $S->{'mx'} } ) ) {
- push ( @{ $Z->{'MX'} }, $S->{'mx'}->{$c} );
+ push( @{ $Z->{'MX'} }, $S->{'mx'}->{$c} );
}
}
@@ -1263,20 +1325,21 @@
# Verification des declarations
if ( !defined( $S->{'network'} ) ) {
- Abort( $ERR_SYNTAX,
- "Adresse de reseau manquante pour le reseau " . $net );
+ Abort( $ERR_SYNTAX,
+ "Adresse de reseau manquante pour le reseau " . $net );
}
if ( !defined( $S->{'netmask'} ) ) {
- Abort( $ERR_SYNTAX,
- "Masque de reseau manquant pour le reseau " . $net );
+ Abort( $ERR_SYNTAX,
+ "Masque de reseau manquant pour le reseau " . $net );
}
if ( defined( $Z->{'NETWORK'}->{ $S->{'network'} } ) ) {
- Abort( $ERR_SYNTAX,
- "Adresse de reseau dupliquee ("
- . $S->{'network'}
- . ") pour le reseau " . $net );
+ Abort( $ERR_SYNTAX,
+ "Adresse de reseau dupliquee ("
+ . $S->{'network'}
+ . ") pour le reseau "
+ . $net );
}
# Calcul des adresses, netmasks et broadcasts
@@ -1288,7 +1351,8 @@
$N->{'mtu'} = $S->{'mtu'};
$N->{'tag'} = $S->{'tag'};
$N->{'media'} = $S->{'media'};
- $N->{'comment'} = $S->{'comment'} || "Network $net <no comment specified>";
+ $N->{'comment'} = $S->{'comment'}
+ || "Network $net <no comment specified>";
# Insertion dans la structure principale
$Z->{'NETWORK'}->{'BY_ADDR'}->{ $N->{'network'} } = $N;
@@ -1305,15 +1369,15 @@
my ( $h, $Z ) = @_;
# !!!!!! Attention ne marchera pas si la classe se termine par de chiffres !!!!
- # Gros fix qui tache
+# Gros fix qui tache
if ( defined $Z->{'SERVERS'}->{'BY_NAME'}->{$h} ) {
- return ($h);
+ return ($h);
}
# Gros fix qui tache encore plus...
$h =~ s/(\d)[a-z]+$/$1/;
if ( defined $Z->{'SERVERS'}->{'BY_NAME'}->{$h} ) {
- return ($h);
+ return ($h);
}
$h =~ s/\d+$//;
@@ -1332,15 +1396,15 @@
my $i;
- my (@A) = split ( /\./, $a );
- my (@N) = split ( /\./, $n );
+ my (@A) = split( /\./, $a );
+ my (@N) = split( /\./, $n );
foreach $i ( 0 .. 3 ) {
- $A[$i] += 0;
- $N[$i] += 0;
- $A[$i] = $A[$i] + ( ( ~( $N[$i] ) ) & 255 );
- }
- return join ( '.', @A );
+ $A[$i] += 0;
+ $N[$i] += 0;
+ $A[$i] = $A[$i] + ( ( ~( $N[$i] ) ) & 255 );
+ }
+ return join( '.', @A );
}
@@ -1364,23 +1428,23 @@
sub Address {
my ( $b, $o, $n ) = @_;
- my @b = split ( '\.', $b );
- my @o = split ( '\.', $o );
+ my @b = split( '\.', $b );
+ my @o = split( '\.', $o );
my @r;
while ( $#o < $#b ) {
- unshift @o, 0;
+ unshift @o, 0;
}
while ( $#o > 0 && $o[0] == 0 ) {
- push @r, shift @b;
- shift @o;
+ push @r, shift @b;
+ shift @o;
}
while ( $#o >= 0 ) {
- push @r, $o[0];
- shift @b;
- shift @o;
+ push @r, $o[0];
+ shift @b;
+ shift @o;
}
$r[3] += $n;
@@ -1388,13 +1452,13 @@
my $i = 3;
my $c = 0;
while ( $i >= 0 ) {
- $r[$i] += $c;
- $c = $r[$i] / 256;
- $r[$i] %= 256;
- $i--;
- }
-
- return ( join ( '.', @r ) );
+ $r[$i] += $c;
+ $c = $r[$i] / 256;
+ $r[$i] %= 256;
+ $i--;
+ }
+
+ return ( join( '.', @r ) );
}
sub Mk_dhcp {
@@ -1403,8 +1467,10 @@
my $vlan;
my $s;
- my $dhcpvlanregex =
- '^([^.]+)\.(' . join ( '|', @{ $Z->{'SOA'}->{'dhcpvlan'} } ) . ')(\.*)?$';
+ my $dhcpvlanregex
+ = '^([^.]+)\.('
+ . join( '|', @{ $Z->{'SOA'}->{'dhcpvlan'} } )
+ . ')(\.*)?$';
open( FIC, ">" . $fic ) || die "Cannot open " . $fic . " : " . $!;
$oldout = select(FIC);
@@ -1412,7 +1478,7 @@
open( HEAD, "<" . $head ) || die "Cannot open " . $head . " : " . $!;
while (<HEAD>) {
- print;
+ print;
}
close(HEAD);
@@ -1420,129 +1486,125 @@
print "\n";
foreach $vlan ( @{ $Z->{'SOA'}->{'dhcpvlan'} } ) {
- printf( "# %s\n", $Z->{'NETWORK'}->{'BY_NAME'}->{$vlan}->{'comment'} );
- printf(
- "subnet %s netmask %s {\n}\n\n",
- $Z->{'NETWORK'}->{'BY_NAME'}->{$vlan}->{'network'},
- $Z->{'NETWORK'}->{'BY_NAME'}->{$vlan}->{'netmask'}
- );
+ printf( "# %s\n",
+ $Z->{'NETWORK'}->{'BY_NAME'}->{$vlan}->{'comment'} );
+ printf(
+ "subnet %s netmask %s {\n}\n\n",
+ $Z->{'NETWORK'}->{'BY_NAME'}->{$vlan}->{'network'},
+ $Z->{'NETWORK'}->{'BY_NAME'}->{$vlan}->{'netmask'}
+ );
}
print "\n";
foreach $s ( sort ( keys %{ $Z->{'SERVERS'}->{'BY_ADDR'} } ) ) {
- my $m;
- my $N = $Z->{'SERVERS'}->{'BY_ADDR'}->{$s};
-
- print "# ", $N->{'comment'}, "\n";
- print "# number: ", $N->{'number'}, "\n";
- print "# nodes: ", $N->{'nodes'}, "\n"
- if ( defined( $N->{'nodes'} ) && $N->{'nodes'} > 1 );
- print "\n";
-
- foreach $m ( sort ( keys %{ $N->{'SRVLIST'} } ) ) {
- my $nam;
- my $M = $N->{'SRVLIST'}->{$m};
-
- foreach $nam ( sort ( keys %{ $M->{'zone'} } ) ) {
- if ( $nam =~ /$dhcpvlanregex/ ) {
- my $nam2 = $1;
-
- #my $vlan2 = $2;
-
- my $hostnum = $nam2;
- $hostnum =~ s/^.*?(\d*)[a-z]*$/$1/;
- $hostnum =~ s/^0*//;
- if ( $hostnum eq "" ) {
- $hostnum = 0;
- }
-
- if ( defined( $M->{'zone'}->{$nam}->{'ether'} ) ) {
- printf( "host %s {\n", $nam2 );
- printf(
- " hardware ethernet %s;\n",
- $M->{'zone'}->{$nam}->{'ether'}
- );
- printf(
- " fixed-address %s.%s;\n", $nam,
- $Z->{'SOA'}->{'name'}
- );
-
- if ( defined( $M->{'filename'} ) && $M->{'filename'} ne "" )
- {
- printf( " filename \"%s\";\n", $M->{'filename'} );
- }
-
- if ( $M->{'initrd'} ) {
+ my $m;
+ my $N = $Z->{'SERVERS'}->{'BY_ADDR'}->{$s};
+
+ print "# ", $N->{'comment'}, "\n";
+ print "# number: ", $N->{'number'}, "\n";
+ print "# nodes: ", $N->{'nodes'}, "\n"
+ if ( defined( $N->{'nodes'} ) && $N->{'nodes'} > 1 );
+ print "\n";
+
+ foreach $m ( sort ( keys %{ $N->{'SRVLIST'} } ) ) {
+ my $nam;
+ my $M = $N->{'SRVLIST'}->{$m};
+
+ foreach $nam ( sort ( keys %{ $M->{'zone'} } ) ) {
+ if ( $nam =~ /$dhcpvlanregex/ ) {
+ my $nam2 = $1;
+
+ #my $vlan2 = $2;
+
+ my $hostnum = $nam2;
+ $hostnum =~ s/^.*?(\d*)[a-z]*$/$1/;
+ $hostnum =~ s/^0*//;
+ if ( $hostnum eq "" ) {
+ $hostnum = 0;
+ }
+
+ if ( defined( $M->{'zone'}->{$nam}->{'ether'} ) ) {
+ printf( "host %s {\n", $nam2 );
+ printf( " hardware ethernet %s;\n",
+ $M->{'zone'}->{$nam}->{'ether'} );
+ printf( " fixed-address %s.%s;\n",
+ $nam, $Z->{'SOA'}->{'name'} );
+
+ if ( defined( $M->{'filename'} )
+ && $M->{'filename'} ne "" )
+ {
+ printf( " filename \"%s\";\n",
+ $M->{'filename'} );
+ }
+
+ if ( $M->{'initrd'} ) {
printf qq{# initrd "%s";\n}, $M->{'initrd'};
- }
-
- if ( $M->{'cmdline'} ) {
+ }
+
+ if ( $M->{'cmdline'} ) {
printf qq{# cmdline "%s";\n}, $M->{'cmdline'};
- }
-
- if ( defined( $M->{'pxefilename'} )
- && $M->{'pxefilename'} ne "" )
- {
- printf( "# pxefilename \"%s\";\n",
- $M->{'pxefilename'} );
- }
-
- if ( defined( $M->{'pxelinuxconf'} )
- && $M->{'pxelinuxconf'} ne "" )
- {
- printf( " option option-209 \"%s\";\n",
- $M->{'pxelinuxconf'} );
- }
-
- my @dns = Get_dns_from_zone( $Z, $M, $hostnum );
-
- if ( $#dns >= 0 && defined $dns[0] ) {
- printf( " option domain-name-servers %s;\n",
- join ( ", ", @dns ) );
- }
-
- print "}\n\n";
- }
- if ( defined( $M->{'zone'}->{$nam}->{'vmether'} )
- && ( $VMWARE || $UML ) )
- {
- printf( "host %s {\n", $nam2 );
- printf(
- " hardware ethernet %s;\n",
- $M->{'zone'}->{$nam}->{'vmether'}
- );
- printf(
- " fixed-address %s.%s;\n", $nam,
- $Z->{'SOA'}->{'name'}
- );
-
- if ( defined( $M->{'vmwfilename'} )
- && $M->{'vmwfilename'} ne "" )
- {
- printf( " filename \"%s\";\n", $M->{'vmwfilename'} );
- }
-
- if ( defined( $M->{'pxelinuxconf'} )
- && $M->{'pxelinuxconf'} ne "" )
- {
- printf( " option option-209 \"%s\";\n",
- $M->{'pxelinuxconf'} );
- }
-
- my @dns = Get_dns_from_zone( $Z, $M, $hostnum );
-
- if ( $#dns >= 0 && defined $dns[0] ) {
- printf( " option domain-name-servers %s;\n",
- join ( ", ", @dns ) );
- }
-
- print "}\n\n";
- }
- }
- }
- }
- print "\n";
+ }
+
+ if ( defined( $M->{'pxefilename'} )
+ && $M->{'pxefilename'} ne "" )
+ {
+ printf( "# pxefilename \"%s\";\n",
+ $M->{'pxefilename'} );
+ }
+
+ if ( defined( $M->{'pxelinuxconf'} )
+ && $M->{'pxelinuxconf'} ne "" )
+ {
+ printf( " option option-209 \"%s\";\n",
+ $M->{'pxelinuxconf'} );
+ }
+
+ my @dns = Get_dns_from_zone( $Z, $M, $hostnum );
+
+ if ( $#dns >= 0 && defined $dns[0] ) {
+ printf( " option domain-name-servers %s;\n",
+ join( ", ", @dns ) );
+ }
+
+ print "}\n\n";
+ }
+ if ( defined( $M->{'zone'}->{$nam}->{'vmether'} )
+ && ( $VMWARE || $UML ) )
+ {
+ printf( "host %s {\n", $nam2 );
+ printf( " hardware ethernet %s;\n",
+ $M->{'zone'}->{$nam}->{'vmether'} );
+ printf( " fixed-address %s.%s;\n",
+ $nam, $Z->{'SOA'}->{'name'} );
+
+ if ( defined( $M->{'vmwfilename'} )
+ && $M->{'vmwfilename'} ne "" )
+ {
+ printf( " filename \"%s\";\n",
+ $M->{'vmwfilename'} );
+ }
+
+ if ( defined( $M->{'pxelinuxconf'} )
+ && $M->{'pxelinuxconf'} ne "" )
+ {
+ printf( " option option-209 \"%s\";\n",
+ $M->{'pxelinuxconf'} );
+ }
+
+ my @dns = Get_dns_from_zone( $Z, $M, $hostnum );
+
+ if ( $#dns >= 0 && defined $dns[0] ) {
+ printf( " option domain-name-servers %s;\n",
+ join( ", ", @dns ) );
+ }
+
+ print "}\n\n";
+ }
+ }
+ }
+ }
+ print "\n";
}
$| = 1;
@@ -1558,71 +1620,76 @@
my @templatecontent;
open( PXETEMPLATE, "$template" )
- || die "impossible d'ouvrir " . $template . ": " . $!;
+ || die "impossible d'ouvrir " . $template . ": " . $!;
@templatecontent = <PXETEMPLATE>;
close(PXETEMPLATE);
- my $dhcpvlanregex =
- '^([^.]+)\.(' . join ( '|', @{ $Z->{'SOA'}->{'dhcpvlan'} } ) . ')(\.*)?$';
+ my $dhcpvlanregex
+ = '^([^.]+)\.('
+ . join( '|', @{ $Z->{'SOA'}->{'dhcpvlan'} } )
+ . ')(\.*)?$';
foreach $s ( sort ( keys %{ $Z->{'SERVERS'}->{'BY_ADDR'} } ) ) {
- my $m;
- my $N = $Z->{'SERVERS'}->{'BY_ADDR'}->{$s};
-
- foreach $m ( sort ( keys %{ $N->{'SRVLIST'} } ) ) {
- my $nam;
- my $M = $N->{'SRVLIST'}->{$m};
-
- foreach $nam ( sort ( keys %{ $M->{'zone'} } ) ) {
- if ( $nam =~ /$dhcpvlanregex/ ) {
- my $nam2 = $1;
-
- #my $vlan2 = $2;
- if ( defined( $M->{'zone'}->{$nam}->{'ether'} )
- && defined( $M->{'filename'} )
- && defined( $M->{'pxefilename'} ) )
- {
- if ( $M->{'filename'} ne 'pxelinux.0' ) {
- Warn( $ERR_SYNTAX,
- "Mk_pxelinuxconf[" . $nam2
- . "]: pxefilename exists but filename is not pxelinux.0!"
- );
- }
- my $addr = Resolv( $nam . '.' . $Z->{'SOA'}->{'name'}, $Z );
- if ( defined $addr
- && $addr ne $nam . '.' . $Z->{'SOA'}->{'name'} )
- {
- my $hexaddr =
- sprintf( '%02X%02X%02X%02X',
- split ( '\.', $addr ) );
-
- if ( -e $pxelinuxconfdir . "/" . $hexaddr ) {
- unlink( $pxelinuxconfdir . "/" . $hexaddr );
- }
-
- open( PXELINUXCFG,
- ">" . $pxelinuxconfdir . "/" . $hexaddr )
- || die "impossible d'ecrire "
- . $pxelinuxconfdir . "/" . $hexaddr . ": " . $!;
- my $temptemplatecontent =
- join ( "", @templatecontent );
- $temptemplatecontent =~
- s/%KERNEL%/$M->{pxefilename}/gs;
- $temptemplatecontent =~
- s/%INITRD%/$M->{initrd}/gs;
- my $ramdisk_size = Get_Ramdisk_size_from_Initrd($M->{'initrd'});
- $temptemplatecontent =~
- s/%RAMDISK_SIZE%/$ramdisk_size/gs;
+ my $m;
+ my $N = $Z->{'SERVERS'}->{'BY_ADDR'}->{$s};
+
+ foreach $m ( sort ( keys %{ $N->{'SRVLIST'} } ) ) {
+ my $nam;
+ my $M = $N->{'SRVLIST'}->{$m};
+
+ foreach $nam ( sort ( keys %{ $M->{'zone'} } ) ) {
+ if ( $nam =~ /$dhcpvlanregex/ ) {
+ my $nam2 = $1;
+
+ #my $vlan2 = $2;
+ if ( defined( $M->{'zone'}->{$nam}->{'ether'} )
+ && defined( $M->{'filename'} )
+ && defined( $M->{'pxefilename'} ) )
+ {
+ if ( $M->{'filename'} ne 'pxelinux.0' ) {
+ Warn( $ERR_SYNTAX,
+ "Mk_pxelinuxconf["
+ . $nam2
+ . "]: pxefilename exists but filename is not pxelinux.0!"
+ );
+ }
+ my $addr = Resolv( $nam . '.' . $Z->{'SOA'}->{'name'},
+ $Z );
+ if ( defined $addr
+ && $addr ne $nam . '.' . $Z->{'SOA'}->{'name'} )
+ {
+ my $hexaddr = sprintf( '%02X%02X%02X%02X',
+ split( '\.', $addr ) );
+
+ if ( -e $pxelinuxconfdir . "/" . $hexaddr ) {
+ unlink( $pxelinuxconfdir . "/" . $hexaddr );
+ }
+
+ open( PXELINUXCFG,
+ ">" . $pxelinuxconfdir . "/" . $hexaddr )
+ || die "impossible d'ecrire "
+ . $pxelinuxconfdir . "/"
+ . $hexaddr . ": "
+ . $!;
+ my $temptemplatecontent
+ = join( "", @templatecontent );
+ $temptemplatecontent
+ =~ s/%KERNEL%/$M->{pxefilename}/gs;
+ $temptemplatecontent
+ =~ s/%INITRD%/$M->{initrd}/gs;
+ my $ramdisk_size = Get_Ramdisk_size_from_Initrd(
+ $M->{'initrd'} );
+ $temptemplatecontent
+ =~ s/%RAMDISK_SIZE%/$ramdisk_size/gs;
my $cmdline = $M->{'cmdline'} || '';
- $temptemplatecontent =~
- s/%CMDLINE%/$cmdline/gs;
- print PXELINUXCFG $temptemplatecontent;
- close(PXELINUXCFG);
- }
- }
- }
- }
- }
+ $temptemplatecontent =~ s/%CMDLINE%/$cmdline/gs;
+ print PXELINUXCFG $temptemplatecontent;
+ close(PXELINUXCFG);
+ }
+ }
+ }
+ }
+ }
}
}
@@ -1633,7 +1700,7 @@
# Ouverture du fichier de destination
open( FIC_ZONE, "> " . $fic_zone )
- || Abort( $ERR_OPEN, "Impossible d'ouvrir " . $fic_zone );
+ || Abort( $ERR_OPEN, "Impossible d'ouvrir " . $fic_zone );
my $old_STDOUT = select(FIC_ZONE);
### Zone
@@ -1642,10 +1709,11 @@
print ";;\n";
print ";; ", $Z->{'SOA'}->{'comment'}, "\n";
print
-";;============================================================================\n\n";
+ ";;============================================================================\n\n";
print "\n";
printf "\$TTL %s\n", $Z->{'SOA'}->{'ttl'};
- printf "%-29s IN SOA\t%s %s (\n", '@', $Z->{'SOA'}->{'soa'}, $Z->{'SOA'}->{'mail'};
+ printf "%-29s IN SOA\t%s %s (\n", '@', $Z->{'SOA'}->{'soa'},
+ $Z->{'SOA'}->{'mail'};
printf "%-30s%s\n", '', $Z->{'SOA'}->{'serial'};
printf "%-30s%s\n", '', $Z->{'SOA'}->{'refresh'};
printf "%-30s%s\n", '', $Z->{'SOA'}->{'retry'};
@@ -1654,19 +1722,19 @@
printf "%-30s%s\n\n", '', ')';
foreach $n ( @{ $Z->{'NS'} } ) {
- printf "%-29s IN NS\t%s\n", '', $n;
+ printf "%-29s IN NS\t%s\n", '', $n;
}
print "\n";
foreach $m ( @{ $Z->{'MX'} } ) {
- printf "%-29s IN MX\t%s\n", '', $m;
+ printf "%-29s IN MX\t%s\n", '', $m;
}
print "\n";
$| = 1;
select($old_STDOUT);
close(FIC_ZONE);
-};
+}
#
# VOID Mk_zone (STRING $fic_zone, HASHREF $Z)
@@ -1681,7 +1749,7 @@
# Ouverture du fichier de destination
open( FIC_ZONE, ">> " . $fic_zone )
- || Abort( $ERR_OPEN, "Impossible d'ouvrir " . $fic_zone );
+ || Abort( $ERR_OPEN, "Impossible d'ouvrir " . $fic_zone );
my $old_STDOUT = select(FIC_ZONE);
my $s;
@@ -1693,60 +1761,76 @@
print "\n\n;;\n";
print ";; Networks\n";
print
-";;============================================================================\n\n";
+ ";;============================================================================\n\n";
foreach $n ( sort ( keys %{ $Z->{'NETWORK'}->{'BY_ADDR'} } ) ) {
- my $N = $Z->{'NETWORK'}->{'BY_ADDR'}->{$n};
- print "; ", $N->{'comment'}, "\n";
- print
-";----------------------------------------------------------------------------\n";
- printf( "%-29s IN A\t%s\n", "network." . $N->{'name'}, $N->{'network'} );
- printf( "%-29s IN A\t%s\n", "netmask." . $N->{'name'}, $N->{'netmask'} );
- printf( "%-29s IN A\t%s\n", "prefix." . $N->{'name'}, $N->{'prefix'} );
- printf( "%-29s IN A\t%s\n", "broadcast." . $N->{'name'},
- $N->{'broadcast'} );
- print "\n";
+ my $N = $Z->{'NETWORK'}->{'BY_ADDR'}->{$n};
+ print "; ", $N->{'comment'}, "\n";
+ print
+ ";----------------------------------------------------------------------------\n";
+ printf(
+ "%-29s IN A\t%s\n",
+ "network." . $N->{'name'},
+ $N->{'network'}
+ );
+ printf(
+ "%-29s IN A\t%s\n",
+ "netmask." . $N->{'name'},
+ $N->{'netmask'}
+ );
+ printf( "%-29s IN A\t%s\n", "prefix." . $N->{'name'},
+ $N->{'prefix'} );
+ printf(
+ "%-29s IN A\t%s\n",
+ "broadcast." . $N->{'name'},
+ $N->{'broadcast'}
+ );
+ print "\n";
}
### Servers
print "\n\n;;\n";
print ";; Servers\n";
print
-";;============================================================================\n\n";
+ ";;============================================================================\n\n";
foreach $s ( sort ( keys %{ $Z->{'SERVERS'}->{'BY_ADDR'} } ) ) {
- my $N = $Z->{'SERVERS'}->{'BY_ADDR'}->{$s};
- print "; ", $N->{'comment'}, "\n";
- print "; number: ", $N->{'number'}, "\n";
- print "; nodes: ", $N->{'nodes'}, "\n"
- if ( defined( $N->{'nodes'} ) && $N->{'nodes'} > 1 );
- print
-";----------------------------------------------------------------------------\n";
-
- foreach $m ( sort ( keys %{ $N->{'SRVLIST'} } ) ) {
- my $M = $N->{'SRVLIST'}->{$m};
- my $nam;
-
- foreach $nam ( sort ( keys %{ $M->{'zone'} } ) ) {
- printf( "%-29s IN %s\t%s\n", $nam, $M->{'zone'}->{$nam}->{'TYPE'},
- $M->{'zone'}->{$nam}->{'FIELD'} );
- }
- print "\n";
- }
+ my $N = $Z->{'SERVERS'}->{'BY_ADDR'}->{$s};
+ print "; ", $N->{'comment'}, "\n";
+ print "; number: ", $N->{'number'}, "\n";
+ print "; nodes: ", $N->{'nodes'}, "\n"
+ if ( defined( $N->{'nodes'} ) && $N->{'nodes'} > 1 );
+ print
+ ";----------------------------------------------------------------------------\n";
+
+ foreach $m ( sort ( keys %{ $N->{'SRVLIST'} } ) ) {
+ my $M = $N->{'SRVLIST'}->{$m};
+ my $nam;
+
+ foreach $nam ( sort ( keys %{ $M->{'zone'} } ) ) {
+ printf(
+ "%-29s IN %s\t%s\n",
+ $nam,
+ $M->{'zone'}->{$nam}->{'TYPE'},
+ $M->{'zone'}->{$nam}->{'FIELD'}
+ );
+ }
+ print "\n";
+ }
}
### Alias
print "\n\n;;\n";
print ";; Alias (round robin)\n";
print
-";;============================================================================\n\n";
+ ";;============================================================================\n\n";
foreach $j ( sort ( keys %{ $Z->{'ALIAS'} } ) ) {
- my $i;
-
- foreach $i ( sort ( @{ $Z->{'ALIAS'}->{$j} } ) ) {
- printf( "%-29s IN A\t%s\n", $j, $i );
- }
+ my $i;
+
+ foreach $i ( sort ( @{ $Z->{'ALIAS'}->{$j} } ) ) {
+ printf( "%-29s IN A\t%s\n", $j, $i );
+ }
}
# Fermeture du fichier de destination
@@ -1768,26 +1852,26 @@
# Calcul de la classe d'appartenance du serveur
my $hostclass = Host_class( $host, $Z );
- my $resolve = 0;
+ my $resolve = 0;
# Recherche des informations dans la base de configuration
my $N = $Z->{'SERVERS'}->{'BY_NAME'}->{$hostclass};
if ( !ref($N) ) {
- Abort( $ERR_SYNTAX,
- "La classe de serveurs "
- . $hostclass
- . " n'existe pas dans la configuration" );
+ Abort( $ERR_SYNTAX,
+ "La classe de serveurs "
+ . $hostclass
+ . " n'existe pas dans la configuration" );
}
my $M = $N->{'SRVLIST'}->{$host};
if ( !ref($M) ) {
- Abort( $ERR_SYNTAX,
- "La machine " . $host . " n'existe pas dans la configuration" );
+ Abort( $ERR_SYNTAX,
+ "La machine " . $host . " n'existe pas dans la configuration" );
}
# Ouverture du fichier de destination
open( FIC_IFACE, "> " . $fic_iface )
- || Abort( $ERR_OPEN, "Impossible d'ouvrir " . $fic_iface );
+ || Abort( $ERR_OPEN, "Impossible d'ouvrir " . $fic_iface );
my $old_STDOUT = select(FIC_IFACE);
# Ajout de l'interface de bouclage
@@ -1796,133 +1880,152 @@
# Ajout de l'interface automatique si presente
if ( defined( $M->{'ifup'}->{'dhcp'} ) ) {
- print "auto ", $M->{'ifup'}->{'dhcp'}, "\n";
- print "iface ", $M->{'ifup'}->{'dhcp'}, " inet dhcp\n";
- Mk_routes( $M, $Z, $M->{'ifup'}->{'dhcp'} );
+ print "auto ", $M->{'ifup'}->{'dhcp'}, "\n";
+ print "iface ", $M->{'ifup'}->{'dhcp'}, " inet dhcp\n";
+ Mk_routes( $M, $Z, $M->{'ifup'}->{'dhcp'} );
}
else {
- $resolve = 1;
+ $resolve = 1;
}
# Ajout des interfaces statiques
#foreach $nam ( sort { $M->{ifup}->{$a} cmp $M->{ifup}->{$b} }
- foreach my $nam ( sort { cmpif( $M->{'ifup'}->{$a}, $M->{'ifup'}->{$b} ) }
- keys %{ $M->{'ifup'} } )
+ foreach my $nam (
+ sort { cmpif( $M->{'ifup'}->{$a}, $M->{'ifup'}->{$b} ) }
+ keys %{ $M->{'ifup'} }
+ )
{
- next if ( $nam eq 'dhcp' );
-
- print "\nauto ", $M->{'ifup'}->{$nam}, "\n";
- print "iface ", $M->{'ifup'}->{$nam}, " inet static\n";
-
- my $net = $nam;
- $net =~ s/^[^\.]+\.//;
- my $NET = $Z->{'NETWORK'}->{'BY_NAME'}->{$net};
-
- if ($resolve) {
- print "\taddress ", $M->{'zone'}->{$nam}->{'FIELD'}, "\n";
- print "\tnetmask ", $NET->{'netmask'}, "\n";
- print "\tbroadcast ", $NET->{'broadcast'}, "\n";
- print "\tnetwork ", $NET->{'network'}, "\n";
- }
- else {
- print "\taddress " . $nam . '.' . $Z->{'SOA'}->{'name'} . "\n";
- print "\tnetmask netmask." . $net . '.'
- . $Z->{'SOA'}->{'name'} . "\n";
- print "\tbroadcast broadcast." . $net . '.'
- . $Z->{'SOA'}->{'name'} . "\n";
- print "\tnetwork network." . $net . '.'
- . $Z->{'SOA'}->{'name'} . "\n";
- }
-
- my $defaultmtu = ($UML) ? 1496 : 1500;
- if ( $M->{'ifup'}->{$nam} =~ m/^([^:.]+)\.(\d+)(:\d+)?$/ ) {
- my $ifname = $1;
- my $iftag = $2;
-
- print "\tvlan_raw_device " . $ifname . "\n";
- $defaultmtu = 1496;
-
- if ( defined( $NET->{'tag'} ) && $NET->{'tag'} != $iftag ) {
- Warn( $ERR_SYNTAX,
- "Les tags de "
- . $M->{'ifup'}->{$nam}
- . " et de " . $net
- . " different (" . $iftag . "!="
- . $NET->{'tag'} . ")!" );
- }
- }
-
- if ( defined( $NET->{'mtu'} ) ) {
- $defaultmtu = $NET->{'mtu'};
- }
-
- print "\tup ifconfig "
- . $M->{'ifup'}->{$nam} . " mtu "
- . ( ( defined( $M->{'mtu'}->{ $M->{'ifup'}->{$nam} } ) )
- ? $M->{'mtu'}->{ $M->{'ifup'}->{$nam} }
- : $defaultmtu ) . " "
- . ( ( defined( $M->{'noarp'}->{ $M->{'ifup'}->{$nam} } ) ) ? "-arp"
- : "arp" ) . "\n";
-
- my $defaultmedia = "autoneg on";
- if ( defined( $NET->{'media'} ) ) {
- $defaultmedia = $NET->{'media'};
- }
- if ( defined( $M->{'media'}->{ $M->{'ifup'}->{$nam} } ) ) {
- $defaultmedia = $M->{'media'}->{ $M->{'ifup'}->{$nam} };
- }
-
- my @defaultmedia = split ( ' ', $defaultmedia );
- my $mediaerror = 0;
- while ( $#defaultmedia >= 0 ) {
- my $mediaopt = shift @defaultmedia;
- my $mediaval = shift @defaultmedia;
-
- if ( !defined $mediaopt || !defined $mediaval ) {
- Warn( $ERR_SYNTAX, "Media syntax error: " . $defaultmedia );
- $mediaerror = 1;
- next;
- }
-
- if ( $mediaopt eq 'speed' ) {
- if ( $mediaval !~ m/^\d+$/ ) {
- Warn( $ERR_SYNTAX, "Media syntax error: " . $defaultmedia );
- $mediaerror = 1;
- next;
- }
- }
- elsif ( $mediaopt eq 'duplex' ) {
- if ( $mediaval !~ m/^(half|full)$/ ) {
- Warn( $ERR_SYNTAX, "Media syntax error: " . $defaultmedia );
- $mediaerror = 1;
- next;
- }
- }
- elsif ( $mediaopt eq 'autoneg' ) {
- if ( $mediaval !~ m/^(on|off)$/ ) {
- Warn( $ERR_SYNTAX, "Media syntax error: " . $defaultmedia );
- $mediaerror = 1;
- next;
- }
- }
- else {
- Warn( $ERR_SYNTAX, "Media syntax error: " . $defaultmedia );
- $mediaerror = 1;
- next;
- }
- }
-
- if ( !$mediaerror ) {
- my $ifname = $M->{ifup}->{$nam};
- if ( $ifname =~ m/^([^:.]+)\.(\d+)(:\d+)?$/ ) {
- $ifname = $1;
- }
- print "\tup ethtool -s " . $ifname . " "
- . $defaultmedia
- . " || true\n";
- }
-
- Mk_routes( $M, $Z, $M->{'ifup'}->{$nam} );
+ next if ( $nam eq 'dhcp' );
+
+ print "\nauto ", $M->{'ifup'}->{$nam}, "\n";
+ print "iface ", $M->{'ifup'}->{$nam}, " inet static\n";
+
+ my $net = $nam;
+ $net =~ s/^[^\.]+\.//;
+ my $NET = $Z->{'NETWORK'}->{'BY_NAME'}->{$net};
+
+ if ($resolve) {
+ print "\taddress ", $M->{'zone'}->{$nam}->{'FIELD'}, "\n";
+ print "\tnetmask ", $NET->{'netmask'}, "\n";
+ print "\tbroadcast ", $NET->{'broadcast'}, "\n";
+ print "\tnetwork ", $NET->{'network'}, "\n";
+ }
+ else {
+ print "\taddress "
+ . $nam . '.'
+ . $Z->{'SOA'}->{'name'} . "\n";
+ print "\tnetmask netmask."
+ . $net . '.'
+ . $Z->{'SOA'}->{'name'} . "\n";
+ print "\tbroadcast broadcast."
+ . $net . '.'
+ . $Z->{'SOA'}->{'name'} . "\n";
+ print "\tnetwork network."
+ . $net . '.'
+ . $Z->{'SOA'}->{'name'} . "\n";
+ }
+
+ my $defaultmtu = ($UML) ? 1496 : 1500;
+ if ( $M->{'ifup'}->{$nam} =~ m/^([^:.]+)\.(\d+)(:\d+)?$/ ) {
+ my $ifname = $1;
+ my $iftag = $2;
+
+ print "\tvlan_raw_device " . $ifname . "\n";
+ $defaultmtu = 1496;
+
+ if ( defined( $NET->{'tag'} ) && $NET->{'tag'} != $iftag ) {
+ Warn( $ERR_SYNTAX,
+ "Les tags de "
+ . $M->{'ifup'}->{$nam}
+ . " et de "
+ . $net
+ . " different ("
+ . $iftag . "!="
+ . $NET->{'tag'}
+ . ")!" );
+ }
+ }
+
+ if ( defined( $NET->{'mtu'} ) ) {
+ $defaultmtu = $NET->{'mtu'};
+ }
+
+ print "\tup ifconfig "
+ . $M->{'ifup'}->{$nam} . " mtu "
+ . (
+ ( defined( $M->{'mtu'}->{ $M->{'ifup'}->{$nam} } ) )
+ ? $M->{'mtu'}->{ $M->{'ifup'}->{$nam} }
+ : $defaultmtu
+ )
+ . " "
+ . (
+ ( defined( $M->{'noarp'}->{ $M->{'ifup'}->{$nam} } ) ) ? "-arp"
+ : "arp"
+ ) . "\n";
+
+ my $defaultmedia = "autoneg on";
+ if ( defined( $NET->{'media'} ) ) {
+ $defaultmedia = $NET->{'media'};
+ }
+ if ( defined( $M->{'media'}->{ $M->{'ifup'}->{$nam} } ) ) {
+ $defaultmedia = $M->{'media'}->{ $M->{'ifup'}->{$nam} };
+ }
+
+ my @defaultmedia = split( ' ', $defaultmedia );
+ my $mediaerror = 0;
+ while ( $#defaultmedia >= 0 ) {
+ my $mediaopt = shift @defaultmedia;
+ my $mediaval = shift @defaultmedia;
+
+ if ( !defined $mediaopt || !defined $mediaval ) {
+ Warn( $ERR_SYNTAX, "Media syntax error: " . $defaultmedia );
+ $mediaerror = 1;
+ next;
+ }
+
+ if ( $mediaopt eq 'speed' ) {
+ if ( $mediaval !~ m/^\d+$/ ) {
+ Warn( $ERR_SYNTAX,
+ "Media syntax error: " . $defaultmedia );
+ $mediaerror = 1;
+ next;
+ }
+ }
+ elsif ( $mediaopt eq 'duplex' ) {
+ if ( $mediaval !~ m/^(half|full)$/ ) {
+ Warn( $ERR_SYNTAX,
+ "Media syntax error: " . $defaultmedia );
+ $mediaerror = 1;
+ next;
+ }
+ }
+ elsif ( $mediaopt eq 'autoneg' ) {
+ if ( $mediaval !~ m/^(on|off)$/ ) {
+ Warn( $ERR_SYNTAX,
+ "Media syntax error: " . $defaultmedia );
+ $mediaerror = 1;
+ next;
+ }
+ }
+ else {
+ Warn( $ERR_SYNTAX, "Media syntax error: " . $defaultmedia );
+ $mediaerror = 1;
+ next;
+ }
+ }
+
+ if ( !$mediaerror ) {
+ my $ifname = $M->{ifup}->{$nam};
+ if ( $ifname =~ m/^([^:.]+)\.(\d+)(:\d+)?$/ ) {
+ $ifname = $1;
+ }
+ print "\tup ethtool -s "
+ . $ifname . " "
+ . $defaultmedia
+ . " || true\n";
+ }
+
+ Mk_routes( $M, $Z, $M->{'ifup'}->{$nam} );
}
print "\n";
@@ -1951,12 +2054,12 @@
my $hostvlan = $3;
if ( !defined $hostshort ) {
- return undef;
+ return undef;
}
my $hostclass = Host_class( $hostshort, $Z );
if ( !defined $hostclass ) {
- return undef;
+ return undef;
}
my $N = $Z->{'SERVERS'}->{'BY_NAME'}->{$hostclass};
@@ -1964,55 +2067,56 @@
my $M = $N->{'SRVLIST'}->{$hostshort};
if ( defined( $M->{'zone'}->{$host2}->{'FIELD'} ) ) {
- if ( $M->{'zone'}->{$host2}->{'TYPE'} eq "CNAME" ) {
- return (
- Resolv(
- $M->{'zone'}->{$host2}->{'FIELD'} . '.' . $Z->{'SOA'}->{'name'},
- $Z
- )
- );
- }
- else {
- return ( $M->{'zone'}->{$host2}->{'FIELD'} );
- }
+ if ( $M->{'zone'}->{$host2}->{'TYPE'} eq "CNAME" ) {
+ return (
+ Resolv(
+ $M->{'zone'}->{$host2}->{'FIELD'} . '.'
+ . $Z->{'SOA'}->{'name'},
+ $Z
+ )
+ );
+ }
+ else {
+ return ( $M->{'zone'}->{$host2}->{'FIELD'} );
+ }
}
foreach $i ( keys %{ $Z->{'SERVERS'}->{'BY_NAME'} } ) {
- my $N2 = $Z->{'SERVERS'}->{'BY_NAME'}->{$i};
- foreach $j ( keys %{ $N2->{'SRVLIST'} } ) {
- my $M2 = $N2->{'SRVLIST'}->{$j};
- if ( defined( $M2->{'zone'}->{$host2}->{'FIELD'} ) ) {
- if ( $M2->{'zone'}->{$host2}->{'TYPE'} eq "CNAME" ) {
- return (
- Resolv(
- $M2->{'zone'}->{$host2}->{'FIELD'} . '.'
- . $Z->{'SOA'}->{'name'},
- $Z
- )
- );
- }
- else {
- return ( $M2->{'zone'}->{$host2}->{'FIELD'} );
- }
- }
- }
+ my $N2 = $Z->{'SERVERS'}->{'BY_NAME'}->{$i};
+ foreach $j ( keys %{ $N2->{'SRVLIST'} } ) {
+ my $M2 = $N2->{'SRVLIST'}->{$j};
+ if ( defined( $M2->{'zone'}->{$host2}->{'FIELD'} ) ) {
+ if ( $M2->{'zone'}->{$host2}->{'TYPE'} eq "CNAME" ) {
+ return (
+ Resolv(
+ $M2->{'zone'}->{$host2}->{'FIELD'} . '.'
+ . $Z->{'SOA'}->{'name'},
+ $Z
+ )
+ );
+ }
+ else {
+ return ( $M2->{'zone'}->{$host2}->{'FIELD'} );
+ }
+ }
+ }
}
if ( defined( $Z->{'ALIAS'}->{$host2} ) ) {
- if (wantarray) {
- return ( @{ $Z->{'ALIAS'}->{$host2} } );
- }
- else {
- return ( $Z->{'ALIAS'}->{$host2}
- [ int( rand( $#{ $Z->{'ALIAS'}->{$host2} } + 1 ) ) ] );
- }
- }
-
- if ( defined($hostvlan)
- && $hostvlan ne ""
- && defined( $Z->{'NETWORK'}->{'BY_NAME'}->{$hostvlan} ) )
+ if (wantarray) {
+ return ( @{ $Z->{'ALIAS'}->{$host2} } );
+ }
+ else {
+ return ( $Z->{'ALIAS'}->{$host2}
+ [ int( rand( $#{ $Z->{'ALIAS'}->{$host2} } + 1 ) ) ] );
+ }
+ }
+
+ if ( defined($hostvlan)
+ && $hostvlan ne ""
+ && defined( $Z->{'NETWORK'}->{'BY_NAME'}->{$hostvlan} ) )
{
- return ( $Z->{'NETWORK'}->{'BY_NAME'}->{$hostvlan}->{$hostshort} );
+ return ( $Z->{'NETWORK'}->{'BY_NAME'}->{$hostvlan}->{$hostshort} );
}
return undef;
@@ -2029,156 +2133,157 @@
my $r;
foreach $r ( sort ( keys %{ $M->{'route'}->{$iface} } ) ) {
- my ( $dst, @gw ) = split ( /\s+/, $M->{'route'}->{$iface}->{$r} );
- my $gw;
- my @gw2;
- foreach $gw (@gw) {
- my @resolved = Resolv( $gw, $Z );
- if ( $#resolved >= 0 && defined $resolved[0] ) {
- my $resolved;
- foreach $resolved (@resolved) {
- push @gw2, $resolved;
- }
- }
- else {
- push @gw2, $gw;
- }
- }
- if ( $Z->{'NETWORK'}->{'BY_NAME'}->{$dst} ) {
- if ( $#gw2 >= 2 ) {
- print "\tup ip route add ";
-
- print $Z->{'NETWORK'}->{'BY_NAME'}->{$dst}->{'network'};
- print "/";
- print netmask2prefix(
- $Z->{'NETWORK'}->{'BY_NAME'}->{$dst}->{'netmask'} );
-
- print " scope global";
-
- print " ", join ( ' nexthop via ', @gw2 );
-
- print " dev " . $iface;
-
- print "\n";
- }
- else {
- print "\tup route add -net ";
-
- #print "network.".$dst.".".$Z->{SOA}->{name};
- print $Z->{'NETWORK'}->{'BY_NAME'}->{$dst}->{'network'};
- print " netmask ";
-
- #print "netmask.".$dst.".".$Z->{SOA}->{name};
- print $Z->{'NETWORK'}->{'BY_NAME'}->{$dst}->{'netmask'};
-
- print " gateway " . $gw2[0] if ( defined $gw2[0] );
-
- print " dev " . $iface;
-
- print "\n";
- }
- }
- elsif ( $dst eq 'default' ) {
- if ( $#gw >= 2 ) {
- print "\tup ip route add ";
-
- print "default";
-
- print " scope global";
-
- print " ", join ( ' nexthop via ', @gw2 );
-
- print " dev " . $iface;
-
- print "\n";
- }
- else {
- print "\tgateway " . $gw2[0] if ( defined $gw2[0] );
-
- #print " dev " . $iface;
-
- print "\n";
- }
- }
- else {
- if ( $#gw >= 2 ) {
- print "\tup ip route add ";
-
- my $dst2 = Resolv( $dst, $Z );
- if ( !defined $dst2 ) {
- $dst2 = $dst;
- }
-
- print $dst2;
-
- print " scope global";
-
- print " ", join ( ' nexthop via ', @gw2 );
-
- print " dev " . $iface;
-
- print "\n";
- }
- else {
- print "\tup route add -host ";
-
- my $dst2 = Resolv( $dst, $Z );
- if ( !defined $dst2 ) {
- $dst2 = $dst;
- }
- print $dst2;
- print " gateway " . $gw2[0] if ( defined $gw2[0] );
-
- print " dev " . $iface;
-
- print "\n";
- }
- }
+ my ( $dst, @gw ) = split( /\s+/, $M->{'route'}->{$iface}->{$r} );
+ my $gw;
+ my @gw2;
+ foreach $gw (@gw) {
+ my @resolved = Resolv( $gw, $Z );
+ if ( $#resolved >= 0 && defined $resolved[0] ) {
+ my $resolved;
+ foreach $resolved (@resolved) {
+ push @gw2, $resolved;
+ }
+ }
+ else {
+ push @gw2, $gw;
+ }
+ }
+ if ( $Z->{'NETWORK'}->{'BY_NAME'}->{$dst} ) {
+ if ( $#gw2 >= 2 ) {
+ print "\tup ip route add ";
+
+ print $Z->{'NETWORK'}->{'BY_NAME'}->{$dst}->{'network'};
+ print "/";
+ print netmask2prefix(
+ $Z->{'NETWORK'}->{'BY_NAME'}->{$dst}->{'netmask'} );
+
+ print " scope global";
+
+ print " ", join( ' nexthop via ', @gw2 );
+
+ print " dev " . $iface;
+
+ print "\n";
+ }
+ else {
+ print "\tup route add -net ";
+
+ #print "network.".$dst.".".$Z->{SOA}->{name};
+ print $Z->{'NETWORK'}->{'BY_NAME'}->{$dst}->{'network'};
+ print " netmask ";
+
+ #print "netmask.".$dst.".".$Z->{SOA}->{name};
+ print $Z->{'NETWORK'}->{'BY_NAME'}->{$dst}->{'netmask'};
+
+ print " gateway " . $gw2[0] if ( defined $gw2[0] );
+
+ print " dev " . $iface;
+
+ print "\n";
+ }
+ }
+ elsif ( $dst eq 'default' ) {
+ if ( $#gw >= 2 ) {
+ print "\tup ip route add ";
+
+ print "default";
+
+ print " scope global";
+
+ print " ", join( ' nexthop via ', @gw2 );
+
+ print " dev " . $iface;
+
+ print "\n";
+ }
+ else {
+ print "\tgateway " . $gw2[0] if ( defined $gw2[0] );
+
+ #print " dev " . $iface;
+
+ print "\n";
+ }
+ }
+ else {
+ if ( $#gw >= 2 ) {
+ print "\tup ip route add ";
+
+ my $dst2 = Resolv( $dst, $Z );
+ if ( !defined $dst2 ) {
+ $dst2 = $dst;
+ }
+
+ print $dst2;
+
+ print " scope global";
+
+ print " ", join( ' nexthop via ', @gw2 );
+
+ print " dev " . $iface;
+
+ print "\n";
+ }
+ else {
+ print "\tup route add -host ";
+
+ my $dst2 = Resolv( $dst, $Z );
+ if ( !defined $dst2 ) {
+ $dst2 = $dst;
+ }
+ print $dst2;
+ print " gateway " . $gw2[0] if ( defined $gw2[0] );
+
+ print " dev " . $iface;
+
+ print "\n";
+ }
+ }
}
foreach $r ( sort ( keys %{ $M->{'delroute'}->{$iface} } ) ) {
- my ($dst) = split ( /\s+/, $M->{'route'}->{$iface}->{$r} );
-
- if ( $Z->{'NETWORK'}->{'BY_NAME'}->{$dst} ) {
- print "\tup ip route del ";
-
- print $Z->{'NETWORK'}->{'BY_NAME'}->{$dst}->{network};
- print "/";
- print netmask2prefix( $Z->{'NETWORK'}->{'BY_NAME'}->{$dst}->{'netmask'} );
-
- print " scope global";
-
- print " dev " . $iface;
-
- print "\n";
- }
- elsif ( $dst eq 'default' ) {
- print "\tup ip route del ";
-
- print "default";
-
- print " scope global";
-
- print " dev " . $iface;
-
- print "\n";
- }
- else {
- print "\tup ip route del ";
-
- my $dst2 = Resolv( $dst, $Z );
- if ( !defined $dst2 ) {
- $dst2 = $dst;
- }
-
- print $dst2;
-
- print " scope global";
-
- print " dev " . $iface;
-
- print "\n";
- }
+ my ($dst) = split( /\s+/, $M->{'route'}->{$iface}->{$r} );
+
+ if ( $Z->{'NETWORK'}->{'BY_NAME'}->{$dst} ) {
+ print "\tup ip route del ";
+
+ print $Z->{'NETWORK'}->{'BY_NAME'}->{$dst}->{network};
+ print "/";
+ print netmask2prefix(
+ $Z->{'NETWORK'}->{'BY_NAME'}->{$dst}->{'netmask'} );
+
+ print " scope global";
+
+ print " dev " . $iface;
+
+ print "\n";
+ }
+ elsif ( $dst eq 'default' ) {
+ print "\tup ip route del ";
+
+ print "default";
+
+ print " scope global";
+
+ print " dev " . $iface;
+
+ print "\n";
+ }
+ else {
+ print "\tup ip route del ";
+
+ my $dst2 = Resolv( $dst, $Z );
+ if ( !defined $dst2 ) {
+ $dst2 = $dst;
+ }
+
+ print $dst2;
+
+ print " scope global";
+
+ print " dev " . $iface;
+
+ print "\n";
+ }
}
}
Modified: trunk/lib/PFTools/Update.pm
URL: http://svn.debian.org/wsvn/pf-tools/trunk/lib/PFTools/Update.pm?rev=539&op=diff
==============================================================================
--- trunk/lib/PFTools/Update.pm (original)
+++ trunk/lib/PFTools/Update.pm Mon Aug 27 14:48:03 2007
@@ -1,8 +1,12 @@
-package PFTools::Update ;
+package PFTools::Update;
##
## $Id$
##
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+## Copyright (C) 2007 Christophe Caillet <tof at sitadelle.com>
+## Copyright (C) 2004-2007 Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
+## Copyright (C) 2004 Gonéri Le Bouder <goneri at sitadelle.com>
+## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -24,20 +28,20 @@
use Exporter;
-our @ISA = ( 'Exporter' ) ;
+our @ISA = ('Exporter');
our @EXPORT = qw(
- $ERR_OPEN
-
- Get_source
-
- Do_update
+ $ERR_OPEN
+
+ Get_source
+
+ Do_update
);
our @EXPORT_OK = qw();
-use PFTools::Conf ;
-use PFTools::Net ;
+use PFTools::Conf;
+use PFTools::Net;
use Getopt::Long;
use Fcntl ':mode';
@@ -48,15 +52,15 @@
use Debconf::ConfModule;
# Error code
-our $ERR_OPEN = 1 ;
-my $ERR_SYNTAX = 2 ;
+our $ERR_OPEN = 1;
+my $ERR_SYNTAX = 2;
$ENV{'PATH'} = $ENV{'PATH'} . ":/usr/local/sbin:/usr/local/bin";
$ENV{'DEBIAN_FRONTEND'} = "noninteractive";
$ENV{'DEBIAN_PRIORITY'} = "critical";
-my $STARTTIME = time();
-$DEFERREDLOG = 0 ;
+my $STARTTIME = time();
+$DEFERREDLOG = 0;
# Constantes
my $PFTOOLSCONF = "/etc/pf-tools.conf";
@@ -80,7 +84,7 @@
#$PKGLIST = "/var/lib/apt/lists";
# Conf Par Defaut
-my $PF_STATUS_DIR = "/var/lib/pftools";
+my $PF_STATUS_DIR = "/var/lib/pftools";
my $CVS_USER = "cvsguest";
my $CVS_RSH = "/usr/local/sbin/cvs_rsh";
@@ -88,8 +92,8 @@
my $CVS_ROOT = "/var/lib/cvs";
my $CVS_REPOSITORY = $CVS_ROOT . "/repository";
my $CVS_CONFIG = "config";
-my $CVS_COMMAND ;
-my $CVS_BRANCHE ;
+my $CVS_COMMAND;
+my $CVS_BRANCHE;
# End Conf Par Defaut!
@@ -110,26 +114,25 @@
my $blksize;
my $blocks;
- ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
- $size, $atime, $mtime, $ctime, $blksize, $blocks )
- = lstat($PFTOOLSCONF);
-
- if ( $uid == 0 && $gid == 0 && S_IMODE($mode) == 0600 && S_ISREG($mode) ) {
-
- my $result;
- my $return ;
- unless ( $result = do $PFTOOLSCONF ) {
- warn "couldn't parse $PFTOOLSCONF: $@" if $@;
- warn "couldn't do $PFTOOLSCONF: $!" unless defined $return;
- warn "couldn't run $PFTOOLSCONF" unless $return;
- }
+ ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
+ $size, $atime, $mtime, $ctime, $blksize, $blocks
+ ) = lstat($PFTOOLSCONF);
+
+ if ( $uid == 0 && $gid == 0 && S_IMODE($mode) == 0600 && S_ISREG($mode) )
+ {
+
+ my $result;
+ my $return;
+ unless ( $result = do $PFTOOLSCONF ) {
+ warn "couldn't parse $PFTOOLSCONF: $@" if $@;
+ warn "couldn't do $PFTOOLSCONF: $!" unless defined $return;
+ warn "couldn't run $PFTOOLSCONF" unless $return;
+ }
}
else {
- print STDERR "Ignoring weak config (check owner/group/mode)\n";
- }
-}
-
-
+ print STDERR "Ignoring weak config (check owner/group/mode)\n";
+ }
+}
# Constantes deduites de la conf
my $CVS_WORKING_DIR = $CVS_CHECKOUT . "/" . $HOSTNAME;
@@ -137,10 +140,6 @@
my $CVS_OLD_DIR = $CVS_CHECKOUT . "/" . $HOSTNAME . "/old";
my $GLOBAL_CONF = $CVS_WORKING_DIR . "/" . $CVS_CONFIG . "/GLOBAL";
my $TEMPLATES = $CVS_WORKING_DIR . "/" . $CVS_CONFIG . "/TEMPLATES";
-
-
-
-
# Fonctions utilisees dans les fichiers de conf
@@ -166,29 +165,29 @@
$newgid = getgrnam($group);
if ( !defined($newuid) || !defined($newgid) ) {
- return 1;
- }
-
- ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
- $size, $atime, $mtime, $ctime, $blksize, $blocks )
- = stat($dest);
-
- if ( ( defined($uid) && $uid == $newuid )
- && ( defined($gid) && $gid == $newgid ) )
+ return 1;
+ }
+
+ ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
+ $size, $atime, $mtime, $ctime, $blksize, $blocks
+ ) = stat($dest);
+
+ if ( ( defined($uid) && $uid == $newuid )
+ && ( defined($gid) && $gid == $newgid ) )
{
- return 0;
+ return 0;
}
if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(chown needed)");
+ Log("(chown needed)");
}
if ( $options->{'simul'} ) {
- return 0;
+ return 0;
}
return !chown( $newuid, $newgid, $dest );
-};
+}
sub fullchmod {
my ( $newmode, $dest, $options ) = @_;
@@ -208,20 +207,20 @@
my $blksize;
my $blocks;
- ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
- $size, $atime, $mtime, $ctime, $blksize, $blocks )
- = stat($dest);
+ ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
+ $size, $atime, $mtime, $ctime, $blksize, $blocks
+ ) = stat($dest);
if ( defined($mode) && ( $mode & 07777 ) == $newmode ) {
- return 0;
+ return 0;
}
if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(chmod needed)");
+ Log("(chmod needed)");
}
if ( $options->{'simul'} ) {
- return 0;
+ return 0;
}
return !chmod( $newmode, $dest );
@@ -241,10 +240,10 @@
$file =~ s://:/:g;
if ( $file =~ m|/| ) {
- $file =~ s|^(.*)/[^/]+/?$|$1|;
+ $file =~ s|^(.*)/[^/]+/?$|$1|;
}
else {
- $file = '.';
+ $file = '.';
}
return $file;
@@ -254,16 +253,16 @@
my ( $dest, $options ) = @_;
if ( -e $dest ) {
- my $old = $CVS_OLD_DIR . "/" . $dest . "." . $STARTTIME;
-
- if ( $options->{'verbose'} ) {
- Log( "(moving old to " . $old . ")" );
- }
-
- if ( !$options->{'simul'} ) {
- Mk_dest_dir($old);
- deferredlogsystem( "/bin/mv '" . $dest . "' '" . $old . "'" );
- }
+ my $old = $CVS_OLD_DIR . "/" . $dest . "." . $STARTTIME;
+
+ if ( $options->{'verbose'} ) {
+ Log( "(moving old to " . $old . ")" );
+ }
+
+ if ( !$options->{'simul'} ) {
+ Mk_dest_dir($old);
+ deferredlogsystem( "/bin/mv '" . $dest . "' '" . $old . "'" );
+ }
}
}
@@ -278,21 +277,24 @@
$group = defined( $S->{'group'} ) ? $S->{'group'} : $DEFAULT_GROUP;
if ( fullchown( $owner, $group, $dest, $options ) ) {
- Warn( $ERR_OPEN,
- "Impossible d'attribuer " . $dest . " a " . $owner . "." . $group );
- return 1;
- }
-
- $mode =
- defined( $S->{'mode'} )
- ? $S->{'mode'}
- : ( ( -d $dest ) ? $DEFAULT_DIRMODE : $DEFAULT_MODE );
+ Warn( $ERR_OPEN,
+ "Impossible d'attribuer "
+ . $dest . " a "
+ . $owner . "."
+ . $group );
+ return 1;
+ }
+
+ $mode
+ = defined( $S->{'mode'} )
+ ? $S->{'mode'}
+ : ( ( -d $dest ) ? $DEFAULT_DIRMODE : $DEFAULT_MODE );
$mode =~ s/^[^0]/0$&/;
if ( fullchmod( eval($mode), $dest, $options ) ) {
- Warn( $ERR_OPEN,
- "Impossible d'attribuer les droits " . $mode . " a " . $dest );
- return 1;
+ Warn( $ERR_OPEN,
+ "Impossible d'attribuer les droits " . $mode . " a " . $dest );
+ return 1;
}
}
@@ -300,11 +302,11 @@
my ( $S, $options ) = @_;
if ( !$options->{'simul'} && defined( $S->{'on_config'} ) ) {
- my $changed = Subst_vars( $S->{'on_config'} );
- if ( deferredlogsystem($changed) ) {
- Warn( $ERR_OPEN, "Impossible d'executer [" . $changed . "]" );
- return 1;
- }
+ my $changed = Subst_vars( $S->{'on_config'} );
+ if ( deferredlogsystem($changed) ) {
+ Warn( $ERR_OPEN, "Impossible d'executer [" . $changed . "]" );
+ return 1;
+ }
}
return 0;
}
@@ -312,15 +314,15 @@
sub Do_before_change {
my ( $S, $options ) = @_;
- if ( !$options->{'simul'}
- && defined( $S->{'before_change'} )
- && !$options->{'noaction'} )
+ if ( !$options->{'simul'}
+ && defined( $S->{'before_change'} )
+ && !$options->{'noaction'} )
{
- my $changed = Subst_vars( $S->{'before_change'} );
- if ( deferredlogsystem($changed) ) {
- Warn( $ERR_OPEN, "Impossible d'executer [" . $changed . "]" );
- return 1;
- }
+ my $changed = Subst_vars( $S->{'before_change'} );
+ if ( deferredlogsystem($changed) ) {
+ Warn( $ERR_OPEN, "Impossible d'executer [" . $changed . "]" );
+ return 1;
+ }
}
return 0;
}
@@ -328,15 +330,15 @@
sub Do_after_change {
my ( $S, $options ) = @_;
- if ( !$options->{'simul'}
- && defined( $S->{'after_change'} )
- && !$options->{'noaction'} )
+ if ( !$options->{'simul'}
+ && defined( $S->{'after_change'} )
+ && !$options->{'noaction'} )
{
- my $changed = Subst_vars( $S->{'after_change'} );
- if ( deferredlogsystem($changed) ) {
- Warn( $ERR_OPEN, "Impossible d'executer [" . $changed . "]" );
- return 1;
- }
+ my $changed = Subst_vars( $S->{'after_change'} );
+ if ( deferredlogsystem($changed) ) {
+ Warn( $ERR_OPEN, "Impossible d'executer [" . $changed . "]" );
+ return 1;
+ }
}
return 0;
}
@@ -344,28 +346,28 @@
sub Do_on_noaction {
my ( $S, $options ) = @_;
- if ( !$options->{'simul'}
- && defined( $S->{'on_noaction'} )
- && $options->{'noaction'} )
+ if ( !$options->{'simul'}
+ && defined( $S->{'on_noaction'} )
+ && $options->{'noaction'} )
{
- my $changed = Subst_vars( $S->{'on_noaction'} );
- if ( deferredlogsystem($changed) ) {
- Warn( $ERR_OPEN, "Impossible d'executer [" . $changed . "]" );
- return 1;
- }
+ my $changed = Subst_vars( $S->{'on_noaction'} );
+ if ( deferredlogsystem($changed) ) {
+ Warn( $ERR_OPEN, "Impossible d'executer [" . $changed . "]" );
+ return 1;
+ }
}
return 0;
}
-my %DEPENDS ;
-my %FUNCTIONS ;
+my %DEPENDS;
+my %FUNCTIONS;
$DEPENDS{'addfile'} = sub {
my ( $S, $dest, $options ) = @_;
while ( $dest ne '/' && $dest ne '.' ) {
- $S->{'depends'} .= " " . dirname($dest);
- $dest = dirname($dest);
+ $S->{'depends'} .= " " . dirname($dest);
+ $dest = dirname($dest);
}
};
@@ -377,108 +379,119 @@
my $cmp;
if ( !defined( $S->{'source'} ) ) {
- Abort( $ERR_SYNTAX, "Source non definie pour " . $dest );
+ Abort( $ERR_SYNTAX, "Source non definie pour " . $dest );
}
if ( $S->{'source'} =~ /\s/ ) {
- $source = Get_tmp_dest($dest) . ".merged";
- unlink($source);
-
- my $splitsource;
- foreach $splitsource ( split ( ' ', $S->{'source'} ) ) {
- $splitsource = Get_source( Subst_vars($splitsource) );
- if ( !-f $splitsource ) {
- Warn( $ERR_OPEN, "Impossible d'ouvrir " . $splitsource );
- return 1;
- }
- if ( deferredlogsystem( "cat '" . $splitsource . "' >> " . $source )
- )
- {
- Warn( $ERR_OPEN,
- "Impossible de concatener "
- . $splitsource . " dans " . $tmp );
- return 1;
- }
- }
+ $source = Get_tmp_dest($dest) . ".merged";
+ unlink($source);
+
+ my $splitsource;
+ foreach $splitsource ( split( ' ', $S->{'source'} ) ) {
+ $splitsource = Get_source( Subst_vars($splitsource) );
+ if ( !-f $splitsource ) {
+ Warn( $ERR_OPEN, "Impossible d'ouvrir " . $splitsource );
+ return 1;
+ }
+ if (deferredlogsystem(
+ "cat '" . $splitsource . "' >> " . $source
+ )
+ )
+ {
+ Warn( $ERR_OPEN,
+ "Impossible de concatener "
+ . $splitsource
+ . " dans "
+ . $tmp );
+ return 1;
+ }
+ }
}
else {
- $source = Get_source( Subst_vars( $S->{'source'} ) );
- }
-
- $SUBST{'SOURCE'} = $source;
- $tmp = Get_tmp_dest($dest);
+ $source = Get_source( Subst_vars( $S->{'source'} ) );
+ }
+
+ $SUBST{'SOURCE'} = $source;
+ $tmp = Get_tmp_dest($dest);
$SUBST{'DESTINATION'} = $tmp;
if ( defined( $S->{'filter'} ) ) {
- my $filter = Subst_vars( $S->{'filter'} );
- if ( deferredlogsystem($filter) ) {
- Warn( $ERR_OPEN, "Impossible d'appliquer " . $filter );
- return 1;
- }
+ my $filter = Subst_vars( $S->{'filter'} );
+ if ( deferredlogsystem($filter) ) {
+ Warn( $ERR_OPEN, "Impossible d'appliquer " . $filter );
+ return 1;
+ }
}
else {
- if (
- deferredlogsystem( "/bin/cp -a '" . $source . "' '" . $tmp . "'" ) )
- {
- Warn( $ERR_OPEN,
- "Impossible de copier " . $source . " vers " . $tmp );
- return 1;
- }
+ if (deferredlogsystem(
+ "/bin/cp -a '" . $source . "' '" . $tmp . "'"
+ )
+ )
+ {
+ Warn( $ERR_OPEN,
+ "Impossible de copier " . $source . " vers " . $tmp );
+ return 1;
+ }
}
if ( !-f $tmp ) {
- Warn( $ERR_OPEN, "Impossible d'ouvrir " . $tmp );
- return 1;
+ Warn( $ERR_OPEN, "Impossible d'ouvrir " . $tmp );
+ return 1;
}
$cmp = 0;
- if ( deferredlogsystem( "/usr/bin/cmp -s '" . $tmp . "' '" . $dest . "'" ) )
+ if ( deferredlogsystem( "/usr/bin/cmp -s '" . $tmp . "' '" . $dest . "'" )
+ )
{
- $cmp = 1;
-
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
-
- if ( $options->{'diff'} ) {
- deferredlogsystem(
- "/usr/bin/diff -uN '" . $dest . "' '" . $tmp . "'" );
- }
-
- Do_on_config( $S, $options ) && return 1;
-
- Do_before_change( $S, $options ) && return 1;
-
- if ( !$options->{'simul'} ) {
-
- # Fuck dpkg conffiles
- if ( $options->{'noaction'} && -e $dest && !-e $dest . ".dpkg-dist" )
- {
- deferredlogsystem(
- "/bin/cp -a '" . $dest . "' '" . $dest . ".dpkg-dist'" );
- }
-
- Do_moveold( $dest, $options );
-
- if ( Mk_dest_dir($dest)
- || deferredlogsystem(
- "/bin/cp -a '" . $tmp . "' '" . $dest . "'" ) )
- {
- Warn( $ERR_OPEN,
- "Impossible de copier " . $tmp . " vers " . $dest );
- return 1;
- }
- }
+ $cmp = 1;
+
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+
+ if ( $options->{'diff'} ) {
+ deferredlogsystem(
+ "/usr/bin/diff -uN '" . $dest . "' '" . $tmp . "'" );
+ }
+
+ Do_on_config( $S, $options ) && return 1;
+
+ Do_before_change( $S, $options ) && return 1;
+
+ if ( !$options->{'simul'} ) {
+
+ # Fuck dpkg conffiles
+ if ( $options->{'noaction'}
+ && -e $dest
+ && !-e $dest . ".dpkg-dist" )
+ {
+ deferredlogsystem(
+ "/bin/cp -a '" . $dest . "' '" . $dest . ".dpkg-dist'" );
+ }
+
+ Do_moveold( $dest, $options );
+
+ if (Mk_dest_dir($dest)
+ || deferredlogsystem(
+ "/bin/cp -a '" . $tmp . "' '" . $dest . "'"
+ )
+ )
+ {
+ Warn( $ERR_OPEN,
+ "Impossible de copier " . $tmp . " vers " . $dest );
+ return 1;
+ }
+ }
}
Do_chownmod( $S, $dest, $options );
if ($cmp) {
- Do_after_change( $S, $options ) && return 1;
-
- Do_on_noaction( $S, $options ) && return 1;
+ Do_after_change( $S, $options ) && return 1;
+
+ Do_on_noaction( $S, $options ) && return 1;
}
return 0;
@@ -491,8 +504,9 @@
if ($name_filter) {
$SUBST{SECTIONNAME} = $dest;
my $newdest = deferredlogpipe( Subst_vars($name_filter) );
- unless (defined $newdest) {
- Warn( $ERR_OPEN, "Impossible d'appliquer name_filter $name_filter" );
+ unless ( defined $newdest ) {
+ Warn( $ERR_OPEN,
+ "Impossible d'appliquer name_filter $name_filter" );
return 1;
}
unless ($newdest) {
@@ -506,40 +520,41 @@
open( DPKG, $DPKG . ' -s ' . $dest . ' 2>/dev/null |' );
while (<DPKG>) {
- if (/^Status:\s+/) {
- if ( !/^Status:\s+install\s+ok\s+installed\s*$/ ) {
- $installed_version = 0;
- last;
- }
- }
-
- if (/^Version:\s+(.+)\s*$/) {
- $installed_version = $1;
- last;
- }
+ if (/^Status:\s+/) {
+ if ( !/^Status:\s+install\s+ok\s+installed\s*$/ ) {
+ $installed_version = 0;
+ last;
+ }
+ }
+
+ if (/^Version:\s+(.+)\s*$/) {
+ $installed_version = $1;
+ last;
+ }
}
close(DPKG);
if ($installed_version) {
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
-
- Do_on_config( $S, $options ) && return 1;
-
- Do_before_change( $S, $options ) && return 1;
-
- if ( !$options->{'simul'} ) {
- if ( deferredlogsystem( $DPKG . " -P '" . $dest . "'" ) ) {
- Warn( $ERR_OPEN, "Purge du package " . $dest . " impossible" );
- return 1;
- }
- }
-
- Do_after_change( $S, $options ) && return 1;
-
- Do_on_noaction( $S, $options ) && return 1;
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+
+ Do_on_config( $S, $options ) && return 1;
+
+ Do_before_change( $S, $options ) && return 1;
+
+ if ( !$options->{'simul'} ) {
+ if ( deferredlogsystem( $DPKG . " -P '" . $dest . "'" ) ) {
+ Warn( $ERR_OPEN,
+ "Purge du package " . $dest . " impossible" );
+ return 1;
+ }
+ }
+
+ Do_after_change( $S, $options ) && return 1;
+
+ Do_on_noaction( $S, $options ) && return 1;
}
return 0;
@@ -549,11 +564,11 @@
my $pkg;
if ($APT_UPDATE) {
- if ( deferredlogsystem( $APT_GET . " update" ) ) {
- Warn( $ERR_OPEN, "apt-get update failed!" );
- return 1;
- }
- $APT_UPDATE = 0;
+ if ( deferredlogsystem( $APT_GET . " update" ) ) {
+ Warn( $ERR_OPEN, "apt-get update failed!" );
+ return 1;
+ }
+ $APT_UPDATE = 0;
}
return 0;
@@ -563,19 +578,19 @@
my ( $S, $dest, $options ) = @_;
if ( aptupdate() ) {
- return 1;
+ return 1;
}
open( APTDEP, $APT_GET_DEPENDS . ' install ' . $dest . ' 2>/dev/null |' );
while (<APTDEP>) {
- if (m/^ (.*)$/) {
- my $pkg;
- foreach $pkg ( split ( ' ', $1 ) ) {
- if ( $pkg ne $dest ) {
- $S->{'depends'} .= " " . $pkg;
- }
- }
- }
+ if (m/^ (.*)$/) {
+ my $pkg;
+ foreach $pkg ( split( ' ', $1 ) ) {
+ if ( $pkg ne $dest ) {
+ $S->{'depends'} .= " " . $pkg;
+ }
+ }
+ }
}
close(APTDEP);
};
@@ -591,8 +606,9 @@
if ($name_filter) {
$SUBST{'SECTIONNAME'} = $dest;
my $newdest = deferredlogpipe( Subst_vars($name_filter) );
- unless (defined $newdest) {
- Warn( $ERR_OPEN, "Impossible d'appliquer name_filter $name_filter" );
+ unless ( defined $newdest ) {
+ Warn( $ERR_OPEN,
+ "Impossible d'appliquer name_filter $name_filter" );
return 1;
}
unless ($newdest) {
@@ -606,101 +622,111 @@
open( APTPOLICY, $APT_POLICY . ' ' . $dest . ' 2>/dev/null |' );
while (<APTPOLICY>) {
- if (m/^ Installed: (.*)$/) {
- $installed_version = $1;
- if ( $installed_version eq '' || $installed_version eq '(none)' ) {
- undef $installed_version;
- }
- }
- elsif (m/^ Candidate: (.*)$/) {
- $available_version = $1;
- }
+ if (m/^ Installed: (.*)$/) {
+ $installed_version = $1;
+ if ( $installed_version eq '' || $installed_version eq '(none)' )
+ {
+ undef $installed_version;
+ }
+ }
+ elsif (m/^ Candidate: (.*)$/) {
+ $available_version = $1;
+ }
}
close(APTPOLICY);
if ( !defined($available_version) ) {
- Warn( $ERR_OPEN, "Package " . $dest . " indisponible" );
- return 1;
- }
-
- if ( !defined($installed_version)
- || !deferredlogsystem( $DPKG
- . ' --compare-versions '
- . $installed_version . ' lt '
- . $available_version ) )
+ Warn( $ERR_OPEN, "Package " . $dest . " indisponible" );
+ return 1;
+ }
+
+ if (!defined($installed_version)
+ || !deferredlogsystem(
+ $DPKG
+ . ' --compare-versions '
+ . $installed_version . ' lt '
+ . $available_version
+ )
+ )
{
- $install++;
+ $install++;
}
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 : '?' )
- . ")" );
- }
-
- if ( defined( $S->{'delay'} ) && !$options->{'noaction'} ) {
- $HOSTNAME =~ /\d+$/;
- if ( $& ne "" ) {
- sleep( 120 * $& );
- }
- }
-
- if ( !$options->{'simul'} && defined( $S->{'debconf'} ) ) {
-
- my $DEB;
- my $conf;
- my $pkg;
-
- Debconf::Db->load;
- foreach $conf ( keys %{ $S->{'debconf'} } ) {
-
- ($pkg) = split ( m:/:, $conf );
-
- if ( !$DEB->{$pkg} ) {
- $DEB->{$pkg} = 1;
- Debconf::Template->load( $TEMPLATES . "/" . $pkg, $pkg );
- }
-
- Debconf::ConfModule->command_set( $conf,
- $S->{'debconf'}->{$conf} );
- Debconf::ConfModule->command_fset( $conf, "seen", "true" );
- }
- Debconf::Db->save;
- }
-
- Do_on_config( $S, $options ) && return 1;
-
- Do_before_change( $S, $options ) && return 1;
-
- if ( defined( $S->{'reply'} ) ) {
- $install = $S->{'reply'};
- eval "\$install = sprintf (\"echo '$install' |\")";
- }
- else {
- $install = '';
- }
-
- if ( !$options->{'simul'} ) {
- if (
- deferredlogsystem(
- $install . " " . $APT_GET . " install '" . $dest . "'" ) )
- {
- Warn( $ERR_OPEN, "Installation de " . $dest . " impossible" );
- return 1;
- }
- }
-
- Do_after_change( $S, $options ) && return 1;
-
- Do_on_noaction( $S, $options ) && return 1;
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+
+ if ( $options->{'diff'} ) {
+ Log("(inst = "
+ . (
+ defined($installed_version) ? $installed_version : '?'
+ )
+ . ", avail = "
+ . (
+ defined($available_version) ? $available_version : '?'
+ )
+ . ")"
+ );
+ }
+
+ if ( defined( $S->{'delay'} ) && !$options->{'noaction'} ) {
+ $HOSTNAME =~ /\d+$/;
+ if ( $& ne "" ) {
+ sleep( 120 * $& );
+ }
+ }
+
+ if ( !$options->{'simul'} && defined( $S->{'debconf'} ) ) {
+
+ my $DEB;
+ my $conf;
+ my $pkg;
+
+ Debconf::Db->load;
+ foreach $conf ( keys %{ $S->{'debconf'} } ) {
+
+ ($pkg) = split( m:/:, $conf );
+
+ if ( !$DEB->{$pkg} ) {
+ $DEB->{$pkg} = 1;
+ Debconf::Template->load( $TEMPLATES . "/" . $pkg, $pkg );
+ }
+
+ Debconf::ConfModule->command_set( $conf,
+ $S->{'debconf'}->{$conf} );
+ Debconf::ConfModule->command_fset( $conf, "seen", "true" );
+ }
+ Debconf::Db->save;
+ }
+
+ Do_on_config( $S, $options ) && return 1;
+
+ Do_before_change( $S, $options ) && return 1;
+
+ if ( defined( $S->{'reply'} ) ) {
+ $install = $S->{'reply'};
+ eval "\$install = sprintf (\"echo '$install' |\")";
+ }
+ else {
+ $install = '';
+ }
+
+ if ( !$options->{'simul'} ) {
+ if (deferredlogsystem(
+ $install . " " . $APT_GET . " install '" . $dest . "'"
+ )
+ )
+ {
+ Warn( $ERR_OPEN, "Installation de " . $dest . " impossible" );
+ return 1;
+ }
+ }
+
+ Do_after_change( $S, $options ) && return 1;
+
+ Do_on_noaction( $S, $options ) && return 1;
}
return 0;
@@ -710,8 +736,8 @@
my ( $S, $dest, $options ) = @_;
while ( $dest ne '/' && $dest ne '.' ) {
- $S->{'depends'} .= " " . dirname($dest);
- $dest = dirname($dest);
+ $S->{'depends'} .= " " . dirname($dest);
+ $dest = dirname($dest);
}
};
@@ -742,20 +768,20 @@
my $Z;
if ( !defined( $S->{'source'} ) ) {
- Abort( $ERR_SYNTAX, "Source non definie pour " . $dest );
+ Abort( $ERR_SYNTAX, "Source non definie pour " . $dest );
}
$source = Subst_vars( $S->{'source'} );
my $sourceaddr = $source;
$sourceaddr =~ s/^([^:]+):(.+)$/$1/; # NFS
if ( defined($sourceaddr) && !isipaddr($sourceaddr) ) {
- if ( !defined($Z) ) {
- $Z = Init_lib_net( Get_source("GLOBAL:private-network") );
- }
- my $sourceip = Resolv( $sourceaddr, $Z );
- if ( defined($sourceip) && $sourceip ne "" ) {
- $source =~ s/^([^:]+):(.+)$/$sourceip:$2/;
- }
+ if ( !defined($Z) ) {
+ $Z = Init_lib_net( Get_source("GLOBAL:private-network") );
+ }
+ my $sourceip = Resolv( $sourceaddr, $Z );
+ if ( defined($sourceip) && $sourceip ne "" ) {
+ $source =~ s/^([^:]+):(.+)$/$sourceip:$2/;
+ }
}
$SUBST{'SOURCE'} = $source;
@@ -765,355 +791,386 @@
my $optsaddr = $opts;
$optsaddr =~ s/^(.*,)?ip=([^,]+)(,.*)?$/$2/;
if ( defined($optsaddr) && !isipaddr($optsaddr) ) {
- if ( !defined($Z) ) {
- $Z = Init_lib_net( Get_source("GLOBAL:private-network") );
- }
- my $optsip = Resolv( $optsaddr, $Z );
- if ( defined($optsip) && $optsip ne "" ) {
- $opts =~ s/^(.*,)?ip=([^,]+)(,.*)?$/$1ip=$optsip$3/;
- }
+ if ( !defined($Z) ) {
+ $Z = Init_lib_net( Get_source("GLOBAL:private-network") );
+ }
+ my $optsip = Resolv( $optsaddr, $Z );
+ if ( defined($optsip) && $optsip ne "" ) {
+ $opts =~ s/^(.*,)?ip=([^,]+)(,.*)?$/$1ip=$optsip$3/;
+ }
}
$SUBST{'OPTIONS'} = $opts;
- $sortedopts = join ( ',', sort split ( ',', $opts ) );
+ $sortedopts = join( ',', sort split( ',', $opts ) );
$fstype = defined( $S->{'fstype'} ) ? $S->{'fstype'} : $DEFAULT_FSTYPE;
$SUBST{'FSTYPE'} = $fstype;
if ( !open( FSTAB, "< /etc/fstab" ) ) {
- Warn( $ERR_OPEN, "Impossible de lire /etc/fstab" );
- return 1;
+ Warn( $ERR_OPEN, "Impossible de lire /etc/fstab" );
+ return 1;
}
while (<FSTAB>) {
- if (
-m/^[ ]*([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)/
- )
- {
- my $resolved1 = $1;
- {
- my $oldsourceaddr = $1;
- $oldsourceaddr =~ s/^([^:]+):(.+)$/$1/; # NFS
- if ( defined($oldsourceaddr) && !isipaddr($oldsourceaddr) ) {
- if ( !defined($Z) ) {
- $Z =
- Init_lib_net( Get_source("GLOBAL:private-network") );
- }
- my $oldsourceip = Resolv( $oldsourceaddr, $Z );
- if ( defined($oldsourceip) && $oldsourceip ne "" ) {
- $resolved1 =~ s/^([^:]+):(.+)$/$oldsourceip:$2/;
- }
- }
- }
-
- my $resolved4 = $4;
- {
- my $oldoptsaddr = $4;
- $oldoptsaddr =~ s/^(.*,)?ip=([^,]+)(,.*)?$/$2/;
- if ( defined($oldoptsaddr) && !isipaddr($oldoptsaddr) ) {
- if ( !defined($Z) ) {
- $Z =
- Init_lib_net( Get_source("GLOBAL:private-network") );
- }
- my $oldoptsip = Resolv( $oldoptsaddr, $Z );
- if ( defined($oldoptsip) && $oldoptsip ne "" ) {
- $resolved4 =~
- s/^(.*,)?ip=([^,]+)(,.*)?$/$1ip=$oldoptsip$3/;
- }
- }
- }
-
- if ( $1 eq $source && $source ne "none" ) {
- $olddest = $2;
- }
- if ( $2 eq $dest ) {
- $oldsource = $1;
- }
-
- if ( $resolved1 eq $source && $2 eq $dest ) {
- $oldfstype = $3;
- $oldopts = $4;
- $oldopts = join ( ',', sort split ( ',', $oldopts ) );
- $oldresolvedopts = $resolved4;
- $oldresolvedopts =
- join ( ',', sort split ( ',', $oldresolvedopts ) );
- }
- }
+ if (m/^[ ]*([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)/
+ )
+ {
+ my $resolved1 = $1;
+ {
+ my $oldsourceaddr = $1;
+ $oldsourceaddr =~ s/^([^:]+):(.+)$/$1/; # NFS
+ if ( defined($oldsourceaddr) && !isipaddr($oldsourceaddr) ) {
+ if ( !defined($Z) ) {
+ $Z = Init_lib_net(
+ Get_source("GLOBAL:private-network") );
+ }
+ my $oldsourceip = Resolv( $oldsourceaddr, $Z );
+ if ( defined($oldsourceip) && $oldsourceip ne "" ) {
+ $resolved1 =~ s/^([^:]+):(.+)$/$oldsourceip:$2/;
+ }
+ }
+ }
+
+ my $resolved4 = $4;
+ {
+ my $oldoptsaddr = $4;
+ $oldoptsaddr =~ s/^(.*,)?ip=([^,]+)(,.*)?$/$2/;
+ if ( defined($oldoptsaddr) && !isipaddr($oldoptsaddr) ) {
+ if ( !defined($Z) ) {
+ $Z = Init_lib_net(
+ Get_source("GLOBAL:private-network") );
+ }
+ my $oldoptsip = Resolv( $oldoptsaddr, $Z );
+ if ( defined($oldoptsip) && $oldoptsip ne "" ) {
+ $resolved4
+ =~ s/^(.*,)?ip=([^,]+)(,.*)?$/$1ip=$oldoptsip$3/;
+ }
+ }
+ }
+
+ if ( $1 eq $source && $source ne "none" ) {
+ $olddest = $2;
+ }
+ if ( $2 eq $dest ) {
+ $oldsource = $1;
+ }
+
+ if ( $resolved1 eq $source && $2 eq $dest ) {
+ $oldfstype = $3;
+ $oldopts = $4;
+ $oldopts = join( ',', sort split( ',', $oldopts ) );
+ $oldresolvedopts = $resolved4;
+ $oldresolvedopts
+ = join( ',', sort split( ',', $oldresolvedopts ) );
+ }
+ }
}
close(FSTAB);
$addmountfstab = 1;
- if ( defined($oldsource)
- && $oldsource eq $source
- && defined($olddest)
- && $olddest eq $dest
- && defined($oldfstype)
- && $oldfstype eq $fstype
- && defined($oldopts)
- && $oldopts eq $sortedopts
- && defined($oldresolvedopts)
- && $oldresolvedopts eq $sortedopts )
+ if ( defined($oldsource)
+ && $oldsource eq $source
+ && defined($olddest)
+ && $olddest eq $dest
+ && defined($oldfstype)
+ && $oldfstype eq $fstype
+ && defined($oldopts)
+ && $oldopts eq $sortedopts
+ && defined($oldresolvedopts)
+ && $oldresolvedopts eq $sortedopts )
{
- $addmountfstab = 0;
+ $addmountfstab = 0;
}
if ( !$options->{'noaction'} ) {
- if ( !open( MOUNTS, "< /proc/mounts" ) ) {
- Warn( $ERR_OPEN, "Impossible de lire /proc/mounts" );
- }
- else {
- while (<MOUNTS>) {
- if (
-m/^([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)/
- )
- {
- my $resolved1 = $1;
- {
- my $oldmsourceaddr = $1;
- $oldmsourceaddr =~ s/^([^:]+):(.+)$/$1/; # NFS
- if ( defined($oldmsourceaddr)
- && !isipaddr($oldmsourceaddr) )
- {
- if ( !defined($Z) ) {
- $Z =
- Init_lib_net(
- Get_source("GLOBAL:private-network") );
- }
- my $oldmsourceip = Resolv( $oldmsourceaddr, $Z );
- if ( defined($oldmsourceip) && $oldmsourceip ne "" )
- {
- $resolved1 =~
- s/^([^:]+):(.+)$/$oldmsourceip:$2/;
- }
- }
- }
-
- if ( $resolved1 eq $source && $source ne "none" ) {
- $oldmdest = $2;
- }
- if ( $2 eq $dest ) {
- $oldmsource = $1;
- $oldmresolvedsource = $resolved1;
- }
-
- if ( $resolved1 eq $source && $2 eq $dest ) {
- $oldmfstype = $3;
- $oldmopts = $4;
- $oldmopts = join ( ',', sort split ( ',', $oldmopts ) );
- }
- }
- }
- close(MOUNTS);
-
- #todo, parsing options, utilisation de celles de fstab
- $addmountmounts = 1;
- if ( defined($oldmresolvedsource)
- && $oldmresolvedsource eq $source
- && defined($oldmdest)
- && $oldmdest eq $dest
- && defined($oldmfstype)
- && $oldmfstype eq $fstype
- && defined($oldresolvedopts)
- && $oldresolvedopts eq $sortedopts )
- {
- $addmountmounts = 0;
- }
- }
+ if ( !open( MOUNTS, "< /proc/mounts" ) ) {
+ Warn( $ERR_OPEN, "Impossible de lire /proc/mounts" );
+ }
+ else {
+ while (<MOUNTS>) {
+ if (m/^([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)[ ]+([^ ]+)/
+ )
+ {
+ my $resolved1 = $1;
+ {
+ my $oldmsourceaddr = $1;
+ $oldmsourceaddr =~ s/^([^:]+):(.+)$/$1/; # NFS
+ if ( defined($oldmsourceaddr)
+ && !isipaddr($oldmsourceaddr) )
+ {
+ if ( !defined($Z) ) {
+ $Z = Init_lib_net(
+ Get_source("GLOBAL:private-network") );
+ }
+ my $oldmsourceip = Resolv( $oldmsourceaddr, $Z );
+ if ( defined($oldmsourceip)
+ && $oldmsourceip ne "" )
+ {
+ $resolved1
+ =~ s/^([^:]+):(.+)$/$oldmsourceip:$2/;
+ }
+ }
+ }
+
+ if ( $resolved1 eq $source && $source ne "none" ) {
+ $oldmdest = $2;
+ }
+ if ( $2 eq $dest ) {
+ $oldmsource = $1;
+ $oldmresolvedsource = $resolved1;
+ }
+
+ if ( $resolved1 eq $source && $2 eq $dest ) {
+ $oldmfstype = $3;
+ $oldmopts = $4;
+ $oldmopts = join( ',', sort split( ',', $oldmopts ) );
+ }
+ }
+ }
+ close(MOUNTS);
+
+ #todo, parsing options, utilisation de celles de fstab
+ $addmountmounts = 1;
+ if ( defined($oldmresolvedsource)
+ && $oldmresolvedsource eq $source
+ && defined($oldmdest)
+ && $oldmdest eq $dest
+ && defined($oldmfstype)
+ && $oldmfstype eq $fstype
+ && defined($oldresolvedopts)
+ && $oldresolvedopts eq $sortedopts )
+ {
+ $addmountmounts = 0;
+ }
+ }
}
if ( $addmountfstab || $addmountmounts || !-d $dest ) {
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
-
- Do_on_config( $S, $options ) && return 1;
-
- Do_before_change( $S, $options ) && return 1;
-
- if ( !-d $dest && $dest ne 'none' ) {
- if ( !defined( $FUNCTIONS{'mkdir'} ) ) {
- Warn( $ERR_OPEN, "Fonction mkdir necessaire pour addmount" );
- return 1;
- }
- $FUNCTIONS{'mkdir'}->( $S, $dest, $options );
- }
-
- if ($addmountfstab) {
- my $tmp = Get_tmp_dest("/etc/fstab");
-
- if ( !open( FSTAB, "< /etc/fstab" ) ) {
- Warn( $ERR_OPEN, "Impossible de lire /etc/fstab" );
- return 1;
- }
-
- if ( !open( NEWFSTAB, "> " . $tmp ) ) {
- Warn( $ERR_OPEN, "Impossible de creer " . $tmp );
- return 1;
- }
-
- while (<FSTAB>) {
- my $line = $_;
- if ( defined($oldsource)
- && $oldsource ne $source
- && $line =~ m|^[ ]*$oldsource[ ]+| )
- {
- Warn( $ERR_OPEN,
- "Suppression de la source "
- . $oldsource
- . " de fstab" );
- }
- elsif ( defined($olddest)
- && $olddest ne $dest
- && $line =~ m|^[ ]*[^ ]+[ ]+$olddest[ ]+| )
- {
- Warn( $ERR_OPEN, "Suppression de la destination " . $olddest
- . " de fstab" );
- }
- elsif ( defined($oldfstype)
- && $oldfstype ne $fstype
- && $line =~ m|^[ ]*$source+[ ]+$dest[ ]+| )
- {
- Warn( $ERR_OPEN,
- "Suppression du mauvais type "
- . $oldfstype . " pour " . $source
- . " de fstab" );
- }
- elsif ( defined($oldopts)
- && $oldopts ne $opts
- && $line =~ m|^[ ]*$source+[ ]+$dest[ ]+| )
- {
- Warn( $ERR_OPEN,
- "Suppression des mauvaises options " . $oldopts
- . " pour " . $source
- . " de fstab" );
- }
- else {
- print NEWFSTAB $line;
- }
- }
- print NEWFSTAB $source . " " . $dest . " " . $fstype . " " . $opts
- . " 0 0\n";
- close(NEWFSTAB);
- close(FSTAB);
-
- if ( $options->{'diff'} ) {
- deferredlogsystem( "diff -uN '/etc/fstab' '" . $tmp . "'" );
- }
-
- if ( !$options->{'simul'} ) {
- if ( system( "cat '" . $tmp . "' > /etc/fstab" ) ) {
- Warn( $ERR_OPEN,
- "Impossible de recopier " . $tmp . " dans /etc/fstab" );
- return 1;
- }
- }
- }
-
- if ($addmountmounts) {
-
- if ( $options->{'diff'} ) {
- if ( ( ( defined $oldmresolvedsource )
- ? $oldmresolvedsource
- : '?' ) ne $source )
- {
- Log( "src "
- . ( ( defined $oldmresolvedsource )
- ? $oldmresolvedsource
- : '?' ) . " -> " . $source );
- }
- if ( ( ( defined $oldmdest ) ? $oldmdest : '?' ) ne $dest ) {
- Log( "dst "
- . ( ( defined $oldmdest ) ? $oldmdest : '?' ) . " -> "
- . $dest );
- }
- if (
- ( ( defined $oldmfstype ) ? $oldmfstype : '?' ) ne $fstype )
- {
- Log( "fs "
- . ( ( defined $oldmfstype ) ? $oldmfstype : '?' )
- . " -> "
- . $fstype );
- }
- if (
- ( ( defined $oldresolvedopts ) ? $oldresolvedopts : '?' ) ne
- $opts )
- {
- Log( "opt "
- . ( ( defined $oldresolvedopts )
- ? $oldresolvedopts
- : '?' ) . " -> " . $opts );
- }
- }
-
- if ( !$options->{'simul'} && !$options->{'noaction'} ) {
-
- if ( defined($oldmsource)
- && $oldmsource ne $source
- && ( !defined($oldmresolvedsource)
- || $oldmresolvedsource ne $source )
- ) # Pas la peine de remounter si le resolv est le meme
- {
- if ( deferredlogsystem( "umount '" . $oldmsource . "'" ) ) {
- Warn( $ERR_OPEN,
- "Impossible d'unmounter la source " . $oldmsource );
- return 1;
- }
- }
-
- if ( defined($oldmdest) && $oldmdest ne $dest ) {
- if ( deferredlogsystem( "umount '" . $oldmdest . "'" ) ) {
- Warn( $ERR_OPEN,
- "Impossible d'unmounter la destination "
- . $oldmdest );
- return 1;
- }
- }
-
- if ( defined($oldmfstype) && $oldmfstype ne $fstype ) {
- if ( deferredlogsystem( "umount '" . $dest . "'" ) ) {
- Warn( $ERR_OPEN,
- "Impossible d'unmounter la destination " . $dest );
- return 1;
- }
- }
-
- if ( defined($oldopts)
- && $oldopts ne $opts
- && defined($oldmfstype)
- && $oldmfstype eq $fstype )
- {
- if (
- deferredlogsystem(
- "mount -o 'remount," . $opts . "' '" . $dest . "'" )
- )
- {
- Warn( $ERR_OPEN,
- "Impossible de remounter la destination " . $dest
- . " avec les options " . $opts );
- return 1;
- }
- }
- else {
-
- if (
- deferredlogsystem(
- "mount -t '" . $fstype . "' -o '" . $opts . "' '"
- . $source . "' '" . $dest . "'" ) )
- {
- Warn( $ERR_OPEN,
- "Impossible de mounter la source " . $source
- . " sur " . $dest
- . " de type " . $fstype
- . " avec les options " . $opts );
- return 1;
- }
- }
- }
- }
-
- Do_after_change( $S, $options ) && return 1;
-
- Do_on_noaction( $S, $options ) && return 1;
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+
+ Do_on_config( $S, $options ) && return 1;
+
+ Do_before_change( $S, $options ) && return 1;
+
+ if ( !-d $dest && $dest ne 'none' ) {
+ if ( !defined( $FUNCTIONS{'mkdir'} ) ) {
+ Warn( $ERR_OPEN, "Fonction mkdir necessaire pour addmount" );
+ return 1;
+ }
+ $FUNCTIONS{'mkdir'}->( $S, $dest, $options );
+ }
+
+ if ($addmountfstab) {
+ my $tmp = Get_tmp_dest("/etc/fstab");
+
+ if ( !open( FSTAB, "< /etc/fstab" ) ) {
+ Warn( $ERR_OPEN, "Impossible de lire /etc/fstab" );
+ return 1;
+ }
+
+ if ( !open( NEWFSTAB, "> " . $tmp ) ) {
+ Warn( $ERR_OPEN, "Impossible de creer " . $tmp );
+ return 1;
+ }
+
+ while (<FSTAB>) {
+ my $line = $_;
+ if ( defined($oldsource)
+ && $oldsource ne $source
+ && $line =~ m|^[ ]*$oldsource[ ]+| )
+ {
+ Warn( $ERR_OPEN,
+ "Suppression de la source "
+ . $oldsource
+ . " de fstab" );
+ }
+ elsif (defined($olddest)
+ && $olddest ne $dest
+ && $line =~ m|^[ ]*[^ ]+[ ]+$olddest[ ]+| )
+ {
+ Warn( $ERR_OPEN,
+ "Suppression de la destination "
+ . $olddest
+ . " de fstab" );
+ }
+ elsif (defined($oldfstype)
+ && $oldfstype ne $fstype
+ && $line =~ m|^[ ]*$source+[ ]+$dest[ ]+| )
+ {
+ Warn( $ERR_OPEN,
+ "Suppression du mauvais type "
+ . $oldfstype
+ . " pour "
+ . $source
+ . " de fstab" );
+ }
+ elsif (defined($oldopts)
+ && $oldopts ne $opts
+ && $line =~ m|^[ ]*$source+[ ]+$dest[ ]+| )
+ {
+ Warn( $ERR_OPEN,
+ "Suppression des mauvaises options "
+ . $oldopts
+ . " pour "
+ . $source
+ . " de fstab" );
+ }
+ else {
+ print NEWFSTAB $line;
+ }
+ }
+ print NEWFSTAB $source . " " . $dest . " " . $fstype . " " . $opts
+ . " 0 0\n";
+ close(NEWFSTAB);
+ close(FSTAB);
+
+ if ( $options->{'diff'} ) {
+ deferredlogsystem( "diff -uN '/etc/fstab' '" . $tmp . "'" );
+ }
+
+ if ( !$options->{'simul'} ) {
+ if ( system( "cat '" . $tmp . "' > /etc/fstab" ) ) {
+ Warn( $ERR_OPEN,
+ "Impossible de recopier "
+ . $tmp
+ . " dans /etc/fstab" );
+ return 1;
+ }
+ }
+ }
+
+ if ($addmountmounts) {
+
+ if ( $options->{'diff'} ) {
+ if (( ( defined $oldmresolvedsource )
+ ? $oldmresolvedsource
+ : '?'
+ ) ne $source
+ )
+ {
+ Log("src "
+ . (
+ ( defined $oldmresolvedsource )
+ ? $oldmresolvedsource
+ : '?'
+ )
+ . " -> "
+ . $source
+ );
+ }
+ if ( ( ( defined $oldmdest ) ? $oldmdest : '?' ) ne $dest ) {
+ Log( "dst "
+ . ( ( defined $oldmdest ) ? $oldmdest : '?' )
+ . " -> "
+ . $dest );
+ }
+ if ( ( ( defined $oldmfstype ) ? $oldmfstype : '?' ) ne
+ $fstype )
+ {
+ Log( "fs "
+ . ( ( defined $oldmfstype ) ? $oldmfstype : '?' )
+ . " -> "
+ . $fstype );
+ }
+ if ( ( ( defined $oldresolvedopts ) ? $oldresolvedopts : '?' )
+ ne $opts )
+ {
+ Log("opt "
+ . (
+ ( defined $oldresolvedopts )
+ ? $oldresolvedopts
+ : '?'
+ )
+ . " -> "
+ . $opts
+ );
+ }
+ }
+
+ if ( !$options->{'simul'} && !$options->{'noaction'} ) {
+
+ if ( defined($oldmsource)
+ && $oldmsource ne $source
+ && ( !defined($oldmresolvedsource)
+ || $oldmresolvedsource ne $source )
+ ) # Pas la peine de remounter si le resolv est le meme
+ {
+ if ( deferredlogsystem( "umount '" . $oldmsource . "'" ) )
+ {
+ Warn( $ERR_OPEN,
+ "Impossible d'unmounter la source "
+ . $oldmsource );
+ return 1;
+ }
+ }
+
+ if ( defined($oldmdest) && $oldmdest ne $dest ) {
+ if ( deferredlogsystem( "umount '" . $oldmdest . "'" ) ) {
+ Warn( $ERR_OPEN,
+ "Impossible d'unmounter la destination "
+ . $oldmdest );
+ return 1;
+ }
+ }
+
+ if ( defined($oldmfstype) && $oldmfstype ne $fstype ) {
+ if ( deferredlogsystem( "umount '" . $dest . "'" ) ) {
+ Warn( $ERR_OPEN,
+ "Impossible d'unmounter la destination "
+ . $dest );
+ return 1;
+ }
+ }
+
+ if ( defined($oldopts)
+ && $oldopts ne $opts
+ && defined($oldmfstype)
+ && $oldmfstype eq $fstype )
+ {
+ if (deferredlogsystem(
+ "mount -o 'remount," . $opts . "' '" . $dest . "'"
+ )
+ )
+ {
+ Warn( $ERR_OPEN,
+ "Impossible de remounter la destination "
+ . $dest
+ . " avec les options "
+ . $opts );
+ return 1;
+ }
+ }
+ else {
+
+ if (deferredlogsystem(
+ "mount -t '"
+ . $fstype
+ . "' -o '"
+ . $opts . "' '"
+ . $source . "' '"
+ . $dest . "'"
+ )
+ )
+ {
+ Warn( $ERR_OPEN,
+ "Impossible de mounter la source "
+ . $source . " sur "
+ . $dest
+ . " de type "
+ . $fstype
+ . " avec les options "
+ . $opts );
+ return 1;
+ }
+ }
+ }
+ }
+
+ Do_after_change( $S, $options ) && return 1;
+
+ Do_on_noaction( $S, $options ) && return 1;
}
return 0;
@@ -1130,12 +1187,12 @@
my $source = Subst_vars( $S->{'source'} );
while ( $source ne '/' && $source ne '.' ) {
- $S->{'depends'} .= " " . dirname($source);
- $source = dirname($source);
+ $S->{'depends'} .= " " . dirname($source);
+ $source = dirname($source);
}
while ( $dest ne '/' && $dest ne '.' ) {
- $S->{'depends'} .= " " . dirname($dest);
- $dest = dirname($dest);
+ $S->{'depends'} .= " " . dirname($dest);
+ $dest = dirname($dest);
}
};
@@ -1145,43 +1202,43 @@
my $cmp = 0;
if ( !defined( $S->{'source'} ) ) {
- Abort( $ERR_SYNTAX, "Source non definie pour " . $dest );
+ Abort( $ERR_SYNTAX, "Source non definie pour " . $dest );
}
my $source = Subst_vars( $S->{'source'} );
if ( !-l $dest || ( -l $dest && readlink($dest) ne $source ) ) {
- $cmp = 1;
-
- 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( $S, $options ) && return 1;
-
- Do_before_change( $S, $options ) && return 1;
-
- if ( !$options->{'simul'} ) {
- Do_moveold( $dest, $options );
-
- if ( Mk_dest_dir($dest) || ln_sfn( $source, $dest ) ) {
- Warn( $ERR_OPEN,
- "Impossible de lier " . $dest . " a " . $source );
- return 1;
- }
- }
-
- Do_after_change( $S, $options ) && return 1;
-
- Do_on_noaction( $S, $options ) && return 1;
+ $cmp = 1;
+
+ 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( $S, $options ) && return 1;
+
+ Do_before_change( $S, $options ) && return 1;
+
+ if ( !$options->{'simul'} ) {
+ Do_moveold( $dest, $options );
+
+ if ( Mk_dest_dir($dest) || ln_sfn( $source, $dest ) ) {
+ Warn( $ERR_OPEN,
+ "Impossible de lier " . $dest . " a " . $source );
+ return 1;
+ }
+ }
+
+ Do_after_change( $S, $options ) && return 1;
+
+ Do_on_noaction( $S, $options ) && return 1;
}
return 0;
@@ -1191,8 +1248,8 @@
my ( $S, $dest, $options ) = @_;
while ( $dest ne '/' && $dest ne '.' ) {
- $S->{'depends'} .= " " . dirname($dest);
- $dest = dirname($dest);
+ $S->{'depends'} .= " " . dirname($dest);
+ $dest = dirname($dest);
}
};
@@ -1202,104 +1259,107 @@
my $cmp = 0;
if ( !defined $S->{'source'} ) {
- if ( !-f $dest ) {
- $cmp = 1;
-
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
-
- Do_on_config( $S, $options ) && return 1;
-
- Do_before_change( $S, $options ) && return 1;
-
- if ( !$options->{'simul'} ) {
-
- #Do_moveold( $dest, $options );
-
- if (
- deferredlogsystem(
- "/usr/bin/touch -t 197901010000 '" . $dest . "'" ) )
- {
- Warn( $ERR_OPEN,
- "Impossible de creer le fichier " . $dest );
- return 1;
- }
- }
- }
+ if ( !-f $dest ) {
+ $cmp = 1;
+
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+
+ Do_on_config( $S, $options ) && return 1;
+
+ Do_before_change( $S, $options ) && return 1;
+
+ if ( !$options->{'simul'} ) {
+
+ #Do_moveold( $dest, $options );
+
+ if (deferredlogsystem(
+ "/usr/bin/touch -t 197901010000 '" . $dest . "'"
+ )
+ )
+ {
+ Warn( $ERR_OPEN,
+ "Impossible de creer le fichier " . $dest );
+ return 1;
+ }
+ }
+ }
}
else {
- my $source;
- my $tmp;
-
- $source = Get_source( Subst_vars( $S->{'source'} ) );
- $SUBST{'SOURCE'} = $source;
-
- $tmp = Get_tmp_dest($dest);
- $SUBST{'DESTINATION'} = $tmp;
-
- if ( !-f $source ) {
- Warn( $ERR_OPEN, "Impossible d'ouvrir " . $source );
- return 1;
- }
-
- if ( defined( $S->{'filter'} ) ) {
- my $filter = Subst_vars( $S->{'filter'} );
- if ( deferredlogsystem($filter) ) {
- Warn( $ERR_OPEN, "Impossible d'appliquer " . $filter );
- return 1;
- }
- }
- else {
-
- if (
- deferredlogsystem(
- "/bin/cp -a '" . $source . "' '" . $tmp . "'" ) )
- {
- Warn( $ERR_OPEN,
- "Impossible de copier " . $source . " vers " . $tmp );
- return 1;
- }
- }
-
- if ( !-f $tmp ) {
- Warn( $ERR_OPEN, "Impossible d'ouvrir " . $tmp );
- return 1;
- }
-
- if ( !-f $dest ) {
- $cmp = 1;
-
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
-
- Do_on_config( $S, $options ) && return 1;
-
- Do_before_change( $S, $options ) && return 1;
-
- if ( !$options->{'simul'} ) {
-
- #Do_moveold( $dest, $options );
-
- if (
- deferredlogsystem(
- "/bin/cp -a '" . $source . "' '" . $dest . "'" ) )
- {
- Warn( $ERR_OPEN,
- "Impossible de creer le fichier " . $dest );
- return 1;
- }
- }
- }
+ my $source;
+ my $tmp;
+
+ $source = Get_source( Subst_vars( $S->{'source'} ) );
+ $SUBST{'SOURCE'} = $source;
+
+ $tmp = Get_tmp_dest($dest);
+ $SUBST{'DESTINATION'} = $tmp;
+
+ if ( !-f $source ) {
+ Warn( $ERR_OPEN, "Impossible d'ouvrir " . $source );
+ return 1;
+ }
+
+ if ( defined( $S->{'filter'} ) ) {
+ my $filter = Subst_vars( $S->{'filter'} );
+ if ( deferredlogsystem($filter) ) {
+ Warn( $ERR_OPEN, "Impossible d'appliquer " . $filter );
+ return 1;
+ }
+ }
+ else {
+
+ if (deferredlogsystem(
+ "/bin/cp -a '" . $source . "' '" . $tmp . "'"
+ )
+ )
+ {
+ Warn( $ERR_OPEN,
+ "Impossible de copier " . $source . " vers " . $tmp );
+ return 1;
+ }
+ }
+
+ if ( !-f $tmp ) {
+ Warn( $ERR_OPEN, "Impossible d'ouvrir " . $tmp );
+ return 1;
+ }
+
+ if ( !-f $dest ) {
+ $cmp = 1;
+
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+
+ Do_on_config( $S, $options ) && return 1;
+
+ Do_before_change( $S, $options ) && return 1;
+
+ if ( !$options->{'simul'} ) {
+
+ #Do_moveold( $dest, $options );
+
+ if (deferredlogsystem(
+ "/bin/cp -a '" . $source . "' '" . $dest . "'"
+ )
+ )
+ {
+ Warn( $ERR_OPEN,
+ "Impossible de creer le fichier " . $dest );
+ return 1;
+ }
+ }
+ }
}
Do_chownmod( $S, $dest, $options );
if ($cmp) {
- Do_after_change( $S, $options ) && return 1;
-
- Do_on_noaction( $S, $options ) && return 1;
+ Do_after_change( $S, $options ) && return 1;
+
+ Do_on_noaction( $S, $options ) && return 1;
}
return 0;
@@ -1309,8 +1369,8 @@
my ( $S, $dest, $options ) = @_;
while ( $dest ne '/' && $dest ne '.' ) {
- $S->{'depends'} .= " " . dirname($dest);
- $dest = dirname($dest);
+ $S->{'depends'} .= " " . dirname($dest);
+ $dest = dirname($dest);
}
};
@@ -1320,32 +1380,33 @@
my $cmp = 0;
if ( !-d $dest ) {
- $cmp = 1;
-
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
-
- Do_on_config( $S, $options ) && return 1;
-
- Do_before_change( $S, $options ) && return 1;
-
- if ( !$options->{'simul'} ) {
- Do_moveold( $dest, $options );
-
- if ( deferredlogsystem( "/bin/mkdir -p '" . $dest . "'" ) ) {
- Warn( $ERR_OPEN, "Impossible de creer le repertoire " . $dest );
- return 1;
- }
- }
+ $cmp = 1;
+
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+
+ Do_on_config( $S, $options ) && return 1;
+
+ Do_before_change( $S, $options ) && return 1;
+
+ if ( !$options->{'simul'} ) {
+ Do_moveold( $dest, $options );
+
+ if ( deferredlogsystem( "/bin/mkdir -p '" . $dest . "'" ) ) {
+ Warn( $ERR_OPEN,
+ "Impossible de creer le repertoire " . $dest );
+ return 1;
+ }
+ }
}
Do_chownmod( $S, $dest, $options );
if ($cmp) {
- Do_after_change( $S, $options ) && return 1;
-
- Do_on_noaction( $S, $options ) && return 1;
+ Do_after_change( $S, $options ) && return 1;
+
+ Do_on_noaction( $S, $options ) && return 1;
}
return 0;
@@ -1356,41 +1417,42 @@
my $cmp = 0;
if ( -d $dest ) {
- Warn( $ERR_OPEN, "La destination " . $dest . "doit etre un fichier!" );
- return 1;
+ Warn( $ERR_OPEN,
+ "La destination " . $dest . "doit etre un fichier!" );
+ return 1;
}
if ( -f $dest ) {
- $cmp = 1;
-
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
-
- Do_on_config( $S, $options ) && return 1;
-
- Do_before_change( $S, $options ) && return 1;
-
- if ( !$options->{'simul'} ) {
-
- Do_moveold( $dest, $options );
-
- # Pas besoin, move -> del
- #if (!unlink($dest) )
- #{
- # Warn( $ERR_OPEN,
- # "Impossible d'effacer " . $dest );
- # return;
- #}
- }
+ $cmp = 1;
+
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+
+ Do_on_config( $S, $options ) && return 1;
+
+ Do_before_change( $S, $options ) && return 1;
+
+ if ( !$options->{'simul'} ) {
+
+ Do_moveold( $dest, $options );
+
+ # Pas besoin, move -> del
+ #if (!unlink($dest) )
+ #{
+ # Warn( $ERR_OPEN,
+ # "Impossible d'effacer " . $dest );
+ # return;
+ #}
+ }
}
# Mais bien sur
#Do_chownmod( $S, $dest, $options );
if ($cmp) {
- Do_after_change( $S, $options ) && return 1;
-
- Do_on_noaction( $S, $options ) && return 1;
+ Do_after_change( $S, $options ) && return 1;
+
+ Do_on_noaction( $S, $options ) && return 1;
}
return 0;
@@ -1401,42 +1463,42 @@
my $cmp = 0;
if ( -e $dest && !-d $dest ) {
- Warn( $ERR_OPEN,
- "La destination " . $dest . "doit etre un repertoire!" );
- return 1;
+ Warn( $ERR_OPEN,
+ "La destination " . $dest . "doit etre un repertoire!" );
+ return 1;
}
if ( -d $dest ) {
- $cmp = 1;
-
- if ( $options->{'verbose'} || $options->{'simul'} ) {
- Log("(action needed)");
- }
-
- Do_on_config( $S, $options ) && return 1;
-
- Do_before_change( $S, $options ) && return 1;
-
- if ( !$options->{'simul'} ) {
-
- Do_moveold( $dest, $options );
-
- # Pas besoin, move -> del
- #if (!rmdir($dest) )
- #{
- # Warn( $ERR_OPEN,
- # "Impossible d'effacer " . $dest );
- # return;
- #}
- }
+ $cmp = 1;
+
+ if ( $options->{'verbose'} || $options->{'simul'} ) {
+ Log("(action needed)");
+ }
+
+ Do_on_config( $S, $options ) && return 1;
+
+ Do_before_change( $S, $options ) && return 1;
+
+ if ( !$options->{'simul'} ) {
+
+ Do_moveold( $dest, $options );
+
+ # Pas besoin, move -> del
+ #if (!rmdir($dest) )
+ #{
+ # Warn( $ERR_OPEN,
+ # "Impossible d'effacer " . $dest );
+ # return;
+ #}
+ }
}
# Mais bien sur
#Do_chownmod( $S, $dest, $options );
if ($cmp) {
- Do_after_change( $S, $options ) && return 1;
-
- Do_on_noaction( $S, $options ) && return 1;
+ Do_after_change( $S, $options ) && return 1;
+
+ Do_on_noaction( $S, $options ) && return 1;
}
return 0;
@@ -1452,10 +1514,10 @@
# verif que pas un fichier a la place d'un rep au milieu du mkdir -p
my $dir2 = $dir;
while ( $dir2 ne "" && !-e $dir2 ) {
- $dir2 =~ s:/[^/]+/*$::;
+ $dir2 =~ s:/[^/]+/*$::;
}
if ( $dir2 ne "" && -e $dir2 && !-d $dir2 ) {
- unlink($dir2);
+ unlink($dir2);
}
$dir && return system( "/bin/mkdir -p '" . $dir . "' >/dev/null 2>&1" );
@@ -1469,10 +1531,10 @@
Mk_dest_dir($tmp);
if ( -d $tmp ) {
- rmdir($tmp);
+ rmdir($tmp);
}
elsif ( -e $tmp ) {
- unlink($tmp);
+ unlink($tmp);
}
return $tmp;
@@ -1494,68 +1556,68 @@
my $prio = 0;
if ( $a eq "/etc/passwd" ) {
- return $prio;
+ return $prio;
}
$prio++;
if ( $a eq "/etc/group" ) {
- return $prio;
+ return $prio;
}
$prio++;
if ( $a eq "/etc/shadow" ) {
- return $prio;
+ return $prio;
}
$prio++;
if ( $a eq "/etc/gshadow" ) {
- return $prio;
+ return $prio;
}
$prio++;
if ( $C->{$a}->{'action'} eq 'mkdir' ) {
- return $prio;
+ return $prio;
}
$prio++;
if ( $C->{$a}->{'action'} eq 'addmount' ) {
- return $prio;
+ return $prio;
}
$prio++;
if ( $a =~ m|^/etc/apt/| ) {
- return $prio;
+ return $prio;
}
$prio++;
if ( $a eq "pf-tools" ) {
- return $prio;
+ return $prio;
}
$prio++;
if ( $C->{$a}->{'action'} eq 'dpkg-purge' ) {
- return $prio;
+ return $prio;
}
$prio++;
if ( $C->{$a}->{'action'} eq 'apt-get' ) {
- return $prio;
+ return $prio;
}
$prio++;
if ( $C->{$a}->{'action'} eq 'createfile' ) {
- return $prio;
+ return $prio;
}
$prio++;
if ( $C->{$a}->{'action'} eq 'addfile' ) {
- return $prio;
+ return $prio;
}
$prio++;
if ( $C->{$a}->{'action'} eq 'addlink' ) {
- return $prio;
+ return $prio;
}
if ( $C->{$a}->{'action'} eq 'removefile' ) {
- return $prio;
+ return $prio;
}
if ( $C->{$a}->{'action'} eq 'removedir' ) {
- return $prio;
+ return $prio;
}
$prio++;
return $prio;
@@ -1568,10 +1630,10 @@
my $priob = Trie_prio( $C, $b );
if ( $prioa != $priob ) {
- return $prioa <=> $priob;
+ return $prioa <=> $priob;
}
else {
- return $a cmp $b;
+ return $a cmp $b;
}
}
@@ -1581,106 +1643,114 @@
my $errorcount = 0;
foreach $s (@sortedkeys) {
- if ( defined( $C->{$s} )
- && !defined( $C->{$s}->{'doing'} )
- && !defined( $C->{$s}->{'done'} ) )
- {
-
- $C->{$s}->{'doing'} = 1;
-
- if ( defined( $C->{$s}->{'action'} )
- && defined( $DEPENDS{ $C->{$s}->{'action'} } ) )
- {
- $DEPENDS{ $C->{$s}->{'action'} }->( $C->{$s}, $s, $options );
- }
-
- if ( defined( $C->{$s}->{'depends'} ) ) {
- my @dependsraw;
- my @depends;
- my $d;
-
- @dependsraw = split ( /[ ,]+/, $C->{$s}->{'depends'} );
-
- foreach $d (@dependsraw) {
- if ( defined($d) && $d ne "" && defined( $C->{$d} ) ) {
- push @depends, $d;
- if ( $C->{$d}->{'action'} eq 'addmount' ) {
- Warn( $ERR_OPEN,
- "[" . $s
- . "] depends on addmount [" . $d
- . "], it may not work during install!" );
- FlushLog();
- }
- }
- }
-
- if ( $#depends >= 0 ) {
- Log( "<" . $s . "> " . join ( ' ', @depends ) );
- $errorcount += Do_updateloop( $C, $options, @depends );
- }
- }
-
- Log( "[" . $s . "]" );
-
- if ( !defined( $C->{$s}->{'action'} ) ) {
- Abort( $ERR_SYNTAX, "Action non definie" );
- }
- if ( !defined( $FUNCTIONS{ $C->{$s}->{'action'} } ) ) {
- Abort( $ERR_SYNTAX,
- "Action inconnue '" . $C->{$s}->{'action'} . "'" );
- }
-
- if ( $FUNCTIONS{ $C->{$s}->{'action'} }->( $C->{$s}, $s, $options ) )
- {
- FlushLog();
- $errorcount++;
- }
- else {
- DelLog();
- }
-
- $C->{$s}->{'done'} = 1;
- }
+ if ( defined( $C->{$s} )
+ && !defined( $C->{$s}->{'doing'} )
+ && !defined( $C->{$s}->{'done'} ) )
+ {
+
+ $C->{$s}->{'doing'} = 1;
+
+ if ( defined( $C->{$s}->{'action'} )
+ && defined( $DEPENDS{ $C->{$s}->{'action'} } ) )
+ {
+ $DEPENDS{ $C->{$s}->{'action'} }->( $C->{$s}, $s, $options );
+ }
+
+ if ( defined( $C->{$s}->{'depends'} ) ) {
+ my @dependsraw;
+ my @depends;
+ my $d;
+
+ @dependsraw = split( /[ ,]+/, $C->{$s}->{'depends'} );
+
+ foreach $d (@dependsraw) {
+ if ( defined($d) && $d ne "" && defined( $C->{$d} ) ) {
+ push @depends, $d;
+ if ( $C->{$d}->{'action'} eq 'addmount' ) {
+ Warn( $ERR_OPEN,
+ "["
+ . $s
+ . "] depends on addmount ["
+ . $d
+ . "], it may not work during install!" );
+ FlushLog();
+ }
+ }
+ }
+
+ if ( $#depends >= 0 ) {
+ Log( "<" . $s . "> " . join( ' ', @depends ) );
+ $errorcount += Do_updateloop( $C, $options, @depends );
+ }
+ }
+
+ Log( "[" . $s . "]" );
+
+ if ( !defined( $C->{$s}->{'action'} ) ) {
+ Abort( $ERR_SYNTAX, "Action non definie" );
+ }
+ if ( !defined( $FUNCTIONS{ $C->{$s}->{'action'} } ) ) {
+ Abort( $ERR_SYNTAX,
+ "Action inconnue '" . $C->{$s}->{'action'} . "'" );
+ }
+
+ if ($FUNCTIONS{ $C->{$s}->{'action'} }->( $C->{$s}, $s, $options )
+ )
+ {
+ FlushLog();
+ $errorcount++;
+ }
+ else {
+ DelLog();
+ }
+
+ $C->{$s}->{'done'} = 1;
+ }
}
return $errorcount;
}
sub Do_update {
- my ( $ref_options ) = @_;
+ my ($ref_options) = @_;
my $C;
my $s;
-# my $options;
+
+ # my $options;
my @sortedkeys;
my $errorcount = 0;
-# if ( $ref_options->{'help'} ) {
-# Do_help();
-# exit;
-# }
-
- my $branchecvs ;
+ # if ( $ref_options->{'help'} ) {
+ # Do_help();
+ # exit;
+ # }
+
+ my $branchecvs;
+
# Si le demande a ma machine une branche precise
- $branchecvs = ($ref_options->{"branche-cvs"})?$ref_options->{"branche-cvs"}:GetBrancheFromCmdLine();
-# Sinon je repart sur celle d'avant
- $branchecvs = GetRunningBrancheName() unless $branchecvs;
-
-
- if ( CVS_update($branchecvs, $ref_options) || ( !( $C = Get_conf() ) ) ) {
- Abort( $ERR_OPEN, "Impossible de charger la configuration\n" );
- }
-
- SaveRunningBrancheName($branchecvs);
-
+ $branchecvs
+ = ( $ref_options->{"branche-cvs"} )
+ ? $ref_options->{"branche-cvs"}
+ : GetBrancheFromCmdLine();
+
+ # Sinon je repart sur celle d'avant
+ $branchecvs = GetRunningBrancheName() unless $branchecvs;
+
+ if ( CVS_update( $branchecvs, $ref_options ) || ( !( $C = Get_conf() ) ) )
+ {
+ Abort( $ERR_OPEN, "Impossible de charger la configuration\n" );
+ }
+
+ SaveRunningBrancheName($branchecvs);
if ( defined( $ref_options->{'noupdate'} ) ) {
- Abort( $ERR_OPEN, "Configuration desactivee [noupdate]" );
+ Abort( $ERR_OPEN, "Configuration desactivee [noupdate]" );
}
@sortedkeys = sort { Trie_dependances( $C, $a, $b ) } keys %$C;
- $| = 1;
+ $| = 1;
$errorcount = Do_updateloop( $C, $ref_options, @sortedkeys );
Log( $errorcount . " error(s) detected." );
@@ -1688,7 +1758,7 @@
}
# sub Do_help {
-#
+#
# print STDERR << "# ENDHELP";
# Usage: $0 [options]
# # -d --debug: print debug info
@@ -1698,36 +1768,36 @@
# -s --simul: simulation mode, fake everything
# -v --verbose: be more verbose
# --branche-cvs=: update based on a specific CVS branche.
-#
+#
# # ENDHELP
# }
-#
+#
# sub Get_options {
# my (@argv) = @_;
-#
+#
# my %optionshash;
# my $options;
-#
+#
# Getopt::Long::Configure("bundling");
-#
+#
# $optionshash{"branche-cvs"}='';
# GetOptions(
# \%optionshash, 'debug|d', 'diff|u', 'help|h',
# 'install|i', 'simul|s', 'verbose|v', 'quiet|q',
# 'noupdate', 'noaction', 'branche-cvs=s'
# ) or die "GetOptions error, try --help: " . $!;
-#
+#
# $options = \%optionshash;
-#
+#
# if ( $options->{'quiet'} ) {
# Log("update-config started in quiet mode...");
# $DEFERREDLOG = 1;
# }
-#
+#
# if ( $options->{'diff'} ) {
# $options->{'simul'} = 1;
# }
-#
+#
# if ( defined( $ARGV[0] ) && $ARGV[0] eq ':NO-ACTION:' ) {
# Warn( $ERR_OPEN, ":NO-ACTION: depreciated, please use --noaction" );
# $options->{'noaction'} = 1;
@@ -1736,7 +1806,7 @@
# Warn( $ERR_OPEN, ":NO-UPDATE: depreciated, please use --noupdate" );
# $options->{'noupdate'} = 1;
# }
-#
+#
# return $options;
# }
@@ -1747,138 +1817,127 @@
my $conf;
$HOSTNAME =~ /^(.*?)(\d*)([a-z]*)$/;
- #$template = "update-" . $1 . "(" . $2 . "(" . $3 . ")?)?"; FAIT PLANTER PERL5.6 XXX
+
+#$template = "update-" . $1 . "(" . $2 . "(" . $3 . ")?)?"; FAIT PLANTER PERL5.6 XXX
$template = "update-" . $1 . "(" . $2 . "|" . $2 . $3 . ")?";
-
+
opendir( CONFIG, Get_source("GLOBAL:") );
foreach $conf ( $COMMON, grep ( /^$template$/, readdir(CONFIG) ) ) {
- my $c = Load_conf( Get_source( "GLOBAL:" . $conf ), 1 );
- foreach ( keys %$c ) {
- if ( $c->{$_}->{'action'} eq 'ignore' && !defined( $C->{$_} ) ) {
- Warn( $ERR_OPEN,
- "ignoring previous inexistant [" . $_ . "] in " . $conf );
- }
- $C->{$_} = $c->{$_};
- }
+ my $c = Load_conf( Get_source( "GLOBAL:" . $conf ), 1 );
+ foreach ( keys %$c ) {
+ if ( $c->{$_}->{'action'} eq 'ignore' && !defined( $C->{$_} ) ) {
+ Warn( $ERR_OPEN,
+ "ignoring previous inexistant [" . $_ . "] in " . $conf );
+ }
+ $C->{$_} = $c->{$_};
+ }
}
closedir(CONFIG);
return $C;
}
-
# Enregsitre le nom de la branche utilise actuellement dans le dossier
-# PF_STATUS_DIR, le but de ce fichier est de permettre a update-config
+# PF_STATUS_DIR, le but de ce fichier est de permettre a update-config
# retrouver la branche du CVS qu'il doit MAJ.
-sub SaveRunningBrancheName($)
-{
-
- `mkdir -p $PF_STATUS_DIR` unless (-d $PF_STATUS_DIR);
- my $branche = shift;
- open STATUSBRANCHE, ">$PF_STATUS_DIR"."/branche";
- print STATUSBRANCHE $branche if $branche;
- close STATUSBRANCHE;
-
-}
-
-sub GetRunningBrancheName
-{
-
- return unless (-r $PF_STATUS_DIR."/branche");
-
- open STATUSBRANCHE, "<$PF_STATUS_DIR"."/branche";
-
- my @STATUSBRANCHE = <STATUSBRANCHE>;
-
- close STATUSBRANCHE;
- return shift @STATUSBRANCHE;
-
-}
-
-# Si une branche a ��pass�en para, elle est retourn� sinon undef.
-sub GetBrancheFromCmdLine
-{
-
- my $branche;
- open CMDLINE, "</proc/cmdline";
- $branche = $1 if (<CMDLINE> =~ /pfbcvs=(\S+)/);
-
- close CMDLINE;
-
- return $branche;
-
-}
-
+sub SaveRunningBrancheName($) {
+
+ `mkdir -p $PF_STATUS_DIR` unless ( -d $PF_STATUS_DIR );
+ my $branche = shift;
+ open STATUSBRANCHE, ">$PF_STATUS_DIR" . "/branche";
+ print STATUSBRANCHE $branche if $branche;
+ close STATUSBRANCHE;
+
+}
+
+sub GetRunningBrancheName {
+
+ return unless ( -r $PF_STATUS_DIR . "/branche" );
+
+ open STATUSBRANCHE, "<$PF_STATUS_DIR" . "/branche";
+
+ my @STATUSBRANCHE = <STATUSBRANCHE>;
+
+ close STATUSBRANCHE;
+ return shift @STATUSBRANCHE;
+
+}
+
+# Si une branche a ��pass�en para, elle est retourn� sinon undef.
+sub GetBrancheFromCmdLine {
+
+ my $branche;
+ open CMDLINE, "</proc/cmdline";
+ $branche = $1 if ( <CMDLINE> =~ /pfbcvs=(\S+)/ );
+
+ close CMDLINE;
+
+ return $branche;
+
+}
# MAJ le CVS, peut mettre une branche pr�ise a jour, en passant le nom
# de cette branche en param�re
sub CVS_update (;$$) {
- my ($branche, $options) = @_;
-
- if ($branche)
- {
- if (defined $CVS_COMMAND)
- {
- print "Attention : j'ignore la variable \$CVS_COMMAND d�inie dans " .
- "`$PFTOOLSCONF' car j'utilise une branche pr�ise ($branche)\n"
- if defined $options and $options->{verbose};
- undef $CVS_COMMAND;
- }
- $CVS_BRANCHE = $branche;
- }
-
-
- my $ret;
- my $umask = umask($CVS_UMASK);
- my $olddeferredlog;
-
- $ENV{'CVS_RSH'} = $CVS_RSH;
-
-
- # CVS_COMMAND peut deja etre def dans /etc/pf-tools.conf
- unless (defined ($CVS_COMMAND) and ($CVS_COMMAND))
- {
- if ( $HOSTNAME =~ /^deploy\d+/ or -d "/vol" )
- {
- $CVS_COMMAND =
- "/usr/bin/cvs -R -d '";
- }
- else
- {
- $CVS_COMMAND =
- "/usr/bin/cvs -d ':ext:"
- . $CVS_USER . "\@"
- . $CVS_SERVER . ":"
- }
-
-
- $CVS_COMMAND .= $CVS_REPOSITORY."'";
-
- $CVS_COMMAND .= " checkout ";
- $CVS_COMMAND .= " -r $CVS_BRANCHE" if ($CVS_BRANCHE);
-
- $CVS_COMMAND .= " $CVS_CONFIG";
-
- }
-
- print $CVS_COMMAND."\n" if $options->{'debug'} or $options->{'verbose'};
-
- system( "/bin/mkdir -p '" . $CVS_WORKING_DIR . "' 2>/dev/null" );
-
- $olddeferredlog = $DEFERREDLOG;
- $DEFERREDLOG = 1;
- $ret = deferredlogsystem( "cd '" . $CVS_WORKING_DIR . "';" . $CVS_COMMAND );
- $DEFERREDLOG = $olddeferredlog;
-
- if ($ret) {
- FlushLog();
- }
- else {
- DelLog();
- }
-
- umask($umask);
- return $ret;
+ my ( $branche, $options ) = @_;
+
+ if ($branche) {
+ if ( defined $CVS_COMMAND ) {
+ print
+ "Attention : j'ignore la variable \$CVS_COMMAND d�inie dans "
+ . "`$PFTOOLSCONF' car j'utilise une branche pr�ise ($branche)\n"
+ if defined $options and $options->{verbose};
+ undef $CVS_COMMAND;
+ }
+ $CVS_BRANCHE = $branche;
+ }
+
+ my $ret;
+ my $umask = umask($CVS_UMASK);
+ my $olddeferredlog;
+
+ $ENV{'CVS_RSH'} = $CVS_RSH;
+
+ # CVS_COMMAND peut deja etre def dans /etc/pf-tools.conf
+ unless ( defined($CVS_COMMAND) and ($CVS_COMMAND) ) {
+ if ( $HOSTNAME =~ /^deploy\d+/ or -d "/vol" ) {
+ $CVS_COMMAND = "/usr/bin/cvs -R -d '";
+ }
+ else {
+ $CVS_COMMAND
+ = "/usr/bin/cvs -d ':ext:"
+ . $CVS_USER . "\@"
+ . $CVS_SERVER . ":";
+ }
+
+ $CVS_COMMAND .= $CVS_REPOSITORY . "'";
+
+ $CVS_COMMAND .= " checkout ";
+ $CVS_COMMAND .= " -r $CVS_BRANCHE" if ($CVS_BRANCHE);
+
+ $CVS_COMMAND .= " $CVS_CONFIG";
+
+ }
+
+ print $CVS_COMMAND. "\n" if $options->{'debug'} or $options->{'verbose'};
+
+ system( "/bin/mkdir -p '" . $CVS_WORKING_DIR . "' 2>/dev/null" );
+
+ $olddeferredlog = $DEFERREDLOG;
+ $DEFERREDLOG = 1;
+ $ret = deferredlogsystem(
+ "cd '" . $CVS_WORKING_DIR . "';" . $CVS_COMMAND );
+ $DEFERREDLOG = $olddeferredlog;
+
+ if ($ret) {
+ FlushLog();
+ }
+ else {
+ DelLog();
+ }
+
+ umask($umask);
+ return $ret;
}
1;
Modified: trunk/sbin/mk_dhcp
URL: http://svn.debian.org/wsvn/pf-tools/trunk/sbin/mk_dhcp?rev=539&op=diff
==============================================================================
--- trunk/sbin/mk_dhcp (original)
+++ trunk/sbin/mk_dhcp Mon Aug 27 14:48:03 2007
@@ -2,7 +2,8 @@
##
## $Id$
##
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -26,23 +27,10 @@
use PFTools::Update;
-if ( $#ARGV != 2 ) {
- print STDERR "Usage: $0 head src dest\n";
-
- #exit 1;
+my ($HEAD, $SRC, $DST) = @ARGV;
+unless ( $HEAD and $SRC and $DST ) {
+ die "Usage: $0 head src dest\n";
}
-
-my ( $HEAD, $SRC, $DST ) = @ARGV;
-
-# compat mode
-if ( !defined $DST ) {
- $HEAD = "/etc/dhcpd.conf.head";
- $SRC = "GLOBAL:private-network";
- $DST = "/etc/dhcpd.conf";
-}
-
-# Generation de la zone
-#-------------------------
Mk_dhcp( Get_source($HEAD), $DST, Init_lib_net( Get_source($SRC) ) );
Modified: trunk/sbin/mk_interfaces
URL: http://svn.debian.org/wsvn/pf-tools/trunk/sbin/mk_interfaces?rev=539&op=diff
==============================================================================
--- trunk/sbin/mk_interfaces (original)
+++ trunk/sbin/mk_interfaces Mon Aug 27 14:48:03 2007
@@ -2,7 +2,8 @@
##
## $Id$
##
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -24,11 +25,10 @@
use PFTools::Net;
-if ( $#ARGV != 2 ) {
- print STDERR "Usage: $0 config host dest\n";
- exit 1;
+my ($config, $host, $dst) = @ARGV;
+unless ($config and $host and $dst) {
+ die "Usage: $0 config host dest\n";
}
-my ( $config, $host, $dst ) = @ARGV;
Mk_interfaces( $host, $dst, Init_lib_net( Get_source($config) ) );
Modified: trunk/sbin/mk_packages
URL: http://svn.debian.org/wsvn/pf-tools/trunk/sbin/mk_packages?rev=539&op=diff
==============================================================================
--- trunk/sbin/mk_packages (original)
+++ trunk/sbin/mk_packages Mon Aug 27 14:48:03 2007
@@ -2,7 +2,8 @@
##
## $Id$
##
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -21,6 +22,10 @@
use strict;
use warnings;
+
+# FIXME
+# This script is totally obsolete and has nothing to do here
+
if ( system("gzip -dc $ARGV[0] >/dev/null 2>&1") ) {
print "Usage: $0 <Path/packages.gz>\n";
Modified: trunk/sbin/mk_privatezone
URL: http://svn.debian.org/wsvn/pf-tools/trunk/sbin/mk_privatezone?rev=539&op=diff
==============================================================================
--- trunk/sbin/mk_privatezone (original)
+++ trunk/sbin/mk_privatezone Mon Aug 27 14:48:03 2007
@@ -2,7 +2,8 @@
##
## $Id$
##
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -25,28 +26,10 @@
use PFTools::Net;
use PFTools::Update;
-
-if ( $#ARGV < 1 ) {
-
- print STDERR "Usage: $0 src forward\n";
-
- #exit 1;
+my ($SRC, $FORWARD) = @ARGV;
+unless ($SRC and $FORWARD) {
+ die "Usage: $0 src forward\n";
}
-
-my ( $SRC, $FORWARD ) = @ARGV;
-shift @ARGV;
-shift @ARGV;
-
-# compat mode
-if ( !defined $FORWARD ) {
- $SRC = "CVS:config/GLOBAL/private-network";
- $FORWARD = "/etc/bind/db.private";
-
- #@ARGV = ("/etc/bind/db.192.168");
-}
-
-# Generation de la zone
-#-------------------------
my $Z = Init_lib_net( Get_source($SRC) );
Mk_zone( Get_source($FORWARD), $Z );
Modified: trunk/sbin/mk_pxelinuxcfg
URL: http://svn.debian.org/wsvn/pf-tools/trunk/sbin/mk_pxelinuxcfg?rev=539&op=diff
==============================================================================
--- trunk/sbin/mk_pxelinuxcfg (original)
+++ trunk/sbin/mk_pxelinuxcfg Mon Aug 27 14:48:03 2007
@@ -2,7 +2,8 @@
##
## $Id$
##
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -25,17 +26,11 @@
use PFTools::Net;
use PFTools::Update;
-
-if ( $#ARGV != 1 ) {
- print STDERR "Usage: $0 src template\n";
- print STDERR "\t(confs will be written do template's dirname)\n";
- exit 1;
+my ($SRC, $TEMPLATE) = @ARGV;
+unless ($SRC and $TEMPLATE) {
+ warn "Usage: $0 src template\n";
+ die "\t(confs will be written do template's dirname)\n";
}
-
-my ( $SRC, $TEMPLATE ) = @ARGV;
-
-# Generation de la zone
-#-------------------------
Mk_pxelinuxcfg( Get_source($TEMPLATE), Init_lib_net( Get_source($SRC) ) );
Modified: trunk/sbin/mk_resolvconf
URL: http://svn.debian.org/wsvn/pf-tools/trunk/sbin/mk_resolvconf?rev=539&op=diff
==============================================================================
--- trunk/sbin/mk_resolvconf (original)
+++ trunk/sbin/mk_resolvconf Mon Aug 27 14:48:03 2007
@@ -2,7 +2,8 @@
##
## $Id$
##
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -25,23 +26,20 @@
use PFTools::Net;
use PFTools::Update;
-if ( $#ARGV != 2 ) {
- print STDERR "Usage: $0 config host dest\n";
- exit 1;
+my ($config, $host, $dst) = @ARGV;
+unless ($config and $host and $dst) {
+ die "Usage: $0 config host dest\n";
}
-my ( $config, $host, $dst ) = @ARGV;
my $Z = Init_lib_net( Get_source($config) );
my @dns = Get_dns_from_hostname( $Z, $host );
-open( OUT, ">$dst" ) || die;
+open OUT, ">$dst" or die "open: $dst: $!\n";;
print OUT "search " . $Z->{SOA}->{name} . "\n";
-foreach $dns (@dns) {
- if ( defined $dns ) {
- print OUT "nameserver " . $dns . "\n";
- }
+foreach my $dns (@dns) {
+ print OUT "nameserver $dns\n" if $dns;
}
-close(OUT);
+close OUT;
Modified: trunk/sbin/update-config
URL: http://svn.debian.org/wsvn/pf-tools/trunk/sbin/update-config?rev=539&op=diff
==============================================================================
--- trunk/sbin/update-config (original)
+++ trunk/sbin/update-config Mon Aug 27 14:48:03 2007
@@ -2,7 +2,8 @@
##
## $Id$
##
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
+## Copyright (C) 2001-2003 Olivier Molteni <olivier at molteni.net>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -21,25 +22,26 @@
use strict;
use warnings;
-use Getopt::Long qw( :config ignore_case_always bundling ) ;
-use PFTools::Update ;
-use PFTools::Conf ;
+
+use Getopt::Long qw( :config ignore_case_always bundling );
+
+use PFTools::Update;
+use PFTools::Conf;
my $program = $0;
$program =~ s%.*/%%; # cheap basename
-my $version = sprintf( "svn-r%s", q$Revision$ =~ /([\d.]+)/ ) ;
+my $version = sprintf( "svn-r%s", q$Revision$ =~ /([\d.]+)/ );
sub Do_help {
-
print STDERR << "# ENDHELP";
$program - version $version
Usage: $0 [options]
-# -d --debug: print debug info
+ -d --debug: print debug info
-u --diff: diff files, versions, mountpoints, links => --simul
-h --help: print help and exit
-# -i --install: install mode
+ -i --install: install mode
-s --simul: simulation mode, fake everything
-v --verbose: be more verbose
--branche-cvs=: update based on a specific CVS branche.
@@ -47,29 +49,22 @@
# ENDHELP
}
-my %optionshash;
-my $options = {} ;
-$options->{'branche-cvs'} = '' ;
-$options->{'diff'} = 0 ;
-$options->{'help'} = 0 ;
-$options->{'simul'} = 0 ;
-$options->{'verbose'} = 0 ;
-$options->{'quiet'} = 0 ;
-$options->{'noupdate'} = 0 ;
-$options->{'noaction'} = 0 ;
+# All options are disabled by default
+my $options = {};
GetOptions(
- 'debug|d' => \$options->{'debug'},
- 'diff|u' => \$options->{'diff'},
- 'help|h' => \$options->{'help'},
- 'install|i' => \$options->{'install'},
- 'simul|s' => \$options->{'simul'},
- 'verbose|v' => \$options->{'verbose'},
- 'quiet|q' => \$options->{'quiet'},
- 'noupdate' => \$options->{'noupdate'},
- 'noaction' => \$options->{'noaction'},
- 'branche-cvs=s' => \$options->{'branche-cvs'}
-) or die "GetOptions error, try --help: " . $!;
+ $options,
+ 'branche-cvs=s',
+ 'debug|d',
+ 'diff|u',
+ 'help|h',
+ 'install|i',
+ 'noaction',
+ 'noupdate',
+ 'quiet|q',
+ 'simul|s',
+ 'verbose|v',
+) or die "GetOptions error, try --help: $!\n";
if ( $options->{'help'} ) {
Do_help();
Modified: trunk/tools/bridge.sh
URL: http://svn.debian.org/wsvn/pf-tools/trunk/tools/bridge.sh?rev=539&op=diff
==============================================================================
--- trunk/tools/bridge.sh (original)
+++ trunk/tools/bridge.sh Mon Aug 27 14:48:03 2007
@@ -1,11 +1,10 @@
#!/bin/sh
+#
+# $Id$
+#
-# $Id$
-
-# Run this script without arguments to know what it does :-).
-# It's basically an helper when debugging bridge problems on host.
-
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+##
+## Copyright (C) 2005 Jeremie Le Hen <tataz at sitadelle.com>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -21,6 +20,9 @@
## along with this program; if not, write to the Free Software
## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
##
+
+# Run this script without arguments to know what it does :-).
+# It's basically an helper when debugging bridge problems on host.
match_br () {
Modified: trunk/tools/dumpiplist.pl
URL: http://svn.debian.org/wsvn/pf-tools/trunk/tools/dumpiplist.pl?rev=539&op=diff
==============================================================================
--- trunk/tools/dumpiplist.pl (original)
+++ trunk/tools/dumpiplist.pl Mon Aug 27 14:48:03 2007
@@ -1,9 +1,6 @@
#!/usr/bin/perl
-# liste toute les adresses ip depuis le fichier private-network
-# prend le fichier private-network en argument et un 1 en second
-# argument si on souhaite avoir les adresses pour les uml (implique alteon00 surtout)
-
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+##
+## Copyright (C) 2004 Stephane Pontier <shad at sitadelle.com>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -20,114 +17,121 @@
## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
##
+# liste toute les adresses ip depuis le fichier private-network
+# prend le fichier private-network en argument et un 1 en second
+# argument si on souhaite avoir les adresses pour les uml (implique alteon00 surtout)
use strict;
use warnings;
+use Data::Dumper;
+
use PFTools::Net;
use PFTools::Update;
-if ( @ARGV == 0 or @ARGV > 2)
-{
- print "Usage: $0 fichier_private_network uml(0/1)\n";
- exit
-}
-if ($ARGV[1])
-{
- $PFTools::Net::UML = 1;
+sub _ipcomp {
+ my ( $a, $b ) = @_;
+ my ( $suba1, $suba2, $suba3, $suba4, $supa ) = split( /\./, $a );
+ my ( $subb1, $subb2, $subb3, $subb4, $supb ) = split( /\./, $b );
+
+ return 1 if ( $suba1 > $subb1 );
+ return -1 if ( $suba1 < $subb1 );
+ return 1 if ( $suba2 > $subb2 );
+ return -1 if ( $suba2 < $subb2 );
+ return 1 if ( $suba3 > $subb3 );
+ return -1 if ( $suba3 < $subb3 );
+ return 1 if ( $suba4 > $subb4 );
+ return -1 if ( $suba4 < $subb4 );
+ $supa = 0 if !defined($supa);
+ $supb = 0 if !defined($supb);
+ return 1 if ( $supa gt $supb );
+ return -1 if ( $supa lt $supb );
+ return 0;
}
-sub _ipcomp
-{
- my ($a,$b) = @_;
- my ($suba1,$suba2,$suba3,$suba4,$supa) = split(/\./,$a);
- my ($subb1,$subb2,$subb3,$subb4,$supb) = split(/\./,$b);
-
- return 1 if ($suba1 > $subb1);
- return -1 if ($suba1 < $subb1);
- return 1 if ($suba2 > $subb2);
- return -1 if ($suba2 < $subb2);
- return 1 if ($suba3 > $subb3);
- return -1 if ($suba3 < $subb3);
- return 1 if ($suba4 > $subb4);
- return -1 if ($suba4 < $subb4);
- $supa = 0 if !defined ($supa);
- $supb = 0 if !defined ($supb);
- return 1 if ($supa gt $supb);
- return -1 if ($supa lt $supb);
- return 0;
+if ( @ARGV == 0 or @ARGV > 2 ) {
+ die "Usage: $0 fichier_private_network uml(0/1)\n";
}
-use Data::Dumper;
-my $bighash= Load_conf ($ARGV[0]);
+my ( $file, $uml ) = @ARGV;
+$PFTools::Net::UML = 1 if $uml;
+
+my $bighash = Load_conf($file);
#print Dumper ($bighash) ;
-my $nethash= {};
-foreach my $entry (keys %{$bighash})
-{
-# print "On est sur la machine $entry\n";
- if (defined($bighash->{$entry}->{'type'}) and $bighash->{$entry}->{'type'}=~/server/)
- {# c'est une machine
- foreach my $interface (keys %{$bighash->{$entry}->{'interface'}})
- {
- my ($ippatte, $netpatte, $netmaskpatte);
- my $vlan = $bighash->{$entry}->{'interface'}->{$interface};
- $netpatte = $bighash->{$vlan}->{'network'} ;
- $netmaskpatte = $bighash->{$vlan}->{'netmask'} ;
- if (defined($bighash->{$entry}->{'ipstart'}->{$vlan}))
- {
- $ippatte = $bighash->{$entry}->{'ipstart'}->{$vlan};
- } else {
- $ippatte = $bighash->{$entry}->{'ipstart'}->{'default'};
- }
- if (!defined($bighash->{$entry}->{'number'}) or $bighash->{$entry}->{'number'} <=1)
- {
- $bighash->{$entry}->{'number'} = 1;
- }
-# print "INTERFACE:$interface PATTE:$netpatte MASK:$netmaskpatte IP:$ippatte VLAN:$vlan\n";
- my $numberpatte;
- for ($numberpatte=0; $numberpatte<$bighash->{$entry}->{'number'}; $numberpatte++)
- {
- # on est soit dans le nouvelle addressage avec un
- # vlan en 10.128.0.0 et une ip de patte en 24.0
- if ($ippatte=~ /(\d{1,3})\.(\d{0,3})/)
- {#print "nouvel addr$ippatte\t";
- my $ippatteXX= "$1." . ($2+$numberpatte);
- $netpatte =~ s/(\d{1,3}\.\d{1,3}\.)\d{1,3}\.\d{1,3}/$1$ippatteXX/;
- } else {#print "ancien addr$ippatte\t";
- # soit en addressage de classe C avec
- # un vlan en 217.19.192.0
- # et une ip de patte en 96
- my $ippatteXX= $ippatte+$numberpatte;
- $netpatte =~ s/(\d{1,3}\.\d{1,3}\.\d{1,3}\.)\d{1,3}/$1$ippatteXX/;
- }
- my $ipkey= $netpatte;
-# print "on a maintenant la machine $entry avec:$netpatte\n";
- if (defined($nethash->{$ipkey}))
- {
- my $nmachine = $entry;
- $nmachine =~ s/%%/0$numberpatte/;
- print "$nmachine($interface)\t" . $netpatte .": ip deja prise par ";
- print "$nethash->{$ipkey}->{'machine'}($nethash->{$ipkey}->{'interface'}) \n";
- $ipkey .= ".X"
- }
- my $machine = $entry;
- $machine =~ s/%%/0$numberpatte/;
- $nethash->{$ipkey}->{'vlan'} = $vlan;
- $nethash->{$ipkey}->{'ip'} = $netpatte;
- $nethash->{$ipkey}->{'netmask'} = $netmaskpatte;
- $nethash->{$ipkey}->{'interface'} = $interface;
- $nethash->{$ipkey}->{'machine'} = $machine;
- }
+my $nethash = {};
+foreach my $entry ( keys %{$bighash} ) {
+ # print "On est sur la machine $entry\n";
+ if ( defined $bighash->{$entry}->{'type'}
+ and $bighash->{$entry}->{'type'} =~ /server/ )
+ { # c'est une machine
+ foreach my $interface ( keys %{ $bighash->{$entry}->{'interface'} } )
+ {
+ my $vlan = $bighash->{$entry}->{'interface'}->{$interface};
+ my $netpatte = $bighash->{$vlan}->{'network'};
+ my $netmaskpatte = $bighash->{$vlan}->{'netmask'};
+ my $ippatte
+ = defined $bighash->{$entry}->{'ipstart'}->{$vlan}
+ ? $bighash->{$entry}->{'ipstart'}->{$vlan}
+ : $bighash->{$entry}->{'ipstart'}->{'default'};
+
+ if ( !defined( $bighash->{$entry}->{'number'} )
+ or $bighash->{$entry}->{'number'} <= 1 )
+ {
+ $bighash->{$entry}->{'number'} = 1;
+ }
+
+# print "INTERFACE:$interface PATTE:$netpatte MASK:$netmaskpatte IP:$ippatte VLAN:$vlan\n";
+ my $numberpatte;
+ foreach
+ my $numberpatte ( 0 .. $bighash->{$entry}->{'number'} - 1 )
+ {
+
+ # on est soit dans le nouvelle addressage avec un
+ # vlan en 10.128.0.0 et une ip de patte en 24.0
+ if ( $ippatte =~ /(\d{1,3})\.(\d{0,3})/ )
+ { #print "nouvel addr$ippatte\t";
+ my $ippatteXX = "$1." . ( $2 + $numberpatte );
+ $netpatte
+ =~ s/(\d{1,3}\.\d{1,3}\.)\d{1,3}\.\d{1,3}/$1$ippatteXX/;
}
+ else { #print "ancien addr$ippatte\t";
+ # soit en addressage de classe C avec
+ # un vlan en 217.19.192.0
+ # et une ip de patte en 96
+ my $ippatteXX = $ippatte + $numberpatte;
+ $netpatte
+ =~ s/(\d{1,3}\.\d{1,3}\.\d{1,3}\.)\d{1,3}/$1$ippatteXX/;
+ }
+ my $ipkey = $netpatte;
+
+ # print "on a maintenant la machine $entry avec:$netpatte\n";
+ if ( defined $nethash->{$ipkey} ) {
+ my $nmachine = $entry;
+ $nmachine =~ s/%%/0$numberpatte/;
+ print "$nmachine($interface)\t"
+ . $netpatte
+ . ": ip deja prise par "
+ . "$nethash->{$ipkey}->{'machine'}($nethash->{$ipkey}->{'interface'})\n";
+ $ipkey .= ".X";
+ }
+ my $machine = $entry;
+ $machine =~ s/%%/0$numberpatte/;
+ $nethash->{$ipkey}->{'vlan'} = $vlan;
+ $nethash->{$ipkey}->{'ip'} = $netpatte;
+ $nethash->{$ipkey}->{'netmask'} = $netmaskpatte;
+ $nethash->{$ipkey}->{'interface'} = $interface;
+ $nethash->{$ipkey}->{'machine'} = $machine;
+ }
+
}
+ }
}
-#foreach my $ownip (sort {$main::a <=> $main::b } keys %{$nethash})
-foreach my $ownip (sort {&_ipcomp($a,$b) } keys %{$nethash})
-{
- print "$nethash->{$ownip}->{'ip'}\t" . $nethash->{$ownip}->{'machine'} . "(". $nethash->{$ownip}->{'interface'} .")\n";
+foreach my $ownip ( sort { &_ipcomp( $a, $b ) } keys %{$nethash} ) {
+ print "$nethash->{$ownip}->{'ip'}\t"
+ . $nethash->{$ownip}->{'machine'} . "("
+ . $nethash->{$ownip}->{'interface'} . ")\n";
}
-
Modified: trunk/tools/pflaunch
URL: http://svn.debian.org/wsvn/pf-tools/trunk/tools/pflaunch?rev=539&op=diff
==============================================================================
--- trunk/tools/pflaunch (original)
+++ trunk/tools/pflaunch Mon Aug 27 14:48:03 2007
@@ -1,10 +1,11 @@
#!/usr/bin/perl
#
# $Id$
-# $Name$
#
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+##
+## Copyright (C) 2004-2006 Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
+## Copyright (C) 2004-2005 Gonéri Le Bouder <goneri at sitadelle.com>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -30,7 +31,6 @@
# il va chercher la conf dans config/GLOBAL/PF/«hostname».cfg
#
-
use Expect;
use File::Temp;
use Getopt::Long;
@@ -41,29 +41,28 @@
use Sitalibs::Config;
-use PFTools::Net ;
-use PFTools::Update ;
-
-my $HOSTNAME = hostname;
+use PFTools::Net;
+use PFTools::Update;
+
+my $HOSTNAME = hostname;
# paths
-my $umlaunch = "/usr/local/sbin/umlaunch";
-my $cfgpath = "/var/lib/cvsguest/$HOSTNAME/config/GLOBAL";
-my $configfile = "$cfgpath/PF/$HOSTNAME.cfg";
-my $privatenetwork = "$cfgpath/private-network";
-my $PF_STATUS_DIR = "/var/lib/pftools";
-my $CVS_CHECKOUT = "/var/lib/cvsguest";
-my $uml_switch_pipe = "/var/run/uml-utilities/uml_switch.ctl";
-my $logfile = "/var/log/pflaunch";
+my $umlaunch = "/usr/local/sbin/umlaunch";
+my $cfgpath = "/var/lib/cvsguest/$HOSTNAME/config/GLOBAL";
+my $configfile = "$cfgpath/PF/$HOSTNAME.cfg";
+my $privatenetwork = "$cfgpath/private-network";
+my $PF_STATUS_DIR = "/var/lib/pftools";
+my $CVS_CHECKOUT = "/var/lib/cvsguest";
+my $uml_switch_pipe = "/var/run/uml-utilities/uml_switch.ctl";
+my $logfile = "/var/log/pflaunch";
# constantes
my $vlan_default_mtu = "1468";
-my $IFNAMSIZ = 16;
-
-my $HALTED=0;
-my $HALTING=1;
-my $RUNNING=2;
-
+my $IFNAMSIZ = 16;
+
+my $HALTED = 0;
+my $HALTING = 1;
+my $RUNNING = 2;
####### GLOBAL
my $cache;
@@ -73,17 +72,16 @@
# Compte les alias créés
my %ifAliasCpt;
-Config_Need_Preproc ($privatenetwork);
-Config_Set_Var ($privatenetwork, ["UML"]);
-
-if ( `which vconfig 2>/dev/null` eq ""
- || `which brctl 2>/dev/null` eq ""
- || `which tunctl 2>/dev/null` eq ""
- || `which screen 2>/dev/null` eq "" )
+Config_Need_Preproc($privatenetwork);
+Config_Set_Var( $privatenetwork, ["UML"] );
+
+if ( `which vconfig 2>/dev/null` eq ""
+ || `which brctl 2>/dev/null` eq ""
+ || `which tunctl 2>/dev/null` eq ""
+ || `which screen 2>/dev/null` eq "" )
{
- __Fault( "Sorry, I need vlan, bridge-utils, uml-utilities and screen");
-}
-
+ __Fault("Sorry, I need vlan, bridge-utils, uml-utilities and screen");
+}
#
# Pour les noms d'interfaces trop longs (lvswebmail00.101 par exemple),
@@ -101,565 +99,539 @@
return $if;
}
-
# Lance une ou plusieurs commande
# parametres :
# string ou ref sur tab de strings
# 1 ou undef :afficher les retours d'erreur ou pas
-sub __runCmds ($;$)
-{
- my $cmds;
- if (ref $_[0] eq 'ARRAY')
- {
- $cmds = shift;
- }
- else
- {
- push @$cmds, shift;
- }
- return unless defined $cmds;
- my $quiet = shift;
-
- my $ok = 1; # OK
- foreach my $cmd (@$cmds)
- {
- my @ret = `$cmd 2>&1`;
-
-
- if ($?)
- {
- $ok = 0;
- }
- elsif ($quiet)
- {
- __Debug(@ret);
- }
- else
- {
- __Debug(@ret);
- }
- }
- return $ok;
+sub __runCmds ($;$) {
+ my $cmds;
+ if ( ref $_[0] eq 'ARRAY' ) {
+ $cmds = shift;
+ }
+ else {
+ push @$cmds, shift;
+ }
+ return unless defined $cmds;
+ my $quiet = shift;
+
+ my $ok = 1; # OK
+ foreach my $cmd (@$cmds) {
+ my @ret = `$cmd 2>&1`;
+
+ if ($?) {
+ $ok = 0;
+ }
+ elsif ($quiet) {
+ __Debug(@ret);
+ }
+ else {
+ __Debug(@ret);
+ }
+ }
+ return $ok;
}
# A partir d'un nom de machine sour la forme machine01,
# retourne un tableau contenant le nom et le numéro de
# la machine
-sub __FamillyNumFromVM ($)
-{
- my $vm = shift;
-
- unless (defined $vm and $vm) {
- __Err ("__FamillyNumFromVM appelé sans parametre");
- return;
- }
-
- if (defined $cache->{'FamillyNumFromVM '}->{$vm} and
- $cache->{'FamillyNumFromVM '}->{$vm}) {
- return (
- $cache->{'FamillyNumFromVM '}->{$vm}->{f},
- $cache->{'FamillyNumFromVM '}->{$vm}->{n},
- $cache->{'FamillyNumFromVM '}->{$vm}->{s}
- );
- }
-
- my $famille;
- my $num;
- my $section;
-
- if ( $vm =~ /^(\S+)(\d\d)$/) {
- $famille = $1;
- $num = $2;
- $section = $famille."%%";
- unless (defined Config_Section($privatenetwork, $section))
+sub __FamillyNumFromVM ($) {
+ my $vm = shift;
+
+ unless ( defined $vm and $vm ) {
+ __Err("__FamillyNumFromVM appelé sans parametre");
+ return;
+ }
+
+ if ( defined $cache->{'FamillyNumFromVM '}->{$vm}
+ and $cache->{'FamillyNumFromVM '}->{$vm} )
{
- if (defined Config_Section($privatenetwork, $vm))
- {
- __Info ("La section $section n'existe pas, c'est $vm qui sera prise à la place");
- $section = $vm;
- }
- else
- {
- __Err ("La section $section n'existe pas, et pas de section $vm à la place. Problème a venir ...");
- }
- }
- } elsif ( $vm =~ /^(\S+)$/) {
- __Info ( "Attention, nom de machine sans extension numerique, c'est bien ce que vous voulez ?" );
- $famille = $1;
- $num = 0;
- $section = $famille;
- unless (Config_Key($privatenetwork, $section, "umlfilename.default")) {
- __Info ("Attention, la machine `$vm' n'a pas de clef umlfilename.default, elle ne sera donc pas lancée");
- }
- } else {
- __Fault("L'entrée `$vm' de votre fichier de configuration de correspond pas a un\n
- nom de machine valide.");
- }
- $cache->{'FamillyNumFromVM '}->{$vm}->{f} = $famille;
- $cache->{'FamillyNumFromVM '}->{$vm}->{n} = $num;
- $cache->{'FamillyNumFromVM '}->{$vm}->{s} = $section;
-
- return ($famille, $num, $section);
-}
-
+ return (
+ $cache->{'FamillyNumFromVM '}->{$vm}->{f},
+ $cache->{'FamillyNumFromVM '}->{$vm}->{n},
+ $cache->{'FamillyNumFromVM '}->{$vm}->{s}
+ );
+ }
+
+ my $famille;
+ my $num;
+ my $section;
+
+ if ( $vm =~ /^(\S+)(\d\d)$/ ) {
+ $famille = $1;
+ $num = $2;
+ $section = $famille . "%%";
+ unless ( defined Config_Section( $privatenetwork, $section ) ) {
+ if ( defined Config_Section( $privatenetwork, $vm ) ) {
+ __Info(
+ "La section $section n'existe pas, c'est $vm qui sera prise à la place"
+ );
+ $section = $vm;
+ }
+ else {
+ __Err(
+ "La section $section n'existe pas, et pas de section $vm à la place. Problème a venir ..."
+ );
+ }
+ }
+ }
+ elsif ( $vm =~ /^(\S+)$/ ) {
+ __Info(
+ "Attention, nom de machine sans extension numerique, c'est bien ce que vous voulez ?"
+ );
+ $famille = $1;
+ $num = 0;
+ $section = $famille;
+ unless (
+ Config_Key( $privatenetwork, $section, "umlfilename.default" ) )
+ {
+ __Info(
+ "Attention, la machine `$vm' n'a pas de clef umlfilename.default, elle ne sera donc pas lancée"
+ );
+ }
+ }
+ else {
+ __Fault(
+ "L'entrée `$vm' de votre fichier de configuration de correspond pas a un\n
+ nom de machine valide."
+ );
+ }
+ $cache->{'FamillyNumFromVM '}->{$vm}->{f} = $famille;
+ $cache->{'FamillyNumFromVM '}->{$vm}->{n} = $num;
+ $cache->{'FamillyNumFromVM '}->{$vm}->{s} = $section;
+
+ return ( $famille, $num, $section );
+}
# Retourne les alias pour une vm sour la forme familleXX
-sub __GetVMAlias ($)
-{
- my ($famille, $num, $section) = __FamillyNumFromVM (shift);
-
-
- my $s = Config_Section($privatenetwork, $section);
-
- __Fault("Familly '$famille' NOT found !") unless (defined ($s) and ($section));
- __Fault("VM $famille$num out of range.") if ($s->{number} <= $num);
-
-
- my $listalias;
- foreach my $key (keys %$s)
- {
- if ($key =~ /^alias\.(\S+)/)
- {
- push @$listalias, $1 if ($num == 0);
- push @$listalias, $1.$num;
- }
- }
-
- return $listalias;
-}
-
-
-# Retourne les IP pour une vm sous la fome familleXX
-sub __GetVMnet ($)
-{
- my $vm = shift;
-
- my $listip;
- my $ipstart;
-
-
- my ($famille, $num, $section) = __FamillyNumFromVM ($vm);
-
- my $s = Config_Section($privatenetwork, $section);
- __Fault("Familly '$famille' NOT found !") unless (defined ($s) and ($s));
-
- # Recherche des ipstart
- $ipstart->{default} = (defined ($s->{"ipstart.default"})) ? $s->{"ipstart.default"} : -1;
-
- foreach my $key (keys %$s)
- {
- if ($key =~ /^ipstart\.(\S+)/)
- {
- # ATTENTION ce calcul est faux si on ne travaille pas que sur des /24. Et
- # c'est justement le cas avec le nouvel adressage !
- # Donc je vire cette vérification.
- #die "$famille, $num : ipstart.$1 out of range (".$s->{$key}.")\n"
- # if (($s->{$key} > 254) or ($s->{$key} < 1));
-
- $ipstart->{$1} = $s->{$key};
- }
- }
-
- # Creation des adresses
- foreach my $key (keys %$s) {
- if ($key =~ /^interface\.\S+/) {
- my $vlan = $s->{$key};
- my $network = Config_Key ($privatenetwork, $vlan, "network");
- __Err("Can't get IP of vlan $vlan") unless defined $network;
- my $ip = Address(
- $network,
- (defined $ipstart->{$vlan}) ? $ipstart->{$vlan} : $ipstart->{default},
- $num
- );
-
- push @$listip, { lan => $vlan, ip => $ip };
- }
- }
-
- return $listip;
-}
-
+sub __GetVMAlias ($) {
+ my ( $famille, $num, $section ) = __FamillyNumFromVM(shift);
+
+ my $s = Config_Section( $privatenetwork, $section );
+
+ __Fault("Familly '$famille' NOT found !")
+ unless ( defined($s) and ($section) );
+ __Fault("VM $famille$num out of range.") if ( $s->{number} <= $num );
+
+ my $listalias;
+ foreach my $key ( keys %$s ) {
+ if ( $key =~ /^alias\.(\S+)/ ) {
+ push @$listalias, $1 if ( $num == 0 );
+ push @$listalias, $1 . $num;
+ }
+ }
+
+ return $listalias;
+}
+
+# Retourne les IP pour une vm sous la fome familleXX
+sub __GetVMnet ($) {
+ my $vm = shift;
+
+ my $listip;
+ my $ipstart;
+
+ my ( $famille, $num, $section ) = __FamillyNumFromVM($vm);
+
+ my $s = Config_Section( $privatenetwork, $section );
+ __Fault("Familly '$famille' NOT found !") unless ( defined($s) and ($s) );
+
+ # Recherche des ipstart
+ $ipstart->{default}
+ = ( defined( $s->{"ipstart.default"} ) )
+ ? $s->{"ipstart.default"}
+ : -1;
+
+ foreach my $key ( keys %$s ) {
+ if ( $key =~ /^ipstart\.(\S+)/ ) {
+
+ # ATTENTION ce calcul est faux si on ne travaille pas que sur des /24. Et
+ # c'est justement le cas avec le nouvel adressage !
+ # Donc je vire cette vérification.
+ #die "$famille, $num : ipstart.$1 out of range (".$s->{$key}.")\n"
+ # if (($s->{$key} > 254) or ($s->{$key} < 1));
+
+ $ipstart->{$1} = $s->{$key};
+ }
+ }
+
+ # Creation des adresses
+ foreach my $key ( keys %$s ) {
+ if ( $key =~ /^interface\.\S+/ ) {
+ my $vlan = $s->{$key};
+ my $network = Config_Key( $privatenetwork, $vlan, "network" );
+ __Err("Can't get IP of vlan $vlan") unless defined $network;
+ my $ip = Address(
+ $network,
+ ( defined $ipstart->{$vlan} )
+ ? $ipstart->{$vlan}
+ : $ipstart->{default},
+ $num
+ );
+
+ push @$listip, { lan => $vlan, ip => $ip };
+ }
+ }
+
+ return $listip;
+}
# Retourne une ref sur la liste des noms des VLANs qui doivent être
# lancés pour les UML inscrites dans le fichier de conf
-sub __GetVLanList
-{
-
- my $listlan;
- my $h;
-
- my $l = Config_Key($configfile, "init", '@vlan');
-
- if ($l)
- {
- foreach (@{$l})
- {
- $h->{"vlan-$_"} = 1 if defined $_;
- }
- }
-
-
- my $section_start = Config_Key($configfile, "init", '@start');
-
- if (!$section_start)
- {
- __Fault( "Je ne trouve pas l'entrée \@start dans $configfile, (section [init])");
- }
-
- foreach my $vm ( @$section_start )
- {
- my ($famille, $num, $section) = __FamillyNumFromVM($vm);
-
- my $s = Config_Section($privatenetwork, $section);
-
- unless ($s)
- {
- __Fault("(Je ne peux pas lire la section `$section` from $privatenetwork pour la vm `$vm'");
- }
-
- foreach my $lan (%{$s})
- {
- $h->{$s->{$lan}} = 1 if ($lan =~ /^interface\./);
- }
- }
-
- # le sort, c'est juste pour ce que soit toujours traité dans le même ordre
- # c'est beaucoup plus facile pour les bidouilles double-adressage
- @$listlan = sort keys %$h;
- return $listlan;
-}
-
-
-# Donne la liste des bridges up
-sub __GetListBridgeUp ()
-{
- my $listbr = [];
- my $b;
- my $h;
-
- my @brshow = `brctl show`;
- shift @brshow; # ligne d'entete
- foreach my $line (@brshow)
- {
- $h->{$1}=1 if ($line =~ /^(\S+)\s+/);
- }
-
- # Dans le cas ou la configuration a changé entre temps
- if (opendir(DIR, $PF_STATUS_DIR."/bridge/"))
- {
- foreach (readdir DIR)
- {
- next if /^\./;
- $h->{$_}=1;
- }
- closedir DIR;
- }
- else
- {
- __Err("Can't open dir ".$PF_STATUS_DIR."/bridge/");
- }
-
- @$listbr = sort keys %$h;
-
- return $listbr;
+sub __GetVLanList {
+
+ my $listlan;
+ my $h;
+
+ my $l = Config_Key( $configfile, "init", '@vlan' );
+
+ if ($l) {
+ foreach ( @{$l} ) {
+ $h->{"vlan-$_"} = 1 if defined $_;
+ }
+ }
+
+ my $section_start = Config_Key( $configfile, "init", '@start' );
+
+ if ( !$section_start ) {
+ __Fault(
+ "Je ne trouve pas l'entrée \@start dans $configfile, (section [init])"
+ );
+ }
+
+ foreach my $vm (@$section_start) {
+ my ( $famille, $num, $section ) = __FamillyNumFromVM($vm);
+
+ my $s = Config_Section( $privatenetwork, $section );
+
+ unless ($s) {
+ __Fault(
+ "(Je ne peux pas lire la section `$section` from $privatenetwork pour la vm `$vm'"
+ );
+ }
+
+ foreach my $lan ( %{$s} ) {
+ $h->{ $s->{$lan} } = 1 if ( $lan =~ /^interface\./ );
+ }
+ }
+
+ # le sort, c'est juste pour ce que soit toujours traité dans le même ordre
+ # c'est beaucoup plus facile pour les bidouilles double-adressage
+ @$listlan = sort keys %$h;
+ return $listlan;
+}
+
+# Donne la liste des bridges up
+sub __GetListBridgeUp () {
+ my $listbr = [];
+ my $b;
+ my $h;
+
+ my @brshow = `brctl show`;
+ shift @brshow; # ligne d'entete
+ foreach my $line (@brshow) {
+ $h->{$1} = 1 if ( $line =~ /^(\S+)\s+/ );
+ }
+
+ # Dans le cas ou la configuration a changé entre temps
+ if ( opendir( DIR, $PF_STATUS_DIR . "/bridge/" ) ) {
+ foreach ( readdir DIR ) {
+ next if /^\./;
+ $h->{$_} = 1;
+ }
+ closedir DIR;
+ }
+ else {
+ __Err( "Can't open dir " . $PF_STATUS_DIR . "/bridge/" );
+ }
+
+ @$listbr = sort keys %$h;
+
+ return $listbr;
}
# Retourne la configuration d'un vlan.
# Parametre :
# vlan sous la forme vlan-nom
-sub __GetVLanSetup ($)
-{
- my $vlan = shift;
-
-
- my $section = Config_Section ($privatenetwork, $vlan);
-
- __Err("Can't read section [$vlan] from `$privatenetwork'") unless (defined ($section) and ($section));
- return $section;
-}
-
+sub __GetVLanSetup ($) {
+ my $vlan = shift;
+
+ my $section = Config_Section( $privatenetwork, $vlan );
+
+ __Err("Can't read section [$vlan] from `$privatenetwork'")
+ unless ( defined($section) and ($section) );
+ return $section;
+}
# retourne une liste ordonnée des UML qui doivent être lancées
# triées par priorité
-sub __GetUMLtoLaunch ()
-{
- my $umlToLaunch;
-
- my $listVM = Config_Key($configfile, "init", "\@start");
-
-
- foreach my $vm (@$listVM)
- {
- my $uml_cfg = Config_Section($configfile, "uml-$vm");
-
- my $priorite = 10; # Val par defaut
- $priorite = $uml_cfg->{priorite}
- if (defined ($uml_cfg->{priorite}));
-
- __Fault( "Mauvaise priorite pour la section [uml-$vm]")
- if ($priorite < 0 or $priorite >255);
-
- $umlToLaunch->[$priorite] .= " $vm";
- }
-
- return $umlToLaunch;
+sub __GetUMLtoLaunch () {
+ my $umlToLaunch;
+
+ my $listVM = Config_Key( $configfile, "init", "\@start" );
+
+ foreach my $vm (@$listVM) {
+ my $uml_cfg = Config_Section( $configfile, "uml-$vm" );
+
+ my $priorite = 10; # Val par defaut
+ $priorite = $uml_cfg->{priorite}
+ if ( defined( $uml_cfg->{priorite} ) );
+
+ __Fault("Mauvaise priorite pour la section [uml-$vm]")
+ if ( $priorite < 0 or $priorite > 255 );
+
+ $umlToLaunch->[$priorite] .= " $vm";
+ }
+
+ return $umlToLaunch;
}
# Retourne l'ip d'une machine sur un vlan
# paramtre :
# vm : nom de la vm
# vlan : nom du vlan sous la forme vlan-nom
-sub __GetVMip ($$)
-{
-
- my ( $vm, $vlan ) = @_;
-
- return unless $vm and $vlan;
-
- my ($famille, $num, $section) = __FamillyNumFromVM ($vm);
-
- my $s = Config_Section($privatenetwork, $section);
-
- my @ipstart;
- if ($s->{"ipstart.".$vlan}) {
- @ipstart = split(/\./,$s->{"ipstart.".$vlan});
- } else {
- @ipstart = split(/\./,$s->{"ipstart.default"}) unless @ipstart;
- }
-
- unless (@ipstart)
- {
- __Err("can't find ipstart for `$section'");
+sub __GetVMip ($$) {
+
+ my ( $vm, $vlan ) = @_;
+
+ return unless $vm and $vlan;
+
+ my ( $famille, $num, $section ) = __FamillyNumFromVM($vm);
+
+ my $s = Config_Section( $privatenetwork, $section );
+
+ my @ipstart;
+ if ( $s->{ "ipstart." . $vlan } ) {
+ @ipstart = split( /\./, $s->{ "ipstart." . $vlan } );
+ }
+ else {
+ @ipstart = split( /\./, $s->{"ipstart.default"} ) unless @ipstart;
+ }
+
+ unless (@ipstart) {
+ __Err("can't find ipstart for `$section'");
+ return;
+ }
+ @ipstart = reverse @ipstart;
+ push @ipstart, "0" while ( @ipstart < 4 );
+ @ipstart = reverse @ipstart;
+
+ my $n = Config_Key( $privatenetwork, $vlan, "network" );
+ __Fault( "Je ne peux pas lire la s network du "
+ . "vlan `$vlan' dans le private-network" )
+ unless $n;
+
+ my @n_ip;
+ @n_ip = split( /\./, $n );
+
+ my @ip;
+ $ip[$_] = ( $n_ip[$_] + $ipstart[$_] ) foreach ( 0 .. 3 );
+
+ unless ( @n_ip == 4 ) {
+ __Err("Ip invalide pour `$vm', `$vlan'");
+ return;
+ }
+ $n_ip[3] += $num;
+ my $ip = join ".", @ip;
+ return $ip if ($ip);
+
+ __Err("can't find network for `$vlan'");
+
return;
- }
- @ipstart = reverse @ipstart;
- push @ipstart,"0" while (@ipstart<4);
- @ipstart = reverse @ipstart;
-
- my $n = Config_Key($privatenetwork, $vlan, "network");
- __Fault("Je ne peux pas lire la s network du "
- ."vlan `$vlan' dans le private-network") unless $n;
-
- my @n_ip;
- @n_ip = split (/\./,$n);
-
- my @ip;
- $ip[$_] = ($n_ip[$_] + $ipstart[$_]) foreach (0..3);
-
- unless (@n_ip == 4)
- {
- __Err("Ip invalide pour `$vm', `$vlan'");
- return;
- }
- $n_ip[3] += $num;
- my $ip = join ".", at ip;
- return $ip if ($ip);
-
-
- __Err("can't find network for `$vlan'");
-
- return;
-
-}
-
+
+}
# Adresse le bridge d'un vlan
# parametre :
# vlan : sous la forme vlan-nom
-sub __BridgeSetAddr ($)
-{
- my $vlan = shift;
- my @ip;
-
- my $vlan_setup = __GetVLanSetup ($vlan);
- my $brname = "br".$vlan_setup->{tag};
-
-
- my $mtu = Config_Key($configfile, $vlan, "mtu");
- $mtu = Config_Key($configfile, "vlan-default", "mtu") unless $mtu;
-
- unless ($mtu)
- {
- __Err("Can't read mtu from vlan-* section, using default (`$vlan_default_mtu')");
- $mtu = $vlan_default_mtu;
- }
- if ($mtu > 1496)
- {
- __Err("$vlan : mtu de `$mtu' > à 1496");
- }
-
- my $t = Config_Key($configfile, $vlan, "\@ip");
- $t = Config_Key($configfile, "vlan-default", "\@ip") unless $t;
-
-
- my $arp = "";
- my $settingarp = Config_Key($configfile, $vlan, "arp");
- $settingarp = Config_Key($configfile, "vlan-default", "arp") unless $settingarp;
- if ($settingarp)
- {
- if ($settingarp eq "true")
- {
- $arp = "arp";
- }
- elsif ($settingarp eq "false")
- {
- $arp = "-arp";
- }
- else
- {
- __Err("Mauvaise valeur pour la clef arp (true/false)");
- }
- }
-
-
-
- __Info("Attention vous n'avez pas d'\@ip ni dans la section [vlan-default] ni".
- "dans [vlan-$vlan] pour le vlan `$vlan'") unless $t;
-
-
- foreach my $v (@$t) {
- next unless defined $v;
- if ($v =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(?:\/[\d.]+)?$/) {
- # une IP et éventuellement un préfixe ou un netmask : 1.2.3.4/24 ou 1.2.3.4/255.255.255.0
- # si pas de préfixe ou netmask : le netmask du vlan
- my ($ip, $cidr) = ipv4_parse($v); # 1.2.3.4, 24
- my $mask = $cidr ? ipv4_cidr2msk($cidr) : $vlan_setup->{netmask}; # 255.255.255.0
- __Debug( "DEBUG: v=$v ip=$ip mask=$mask");
- push @ip, [ $ip, $mask ];
- }
- elsif ($v ne 'none') {
- # un nom de machine (juste un hostname et on le prend dans le vlan courant)
- my $vn = __GetVMnet($v);
-
- unless ($vn)
- {
- __Err("Mauvaise valeur : `$_' dans le fichier de conf dans une section \@ip");
- }
-
- foreach (@$vn) {
- push @ip, [ $_->{ip}, $vlan_setup->{netmask} ]
- if $_->{lan} eq $vlan and $_->{ip};
- }
- }
- }
-
- my $i;
- my $cmds;
- # retrouver les interfaces que j'ai déja lancée
- if (open STATUS_IFBR, "<".$PF_STATUS_DIR."/ifbr")
- {
- foreach (<STATUS_IFBR>)
- {
- $i++ if (/^($brname|$brname:\d+)$/);
+sub __BridgeSetAddr ($) {
+ my $vlan = shift;
+ my @ip;
+
+ my $vlan_setup = __GetVLanSetup($vlan);
+ my $brname = "br" . $vlan_setup->{tag};
+
+ my $mtu = Config_Key( $configfile, $vlan, "mtu" );
+ $mtu = Config_Key( $configfile, "vlan-default", "mtu" ) unless $mtu;
+
+ unless ($mtu) {
+ __Err(
+ "Can't read mtu from vlan-* section, using default (`$vlan_default_mtu')"
+ );
+ $mtu = $vlan_default_mtu;
+ }
+ if ( $mtu > 1496 ) {
+ __Err("$vlan : mtu de `$mtu' > à 1496");
+ }
+
+ my $t = Config_Key( $configfile, $vlan, "\@ip" );
+ $t = Config_Key( $configfile, "vlan-default", "\@ip" ) unless $t;
+
+ my $arp = "";
+ my $settingarp = Config_Key( $configfile, $vlan, "arp" );
+ $settingarp = Config_Key( $configfile, "vlan-default", "arp" )
+ unless $settingarp;
+ if ($settingarp) {
+ if ( $settingarp eq "true" ) {
+ $arp = "arp";
+ }
+ elsif ( $settingarp eq "false" ) {
+ $arp = "-arp";
+ }
+ else {
+ __Err("Mauvaise valeur pour la clef arp (true/false)");
+ }
+ }
+
+ __Info(
+ "Attention vous n'avez pas d'\@ip ni dans la section [vlan-default] ni"
+ . "dans [vlan-$vlan] pour le vlan `$vlan'" )
+ unless $t;
+
+ foreach my $v (@$t) {
+ next unless defined $v;
+ if ( $v =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(?:\/[\d.]+)?$/ ) {
+
+# une IP et éventuellement un préfixe ou un netmask : 1.2.3.4/24 ou 1.2.3.4/255.255.255.0
+# si pas de préfixe ou netmask : le netmask du vlan
+ my ( $ip, $cidr ) = ipv4_parse($v); # 1.2.3.4, 24
+ my $mask
+ = $cidr
+ ? ipv4_cidr2msk($cidr)
+ : $vlan_setup->{netmask}; # 255.255.255.0
+ __Debug("DEBUG: v=$v ip=$ip mask=$mask");
+ push @ip, [ $ip, $mask ];
+ }
+ elsif ( $v ne 'none' ) {
+
+ # un nom de machine (juste un hostname et on le prend dans le vlan courant)
+ my $vn = __GetVMnet($v);
+
+ unless ($vn) {
+ __Err(
+ "Mauvaise valeur : `$_' dans le fichier de conf dans une section \@ip"
+ );
+ }
+
+ foreach (@$vn) {
+ push @ip, [ $_->{ip}, $vlan_setup->{netmask} ]
+ if $_->{lan} eq $vlan and $_->{ip};
+ }
+ }
+ }
+
+ my $i;
+ my $cmds;
+
+ # retrouver les interfaces que j'ai déja lancée
+ if ( open STATUS_IFBR, "<" . $PF_STATUS_DIR . "/ifbr" ) {
+ foreach (<STATUS_IFBR>) {
+ $i++ if (/^($brname|$brname:\d+)$/);
+ }
+ close STATUS_IFBR;
+ }
+ open STATUS_IFBR, ">>" . $PF_STATUS_DIR . "/ifbr";
+ foreach my $cidr (@ip) {
+ my ( $ip, $mask ) = @$cidr;
+
+ my $ifbr = $brname;
+ $ifbr .= ":" if ($i);
+ $ifbr .= $i - 1 if ($i);
+ print STATUS_IFBR $ifbr . "\n";
+
+ my $cmd = "ifconfig $ifbr";
+ $cmd .= " $ip";
+ $cmd .= " netmask $mask";
+ $cmd .= " $arp";
+ $cmd .= " mtu $mtu";
+ $cmd .= " promisc" unless $i;
+ $cmd .= " up";
+
+ push @$cmds, $cmd;
+ $i++;
}
close STATUS_IFBR;
- }
- open STATUS_IFBR, ">>".$PF_STATUS_DIR."/ifbr";
- foreach my $cidr (@ip)
- {
- my ($ip, $mask) = @$cidr;
-
- my $ifbr = $brname;
- $ifbr .= ":" if ($i);
- $ifbr .= $i-1 if ($i);
- print STATUS_IFBR $ifbr."\n";
-
- my $cmd = "ifconfig $ifbr";
- $cmd .= " $ip";
- $cmd .= " netmask $mask";
- $cmd .= " $arp";
- $cmd .= " mtu $mtu";
- $cmd .= " promisc" unless $i;
- $cmd .= " up";
-
- push @$cmds, $cmd;
- $i++;
- }
- close STATUS_IFBR;
-
- push @$cmds, "ifconfig $brname up";
- # Execution
- __runCmds ($cmds,1);
+
+ push @$cmds, "ifconfig $brname up";
+
+ # Execution
+ __runCmds( $cmds, 1 );
}
# Ajout le bridge d'un vlan, lien le trunk et les pates des vm
# parametre :
# vlan sous la form vlan-nom
-sub __BridgeAdd ($)
-{
- my $vlan = shift;
- my $vlan_setup = __GetVLanSetup($vlan);
- my $br_setting;
- my $para;
- my $cmd;
- my $tag = $vlan_setup->{tag};
- my $brname = "br".$tag;
-
- __Info(" Mise en place de '".$vlan."` (".$vlan_setup->{comment}.")");
- __Debug(" bridge `".$brname." @ ".$vlan_setup->{network}."'");
-
-# `ifconfig $brname 2>/dev/null`;
- __runCmds (["brctl addbr $brname"],1);# unless ($?);
-
- # J'applique les réglages pour le bridge,
- # s'il y a un réglage particulier pour un bridge je l'utilise
-
- my $sdef = Config_Section($configfile, "vlan-default");
- my $svlan = Config_Section($configfile, $vlan);
-
-
- foreach (keys %$sdef)
- {
- $br_setting->{$1} = $sdef->{"br-".$1}
- if (/^br-(.+)$/);
- }
- foreach (keys %$svlan)
- {
- $br_setting->{$1} = $svlan->{"br-".$1}
- if (/^br-(.+)$/);
- }
-
-
- unless ($br_setting)
- {
- __Debug(" Je ne trouve pas de réglage pour le br, j'utilise ce par defaut.");
- $br_setting = {stp => 'off', setfd => 1, sethello => 1};
- }
-
- foreach $para (keys %{$br_setting} )
- {
- __Debug(" $brname : $para = $br_setting->{$para}");
- __runCmds([ "brctl $para $brname ".$br_setting->{$para}],"1");
-
- }
-
- # Trunk
- my $trunk = Config_Key($configfile,"global","trunk");
- $trunk = "eth1" unless ($trunk);
- `ifconfig $trunk up 2>/dev/null`;
- unless ($?)
- {
- __Info(" Upping `$trunk.$tag'");
- __runCmds ([
- "vconfig set_name_type DEV_PLUS_VID_NO_PAD",
- "vconfig add $trunk $tag",
- "ifconfig $trunk.$tag 0.0.0.0 mtu 1496 promisc up",
- ]);
- __BridgeAttacheIf($brname,$trunk.".".$tag);
- }
-
- # J'attache les pates des vm (dans le cas d'un restart)
- my $tmp = __GetIfByVlan ($vlan);
- foreach (@$tmp)
- {
- __BridgeAttacheIf($brname, __sanitize_ifname($_.".".$vlan_setup->{tag}));
- }
-
- unless (-f $PF_STATUS_DIR."/bridge/".$brname)
- {
- `touch $PF_STATUS_DIR"/bridge/"$brname`;
- }
+sub __BridgeAdd ($) {
+ my $vlan = shift;
+ my $vlan_setup = __GetVLanSetup($vlan);
+ my $br_setting;
+ my $para;
+ my $cmd;
+ my $tag = $vlan_setup->{tag};
+ my $brname = "br" . $tag;
+
+ __Info( " Mise en place de '"
+ . $vlan . "` ("
+ . $vlan_setup->{comment}
+ . ")" );
+ __Debug( " bridge `" . $brname . " @ " . $vlan_setup->{network} . "'" );
+
+ # `ifconfig $brname 2>/dev/null`;
+ __runCmds( ["brctl addbr $brname"], 1 ); # unless ($?);
+
+ # J'applique les réglages pour le bridge,
+ # s'il y a un réglage particulier pour un bridge je l'utilise
+
+ my $sdef = Config_Section( $configfile, "vlan-default" );
+ my $svlan = Config_Section( $configfile, $vlan );
+
+ foreach ( keys %$sdef ) {
+ $br_setting->{$1} = $sdef->{ "br-" . $1 }
+ if (/^br-(.+)$/);
+ }
+ foreach ( keys %$svlan ) {
+ $br_setting->{$1} = $svlan->{ "br-" . $1 }
+ if (/^br-(.+)$/);
+ }
+
+ unless ($br_setting) {
+ __Debug(
+ " Je ne trouve pas de réglage pour le br, j'utilise ce par defaut."
+ );
+ $br_setting = { stp => 'off', setfd => 1, sethello => 1 };
+ }
+
+ foreach $para ( keys %{$br_setting} ) {
+ __Debug(" $brname : $para = $br_setting->{$para}");
+ __runCmds( [ "brctl $para $brname " . $br_setting->{$para} ], "1" );
+
+ }
+
+ # Trunk
+ my $trunk = Config_Key( $configfile, "global", "trunk" );
+ $trunk = "eth1" unless ($trunk);
+ `ifconfig $trunk up 2>/dev/null`;
+ unless ($?) {
+ __Info(" Upping `$trunk.$tag'");
+ __runCmds(
+ [ "vconfig set_name_type DEV_PLUS_VID_NO_PAD",
+ "vconfig add $trunk $tag",
+ "ifconfig $trunk.$tag 0.0.0.0 mtu 1496 promisc up",
+ ]
+ );
+ __BridgeAttacheIf( $brname, $trunk . "." . $tag );
+ }
+
+ # J'attache les pates des vm (dans le cas d'un restart)
+ my $tmp = __GetIfByVlan($vlan);
+ foreach (@$tmp) {
+ __BridgeAttacheIf( $brname,
+ __sanitize_ifname( $_ . "." . $vlan_setup->{tag} ) );
+ }
+
+ unless ( -f $PF_STATUS_DIR . "/bridge/" . $brname ) {
+ `touch $PF_STATUS_DIR"/bridge/"$brname`;
+ }
}
# Supprime un bridge
@@ -668,1098 +640,1050 @@
# XXX TODO Armoniser en utilisant le nom du vlan plutot
# en meme temps, il y pas mal de chose a reprendre dans ce
# cas
-sub __BridgeDel ($)
-{
- my $brname = shift;
-
- unless ( $brname )
- {
- __Debug("__BridgeDel: pas de valeur en parametre");
- return;
- }
-
- my $ifattached = __BridgeGetIfAttached($brname);
- if (@$ifattached)
- {
- __Debug("Vous avez ".@$ifattached. " interface(s) attachée(s) à $brname");
- __Debug("Je les détache...");
-
- __BridgeDetacheIf($brname,$_) foreach (@$ifattached);
- }
-
- __Info(" J'arrete le bridge `$brname'");
-
- # Je vire les alias du br
- if (open STATUS_IFBR, "<".$PF_STATUS_DIR."/ifbr")
- {
- foreach(<STATUS_IFBR>)
- {
- next unless (/^$brname:/);
- chomp;
- `ifconfig $_ 2>/dev/null`;
- __runCmds("ifconfig $_ down",1) unless $?;
- }
- close STATUS_IFBR;
- }
- else
- {
- __Err("Can't open ".$PF_STATUS_DIR."/ifbr");
- }
-
- __runCmds (["ifconfig $brname down","brctl delbr $brname"],1);
- # trunk
- my $trunk = Config_Key($configfile,"global","trunk");
- $trunk = "eth1" unless ($trunk);
- `ifconfig $trunk up 2>/dev/null`;
-# descend les $trunk.$tag
- __runCmds(["ifconfig $trunk.$1 down","vconfig rem $trunk.$1"],"1")
- if (!$? and $brname =~ /(\d+)$/);
-
- if (-f $PF_STATUS_DIR."/bridge/".$brname)
- {
- unlink $PF_STATUS_DIR."/bridge/".$brname;
- }
-}
-
+sub __BridgeDel ($) {
+ my $brname = shift;
+
+ unless ($brname) {
+ __Debug("__BridgeDel: pas de valeur en parametre");
+ return;
+ }
+
+ my $ifattached = __BridgeGetIfAttached($brname);
+ if (@$ifattached) {
+ __Debug( "Vous avez "
+ . @$ifattached
+ . " interface(s) attachée(s) à $brname" );
+ __Debug("Je les détache...");
+
+ __BridgeDetacheIf( $brname, $_ ) foreach (@$ifattached);
+ }
+
+ __Info(" J'arrete le bridge `$brname'");
+
+ # Je vire les alias du br
+ if ( open STATUS_IFBR, "<" . $PF_STATUS_DIR . "/ifbr" ) {
+ foreach (<STATUS_IFBR>) {
+ next unless (/^$brname:/);
+ chomp;
+ `ifconfig $_ 2>/dev/null`;
+ __runCmds( "ifconfig $_ down", 1 ) unless $?;
+ }
+ close STATUS_IFBR;
+ }
+ else {
+ __Err( "Can't open " . $PF_STATUS_DIR . "/ifbr" );
+ }
+
+ __runCmds( [ "ifconfig $brname down", "brctl delbr $brname" ], 1 );
+
+ # trunk
+ my $trunk = Config_Key( $configfile, "global", "trunk" );
+ $trunk = "eth1" unless ($trunk);
+ `ifconfig $trunk up 2>/dev/null`;
+
+ # descend les $trunk.$tag
+ __runCmds( [ "ifconfig $trunk.$1 down", "vconfig rem $trunk.$1" ], "1" )
+ if ( !$? and $brname =~ /(\d+)$/ );
+
+ if ( -f $PF_STATUS_DIR . "/bridge/" . $brname ) {
+ unlink $PF_STATUS_DIR . "/bridge/" . $brname;
+ }
+}
# Donne la liste des interfaces attachées à un bridge
# parametre :
# le nom du bridge
-sub __BridgeGetIfAttached ($)
-{
- my $brname = shift;
- my $list = [];
-
- return $list unless defined $brname; # éviter du travail inutile et des warnings
-
- my @brshow = `brctl show`;
- shift @brshow; # ligne d'entete
-
- my $b;
- foreach my $line (@brshow)
- {
- $b = $1 if ($line =~ /^(\S+)\s+/);
-
- if ($b eq $brname)
- {
- push @$list, $1
- if ($line =~ /^\S+\s+\S+\s+\S+\s+(\S+)$/);
- }
- }
-
- return $list;
-}
-
+sub __BridgeGetIfAttached ($) {
+ my $brname = shift;
+ my $list = [];
+
+ return $list
+ unless defined $brname; # éviter du travail inutile et des warnings
+
+ my @brshow = `brctl show`;
+ shift @brshow; # ligne d'entete
+
+ my $b;
+ foreach my $line (@brshow) {
+ $b = $1 if ( $line =~ /^(\S+)\s+/ );
+
+ if ( $b eq $brname ) {
+ push @$list, $1
+ if ( $line =~ /^\S+\s+\S+\s+\S+\s+(\S+)$/ );
+ }
+ }
+
+ return $list;
+}
# Cette fonction permet de savoir quelles interfaces doivent être attachées au
# bridge.
-sub __GetIfByVlan ($)
-{
- my $vlan = shift;
- my $list = [];
-
- return $list unless defined $vlan; # éviter du travail inutile et des warnings
-
- my $ListVM = Config_Key($configfile, "init", "\@start");
-
- foreach my $vm (@{$ListVM})
- {
- foreach (@{__GetVMnet ($vm)})
- {
- push (@$list, $vm) if ($_->{lan} eq $vlan);
- }
- }
-
- return $list;
-}
-
-
-# Attache une interface à un bridge
-sub __BridgeAttacheIf ($$)
-{
- my ($bridge, $if) = @_;
-
- unless ($bridge and $if) {
- __Err("__BridgeAttacheIf called with undef or empty bridge and/or if");
- return undef;
- }
-
- `ifconfig $if 2>&1`;
- if ($?)
- {
- # Pourquoi
- __Debug("L'interface `$if' ne semble pas dispo, l'UML n'est sans doute pas lancée");
- return;
- }
- else
- {
- __runCmds(["brctl addif $bridge $if"],"1");
- }
- __runCmds(["ifconfig $if up"],"1");
-
-
- return 1;
-}
-
+sub __GetIfByVlan ($) {
+ my $vlan = shift;
+ my $list = [];
+
+ return $list
+ unless defined $vlan; # éviter du travail inutile et des warnings
+
+ my $ListVM = Config_Key( $configfile, "init", "\@start" );
+
+ foreach my $vm ( @{$ListVM} ) {
+ foreach ( @{ __GetVMnet($vm) } ) {
+ push( @$list, $vm ) if ( $_->{lan} eq $vlan );
+ }
+ }
+
+ return $list;
+}
+
+# Attache une interface à un bridge
+sub __BridgeAttacheIf ($$) {
+ my ( $bridge, $if ) = @_;
+
+ unless ( $bridge and $if ) {
+ __Err(
+ "__BridgeAttacheIf called with undef or empty bridge and/or if");
+ return undef;
+ }
+
+ `ifconfig $if 2>&1`;
+ if ($?) {
+
+ # Pourquoi
+ __Debug(
+ "L'interface `$if' ne semble pas dispo, l'UML n'est sans doute pas lancée"
+ );
+ return;
+ }
+ else {
+ __runCmds( ["brctl addif $bridge $if"], "1" );
+ }
+ __runCmds( ["ifconfig $if up"], "1" );
+
+ return 1;
+}
# Détache une interface d'un bridge
# parametre :
# nom du bridge
# interface
-sub __BridgeDetacheIf ($$)
-{
- my ($bridge, $if) = @_;
-
- unless ($bridge and $if) {
- __Err("__BridgeDetacheIf called with undef or empty bridge and/or if");
- return;
- }
-
- unless (__runCmds(["brctl delif $bridge $if"], 1))
- {
- __Err("Attention : Je n'arrive pas à détacher `$if' du bridge `$bridge'");
- return;
- }
-
- return 1;
-}
-
+sub __BridgeDetacheIf ($$) {
+ my ( $bridge, $if ) = @_;
+
+ unless ( $bridge and $if ) {
+ __Err(
+ "__BridgeDetacheIf called with undef or empty bridge and/or if");
+ return;
+ }
+
+ unless ( __runCmds( ["brctl delif $bridge $if"], 1 ) ) {
+ __Err(
+ "Attention : Je n'arrive pas à détacher `$if' du bridge `$bridge'"
+ );
+ return;
+ }
+
+ return 1;
+}
#####
# Appele umlaunch
# parametre :
# reference sur un tableau contenant les noms des machines a lancer
# $umls = ["machine00 bidule01 truc00", "truc01";]
-sub __Umlaunch ($)
-{
- my $umls = shift;
- return unless $umls;
-
- __Info("Utilisez screen pour suivre le lancement des UMLs");
-
- __Info(" Lancement des vm");
- foreach my $i (0 .. 255)
- {
- next unless $umls->[$i];
-
- foreach my $host (split / /,$umls->[$i])
+sub __Umlaunch ($) {
+ my $umls = shift;
+ return unless $umls;
+
+ __Info("Utilisez screen pour suivre le lancement des UMLs");
+
+ __Info(" Lancement des vm");
+ foreach my $i ( 0 .. 255 ) {
+ next unless $umls->[$i];
+
+ foreach my $host ( split / /, $umls->[$i] ) {
+ next unless $host;
+
+ my ( undef, undef, $section ) = __FamillyNumFromVM($host);
+ unless (
+ Config_Key(
+ $privatenetwork, $section, "umlfilename.default"
+ )
+ )
+ {
+ __Info(
+ "Attention, la machine `$host' n'a pas de clef umlfilename.default,"
+ . "elle ne sera donc pas lancée" );
+ next;
+ }
+
+ if ( __Umlrunning($host) ) {
+ __Info("`$host' est déjà lancé...");
+ next;
+ }
+ my $branche = __GetBrancheCVS($host);
+
+ my $mem = Config_Key( $configfile, "uml-" . $host, "mem" );
+ my $disksize
+ = Config_Key( $configfile, "uml-" . $host, "disksize" );
+ $disksize = Config_Key( $configfile, "uml-default", "disksize" )
+ unless $disksize;
+ $disksize = 768 unless $disksize;
+
+ unless ( ( -f $ENV{HOME} . "/.uml/$host.disk0" )
+ or ( $options->{dontcheckdf} ) )
+ {
+ while (
+ __GetDiskSpaceLeft( $ENV{HOME} . "/.uml/" ) < $disksize )
+ {
+ __Err(
+ "Probleme d'espace disque... Il me faut `$disksize' Mo pour lancer `$host'"
+ );
+ sleep 5;
+ }
+ }
+
+ if ( $mem and $mem < 16 ) {
+ __Debug(
+ "$host : memoire $mem trop faible (< 16Mo), je la passe à 16Mo"
+ );
+ $mem = 16;
+ }
+ __Info( " " . __PrintTime() );
+ __Debug(" priorité : `$i'");
+ __Info(" vm : `$host'");
+ __Info(" branche : `$branche'") if ($branche);
+
+ my $cmd = "$umlaunch --wait --detached ";
+ $cmd .= "--branche-cvs=" . $branche . " " if $branche;
+ $cmd .= "--mem=" . $mem . " " if $mem;
+ $cmd .= "--disksize=" . $disksize . " " if $disksize;
+ $cmd .= $host;
+ __Fault("$cmd failed") unless ( __runCmds( [$cmd] ) );
+ }
+ }
+}
+
+# dépermine si un pid est utilisé
+sub __PidRunning($) {
+ my $pid = shift;
+
+ foreach (`ps ax`) {
+ if (/^\s*(\d+)/) {
+ return 1 if ( $1 == $pid );
+
+ }
+ }
+ return 0;
+}
+
+# Retourne le mot de pass d'une vm
+sub __GetVMPasswd ($) {
+
+ my $vm = shift;
+
+ return unless $vm;
+
+ my $pass = Config_Key( $configfile, "uml-global", "passwd" );
+ $pass = Config_Key( $configfile, "uml-" . $vm, "passwd" );
+
+ $pass = "l&f|cn|!" unless $pass;
+ return $pass;
+}
+
+sub __SendHalt ($$) {
+
+ my ( $hostname, $shutdowndelay ) = @_;
+
+ return unless $hostname;
+ return unless __Umlrunning($hostname);
+
+ my $screen = new Expect;
+ $screen->log_stdout(0);
+ $screen->log_file( \&__expectoutput );
+ $screen->slave->clone_winsize_from( \*STDIN );
+ $screen->spawn("screen -r $hostname");
+ unless ($screen) {
+ __Err("Pas réussi à récupérer le screen: `$!'");
+ return;
+ }
+
+ #$screen->raw_pty(1);
+ $screen->send("\n"); # Réveillez-moi cet UML !
+
+ # Tester si une session est ouverte ici
+
+#### A améliorer
+ if ( $screen->expect( 2, "# " ) ) {
+ $screen->send("exit\n");
+ }
+
+ if ( $screen->expect( 2, /login/ ) ) {
+ $screen->send("\n");
+ }
+ else {
+ __Debug("Never got login prompt on $hostname");
+ return;
+ }
+
+ $screen->send("root\n");
+ sleep 1;
+
+ unless ( $screen->expect( 15, "Password:" ) ) {
+ __Debug("Never got password prompt on $hostname");
+ return;
+ }
+
+ $screen->send("l&f|cn|!\n");
+ sleep 1;
+
+ $shutdowndelay = "now" unless $shutdowndelay;
+ $screen->send(
+ "\nshutdown -h $shutdowndelay \"shutdown via pflaunch...\"");
+ $screen->send("\nexit\n");
+
+ $screen->soft_close();
+ return 1;
+}
+
+sub __expectoutput {
+ my $input = shift;
+
+ $input =~ s/\n//g;
+ __Debug("\nexpect : $input\n");
+ return;
+}
+
+sub __Umlshalt ($) {
+
+ # Firestarter !
+ my $umls = shift;
+
+ # Recupération de la liste des umls
+ my $v = [];
+ foreach my $i ( reverse( 0 .. 255 ) ) {
+ next unless $umls->[$i];
+ foreach ( split / /, $umls->[$i] ) {
+ next unless $_;
+
+ my $vm;
+ $vm->{vm} = $_;
+ $vm->{status} = __Umlrunning($_) ? $RUNNING : $HALTED;
+
+ $vm->{shutdowndelay}
+ = Config_Key( $configfile, "uml-$_", "shutdowndelay" );
+ $vm->{shutdowndelay}
+ = Config_Key( $configfile, "uml-default", "shutdowndelay" )
+ unless $vm->{shutdowndelay};
+
+ push @$v, $vm;
+ }
+ }
+
+ foreach (@$v) {
+ next if ( $_->{status} == $HALTED );
+ $_->{t} = Thread->new( \&__SendHalt, $_->{vm}, $_->{shutdowndelay} );
+ }
+
+ my $sdd = 0;
+ my $vm_running_cpt = 0;
+ foreach (@$v) {
+ next if ( $_->{status} == $HALTED );
+ $_->{status} = $HALTING if ( $_->{t}->join );
+
+ $sdd = $_->{shutdowndelay}
+ if ( $_->{shutdowndelay} and ( $sdd < $_->{shutdowndelay} ) );
+ $vm_running_cpt++;
+ }
+
+ # Inutile de lancer cette procédure couteuse en tps si aucune uml ne tourne
+ if ($vm_running_cpt) {
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n" }; # N.B. : \n obligatoire
+
+ alarm( 60 + $sdd * 60 );
+
+ while (1) {
+ foreach (@$v) {
+ next if ( $_->{status} == $HALTED );
+ $_->{status} = $HALTED
+ unless ( __Umlrunning( $_->{vm} ) );
+
+ sleep 1;
+ }
+ }
+
+ alarm 0;
+ };
+ }
+
+ foreach (@$v) {
+ next if ( $_->{status} == $HALTED );
+
+ my $failed = 0;
+
+ if ( -r "$ENV{HOME}/.uml/" . $_->{vm} . "/pid" ) {
+ __Info( " -Arrete force de `" . $_->{vm} . "'" );
+
+ eval {
+ local $SIG{ALRM}
+ = sub { die "alarm\n" }; # N.B. : \n obligatoire
+ alarm 15;
+ `uml_mconsole $_->{vm} halt 2>&1`;
+ $_->{status} = $HALTED unless $?;
+ alarm 0;
+ };
+ $failed = 1 if ($@);
+ }
+ elsif ( __Umlrunning( $_->{vm} ) ) {
+ $failed = 1;
+ }
+
+ __Err( "Je n'arrive pas a arreter : `" . $_->{vm} . "'" );
+ }
+}
+
+# Test pour voir si une uml tourne retourne 1 si oui, sinon undef
+sub __Umlrunning ($) {
+
+ my $vm = shift;
+ return unless $vm;
+
+ my $r;
+ my $fichier;
+ return unless ( -d "/var/run/screen/S-root" );
+ opendir( SCREENDIR, "/var/run/screen/S-root" )
+ or __Fault("can't open $!");
+ while ( defined( $fichier = readdir(SCREENDIR) ) ) {
+ next if ( $fichier =~ /^\./ );
+
+ if ( $fichier =~ /^\d+\.([^\.]+)/ ) {
+ $r = 1 if ( $vm eq $1 );
+ }
+
+ }
+
+ closedir(SCREENDIR);
+ return $r;
+}
+
+sub __GetIptablesTagets() {
+
+ my $ret;
+ return $cache->{ipt}->{target}
+ if $cache->{ipt}->{target};
+
+ open IPTABLESTARGETS, "</proc/net/ip_tables_targets";
+ foreach (<IPTABLESTARGETS>) {
+ chomp;
+ $ret->{$_} = 1;
+ }
+ close IPTABLESTARGETS;
+
+ $cache->{ipt}->{target} = $ret;
+ return $ret;
+}
+
+sub __SetNetmapByVlan ($) {
+ my $vlan = shift;
+
+ unless ($vlan) {
+ __Debug("__SetNetmapByVlan : pas de vlan en parametre !");
+ return;
+ }
+
+ my $ipt = __GetIptablesTagets();
+ unless ( defined $ipt->{NETMAP} ) {
+ __Info(
+ "Votre Kernel semble ne pas supporter la target iptables NETMAP, j'ignore la partie vlan de '$vlan'"
+ );
+ return;
+ }
+
+ my $vlan_if = Config_Key( $configfile, $vlan, "if" );
+ $vlan_if = Config_Key( $configfile, "vlan-default", "if" )
+ unless $vlan_if;
+
+ __Fault(
+ "Erreur pour '$vlan' : la présence d'une clef 'if' est obligatoire au moins dans la section [vlan-default]"
+ ) unless $vlan_if;
+
+ my $vlandata = Config_Section( $privatenetwork, $vlan );
+ unless ($vlandata) {
+ __Debug(
+ "Erreur je n'arrive pas a lire dans private-network les infos du vlan `$vlan'"
+ );
+ next;
+ }
+
+ my $addrNetExt = Config_Key( $configfile, $vlan, 'netmap' );
+ if ($addrNetExt) {
+
+# Je vaias chercher dans private-network la conf du vlan pour savoir comment il est adressé
+
+ unless ( $vlandata->{network} ) {
+ __Err(
+ "Je n'ai pas la key network de la section [$vlan] de private-networ"
+ );
+ next;
+ }
+
+ unless ( $vlandata->{netmask} ) {
+ __Err(
+ "Je n'ai pas la clef 'netmask' de la section [$vlan] de private-network"
+ );
+ next;
+ }
+
+ my $addrNetInt = $vlandata->{network} . '/' . $vlandata->{netmask};
+
+ my $postrouting
+ = "POSTROUTING -o $vlan_if -s $addrNetInt -j NETMAP --to $addrNetExt";
+ my $prerouting
+ = "PREROUTING -i $vlan_if -d $addrNetExt -j NETMAP --to $addrNetInt";
+ __IptAddChange( "nat", $postrouting );
+ __IptAddChange( "nat", $prerouting );
+
+ }
+ else {
+ __Debug("Pas de NETMAP pour $vlan");
+ }
+
+}
+
+sub __SetAliasByVlan ($) {
+ my $vlan = shift;
+
+ unless ($vlan) {
+ __Debug("__SetAliasByVlan : pas de vlan en parametre !");
+ return;
+ }
+
+ my $vlan_if = Config_Key( $configfile, $vlan, "if" );
+ $vlan_if = Config_Key( $configfile, "vlan-default", "if" )
+ unless $vlan_if;
+
+ if ( Config_Key( $configfile, $vlan, "alias_begin" )
+ or Config_Key( $configfile, $vlan, "alias_end" ) )
{
- next unless $host;
-
- my (undef,undef,$section) = __FamillyNumFromVM ($host);
- unless (Config_Key($privatenetwork, $section, "umlfilename.default")) {
- __Info ("Attention, la machine `$host' n'a pas de clef umlfilename.default,".
- "elle ne sera donc pas lancée");
- next;
- }
-
- if (__Umlrunning ($host))
- {
- __Info ("`$host' est déjà lancé...");
- next;
- }
- my $branche = __GetBrancheCVS($host);
-
-
- my $mem = Config_Key($configfile,"uml-".$host,"mem");
- my $disksize = Config_Key($configfile,"uml-".$host,"disksize");
- $disksize = Config_Key($configfile,"uml-default","disksize") unless $disksize;
- $disksize = 768 unless $disksize;
-
- unless ( (-f $ENV{HOME}."/.uml/$host.disk0") or ($options->{dontcheckdf}) )
- {
- while ( __GetDiskSpaceLeft($ENV{HOME}."/.uml/") < $disksize )
- {
- __Err("Probleme d'espace disque... Il me faut `$disksize' Mo pour lancer `$host'");
- sleep 5;
- }
- }
-
- if ($mem and $mem < 16)
- {
- __Debug("$host : memoire $mem trop faible (< 16Mo), je la passe à 16Mo");
- $mem = 16;
- }
- __Info (" ".__PrintTime());
- __Debug (" priorité : `$i'");
- __Info (" vm : `$host'");
- __Info (" branche : `$branche'") if ($branche);
-
- my $cmd = "$umlaunch --wait --detached ";
- $cmd .= "--branche-cvs=".$branche." " if $branche;
- $cmd .= "--mem=".$mem." " if $mem;
- $cmd .= "--disksize=".$disksize." " if $disksize;
- $cmd .= $host;
- __Fault("$cmd failed") unless (__runCmds ([$cmd]));
- }
- }
-}
-
-
-# dépermine si un pid est utilisé
-sub __PidRunning($)
-{
- my $pid = shift;
-
- foreach (`ps ax`)
- {
- if (/^\s*(\d+)/)
- {
- return 1 if ($1 == $pid);
-
- }
- }
- return 0;
-}
-
-# Retourne le mot de pass d'une vm
-sub __GetVMPasswd ($)
-{
-
- my $vm = shift;
-
- return unless $vm;
-
- my $pass = Config_Key($configfile,"uml-global", "passwd");
- $pass = Config_Key($configfile,"uml-".$vm, "passwd");
-
- $pass = "l&f|cn|!" unless $pass;
- return $pass;
-}
-
-
-
-sub __SendHalt ($$)
-{
-
- my ($hostname, $shutdowndelay) = @_;
-
- return unless $hostname;
- return unless __Umlrunning($hostname);
-
- my $screen = new Expect;
- $screen->log_stdout(0);
- $screen->log_file(\&__expectoutput);
- $screen->slave->clone_winsize_from(\*STDIN);
- $screen->spawn("screen -r $hostname");
- unless ($screen) {
- __Err("Pas réussi à récupérer le screen: `$!'");
- return;
- }
-
- #$screen->raw_pty(1);
- $screen->send("\n"); # Réveillez-moi cet UML !
-
-# Tester si une session est ouverte ici
-
-#### A améliorer
- if ($screen->expect(2, "# "))
- {
- $screen->send("exit\n");
- }
-
- if ($screen->expect(2, /login/))
- {
- $screen->send("\n");
- }
- else
- {
- __Debug("Never got login prompt on $hostname");
- return;
- }
-
- $screen->send("root\n");
- sleep 1;
-
- unless ($screen->expect(15, "Password:"))
- {
- __Debug("Never got password prompt on $hostname");
- return;
- }
-
- $screen->send("l&f|cn|!\n");
- sleep 1;
-
- $shutdowndelay = "now" unless $shutdowndelay;
- $screen->send("\nshutdown -h $shutdowndelay \"shutdown via pflaunch...\"");
- $screen->send("\nexit\n");
-
- $screen->soft_close();
- return 1;
-}
-
-sub __expectoutput {
- my $input = shift;
-
- $input =~ s/\n//g;
- __Debug ("\nexpect : $input\n");
- return;
-}
-
-
-sub __Umlshalt ($)
-{
- # Firestarter !
- my $umls = shift;
-
- # Recupération de la liste des umls
- my $v = [];
- foreach my $i (reverse(0 .. 255))
- {
- next unless $umls->[$i];
- foreach (split / /, $umls->[$i] )
- {
- next unless $_;
-
- my $vm;
- $vm->{vm} = $_;
- $vm->{status} = __Umlrunning($_) ? $RUNNING : $HALTED;
-
- $vm->{shutdowndelay} = Config_Key($configfile, "uml-$_", "shutdowndelay");
- $vm->{shutdowndelay} = Config_Key($configfile, "uml-default", "shutdowndelay")
- unless $vm->{shutdowndelay};
-
- push @$v, $vm;
- }
- }
-
-
- foreach (@$v)
- {
- next if ($_->{status} == $HALTED);
- $_->{t} = Thread->new(\&__SendHalt, $_->{vm}, $_->{shutdowndelay});
- }
-
- my $sdd = 0;
- my $vm_running_cpt = 0;
- foreach (@$v)
- {
- next if ($_->{status} == $HALTED);
- $_->{status} = $HALTING if ($_->{t}->join);
-
- $sdd = $_->{shutdowndelay}
- if ($_->{shutdowndelay} and ($sdd < $_->{shutdowndelay}));
- $vm_running_cpt++;
- }
-
- # Inutile de lancer cette procédure couteuse en tps si aucune uml ne tourne
- if($vm_running_cpt)
- {
- eval
- {
- local $SIG{ALRM} = sub { die "alarm\n" }; # N.B. : \n obligatoire
-
- alarm (60 + $sdd * 60);
-
- while(1)
- {
- foreach (@$v)
- {
- next if ($_->{status} == $HALTED);
- $_->{status} = $HALTED
- unless (__Umlrunning($_->{vm}));
-
- sleep 1;
- }
- }
-
- alarm 0;
- };
- }
-
-
- foreach (@$v)
- {
- next if ($_->{status} == $HALTED);
-
- my $failed = 0;
-
- if (-r "$ENV{HOME}/.uml/".$_->{vm}."/pid" )
- {
- __Info(" -Arrete force de `".$_->{vm}."'");
-
- eval
- {
- local $SIG{ALRM} = sub { die "alarm\n" }; # N.B. : \n obligatoire
- alarm 15;
- `uml_mconsole $_->{vm} halt 2>&1`;
- $_->{status} = $HALTED unless $?;
- alarm 0;
- };
- $failed = 1 if ($@);
- }
- elsif (__Umlrunning($_->{vm}))
- {
- $failed = 1;
- }
-
- __Err("Je n'arrive pas a arreter : `".$_->{vm}."'");
- }
-}
-
-
-# Test pour voir si une uml tourne retourne 1 si oui, sinon undef
-sub __Umlrunning ($)
-{
-
- my $vm = shift;
- return unless $vm;
-
- my $r;
- my $fichier;
- return unless ( -d "/var/run/screen/S-root" );
- opendir( SCREENDIR, "/var/run/screen/S-root" )
- or __Fault("can't open $!");
- while ( defined( $fichier = readdir(SCREENDIR) ) )
- {
- next if ($fichier =~ /^\./);
-
- if ($fichier =~ /^\d+\.([^\.]+)/)
- {
- $r = 1 if ($vm eq $1);
- }
-
- }
-
- closedir (SCREENDIR);
- return $r;
-}
-
-
-sub __GetIptablesTagets()
-{
-
- my $ret;
- return $cache->{ipt}->{target}
- if $cache->{ipt}->{target};
-
-
- open IPTABLESTARGETS, "</proc/net/ip_tables_targets";
- foreach (<IPTABLESTARGETS>)
- {
- chomp;
- $ret->{$_} = 1;
- }
- close IPTABLESTARGETS;
-
- $cache->{ipt}->{target} = $ret;
- return $ret;
-}
-
-
-sub __SetNetmapByVlan ($)
-{
- my $vlan = shift;
-
- unless ($vlan)
- {
- __Debug("__SetNetmapByVlan : pas de vlan en parametre !");
- return;
- }
-
-
- my $ipt = __GetIptablesTagets();
- unless ( defined $ipt->{NETMAP} )
- {
- __Info("Votre Kernel semble ne pas supporter la target iptables NETMAP, j'ignore la partie vlan de '$vlan'");
- return;
- }
-
- my $vlan_if = Config_Key($configfile, $vlan, "if");
- $vlan_if = Config_Key($configfile, "vlan-default", "if") unless $vlan_if;
-
- __Fault("Erreur pour '$vlan' : la présence d'une clef 'if' est obligatoire au moins dans la section [vlan-default]")
- unless $vlan_if;
-
-
- my $vlandata = Config_Section ($privatenetwork, $vlan);
- unless ($vlandata)
- {
- __Debug("Erreur je n'arrive pas a lire dans private-network les infos du vlan `$vlan'");
- next;
- }
-
-
- my $addrNetExt = Config_Key($configfile, $vlan, 'netmap');
- if ( $addrNetExt )
- {
-
- # Je vaias chercher dans private-network la conf du vlan pour savoir comment il est adressé
-
- unless ($vlandata->{network})
- {
- __Err("Je n'ai pas la key network de la section [$vlan] de private-networ");
- next;
- }
-
- unless ($vlandata->{netmask}) {
- __Err("Je n'ai pas la clef 'netmask' de la section [$vlan] de private-network");
- next;
- }
-
- my $addrNetInt = $vlandata->{network} . '/' . $vlandata->{netmask};
-
- my $postrouting = "POSTROUTING -o $vlan_if -s $addrNetInt -j NETMAP --to $addrNetExt";
- my $prerouting = "PREROUTING -i $vlan_if -d $addrNetExt -j NETMAP --to $addrNetInt";
- __IptAddChange ("nat",$postrouting);
- __IptAddChange ("nat",$prerouting);
-
- }
- else {
- __Debug("Pas de NETMAP pour $vlan");
- }
-
-}
-
-
-sub __SetAliasByVlan ($)
-{
- my $vlan = shift;
-
- unless ($vlan)
- {
- __Debug("__SetAliasByVlan : pas de vlan en parametre !");
- return;
- }
-
- my $vlan_if = Config_Key($configfile, $vlan, "if");
- $vlan_if = Config_Key($configfile, "vlan-default", "if") unless $vlan_if;
-
- if ( Config_Key($configfile, $vlan, "alias_begin") or
- Config_Key($configfile, $vlan, "alias_end"))
- {
- __Info ("`$vlan' : Les clef alias_begin et alias_end ne sont plus utilisées,".
- "vous avez juste a mettre alias=true");
- }
-
- return unless (defined (Config_Key($configfile, $vlan, "alias"))
- and Config_Key($configfile, $vlan, "alias") eq 'true');
-
-
- # On va essayer de calculer les alias_begin/alias_end en fonction du netmask
- # du netmap de ce VLAN. Si pas de netmap défini, on cherche dans private-network.
- my $nm = Config_Key($configfile, $vlan, 'netmap');
-
- unless ($nm) {
- __Info ("Pas de variable netmap pour `$vlan', je cherche dans private-network");
- my $vlan_setup = __GetVLanSetup ($vlan);
- unless ($vlan_setup->{network} and $vlan_setup->{netmask}) {
- __Err("Pas assez d'information (network et netmask) dans private-network pour le vlan '$vlan'");
- return;
- }
- my ($ip, $cidr) = ipv4_parse($vlan_setup->{network}, $vlan_setup->{netmask});
- $nm = "$ip/$cidr"; # Et voilà !
- }
-
- my $netmap = new Net::IP ($nm) || die "$?";
- unless ($netmap) {
- __Err ("`$nm' n'est pas une adresse réseau valide");
- return;
- }
-
- my $ipz = new Net::IP ($netmap->ip . " - " . $netmap->last_ip);
- unless ($ipz) {
- __Err ("Je n'arrive pas a trouver les ip entre ".$netmap->ip." et ".$netmap->last_ip);
- return;
- }
-
-
- my $cmd = [];
- unless (defined $ifAliasCpt{$vlan_if}) {
- $ifAliasCpt{$vlan_if} = 0;
- }
- open STATUS_ALIAS, ">>".$PF_STATUS_DIR."/aliases";
- do {
- print STATUS_ALIAS "$vlan_if:$ifAliasCpt{$vlan_if}\n";
- push @$cmd, "ifconfig $vlan_if:".$ifAliasCpt{$vlan_if} ." ".$ipz->ip();
- $ifAliasCpt{$vlan_if}++;
- $ipz = $ipz->ip_add_num(1);
- } while ($ipz);
-
- __runCmds($cmd,"1") if @$cmd;
- close STATUS_ALIAS;
-
-}
-
-sub __SetDNATs
-{
- my $dnats = shift;
-
- unless ($dnats)
- {
- __Debug("__SetDNATs () appelé sans parametre");
- return;
- }
-
- my $ipt = __GetIptablesTagets();
- unless (defined $ipt->{DNAT})
- {
- __Info("Votre Kernel semble ne pas supporter la tarjet iptables DNAT");
- __Info("J'ignore la clef \@dnat de la section [init]");
- return;
- }
-
- foreach my $dnat (@{$dnats})
- {
- my $dnat_config = Config_Section($configfile,"dnat-$dnat");
- unless ($dnat_config)
- {
- __Err("`$dnat' est dans la section [init] mais n'a pas de [dnat-$dnat],".
- "le dnat $dnat n'est pas initialisé...");
- return;
- }
- unless ($dnat_config->{'original-dest'} && $dnat_config->{'rewrite-dest-to'})
- {
- __Err("La section [dnat-`$dnat'] n'est pas valide, la section doit contenir les clefs original-dest et rewrite-dest-to");
- return;
- }
-
- __Info(" dnat `$dnat' (`".$dnat_config->{'original-dest'}."' -> `".$dnat_config->{'rewrite-dest-to'}."')");
-
- __IptAddChange ("nat","PREROUTING -d ".$dnat_config->{'original-dest'}." -j DNAT --to-destination ".
- $dnat_config->{'rewrite-dest-to'});
- }
-}
-
-sub __SetMasqueradeByVlan
-{
- my $masquerades = shift;
-
- unless ($masquerades)
- {
- __Debug("__SetMasqueradeByVlan () appelé sans parametre");
- return;
- }
-
- my $ipt = __GetIptablesTagets();
- unless (defined $ipt->{MASQUERADE})
- {
- __Info("Votre Kernel semble ne pas supporter la tarjet iptables MASQUERADE");
- __Info("J'ignore la clef \@masquerade de la section [init]");
- return;
- }
-
- foreach my $masquerade (@{$masquerades})
- {
- my $masquerade_config = Config_Section($configfile,"masquerade-$masquerade");
- unless ($masquerade_config)
- {
- __Err("`$masquerade' est dans la section [init] mais n'a pas de [masquerade-$masquerade],".
- "le masquerade $masquerade n'est pas initialisé...");
- return;
- }
- unless ($masquerade_config->{from})
- {
- __Err("La section [masquerade-`$masquerade'] n'est pas valide, la section doit contenir une clef from et if_out");
- return;
- }
-
- __Info(" masquerade `$masquerade' (`".$masquerade_config->{if_out}."' / `".$masquerade_config->{from}."')");
-
- __IptAddChange ("nat","POSTROUTING -o ".$masquerade_config->{if_out}." -s ".$masquerade_config->{from}." -j MASQUERADE");
- }
+ __Info(
+ "`$vlan' : Les clef alias_begin et alias_end ne sont plus utilisées,"
+ . "vous avez juste a mettre alias=true" );
+ }
+
+ return
+ unless ( defined( Config_Key( $configfile, $vlan, "alias" ) )
+ and Config_Key( $configfile, $vlan, "alias" ) eq 'true' );
+
+# On va essayer de calculer les alias_begin/alias_end en fonction du netmask
+# du netmap de ce VLAN. Si pas de netmap défini, on cherche dans private-network.
+ my $nm = Config_Key( $configfile, $vlan, 'netmap' );
+
+ unless ($nm) {
+ __Info(
+ "Pas de variable netmap pour `$vlan', je cherche dans private-network"
+ );
+ my $vlan_setup = __GetVLanSetup($vlan);
+ unless ( $vlan_setup->{network} and $vlan_setup->{netmask} ) {
+ __Err(
+ "Pas assez d'information (network et netmask) dans private-network pour le vlan '$vlan'"
+ );
+ return;
+ }
+ my ( $ip, $cidr )
+ = ipv4_parse( $vlan_setup->{network}, $vlan_setup->{netmask} );
+ $nm = "$ip/$cidr"; # Et voilà !
+ }
+
+ my $netmap = new Net::IP($nm) || die "$?";
+ unless ($netmap) {
+ __Err("`$nm' n'est pas une adresse réseau valide");
+ return;
+ }
+
+ my $ipz = new Net::IP( $netmap->ip . " - " . $netmap->last_ip );
+ unless ($ipz) {
+ __Err( "Je n'arrive pas a trouver les ip entre "
+ . $netmap->ip . " et "
+ . $netmap->last_ip );
+ return;
+ }
+
+ my $cmd = [];
+ unless ( defined $ifAliasCpt{$vlan_if} ) {
+ $ifAliasCpt{$vlan_if} = 0;
+ }
+ open STATUS_ALIAS, ">>" . $PF_STATUS_DIR . "/aliases";
+ do {
+ print STATUS_ALIAS "$vlan_if:$ifAliasCpt{$vlan_if}\n";
+ push @$cmd,
+ "ifconfig $vlan_if:" . $ifAliasCpt{$vlan_if} . " " . $ipz->ip();
+ $ifAliasCpt{$vlan_if}++;
+ $ipz = $ipz->ip_add_num(1);
+ } while ($ipz);
+
+ __runCmds( $cmd, "1" ) if @$cmd;
+ close STATUS_ALIAS;
+
+}
+
+sub __SetDNATs {
+ my $dnats = shift;
+
+ unless ($dnats) {
+ __Debug("__SetDNATs () appelé sans parametre");
+ return;
+ }
+
+ my $ipt = __GetIptablesTagets();
+ unless ( defined $ipt->{DNAT} ) {
+ __Info(
+ "Votre Kernel semble ne pas supporter la tarjet iptables DNAT");
+ __Info("J'ignore la clef \@dnat de la section [init]");
+ return;
+ }
+
+ foreach my $dnat ( @{$dnats} ) {
+ my $dnat_config = Config_Section( $configfile, "dnat-$dnat" );
+ unless ($dnat_config) {
+ __Err(
+ "`$dnat' est dans la section [init] mais n'a pas de [dnat-$dnat],"
+ . "le dnat $dnat n'est pas initialisé..." );
+ return;
+ }
+ unless ( $dnat_config->{'original-dest'}
+ && $dnat_config->{'rewrite-dest-to'} )
+ {
+ __Err(
+ "La section [dnat-`$dnat'] n'est pas valide, la section doit contenir les clefs original-dest et rewrite-dest-to"
+ );
+ return;
+ }
+
+ __Info( " dnat `$dnat' (`"
+ . $dnat_config->{'original-dest'}
+ . "' -> `"
+ . $dnat_config->{'rewrite-dest-to'}
+ . "')" );
+
+ __IptAddChange( "nat",
+ "PREROUTING -d "
+ . $dnat_config->{'original-dest'}
+ . " -j DNAT --to-destination "
+ . $dnat_config->{'rewrite-dest-to'} );
+ }
+}
+
+sub __SetMasqueradeByVlan {
+ my $masquerades = shift;
+
+ unless ($masquerades) {
+ __Debug("__SetMasqueradeByVlan () appelé sans parametre");
+ return;
+ }
+
+ my $ipt = __GetIptablesTagets();
+ unless ( defined $ipt->{MASQUERADE} ) {
+ __Info(
+ "Votre Kernel semble ne pas supporter la tarjet iptables MASQUERADE"
+ );
+ __Info("J'ignore la clef \@masquerade de la section [init]");
+ return;
+ }
+
+ foreach my $masquerade ( @{$masquerades} ) {
+ my $masquerade_config
+ = Config_Section( $configfile, "masquerade-$masquerade" );
+ unless ($masquerade_config) {
+ __Err(
+ "`$masquerade' est dans la section [init] mais n'a pas de [masquerade-$masquerade],"
+ . "le masquerade $masquerade n'est pas initialisé..." );
+ return;
+ }
+ unless ( $masquerade_config->{from} ) {
+ __Err(
+ "La section [masquerade-`$masquerade'] n'est pas valide, la section doit contenir une clef from et if_out"
+ );
+ return;
+ }
+
+ __Info( " masquerade `$masquerade' (`"
+ . $masquerade_config->{if_out} . "' / `"
+ . $masquerade_config->{from}
+ . "')" );
+
+ __IptAddChange( "nat",
+ "POSTROUTING -o "
+ . $masquerade_config->{if_out} . " -s "
+ . $masquerade_config->{from}
+ . " -j MASQUERADE" );
+ }
}
# Test si une route existe déjà pour un reseau
# oui = 1
# non = undef
-sub __RouteExiste($)
-{
- return unless @_;
- my $procf = "/proc/net/route";
-
- my $p = join ('.',reverse split (/\./,shift));
-
- my $ip = new Net::IP ($p) or __Fault (Net::IP::Error());
-
-
- my $hex = sprintf("%x",$ip->intip());
-
-
- if (open RT, "<".$procf) {
- my @r = <RT>;
- close RT or __Err ("Can't close `$procf'");
- shift @r;
- foreach (@r) {
- if (/^\S+\s+0+(\S+)/) {
- return 1 if (lc($1) eq lc($hex));
- }
- }
- } else {
- __Err ( "Can't open `$procf'" );
- }
- return;
-}
-
-
+sub __RouteExiste($) {
+ return unless @_;
+ my $procf = "/proc/net/route";
+
+ my $p = join( '.', reverse split( /\./, shift ) );
+
+ my $ip = new Net::IP($p) or __Fault( Net::IP::Error() );
+
+ my $hex = sprintf( "%x", $ip->intip() );
+
+ if ( open RT, "<" . $procf ) {
+ my @r = <RT>;
+ close RT or __Err("Can't close `$procf'");
+ shift @r;
+ foreach (@r) {
+ if (/^\S+\s+0+(\S+)/) {
+ return 1 if ( lc($1) eq lc($hex) );
+ }
+ }
+ }
+ else {
+ __Err("Can't open `$procf'");
+ }
+ return;
+}
# Cree les routes si il y a lieu de le faire
sub __RoutesInit {
-# my @net = ();
- my $routes;
-
- foreach my $vlan (@{__GetVLanList()}) {
- my $gws = Config_Key($configfile,"$vlan","gateway");
- $gws = Config_Key($configfile,"vlan-default","gateway") unless $gws;
-
- my $vs = __GetVLanSetup ($vlan);
- unless ($vs->{network} and $vs->{netmask}) {
- __Fault("Je ne trouve pas assez d'information pour le vlan `$vlan'".
- "network = `".$vs->{network}."'".
- "netmask = `".$vs->{netmask}."'");
- next;
- }
- next if (__RouteExiste ($vs->{network}));
- my $dest = "";
- if (defined $gws and $gws) {
- if ($gws =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) {
- $dest = "gateway ".$gws; # une IP a ete rentré
- } else {
- $dest = "gateway ".__GetVMip ($gws,$vlan);
- }
- } elsif (defined ($vs->{tag}) and ($vs->{tag})) {
- $dest = "dev br".$vs->{tag};
- } else {
- __Debug ("Je n'ai pas de sortie pour `$vlan'");
- next;
- }
-
- $routes->{"-net $vs->{network} netmask $vs->{netmask} $dest"} = 1;
- }
- __Debug($_) foreach (`route`);
- if (open (STATUS_ROUTE, ">>".$PF_STATUS_DIR."/route")) {
- foreach my $r (keys %$routes) {
- if (__runCmds("route add ".$r)) {
- print STATUS_ROUTE $r."\n";
- }
- }
- } else {
- __Fault("Can't open ".$PF_STATUS_DIR."/route");
- }
- close STATUS_ROUTE or __Err("Je n'arrive pas a fermer STATUS_ROUTE");
-}
-
-
-sub __RoutesFlush
-{
-
- return unless (-r $PF_STATUS_DIR."/route");
-
- open STATUS_ROUTE, "<".$PF_STATUS_DIR."/route";
-
- my $cmds;
- foreach (<STATUS_ROUTE>)
- {
- chomp;
- push @$cmds, "route del $_";
- }
-
- __runCmds ($cmds,"stfu");
- close STATUS_ROUTE;
- unlink $PF_STATUS_DIR."/route";
-
-}
-
-
-
-sub __AliasFlush
-{
-
- return unless (-r $PF_STATUS_DIR."/aliases");
-
- open STATUS_ALIAS, "<".$PF_STATUS_DIR."/aliases";
-
- my $cmds;
- foreach my $if (<STATUS_ALIAS>)
- {
- chomp $if;
- push @$cmds, "ifconfig $if down" if $if;
- }
-
- __runCmds ($cmds,"stfu");
- close STATUS_ALIAS;
- unlink $PF_STATUS_DIR."/aliases";
-}
-
-
+ # my @net = ();
+ my $routes;
+
+ foreach my $vlan ( @{ __GetVLanList() } ) {
+ my $gws = Config_Key( $configfile, "$vlan", "gateway" );
+ $gws = Config_Key( $configfile, "vlan-default", "gateway" )
+ unless $gws;
+
+ my $vs = __GetVLanSetup($vlan);
+ unless ( $vs->{network} and $vs->{netmask} ) {
+ __Fault(
+ "Je ne trouve pas assez d'information pour le vlan `$vlan'"
+ . "network = `"
+ . $vs->{network} . "'"
+ . "netmask = `"
+ . $vs->{netmask}
+ . "'" );
+ next;
+ }
+ next if ( __RouteExiste( $vs->{network} ) );
+ my $dest = "";
+ if ( defined $gws and $gws ) {
+ if ( $gws =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ ) {
+ $dest = "gateway " . $gws; # une IP a ete rentré
+ }
+ else {
+ $dest = "gateway " . __GetVMip( $gws, $vlan );
+ }
+ }
+ elsif ( defined( $vs->{tag} ) and ( $vs->{tag} ) ) {
+ $dest = "dev br" . $vs->{tag};
+ }
+ else {
+ __Debug("Je n'ai pas de sortie pour `$vlan'");
+ next;
+ }
+
+ $routes->{"-net $vs->{network} netmask $vs->{netmask} $dest"} = 1;
+ }
+ __Debug($_) foreach (`route`);
+ if ( open( STATUS_ROUTE, ">>" . $PF_STATUS_DIR . "/route" ) ) {
+ foreach my $r ( keys %$routes ) {
+ if ( __runCmds( "route add " . $r ) ) {
+ print STATUS_ROUTE $r . "\n";
+ }
+ }
+ }
+ else {
+ __Fault( "Can't open " . $PF_STATUS_DIR . "/route" );
+ }
+ close STATUS_ROUTE or __Err("Je n'arrive pas a fermer STATUS_ROUTE");
+}
+
+sub __RoutesFlush {
+
+ return unless ( -r $PF_STATUS_DIR . "/route" );
+
+ open STATUS_ROUTE, "<" . $PF_STATUS_DIR . "/route";
+
+ my $cmds;
+ foreach (<STATUS_ROUTE>) {
+ chomp;
+ push @$cmds, "route del $_";
+ }
+
+ __runCmds( $cmds, "stfu" );
+ close STATUS_ROUTE;
+ unlink $PF_STATUS_DIR . "/route";
+
+}
+
+sub __AliasFlush {
+
+ return unless ( -r $PF_STATUS_DIR . "/aliases" );
+
+ open STATUS_ALIAS, "<" . $PF_STATUS_DIR . "/aliases";
+
+ my $cmds;
+ foreach my $if (<STATUS_ALIAS>) {
+ chomp $if;
+ push @$cmds, "ifconfig $if down" if $if;
+ }
+
+ __runCmds( $cmds, "stfu" );
+ close STATUS_ALIAS;
+ unlink $PF_STATUS_DIR . "/aliases";
+}
# Retourne la branche CVS sur laquelle on marche en fonction du paramètre
# passé ou du contenu de /var/lib/pf-tools/branche
-sub __GetBrancheCVS
-{
- my $vm = shift;
-
- # 1/ Le fichier de config
- if ($vm)
- {
- my $branche = Config_Key($configfile, "uml-$vm", "branche");
- return $branche if $branche;
- }
-
- # 2/ le paramètre de la ligne de commande
- return $options->{branchecvs}
- if $options->{branchecvs};
-
- # 3/ Le contenu de $PF_STATUS_DIR/branche
- if (-r $PF_STATUS_DIR."/branche")
- {
- if (open STATUSBRANCHE, "<$PF_STATUS_DIR"."/branche")
- {
- my @STATUSBRANCHE = <STATUSBRANCHE>;
- close STATUSBRANCHE;
- return shift @STATUSBRANCHE;
- }
- else
- {
- __Err("je n'arrive pas a ouvrir ".$PF_STATUS_DIR."/branche");
- }
-
- }
-
- # If all else failed ...
- return undef; # 'HEAD'
-}
-
-
-sub __UpdateConfig
-{
- if ($cvsupdated or $options->{nocvsupdate})
- {
- __Debug("Pas d'update du CVS");
-
- }
- else
- {
-
- my $pflaunchcfg;
- my $privatenetworkcfg;
- my $runningbranche;
- my $branchecvs = __GetBrancheCVS();
-
- __Info("Getting config from CVS");
- __Info(" branche CVS `".$branchecvs."'") if ($branchecvs);
-
- CVS_update($branchecvs, $options);
- $cvsupdated = 1;
-
- # J'enregistre la branche utilisée pour la prochaine utilisation
- SaveRunningBrancheName($branchecvs) if $branchecvs;
-
- unless (-r $configfile)
- {
- __Fault("Je n'arrive pas a lire $configfile, vérifiez votre installation");
- }
- unless (-r $privatenetwork)
- {
- __Fault("Je n'arrive pas a lire $privatenetwork, vérifiez votre installation");
- }
- }
+sub __GetBrancheCVS {
+ my $vm = shift;
+
+ # 1/ Le fichier de config
+ if ($vm) {
+ my $branche = Config_Key( $configfile, "uml-$vm", "branche" );
+ return $branche if $branche;
+ }
+
+ # 2/ le paramètre de la ligne de commande
+ return $options->{branchecvs}
+ if $options->{branchecvs};
+
+ # 3/ Le contenu de $PF_STATUS_DIR/branche
+ if ( -r $PF_STATUS_DIR . "/branche" ) {
+ if ( open STATUSBRANCHE, "<$PF_STATUS_DIR" . "/branche" ) {
+ my @STATUSBRANCHE = <STATUSBRANCHE>;
+ close STATUSBRANCHE;
+ return shift @STATUSBRANCHE;
+ }
+ else {
+ __Err(
+ "je n'arrive pas a ouvrir " . $PF_STATUS_DIR . "/branche" );
+ }
+
+ }
+
+ # If all else failed ...
+ return undef; # 'HEAD'
+}
+
+sub __UpdateConfig {
+ if ( $cvsupdated or $options->{nocvsupdate} ) {
+ __Debug("Pas d'update du CVS");
+
+ }
+ else {
+
+ my $pflaunchcfg;
+ my $privatenetworkcfg;
+ my $runningbranche;
+ my $branchecvs = __GetBrancheCVS();
+
+ __Info("Getting config from CVS");
+ __Info( " branche CVS `" . $branchecvs . "'" ) if ($branchecvs);
+
+ CVS_update( $branchecvs, $options );
+ $cvsupdated = 1;
+
+ # J'enregistre la branche utilisée pour la prochaine utilisation
+ SaveRunningBrancheName($branchecvs) if $branchecvs;
+
+ unless ( -r $configfile ) {
+ __Fault(
+ "Je n'arrive pas a lire $configfile, vérifiez votre installation"
+ );
+ }
+ unless ( -r $privatenetwork ) {
+ __Fault(
+ "Je n'arrive pas a lire $privatenetwork, vérifiez votre installation"
+ );
+ }
+ }
}
# Active le lock, et fait mourrir plfaunch si
# il y a un pflaunch déjà tournant
-sub __GetLock
-{
-
- return unless (-f $PF_STATUS_DIR . "/lock");
- open (LOCK, "<". $PF_STATUS_DIR . "/lock") or __Fault("Can't open lock file $!");
- my $pid = <LOCK>;
- close LOCK;
-
- return unless $pid;
-
-
- if ( __PidRunning($pid) )
- {
- __Fault("Vous avez provablement un plfaunch ".
- " déjà lancé, si ne n'est pas la cas effacé ".
- "le fichier de lock ".$PF_STATUS_DIR . "/lock");
- }
- else
- {
-
- unlink $PF_STATUS_DIR . "/lock";
-
- }
-}
-
-sub __SetLock
-{
-
- open (LOCK, ">". $PF_STATUS_DIR . "/lock") or __Fault("Can't open lock file $!");
- print LOCK $$;
- close LOCK;
-
-}
-
-sub __RemoveLock
-{
-
- unlink ($PF_STATUS_DIR . "/lock") or __Err("Can't remove lock file : ".$PF_STATUS_DIR . "/lock");
+sub __GetLock {
+
+ return unless ( -f $PF_STATUS_DIR . "/lock" );
+ open( LOCK, "<" . $PF_STATUS_DIR . "/lock" )
+ or __Fault("Can't open lock file $!");
+ my $pid = <LOCK>;
+ close LOCK;
+
+ return unless $pid;
+
+ if ( __PidRunning($pid) ) {
+ __Fault( "Vous avez provablement un plfaunch "
+ . " déjà lancé, si ne n'est pas la cas effacé "
+ . "le fichier de lock "
+ . $PF_STATUS_DIR
+ . "/lock" );
+ }
+ else {
+
+ unlink $PF_STATUS_DIR . "/lock";
+
+ }
+}
+
+sub __SetLock {
+
+ open( LOCK, ">" . $PF_STATUS_DIR . "/lock" )
+ or __Fault("Can't open lock file $!");
+ print LOCK $$;
+ close LOCK;
+
+}
+
+sub __RemoveLock {
+
+ unlink( $PF_STATUS_DIR . "/lock" )
+ or __Err( "Can't remove lock file : " . $PF_STATUS_DIR . "/lock" );
}
# utilisé pour déterminer si l'on doit faire des la places avant
# de lancer une vm
-sub __GetDiskSpaceLeft
-{
- my $path = shift;
- $path = "/" unless $path;
- my @dfr = `/bin/df -P $path`;
-
- if ($?)
- {
- __Err("df failed");
- return;
- }
-
- my @dfs = split /\ +/,$dfr[1];
- unless ($dfs[3])
- {
- __Err("__GetDiskSpaceLeft:je n'arrive pas trouver l'espace disque...");
- return 0;
- }
- return int $dfs[3]/1024;
-
-}
-
-sub __PrintTime
-{
- my ($s, $m, $h, $j, $mois, $y)= localtime(time);
- $s = "0$s" if ($s < 10);
- $m = "0$m" if ($m < 10);
- $mois += 1;
- $y += 1900;
- return "le $j/$mois/$y à $h:$m:$s";
-}
-
-sub __Fault
-{
- foreach (@_)
- {
- __Print("FAULT>".$_,1);
- }
- exit 1;
-}
-
-sub __Err
-{
- return unless @_;
- foreach (@_)
- {
- __Print("ERROR>".$_,1);
- }
-}
-
-sub __Debug
-{
- return unless ($options->{debug});
- return unless @_;
- foreach (@_)
- {
- __Print("DEBUG>".$_,$options->{debug});
- }
-}
-
-sub __Info
-{
- return unless @_;
- foreach (@_)
- {
- __Print(" INFO>".$_,$options->{verbose});
- }
+sub __GetDiskSpaceLeft {
+ my $path = shift;
+ $path = "/" unless $path;
+ my @dfr = `/bin/df -P $path`;
+
+ if ($?) {
+ __Err("df failed");
+ return;
+ }
+
+ my @dfs = split /\ +/, $dfr[1];
+ unless ( $dfs[3] ) {
+ __Err(
+ "__GetDiskSpaceLeft:je n'arrive pas trouver l'espace disque...");
+ return 0;
+ }
+ return int $dfs[3] / 1024;
+
+}
+
+sub __PrintTime {
+ my ( $s, $m, $h, $j, $mois, $y ) = localtime(time);
+ $s = "0$s" if ( $s < 10 );
+ $m = "0$m" if ( $m < 10 );
+ $mois += 1;
+ $y += 1900;
+ return "le $j/$mois/$y à $h:$m:$s";
+}
+
+sub __Fault {
+ foreach (@_) {
+ __Print( "FAULT>" . $_, 1 );
+ }
+ exit 1;
+}
+
+sub __Err {
+ return unless @_;
+ foreach (@_) {
+ __Print( "ERROR>" . $_, 1 );
+ }
+}
+
+sub __Debug {
+ return unless ( $options->{debug} );
+ return unless @_;
+ foreach (@_) {
+ __Print( "DEBUG>" . $_, $options->{debug} );
+ }
+}
+
+sub __Info {
+ return unless @_;
+ foreach (@_) {
+ __Print( " INFO>" . $_, $options->{verbose} );
+ }
}
# Parametre :
# string
# print, si vrais, alors les msgs sont affichés a l'écran
-sub __Print
-{
- my ($str, $p) = @_;
- return unless $str;
- $str .="\n" unless ($str =~ /\n$/);
-
-
- print $str if ($p);
-
- if ($logfile)
- {
- if (open (LOG, ">>$logfile"))
+sub __Print {
+ my ( $str, $p ) = @_;
+ return unless $str;
+ $str .= "\n" unless ( $str =~ /\n$/ );
+
+ print $str if ($p);
+
+ if ($logfile) {
+ if ( open( LOG, ">>$logfile" ) ) {
+ print LOG $str;
+ close LOG;
+ }
+ else {
+ print STDERR "Can't open log file : `$logfile'\n";
+ }
+ }
+}
+
+# Enregistre les changements fait par iptables pour pouvoir les effacer plus facilement
+sub __IptAddChange ($$) {
+ return unless @_;
+ my ( $table, $change ) = @_;
+
+ return unless ( defined $table and $table );
+ return unless ( defined $change and $change );
+
+ unless ( $table =~ /^nat$/ ) # filter, mangle
{
- print LOG $str;
- close LOG;
- }
- else
- {
- print STDERR "Can't open log file : `$logfile'\n";
- }
- }
-}
-
-# Enregistre les changements fait par iptables pour pouvoir les effacer plus facilement
-sub __IptAddChange ($$)
-{
- return unless @_;
- my ($table, $change) = @_;
-
- return unless (defined $table and $table);
- return unless (defined $change and $change);
-
- unless ($table =~ /^nat$/) # filter, mangle
- {
- __Err ("Table invalide");
- return;
- }
-
- return unless __runCmds("iptables -t $table -A ".$change);
-
-
- if (!(open STATUS_IPT, ">>".$PF_STATUS_DIR."/ipt_".$table))
- {
- __Err("Can't record iptables rules changes");
- return;
- }
- else
- {
- __Debug("Enregistrement d'une regle iptables (nat)");
- print STATUS_IPT $change."\n";
- if (!close STATUS_IPT)
- {
- __Err ("Can't close STATUS_IPT");
- return;
- }
- }
- return 1;
-}
-
-sub __IptCleanChange ()
-{
- foreach my $table ("nat","mangle")
- {
- my $file = $PF_STATUS_DIR."/ipt_".$table;
- next unless (-f $file);
- if (!(open STATUS_IPT, "<".$file))
- {
- __Err("Can't open ".$file);
- next;
- }
- else
- {
- __Debug("Suppression des regles iptables ajoutes par pflaunch : ($table)");
- __runCmds("iptables -t $table -D ".$_) foreach (<STATUS_IPT>);
- close STATUS_IPT;
- if (!unlink($file))
- {
- __Err("Je ne peux pas effacer $file");
- return;
- }
- }
- }
- return 1;
-}
-
+ __Err("Table invalide");
+ return;
+ }
+
+ return unless __runCmds( "iptables -t $table -A " . $change );
+
+ if ( !( open STATUS_IPT, ">>" . $PF_STATUS_DIR . "/ipt_" . $table ) ) {
+ __Err("Can't record iptables rules changes");
+ return;
+ }
+ else {
+ __Debug("Enregistrement d'une regle iptables (nat)");
+ print STATUS_IPT $change . "\n";
+ if ( !close STATUS_IPT ) {
+ __Err("Can't close STATUS_IPT");
+ return;
+ }
+ }
+ return 1;
+}
+
+sub __IptCleanChange () {
+ foreach my $table ( "nat", "mangle" ) {
+ my $file = $PF_STATUS_DIR . "/ipt_" . $table;
+ next unless ( -f $file );
+ if ( !( open STATUS_IPT, "<" . $file ) ) {
+ __Err( "Can't open " . $file );
+ next;
+ }
+ else {
+ __Debug(
+ "Suppression des regles iptables ajoutes par pflaunch : ($table)"
+ );
+ __runCmds( "iptables -t $table -D " . $_ ) foreach (<STATUS_IPT>);
+ close STATUS_IPT;
+ if ( !unlink($file) ) {
+ __Err("Je ne peux pas effacer $file");
+ return;
+ }
+ }
+ }
+ return 1;
+}
#############################################################
#############################################################
@@ -1767,236 +1691,226 @@
#############################################################
#############################################################
-
my $main = {};
-$main->{start_nets} = sub ()
-{
-
- __UpdateConfig();
-
- __Info ("Starting Network...");
-
- `modprobe ipt_NETMAP 2>&1`;`modprobe ipt_MASQUERADE 2>&1`;
- ### Reglage de /proc/sys/net/ipv4/ip_forward
- my $forward = ( defined (Config_Key($configfile,"global","router")) and
- Config_Key($configfile,"global","router") =~ "true" )?
- 1 : 0;
- __Debug(" /proc/sys/net/ipv4/ip_forward = $forward");
- open IP_FORWARD,">/proc/sys/net/ipv4/ip_forward" or __Err("Can't open /proc/sys/net/ipv4/ip_forward (w mode)");
- print IP_FORWARD $forward;
- close IP_FORWARD;
-
- # peut-être aussi bridge-nf-call-arptables et bridge-nf-call-ip6tables ?
- foreach my $procfile (map { "/proc/sys/net/bridge/$_" } qw'bridge-nf-call-iptables bridge-nf-filter-vlan-tagged') {
- if (-f $procfile) {
- __Debug(" $procfile = 0");
- open (EBTABLE, "> $procfile") or __Err("Can't open $procfile for writing: $!");
- print EBTABLE 0;
- close (EBTABLE) or __Fault("Can't close $procfile after writing: $!");
- }
+$main->{start_nets} = sub () {
+
+ __UpdateConfig();
+
+ __Info("Starting Network...");
+
+ `modprobe ipt_NETMAP 2>&1`;
+ `modprobe ipt_MASQUERADE 2>&1`;
+ ### Reglage de /proc/sys/net/ipv4/ip_forward
+ my $forward
+ = ( defined( Config_Key( $configfile, "global", "router" ) )
+ and Config_Key( $configfile, "global", "router" ) =~ "true" )
+ ? 1
+ : 0;
+ __Debug(" /proc/sys/net/ipv4/ip_forward = $forward");
+ open IP_FORWARD, ">/proc/sys/net/ipv4/ip_forward"
+ or __Err("Can't open /proc/sys/net/ipv4/ip_forward (w mode)");
+ print IP_FORWARD $forward;
+ close IP_FORWARD;
+
+ # peut-être aussi bridge-nf-call-arptables et bridge-nf-call-ip6tables ?
+ foreach my $procfile ( map {"/proc/sys/net/bridge/$_"}
+ qw'bridge-nf-call-iptables bridge-nf-filter-vlan-tagged' )
+ {
+ if ( -f $procfile ) {
+ __Debug(" $procfile = 0");
+ open( EBTABLE, "> $procfile" )
+ or __Err("Can't open $procfile for writing: $!");
+ print EBTABLE 0;
+ close(EBTABLE)
+ or __Fault("Can't close $procfile after writing: $!");
+ }
+
# else {
- # Ces machins n'existent pas en 2.4
+# Ces machins n'existent pas en 2.4
# __Debug(" $procfile n'existe pas, donc pas besoin de le désactiver.");
# }
- }
-
-# my $listbrup = __GetListBridgeUp();
- foreach my $lan (@{__GetVLanList()})
- {
- __BridgeAdd ($lan);
- __BridgeSetAddr($lan);
- }
-
-
- __Info(" setting netmap rules and alias...");
- foreach my $vlan (@{__GetVLanList()})
- {
- __Info (" $vlan");
- __SetNetmapByVlan ($vlan);
- __SetAliasByVlan ($vlan);
- }
-
- # On fait les routes après les alias pour faciliter les bidouilles double-adressage
- __Info(" setting routes...");
- __RoutesInit();
-
- __Info(" setting masquerading rules...");
- my $masquerades = Config_Key($configfile, 'init', '@masquerade');
- __SetMasqueradeByVlan ($masquerades) if $masquerades;
-
- __Info(" setting dnat rules...");
- my $dnat = Config_Key($configfile, 'init', '@dnat');
- __SetDNATs ($dnat) if $dnat;
+ }
+
+ # my $listbrup = __GetListBridgeUp();
+ foreach my $lan ( @{ __GetVLanList() } ) {
+ __BridgeAdd($lan);
+ __BridgeSetAddr($lan);
+ }
+
+ __Info(" setting netmap rules and alias...");
+ foreach my $vlan ( @{ __GetVLanList() } ) {
+ __Info(" $vlan");
+ __SetNetmapByVlan($vlan);
+ __SetAliasByVlan($vlan);
+ }
+
+# On fait les routes après les alias pour faciliter les bidouilles double-adressage
+ __Info(" setting routes...");
+ __RoutesInit();
+
+ __Info(" setting masquerading rules...");
+ my $masquerades = Config_Key( $configfile, 'init', '@masquerade' );
+ __SetMasqueradeByVlan($masquerades) if $masquerades;
+
+ __Info(" setting dnat rules...");
+ my $dnat = Config_Key( $configfile, 'init', '@dnat' );
+ __SetDNATs($dnat) if $dnat;
};
-
-$main->{start_umls} = sub ()
-{
- __UpdateConfig();
- __Info("Starting umls...");
- __Umlaunch(__GetUMLtoLaunch());
+$main->{start_umls} = sub () {
+ __UpdateConfig();
+ __Info("Starting umls...");
+ __Umlaunch( __GetUMLtoLaunch() );
};
-
-$main->{start} = sub ()
-{
- $main->{start_nets}();
- $main->{start_umls}();
+$main->{start} = sub () {
+ $main->{start_nets}();
+ $main->{start_umls}();
};
-
-$main->{stop_umls} = sub ()
-{
- __UpdateConfig(); # TODO, Eviter l'updateconfig avant un arrete...
- # continuer l'enregistrement de toutes les modifs faite
- # dans /var/lib/pflaunch et partir de la pour savoir quoi
- # arreter
- __Info("Halting UMLs...");
- __Umlshalt(__GetUMLtoLaunch());
+$main->{stop_umls} = sub () {
+ __UpdateConfig(); # TODO, Eviter l'updateconfig avant un arrete...
+ # continuer l'enregistrement de toutes les modifs faite
+ # dans /var/lib/pflaunch et partir de la pour savoir quoi
+ # arreter
+ __Info("Halting UMLs...");
+ __Umlshalt( __GetUMLtoLaunch() );
};
-
-$main->{stop_nets} = sub ()
-{
- __UpdateConfig();
- # Arrête les bridges définis dans la cfg et qui sont lancés (__GetListBridgeUp)
-
- my $listbrup = __GetListBridgeUp();
-
- __Info(" Flushing route...");
- __RoutesFlush();
-
- __Info(" Halting Bridges...");
-
- foreach my $brname (@$listbrup)
- {
- __BridgeDel ($brname);
- }
-
- __Info(" Flushing iptables rules...");
- &__IptCleanChange();
- __Info(" Flushing Aliases...\n");
- &__AliasFlush();
-
- __Info(" Arrêt des interfaces");
-
- foreach (@{__GetVLanList()})
- {
- my $vs = __GetVLanSetup ($_);
- __runCmds (["ifconfig $_.".$vs->{tag}." down"],1) foreach (@{__GetIfByVlan($_)});
- }
-
- unlink $PF_STATUS_DIR."/ifbr";
+$main->{stop_nets} = sub () {
+ __UpdateConfig();
+
+# Arrête les bridges définis dans la cfg et qui sont lancés (__GetListBridgeUp)
+
+ my $listbrup = __GetListBridgeUp();
+
+ __Info(" Flushing route...");
+ __RoutesFlush();
+
+ __Info(" Halting Bridges...");
+
+ foreach my $brname (@$listbrup) {
+ __BridgeDel($brname);
+ }
+
+ __Info(" Flushing iptables rules...");
+ &__IptCleanChange();
+ __Info(" Flushing Aliases...\n");
+ &__AliasFlush();
+
+ __Info(" Arrêt des interfaces");
+
+ foreach ( @{ __GetVLanList() } ) {
+ my $vs = __GetVLanSetup($_);
+ __runCmds( [ "ifconfig $_." . $vs->{tag} . " down" ], 1 )
+ foreach ( @{ __GetIfByVlan($_) } );
+ }
+
+ unlink $PF_STATUS_DIR . "/ifbr";
};
-
-$main->{stop} = sub ()
-{
- $main->{stop_umls}();
- $main->{stop_nets}();
+$main->{stop} = sub () {
+ $main->{stop_umls}();
+ $main->{stop_nets}();
};
-
-$main->{restart} = sub ()
-{
- $main->{stop}();
- $main->{start}();
+$main->{restart} = sub () {
+ $main->{stop}();
+ $main->{start}();
};
-
-$main->{restart_nets} = sub ()
-{
- $main->{stop_nets}();
- $main->{start_nets}();
+$main->{restart_nets} = sub () {
+ $main->{stop_nets}();
+ $main->{start_nets}();
};
-
-sub __usage
-{
- print "Usage : flags commande\n";
- print "\n";
- print "Commande\n";
- print " * start : Lance tous\n";
- print " * start_nets : Lance les bridges\n";
- print " * start_umls : Lance les UMLs\n";
- print " * stop : Arrete tous\n";
- print " * stop_nets : Arrete les bridges\n";
- print " * stop_umls : Arrete les UMLs\n";
- print " * restart : restart\n";
- print " * restart_nets : restart bridges\n";
- print "\n";
- print "Flags\n";
- print " * -h --help : Aide\n";
- print " * -v --verbose : Bavard...\n";
- print " * -d --debug : Debug...\n";
- print " * -f --fork : Fork\n";
-# print " * -l --log : log dans /var/log/pflaunch (verbose par défaut)\n";
- print " * --nocvsupdate : pas d'update CVS lors du lancement d'une commande\n";
- print " * --branche-cvs=BRANCHE : Possiblité de forcer une branche CVS\n";
- print " * --dontcheckdf : Ne controle pas l'espace dispo avant de créer un disque\n";
- print "\n";
- print " En cas de probleme ou de souhait, n'hésitez pas a utiliser Bugzilla\n";
- exit;
+sub __usage {
+ print "Usage : flags commande\n";
+ print "\n";
+ print "Commande\n";
+ print " * start : Lance tous\n";
+ print " * start_nets : Lance les bridges\n";
+ print " * start_umls : Lance les UMLs\n";
+ print " * stop : Arrete tous\n";
+ print " * stop_nets : Arrete les bridges\n";
+ print " * stop_umls : Arrete les UMLs\n";
+ print " * restart : restart\n";
+ print " * restart_nets : restart bridges\n";
+ print "\n";
+ print "Flags\n";
+ print " * -h --help : Aide\n";
+ print " * -v --verbose : Bavard...\n";
+ print " * -d --debug : Debug...\n";
+ print " * -f --fork : Fork\n";
+
+ # print " * -l --log : log dans /var/log/pflaunch (verbose par défaut)\n";
+ print
+ " * --nocvsupdate : pas d'update CVS lors du lancement d'une commande\n";
+ print
+ " * --branche-cvs=BRANCHE : Possiblité de forcer une branche CVS\n";
+ print
+ " * --dontcheckdf : Ne controle pas l'espace dispo avant de créer un disque\n";
+ print "\n";
+ print
+ " En cas de probleme ou de souhait, n'hésitez pas a utiliser Bugzilla\n";
+ exit;
}
__usage() unless @ARGV;
# Run baby run !
-my $cmd = $ARGV[@ARGV - 1];
-undef $ARGV[@ARGV - 1];
-
-GetOptions (
- 'help|h' => \$options->{help},
- 'branche-cvs=s' => \$options->{branchecvs},
- 'nocvsupdate' => \$options->{nocvsupdate},
- 'verbose|v' => \$options->{verbose},
- 'debug|d' => \$options->{debug},
- 'fork|f' => \$options->{"fork"},
-# 'log|l' => \$options->{"log"},
- 'dontcheckdf' => \$options->{dontcheckdf},
+my $cmd = $ARGV[ @ARGV - 1 ];
+undef $ARGV[ @ARGV - 1 ];
+
+GetOptions(
+ 'help|h' => \$options->{help},
+ 'branche-cvs=s' => \$options->{branchecvs},
+ 'nocvsupdate' => \$options->{nocvsupdate},
+ 'verbose|v' => \$options->{verbose},
+ 'debug|d' => \$options->{debug},
+ 'fork|f' => \$options->{"fork"},
+
+ # 'log|l' => \$options->{"log"},
+ 'dontcheckdf' => \$options->{dontcheckdf},
);
-
__usage() if $options->{help};
# Tests divers
-if ( $ENV{'USER'} and $ENV{'USER'} ne "root" )
-{
- __Fault("Vous devez lancer ce script en root");
-}
-
+if ( $ENV{'USER'} and $ENV{'USER'} ne "root" ) {
+ __Fault("Vous devez lancer ce script en root");
+}
# Paramètres
$options->{verbose} = 1
-if $options->{debug};
-
-
-if ($options->{nocvsupdate} and $options->{branchecvs})
+ if $options->{debug};
+
+if ( $options->{nocvsupdate} and $options->{branchecvs} ) {
+ __Fault(
+ "Hum Hum, vous demandez une branche CVS précise avec en même temps le "
+ . "flag '--nocvsupdate' !" );
+}
+
+mkdir($PF_STATUS_DIR) unless ( -d $PF_STATUS_DIR );
+mkdir( $PF_STATUS_DIR . "/bridge" ) unless ( -d $PF_STATUS_DIR . "/bridge" );
+__Fault("uml_switch est il lancé ? (Paquage uml-utilities)")
+ unless ( -S $uml_switch_pipe );
+
+# Main !!
+if ( defined $cmd
+ and defined $main->{$cmd}
+ and ( !defined $options->{help} ) )
{
- __Fault("Hum Hum, vous demandez une branche CVS précise avec en même temps le ".
- "flag '--nocvsupdate' !");
-}
-
-
-mkdir ($PF_STATUS_DIR) unless (-d $PF_STATUS_DIR);
-mkdir ($PF_STATUS_DIR."/bridge") unless (-d $PF_STATUS_DIR."/bridge");
-__Fault("uml_switch est il lancé ? (Paquage uml-utilities)") unless ( -S $uml_switch_pipe );
-
-
-# Main !!
-if (defined $cmd and defined $main->{$cmd} and (! defined $options->{help}))
-{
- __Info("\n<------------------->\n".__PrintTime());
- __GetLock();
- __SetLock();
-
- exit () if ($options->{"fork"} and fork());
- $main->{$cmd}();
- __RemoveLock();
-}
-else
-{
- __usage();
-}
+ __Info( "\n<------------------->\n" . __PrintTime() );
+ __GetLock();
+ __SetLock();
+
+ exit() if ( $options->{"fork"} and fork() );
+ $main->{$cmd}();
+ __RemoveLock();
+}
+else {
+ __usage();
+}
Modified: trunk/tools/umlaunch
URL: http://svn.debian.org/wsvn/pf-tools/trunk/tools/umlaunch?rev=539&op=diff
==============================================================================
--- trunk/tools/umlaunch (original)
+++ trunk/tools/umlaunch Mon Aug 27 14:48:03 2007
@@ -4,7 +4,9 @@
# $Name$
#
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+##
+## Copyright (C) 2004-2007 Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
+## Copyright (C) 2003-2005 Damien Clermonte <damien at sitadelle.com>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -26,9 +28,9 @@
use Getopt::Long;
use Socket;
-use PFTools::Conf ;
-use PFTools::Net ;
-use PFTools::Update ;
+use PFTools::Conf;
+use PFTools::Net;
+use PFTools::Update;
$PFTools::Net::UML = 1;
@@ -40,18 +42,18 @@
my $IFNAMSIZ = 16;
-if ( `which vconfig 2>/dev/null` eq ""
- || `which brctl 2>/dev/null` eq ""
+if ( `which vconfig 2>/dev/null` eq ""
+ || `which brctl 2>/dev/null` eq ""
|| `which tunctl 2>/dev/null` eq ""
|| `which screen 2>/dev/null` eq "" )
{
- print STDERR "Sorry, I need vlan, bridge-utils, uml-utilities and screen\n";
+ print STDERR
+ "Sorry, I need vlan, bridge-utils, uml-utilities and screen\n";
exit 1;
}
`ifconfig $ETHTRUNK 2>/dev/null`;
undef $ETHTRUNK if $?;
-
my $options;
$options->{errors} = 1;
@@ -69,8 +71,7 @@
'branche-cvs=s' => \$options->{branchecvs},
'mem|m=s' => \$options->{mem},
'disksize=s' => \$options->{disksize}
- )
- or die "GetOptions error, try --help";
+) or die "GetOptions error, try --help";
if ( $options->{'help'} ) {
print STDERR "Usage: $0 [options] [hostregexp] ...\n";
@@ -80,13 +81,13 @@
print STDERR "\t --wait attendre la fin du deploiement\n";
print STDERR "\t --regex specification des uml par regex\n";
print STDERR
- "\t --no-errors passer a la machine suivante meme en cas d'erreur\n";
- print STDERR
- "\t --branche-cvs permet l'utilisation d'une branche specifique\n";
- print STDERR
- "\t-m --mem=XXX volume de RAM pour l'UML en Mo, défaut ($mem Mo)\n";
- print STDERR
-"\t --disksize=XXX taille de l'image disque en Mo, défaut ($disksize Mo)\n";
+ "\t --no-errors passer a la machine suivante meme en cas d'erreur\n";
+ print STDERR
+ "\t --branche-cvs permet l'utilisation d'une branche specifique\n";
+ print STDERR
+ "\t-m --mem=XXX volume de RAM pour l'UML en Mo, défaut ($mem Mo)\n";
+ print STDERR
+ "\t --disksize=XXX taille de l'image disque en Mo, défaut ($disksize Mo)\n";
exit 1;
}
@@ -96,7 +97,7 @@
}
CVS_update( $options->{branchecvs}, $options )
- && die "Impossible de charger la configuration\n";
+ && die "Impossible de charger la configuration\n";
my $Z = Init_lib_net( Get_source("GLOBAL:private-network") );
@@ -119,7 +120,7 @@
$mem = $options->{mem} if $options->{mem};
$disksize = $options->{disksize} if $options->{disksize};
-print STDERR join ( ' ', @hosts ), "\n";
+print STDERR join( ' ', @hosts ), "\n";
while ( defined( my $host = shift @hosts ) ) {
@@ -128,195 +129,197 @@
my $umlfilename = Get_UM_Filename( $Z, $host );
if ( !defined($umlfilename) ) {
- print STDERR $host . ": no umlfilename\n";
-
- if ( !$options->{'errors'} ) {
- next;
- }
- exit 1;
-
- #$umlfilename = 'linux-uml-elf-2.4.21-gr1.9.11';
+ print STDERR $host . ": no umlfilename\n";
+
+ if ( !$options->{'errors'} ) {
+ next;
+ }
+ exit 1;
+
+ #$umlfilename = 'linux-uml-elf-2.4.21-gr1.9.11';
}
#UMRemap_If( $Z, $host );
my $umif = Get_UM_If( $Z, $host );
- my $initrd = Get_Initrd_Filename($Z, $host);
+ my $initrd = Get_Initrd_Filename( $Z, $host );
my $ramdisk_size = Get_Ramdisk_size_from_Initrd($initrd);
$initrd = "/distrib/tftpboot/$initrd";
- my $disk0 = $ENV{HOME} . "/.uml/" . $host . ".disk0";
+ my $disk0 = $ENV{HOME} . "/.uml/" . $host . ".disk0";
my ( $dhcpif, $dhcpaddr ) = Get_Dhcp_Infos( $Z, $host );
if ($dhcpif) {
- $dhcpif =~ s/:.*$//
- ; # FIX pour vlan-truc sur ethN:M au lieu de ethN (à cause du double adressage)
+ $dhcpif =~ s/:.*$//
+ ; # FIX pour vlan-truc sur ethN:M au lieu de ethN (à cause du double adressage)
}
if ( !-f $disk0 ) {
- print STDERR "Cannot find disk $disk0, creating empty one\n";
- system("mkdir -p -m 750 `dirname $disk0`");
- system("dd if=/dev/zero of=$disk0 seek=$disksize count=0 bs=1M");
+ print STDERR "Cannot find disk $disk0, creating empty one\n";
+ system("mkdir -p -m 750 `dirname $disk0`");
+ system("dd if=/dev/zero of=$disk0 seek=$disksize count=0 bs=1M");
}
my $cmdline;
if ( $options->{'detached'} ) {
- $cmdline = "screen -S $host -d -m ";
+ $cmdline = "screen -S $host -d -m ";
}
else {
- $cmdline = "screen -S $host ";
- }
-
- $cmdline .=
-"/distrib/tftpboot/$umlfilename umid=$host mconsole=notify:$ENV{HOME}/.uml/$host.notify con0=fd:0,fd:1 con=null ssl=null mem="
- . $mem
- . "M fakehd fake_ide ubd=3 root=/dev/ram0 initrd=$initrd ramdisk_size=$ramdisk_size init=/linuxrc ubd0=$disk0";
+ $cmdline = "screen -S $host ";
+ }
+
+ $cmdline
+ .= "/distrib/tftpboot/$umlfilename umid=$host mconsole=notify:$ENV{HOME}/.uml/$host.notify con0=fd:0,fd:1 con=null ssl=null mem="
+ . $mem
+ . "M fakehd fake_ide ubd=3 root=/dev/ram0 initrd=$initrd ramdisk_size=$ramdisk_size init=/linuxrc ubd0=$disk0";
$cmdline .= " pfbcvs=" . $options->{branchecvs}
- if ( $options->{branchecvs} );
-
- my $optcmdline = Get_Cmdline($Z, $host);
+ if ( $options->{branchecvs} );
+
+ my $optcmdline = Get_Cmdline( $Z, $host );
if ($optcmdline) {
$cmdline .= ' ' . $optcmdline;
}
foreach my $nam ( sort { cmpif( $a, $b ) } keys %{$umif} ) {
- my $tapaddr;
- my @tapaddr;
-
- if ( !defined $umif->{$nam} ) {
- next;
- }
-
- print STDERR $nam . " <-> " . $umif->{$nam} . "\n";
-
- my $tag = $umif->{$nam};
- if ( $tag eq 'TRUNK' ) {
- $tag = 0;
- }
-
- if ( `ifconfig br$tag 2>/dev/null` eq "" ) {
- print STDERR "Upping br" . $tag . "...\n";
-
- system( "brctl addbr br" . $tag );
- system( "ifconfig br" . $tag
- . " 169.254."
- . ( $tag >> 8 ) . "."
- . ( $tag & 255 )
- . " netmask 255.255.255.255 mtu "
- . ( ($tag) ? 1496 : 1500 )
- . " promisc up" );
-
- system( "brctl stp br" . $tag . " off" );
- system( "brctl setfd br" . $tag . " 1" );
- system( "brctl sethello br" . $tag . " 1" );
- }
-
- if ( defined $ETHTRUNK and $ETHTRUNK ) {
- system("ifconfig $ETHTRUNK 0.0.0.0 mtu 1500 promisc up");
- if ( $tag != 0 ) {
- if ( `ifconfig $ETHTRUNK.$tag 2>/dev/null` eq "" ) {
- print STDERR "Upping $ETHTRUNK." . $tag . "...\n";
- system("vconfig set_name_type DEV_PLUS_VID_NO_PAD");
- system("vconfig add $ETHTRUNK $tag");
- system(
- "ifconfig $ETHTRUNK.$tag 0.0.0.0 mtu 1496 promisc up");
- }
- }
-
- if ( $tag == 0 ) {
- system("brctl addif br$tag $ETHTRUNK 2>/dev/null");
- }
- else {
- system("brctl addif br$tag $ETHTRUNK.$tag 2>/dev/null");
- }
- }
-
- my $tap = "$host.$tag";
- if ( length($tap) > $IFNAMSIZ - 1 ) {
- $tap = substr( $tap, length($tap) - $IFNAMSIZ + 1 );
- }
-
- if ( system("tunctl -b -d $tap 1>/dev/null 2>/dev/null") ) {
- print STDERR
-"tunctl refused to free tap device (already running?), aborting\n";
- if ( !$options->{'errors'} ) {
- next;
- }
- exit 1;
- }
- chomp( $tap = `tunctl -b -u 0 -t $tap` );
- if ( $tap eq '' ) {
- print STDERR
- "tunctl returned no tap devices (already running?), aborting\n";
- if ( !$options->{'errors'} ) {
- next;
- }
- exit 1;
- }
-
- system( "ifconfig " . $tap . " 0.0.0.0 promisc up" );
-
- # addresse generee aleatoirement, on s'embete pas, on la prend
- chomp( $tapaddr = `LANG=C LC_ALL=C ifconfig $tap | grep HWaddr` );
- $tapaddr =~ s/^.* HWaddr ([0-9A-F:]+).*/$1/;
- @tapaddr = split ( ':', $tapaddr );
- $tapaddr[1] = 'FE';
- $tapaddr = join ( ':', @tapaddr );
-
- system( "brctl addif br" . $tag . " " . $tap );
-
- print STDERR $nam . " <-> " . $tap . "\n";
-
- if ( defined $dhcpif && $nam eq $dhcpif ) {
- $cmdline .= " " . $nam . "=tuntap," . $tap . "," . $dhcpaddr;
- }
- else {
- $cmdline .= " " . $nam . "=tuntap," . $tap . "," . $tapaddr;
- }
+ my $tapaddr;
+ my @tapaddr;
+
+ if ( !defined $umif->{$nam} ) {
+ next;
+ }
+
+ print STDERR $nam . " <-> " . $umif->{$nam} . "\n";
+
+ my $tag = $umif->{$nam};
+ if ( $tag eq 'TRUNK' ) {
+ $tag = 0;
+ }
+
+ if ( `ifconfig br$tag 2>/dev/null` eq "" ) {
+ print STDERR "Upping br" . $tag . "...\n";
+
+ system( "brctl addbr br" . $tag );
+ system( "ifconfig br"
+ . $tag
+ . " 169.254."
+ . ( $tag >> 8 ) . "."
+ . ( $tag & 255 )
+ . " netmask 255.255.255.255 mtu "
+ . ( ($tag) ? 1496 : 1500 )
+ . " promisc up" );
+
+ system( "brctl stp br" . $tag . " off" );
+ system( "brctl setfd br" . $tag . " 1" );
+ system( "brctl sethello br" . $tag . " 1" );
+ }
+
+ if ( defined $ETHTRUNK and $ETHTRUNK ) {
+ system("ifconfig $ETHTRUNK 0.0.0.0 mtu 1500 promisc up");
+ if ( $tag != 0 ) {
+ if ( `ifconfig $ETHTRUNK.$tag 2>/dev/null` eq "" ) {
+ print STDERR "Upping $ETHTRUNK." . $tag . "...\n";
+ system("vconfig set_name_type DEV_PLUS_VID_NO_PAD");
+ system("vconfig add $ETHTRUNK $tag");
+ system(
+ "ifconfig $ETHTRUNK.$tag 0.0.0.0 mtu 1496 promisc up"
+ );
+ }
+ }
+
+ if ( $tag == 0 ) {
+ system("brctl addif br$tag $ETHTRUNK 2>/dev/null");
+ }
+ else {
+ system("brctl addif br$tag $ETHTRUNK.$tag 2>/dev/null");
+ }
+ }
+
+ my $tap = "$host.$tag";
+ if ( length($tap) > $IFNAMSIZ - 1 ) {
+ $tap = substr( $tap, length($tap) - $IFNAMSIZ + 1 );
+ }
+
+ if ( system("tunctl -b -d $tap 1>/dev/null 2>/dev/null") ) {
+ print STDERR
+ "tunctl refused to free tap device (already running?), aborting\n";
+ if ( !$options->{'errors'} ) {
+ next;
+ }
+ exit 1;
+ }
+ chomp( $tap = `tunctl -b -u 0 -t $tap` );
+ if ( $tap eq '' ) {
+ print STDERR
+ "tunctl returned no tap devices (already running?), aborting\n";
+ if ( !$options->{'errors'} ) {
+ next;
+ }
+ exit 1;
+ }
+
+ system( "ifconfig " . $tap . " 0.0.0.0 promisc up" );
+
+ # addresse generee aleatoirement, on s'embete pas, on la prend
+ chomp( $tapaddr = `LANG=C LC_ALL=C ifconfig $tap | grep HWaddr` );
+ $tapaddr =~ s/^.* HWaddr ([0-9A-F:]+).*/$1/;
+ @tapaddr = split( ':', $tapaddr );
+ $tapaddr[1] = 'FE';
+ $tapaddr = join( ':', @tapaddr );
+
+ system( "brctl addif br" . $tag . " " . $tap );
+
+ print STDERR $nam . " <-> " . $tap . "\n";
+
+ if ( defined $dhcpif && $nam eq $dhcpif ) {
+ $cmdline .= " " . $nam . "=tuntap," . $tap . "," . $dhcpaddr;
+ }
+ else {
+ $cmdline .= " " . $nam . "=tuntap," . $tap . "," . $tapaddr;
+ }
}
if ( -e "$ENV{HOME}/.uml/$host/mconsole"
- && `uml_mconsole $ENV{HOME}/.uml/$host/mconsole version 2>/dev/null` ne
- '' )
+ && `uml_mconsole $ENV{HOME}/.uml/$host/mconsole version 2>/dev/null`
+ ne '' )
{
- printf STDERR "uml already running!\n";
- if ( !$options->{'errors'} ) {
- next;
- }
- exit 1;
+ printf STDERR "uml already running!\n";
+ if ( !$options->{'errors'} ) {
+ next;
+ }
+ exit 1;
}
my $notify;
socket( $notify, AF_UNIX, SOCK_DGRAM, 0 ) || die "socket: $!\n";
unlink("$ENV{HOME}/.uml/$host.notify");
bind( $notify, sockaddr_un("$ENV{HOME}/.uml/$host.notify") )
- || die "bind: $!\n";
+ || die "bind: $!\n";
print $cmdline . "\n";
system($cmdline);
if ( $options->{'wait'} ) {
- print STDERR "Waiting for host ready notification... ";
- while (1) {
- my $data;
-
- if ( !defined recv( $notify, $data, 4096, 0 ) ) {
- last;
- }
-
- my ( $magic, $version, $type, $len, $message ) =
- unpack( "LiiiA*", $data );
-
- if ( $magic != 0xcafebabe || $version != 2 ) {
- die "Sorry, I don't understand this notification version\n";
- }
- if ( $type == 3 ) { # user notify
- if ( $message eq "$host ready" ) {
- print STDERR "ready!\n";
- last;
- }
- }
- }
+ print STDERR "Waiting for host ready notification... ";
+ while (1) {
+ my $data;
+
+ if ( !defined recv( $notify, $data, 4096, 0 ) ) {
+ last;
+ }
+
+ my ( $magic, $version, $type, $len, $message )
+ = unpack( "LiiiA*", $data );
+
+ if ( $magic != 0xcafebabe || $version != 2 ) {
+ die "Sorry, I don't understand this notification version\n";
+ }
+ if ( $type == 3 ) { # user notify
+ if ( $message eq "$host ready" ) {
+ print STDERR "ready!\n";
+ last;
+ }
+ }
+ }
}
close($notify);
Modified: trunk/tools/xenlaunch
URL: http://svn.debian.org/wsvn/pf-tools/trunk/tools/xenlaunch?rev=539&op=diff
==============================================================================
--- trunk/tools/xenlaunch (original)
+++ trunk/tools/xenlaunch Mon Aug 27 14:48:03 2007
@@ -1,6 +1,7 @@
-#!/usr/bin/perl -w
-
-## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+#!/usr/bin/perl
+
+##
+## Copyright (C) 2005 Gonéri Le Bouder <goneri at sitadelle.com>
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
@@ -17,239 +18,225 @@
## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
##
-
use strict;
+use warnings;
use Sitalibs::Config;
use Data::Dumper;
use Getopt::Long;
-my $XENCFGDIR = "/etc/xen";
-my $KERNELDIR = "/distrib/tftpboot";
-my $DISKDIR = "/root/.xen";
-my $disksize = "768";
-my $SWAPSIZE = "128";
-my $mem = "128";
-my $privatenetwork = "private-network.cfg";
+my $XENCFGDIR = "/etc/xen";
+my $KERNELDIR = "/distrib/tftpboot";
+my $DISKDIR = "/root/.xen";
+my $disksize = "768";
+my $SWAPSIZE = "128";
+my $mem = "128";
+my $privatenetwork = "private-network.cfg";
die "J'ai besoin de xm"
-unless (`which xm 2>/dev/null`);
+ unless (`which xm 2>/dev/null`);
die "J'ai besoin de ifrename"
-unless (`which ifrename 2>/dev/null`);
-
+ unless (`which ifrename 2>/dev/null`);
# methode reprise de pflaunch (a mettre dans une lib)
-sub __FamillyNumFromVM ($)
-{
- my $vm = shift;
-
- my ($famille, $num) = ("unknowedonedfamilly", 0);
- if (defined $vm and $vm =~ m/^([a-zA-Z0-9-]+)(\d\d)$/) {
- ($famille, $num) = ($1, $2);
- }
-
- return ($famille, $num);
-}
-
-sub __GetVLanSetup ($)
-{
- my $vlan = shift;
-
- my $section = Config_Section ($privatenetwork, $vlan);
-
- print STDERR "ERROR : Can't read section [$vlan%%] from $privatenetwork\n" unless (defined ($section) and ($section));
-
- return $section;
+sub __FamillyNumFromVM ($) {
+ my $vm = shift;
+
+ my ( $famille, $num ) = ( "unknowedonedfamilly", 0 );
+ if ( defined $vm and $vm =~ m/^([a-zA-Z0-9-]+)(\d\d)$/ ) {
+ ( $famille, $num ) = ( $1, $2 );
+ }
+
+ return ( $famille, $num );
+}
+
+sub __GetVLanSetup ($) {
+ my $vlan = shift;
+
+ my $section = Config_Section( $privatenetwork, $vlan );
+
+ print STDERR "ERROR : Can't read section [$vlan%%] from $privatenetwork\n"
+ unless ( defined($section) and ($section) );
+
+ return $section;
}
# Retourne la configutation réseau d'une machine
-sub __GetIfsSetup ($$)
-{
- my ($famille,$num) = @_;
-
- my @ret;
- my $mac = Config_Key ($privatenetwork, $famille."%%","ether.".$num);
- unless ($mac)
- {
- $mac = Config_Key ($privatenetwork, $famille."%%","vmether.".$num);
- }
- unless ($mac)
- {
- warn "Can't find first if mac addr ($famille, $num)";
- }
-
- my $shortname = Config_Key ($privatenetwork, $famille."%%","shortname");
- unless ($shortname)
- {
- $shortname = "vlan-7";
- warn "Attention $famille%% n'a pas de shortname ! J'utilise vlan-7 par defaut\n";
- }
-
-
- my $section = Config_Section ($privatenetwork, $famille."%%");
-
-
- foreach my $key (keys %$section)
- {
-
- if ($key =~ /^interface\.eth(\d+)/)
- {
- my $ifnum = $1;
- $ret[$ifnum]->{vlan} = $section->{$key};
-
- my $vlan_setup = __GetVLanSetup ($section->{$key});
- $ret[$ifnum]->{tag} = $vlan_setup->{tag};
-
- $ret[$ifnum]->{mac} = $mac
- if ($ret[$ifnum]->{vlan} eq $shortname);
-
- }
- }
- return @ret;
+sub __GetIfsSetup ($$) {
+ my ( $famille, $num ) = @_;
+
+ my @ret;
+ my $mac = Config_Key( $privatenetwork, $famille . "%%", "ether." . $num );
+ unless ($mac) {
+ $mac = Config_Key( $privatenetwork, $famille . "%%",
+ "vmether." . $num );
+ }
+ unless ($mac) {
+ warn "Can't find first if mac addr ($famille, $num)";
+ }
+
+ my $shortname
+ = Config_Key( $privatenetwork, $famille . "%%", "shortname" );
+ unless ($shortname) {
+ $shortname = "vlan-7";
+ warn
+ "Attention $famille%% n'a pas de shortname ! J'utilise vlan-7 par defaut\n";
+ }
+
+ my $section = Config_Section( $privatenetwork, $famille . "%%" );
+
+ foreach my $key ( keys %$section ) {
+
+ if ( $key =~ /^interface\.eth(\d+)/ ) {
+ my $ifnum = $1;
+ $ret[$ifnum]->{vlan} = $section->{$key};
+
+ my $vlan_setup = __GetVLanSetup( $section->{$key} );
+ $ret[$ifnum]->{tag} = $vlan_setup->{tag};
+
+ $ret[$ifnum]->{mac} = $mac
+ if ( $ret[$ifnum]->{vlan} eq $shortname );
+
+ }
+ }
+ return @ret;
}
############ Fin des methodes a expatrier
# Créé la ligne de configuration pour les vifs
-sub __Mk_vif ($$)
-{
-
- my ($famille,$num) = @_;
-
- my $count=0;
- my $ret;
-
- my @ifsetup = __GetIfsSetup ($famille, $num);
-
-
- $ret .= "vif = [ '";
-
- foreach (@ifsetup)
- {
- $ret .= "','" if $count;
- $ret .= "mac=".$_->{mac}."," if $_->{mac};
- $ret .= "bridge=br".$_->{tag};
- $count++;
- }
-
- $ret .= "' ]";
-
- return $ret;
-}
-
-# renomme les interfaces de la meme façon que
-sub __renamevif ($$$)
-{
-
- my ($vm, $famille,$num) = @_;
- my @ifsetup = __GetIfsSetup ($famille, $num);
-
- die "Can't get domaine ID" unless (`xm domid deploy00` =~ /(\d+)/);
- my $domid = $1;
-
- print $domid."\n";
-
- my @viflist = `xm vif-list $vm`;
-
-
- foreach (@viflist)
- {
- if (/\(vif\ (\d+)\)/)
- {
-
- my $vifnum = $1;
- print "vif$domid.$vifnum -> $vm.$ifsetup[$vifnum]->{tag}\n";
-
- `ifconfig vif$domid.$vifnum down`;
- `ifrename -i vif$domid.$vifnum -n $vm.$ifsetup[$vifnum]->{tag}`;
- `ifconfig $vm.$ifsetup[$vifnum]->{tag} up`;
- }
- }
+sub __Mk_vif ($$) {
+
+ my ( $famille, $num ) = @_;
+
+ my $count = 0;
+ my $ret;
+
+ my @ifsetup = __GetIfsSetup( $famille, $num );
+
+ $ret .= "vif = [ '";
+
+ foreach (@ifsetup) {
+ $ret .= "','" if $count;
+ $ret .= "mac=" . $_->{mac} . "," if $_->{mac};
+ $ret .= "bridge=br" . $_->{tag};
+ $count++;
+ }
+
+ $ret .= "' ]";
+
+ return $ret;
+}
+
+# renomme les interfaces de la meme façon que
+sub __renamevif ($$$) {
+
+ my ( $vm, $famille, $num ) = @_;
+ my @ifsetup = __GetIfsSetup( $famille, $num );
+
+ die "Can't get domaine ID" unless ( `xm domid deploy00` =~ /(\d+)/ );
+ my $domid = $1;
+
+ print $domid. "\n";
+
+ my @viflist = `xm vif-list $vm`;
+
+ foreach (@viflist) {
+ if (/\(vif\ (\d+)\)/) {
+
+ my $vifnum = $1;
+ print "vif$domid.$vifnum -> $vm.$ifsetup[$vifnum]->{tag}\n";
+
+ `ifconfig vif$domid.$vifnum down`;
+ `ifrename -i vif$domid.$vifnum -n $vm.$ifsetup[$vifnum]->{tag}`;
+ `ifconfig $vm.$ifsetup[$vifnum]->{tag} up`;
+ }
+ }
}
########################################
## Main
#
-
-
my $options;
-$options->{errors} = 1;
+$options->{errors} = 1;
$options->{branchecvs} = '';
GetOptions(
- 'help|h' => \$options->{help},
-# 'errors!' => \$options->{errors},
-# 'oneeach|1' => \$options->{oneeach} ,
-# 'detached!' => \$options->{detached},
-# 'wait!' => \$options->{"wait"},
-# 'regex|e' => \$options->{regex},
- 'branche-cvs=s' => \$options->{branchecvs},
- 'mem|m=s' => \$mem,
- 'disksize=s' => \$disksize
+ 'help|h' => \$options->{help},
+
+ # 'errors!' => \$options->{errors},
+ # 'oneeach|1' => \$options->{oneeach} ,
+ # 'detached!' => \$options->{detached},
+ # 'wait!' => \$options->{"wait"},
+ # 'regex|e' => \$options->{regex},
+ 'branche-cvs=s' => \$options->{branchecvs},
+ 'mem|m=s' => \$mem,
+ 'disksize=s' => \$disksize
) or die "GetOptions error, try --help";
-
if ( $options->{'help'} ) {
- print STDERR "Usage: $0 [options] [hostregexp] ...\n";
- print STDERR "Options:\n";
+ print STDERR "Usage: $0 [options] [hostregexp] ...\n";
+ print STDERR "Options:\n";
+
# print STDERR "\t-1 --oneeach 1 machine de chaque\n";
# print STDERR "\t --detached deployer en tache de fond\n";
# print STDERR "\t --wait attendre la fin du deploiement\n";
# print STDERR "\t --regex specification des uml par regex\n";
# print STDERR "\t --no-errors passer a la machine suivante meme en cas d'erreur\n";
- print STDERR "\t --branche-cvs permet l'utilisation d'une branche specifique\n";
- print STDERR "\t-m --mem=XXX volume de RAM pour l'UML en Mo, défaut ($mem Mo)\n";
- print STDERR "\t --disksize=XXX taille de l'image disque en Mo, défaut ($disksize Mo)\n";
- exit 1;
+ print STDERR
+ "\t --branche-cvs permet l'utilisation d'une branche specifique\n";
+ print STDERR
+ "\t-m --mem=XXX volume de RAM pour l'UML en Mo, défaut ($mem Mo)\n";
+ print STDERR
+ "\t --disksize=XXX taille de l'image disque en Mo, défaut ($disksize Mo)\n";
+ exit 1;
}
if ( !defined( $ARGV[0] ) ) {
- print STDERR "Usage: " . $0 . " host ...\n";
- exit 1;
+ print STDERR "Usage: " . $0 . " host ...\n";
+ exit 1;
}
my $vm = $ARGV[0];
-
require("lib-update");
-CVS_update($options->{branchecvs}, $options) && die "Impossible de charger la configuration\n";
-
-
-
-
-
-
-Config_Set_Var ($privatenetwork, ["UML"]);
-
-
-my ($famille, $num) = __FamillyNumFromVM ($vm);
-
-unless ($famille and $num)
-{
- print STDERR "Can't parse vm name\n";
- exit 1;
-}
-
-$num--;$num++; # suppression des 0 au debut du nombre, a revoir
+CVS_update( $options->{branchecvs}, $options )
+ && die "Impossible de charger la configuration\n";
+
+Config_Set_Var( $privatenetwork, ["UML"] );
+
+my ( $famille, $num ) = __FamillyNumFromVM($vm);
+
+unless ( $famille and $num ) {
+ print STDERR "Can't parse vm name\n";
+ exit 1;
+}
+
+$num--;
+$num++; # suppression des 0 au debut du nombre, a revoir
# image kernel
-my $kernel = Config_Key ($privatenetwork, $famille."%%","xenfilename.".scalar($num));
-my $kernel = Config_Key ($privatenetwork, $famille."%%","xenfilename.default") unless $kernel;
+my $kernel = Config_Key(
+ $privatenetwork,
+ $famille . "%%",
+ "xenfilename." . scalar($num)
+);
+my $kernel
+ = Config_Key( $privatenetwork, $famille . "%%", "xenfilename.default" )
+ unless $kernel;
die "Je n'arrive pas a trouver le nom du kernel Xen" unless $kernel;
-
-
# vlan
-my $vlan = Config_Key ($privatenetwork, $famille."%%","shortname"); # shortname ?
-my $vlan_setup = __GetVLanSetup ($vlan);
-my $brname = "br".$vlan_setup->{tag};
-
-
-my $vif = __Mk_vif($famille, $num);
+my $vlan = Config_Key( $privatenetwork, $famille . "%%", "shortname" )
+ ; # shortname ?
+my $vlan_setup = __GetVLanSetup($vlan);
+my $brname = "br" . $vlan_setup->{tag};
+
+my $vif = __Mk_vif( $famille, $num );
print "famille : `$famille'\n";
-print "num : `".$num."'\n";
+print "num : `" . $num . "'\n";
print "-------\n";
print "kernel : `$kernel'\n";
@@ -257,44 +244,45 @@
print "brname : `$brname'\n";
# disks
-unless ( -d $DISKDIR."/".$vm )
-{
- `mkdir -p $DISKDIR/$vm`;
- die "Probleme lors de la cration du dossier ".$DISKDIR."/".$vm if ($!);
-}
-unless ( -f $DISKDIR."/".$vm."/swap.img" )
-{
- print "Creation du l'image swap\n";
- system("dd if=/dev/zero of=$DISKDIR/$vm/swap.img seek=200 count=0 bs=1M 2>/dev/null");
- system ("mksawp -f -v1 /dev/zero of=$DISKDIR/$vm/swap.img 2>/dev/null");
-
-}
-unless ( -f $DISKDIR."/".$vm."/hda1.img" )
-{
- print "Creation du l'image disk boot\n";
- system("dd if=/dev/zero of=$DISKDIR/$vm/hda1.img seek=15 count=0 bs=1M 2>/dev/null");
- system("mkfs.ext2 -F $DISKDIR/$vm/hda1.img 2>/dev/null");
-}
-unless ( -f $DISKDIR."/".$vm."/hda2.img" )
-{
- print "Creation du l'image disk systeme\n";
- system("dd if=/dev/zero of=$DISKDIR/$vm/hda2.img seek=$disksize count=0 bs=1M 2>/dev/null");
- system("mkfs.ext2 -F $DISKDIR/$vm/hda2.img 2>/dev/null");
-}
-
+unless ( -d $DISKDIR . "/" . $vm ) {
+ `mkdir -p $DISKDIR/$vm`;
+ die "Probleme lors de la cration du dossier " . $DISKDIR . "/" . $vm
+ if ($!);
+}
+unless ( -f $DISKDIR . "/" . $vm . "/swap.img" ) {
+ print "Creation du l'image swap\n";
+ system(
+ "dd if=/dev/zero of=$DISKDIR/$vm/swap.img seek=200 count=0 bs=1M 2>/dev/null"
+ );
+ system("mksawp -f -v1 /dev/zero of=$DISKDIR/$vm/swap.img 2>/dev/null");
+
+}
+unless ( -f $DISKDIR . "/" . $vm . "/hda1.img" ) {
+ print "Creation du l'image disk boot\n";
+ system(
+ "dd if=/dev/zero of=$DISKDIR/$vm/hda1.img seek=15 count=0 bs=1M 2>/dev/null"
+ );
+ system("mkfs.ext2 -F $DISKDIR/$vm/hda1.img 2>/dev/null");
+}
+unless ( -f $DISKDIR . "/" . $vm . "/hda2.img" ) {
+ print "Creation du l'image disk systeme\n";
+ system(
+ "dd if=/dev/zero of=$DISKDIR/$vm/hda2.img seek=$disksize count=0 bs=1M 2>/dev/null"
+ );
+ system("mkfs.ext2 -F $DISKDIR/$vm/hda2.img 2>/dev/null");
+}
# Generation du fichier de configuration
-open XMCFG, ">".$XENCFGDIR."/".$vm or die "Can't open $XENCFGDIR/$vm $!";
-
-
-print XMCFG "kernel = \"".$KERNELDIR."/".$kernel."\"\n";
+open XMCFG, ">" . $XENCFGDIR . "/" . $vm
+ or die "Can't open $XENCFGDIR/$vm $!";
+
+print XMCFG "kernel = \"" . $KERNELDIR . "/" . $kernel . "\"\n";
print XMCFG "memory = $mem\n";
print XMCFG "name = \"$vm\"\n";
-
# TODO, relier correctment if <-> br
-print XMCFG $vif."\n";
+print XMCFG $vif . "\n";
print XMCFG "ramdisk = \"/distrib/tftpboot/initrd\"\n";
print XMCFG "extra = \"ramdisk_size=16000 init=/linuxrc\"\n";
print XMCFG "disk = ['file:$DISKDIR/$vm/hda1.img,hda1,w', ";
@@ -302,11 +290,10 @@
print XMCFG "'file:$DISKDIR/$vm/swap.img,hda3,w']\n";
close XMCFG;
-
print "Lancement de $vm\n";
my @xmlog = `xm create $vm`;
if ($?) { print foreach @xmlog }
-&__renamevif ($vm, $famille, $num);
-
+&__renamevif( $vm, $famille, $num );
+
More information about the Pf-tools-commits
mailing list