pf-tools commit: r441 [ccaillet-guest] - in /trunk/lib: ./ PFTools/
PFTools/Conf.pm PFTools/Net.pm PFTools/Update.pm
parmelan-guest at users.alioth.debian.org
parmelan-guest at users.alioth.debian.org
Mon Mar 5 15:16:47 CET 2007
Author: ccaillet-guest
Date: Mon Mar 5 14:16:45 2007
New Revision: 441
URL: http://svn.debian.org/wsvn/pf-tools/?sc=1&rev=441
Log:
ADD:
* adding Conf.pm which will replace lib-conf with proper package implementation
* adding Net.pm for lib-net replacement
* adding Update.pm for lib-update replacement
WARNING : it is not a code cleanup nor a reimplementation it is just :
* use strict
* exporting the right function by the Exporter module
Added:
trunk/lib/
trunk/lib/PFTools/
trunk/lib/PFTools/Conf.pm
trunk/lib/PFTools/Net.pm (with props)
trunk/lib/PFTools/Update.pm (with props)
Added: trunk/lib/PFTools/Conf.pm
URL: http://svn.debian.org/wsvn/pf-tools/trunk/lib/PFTools/Conf.pm?rev=441&op=file
==============================================================================
--- trunk/lib/PFTools/Conf.pm (added)
+++ trunk/lib/PFTools/Conf.pm Mon Mar 5 14:16:45 2007
@@ -1,0 +1,584 @@
+package PFTools::Conf ;
+##
+## $Id$
+##
+## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+##
+## This program is free software; you can redistribute it and/or
+## modify it under the terms of the GNU General Public License
+## as published by the Free Software Foundation; either version 2
+## of the License, or (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+##
+
+use Exporter ;
+
+ at ISA = ( 'Exporter' ) ;
+
+ at EXPORT = qw (
+ $DEFERREDLOG
+ %SUBST
+
+ Load_conf
+) ;
+
+ at EXPORT_OK = qw (
+) ;
+
+use strict ;
+use warnings ;
+
+# Error code
+my $ERR_OPEN = 1 ;
+my $ERR_SYNTAX = 2 ;
+
+# Vars needed by pf-launch
+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 ;
+}
+else {
+ 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` ) ;
+ }
+ elsif ( -x "/bin/dnsdomainname" ) {
+ 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{'HOSTNODEINDEX'} = $3;
+
+$SUBST{HOSTNUM} = $SUBST{HOSTDIGITS};
+$SUBST{HOSTNUM} =~ s/^0*//;
+if ( $SUBST{HOSTNUM} eq "" ) {
+ $SUBST{HOSTNUM} = 0;
+}
+
+$SUBST{HOSTMINUTE} = $SUBST{HOSTNUM} % 60;
+
+$SUBST{HOSTHOUR} = $SUBST{HOSTNUM} % 24;
+
+# Subst_vars
+sub Subst_vars {
+ my ($str) = @_;
+
+ while ( $str =~ s/%([^%\s]*)%/$SUBST{"$1"}/ ) { }
+ return ($str);
+}
+
+my $deferbuffer ;
+my $deferredlogbuffer = '';
+my @rotatecursortemplate = ( '-', '\\', '|', '/' );
+my $rotatecursorcount = 0;
+
+sub RotateCursor {
+ print STDERR $rotatecursortemplate[$rotatecursorcount], "\r";
+ $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;
+
+}
+
+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: $!
+ +";
+ 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;
+
+}
+
+
+# Returns undef on error
+sub deferredlogpipe {
+ my $ret = '';
+
+ DeferOutput() if $DEFERREDLOG;
+
+ unless (open DEFERREDLOGPIPE, '-|', @_) {
+ Warn($ERR_OPEN, "Unable to open pipe @_: $!");
+ return;
+ }
+
+ while (<DEFERREDLOGPIPE>) {
+ chomp;
+ $ret .= $_;
+ }
+ close DEFERREDLOGPIPE;
+
+ UndeferOutput() if $DEFERREDLOG;
+
+ if ($deferbuffer) {
+ $deferredlogbuffer .= $deferbuffer;
+ $deferbuffer = undef;
+ }
+
+ RotateCursor() if $DEFERREDLOG;
+
+ return $ret;
+}
+
+
+sub deferredlogsystem {
+ my $ret;
+
+ DeferOutput() if ($DEFERREDLOG);
+
+ $ret = system(@_);
+
+ UndeferOutput() if ($DEFERREDLOG);
+
+ if ( defined $deferbuffer && $deferbuffer ne '' ) {
+ $deferredlogbuffer .= $deferbuffer;
+ $deferbuffer = undef;
+ }
+
+ RotateCursor() if ($DEFERREDLOG);
+
+ return $ret;
+}
+
+sub DelLog {
+ $deferredlogbuffer = '';
+}
+
+sub FlushLog {
+ print STDERR $deferredlogbuffer;
+ DelLog();
+}
+
+# Log
+sub Log {
+ 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;
+ }
+ }
+ }
+
+ $deferredlogbuffer .= "\n";
+
+ if ( !$DEFERREDLOG ) {
+ FlushLog();
+ }
+ else {
+ RotateCursor();
+ }
+}
+
+
+# Debug
+sub Debug ($) {
+ my (@msg) = @_;
+
+ my $basename = ( split ( '/', $0 ) )[-1]; # FIXME �faire une bonne fois pour toutes !
+ Log( $basename . ": DEBUG: ", @msg );
+}
+
+
+# Warn
+sub Warn {
+ my ( $err, @msg ) = @_;
+ my $basename;
+
+ $basename = ( split ( '/', $0 ) )[-1];
+
+ Log( $basename . ": WARN: ", @msg );
+}
+
+# Abort
+sub Abort {
+ my ( $err, @msg ) = @_;
+ my $basename;
+
+ $basename = ( split ( '/', $0 ) )[-1];
+
+ Log( $basename . ": ERR: ", @msg );
+ FlushLog();
+ exit $err;
+}
+
+# Load_conf
+sub Load_conf {
+ my ($fic_conf, $substdestvars) = @_;
+
+ my $CONF = {};
+ my $current = ']';
+ my @FIC_CONF = ();
+ my @line = ();
+ my @cond = ();
+
+ unshift @FIC_CONF, $fic_conf;
+ unshift @line, 0;
+ open( $FIC_CONF[0], $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;
+ }
+
+ # Conditions non fermees
+ if ( $#cond >= 0 ) {
+ Abort( $ERR_SYNTAX, "EOC: endif manquant" );
+ }
+
+ return ($CONF);
+}
+
+# Add_var
+sub Add_var {
+ 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 );
+ }
+ else {
+ $var =~ s/\\\././g;
+ if ( defined( $V->{$var} ) ) {
+ return ($ERR_SYNTAX);
+ }
+ $V->{$var} = $val;
+ return (0);
+ }
+}
+
+# Print_conf
+sub Print_conf {
+ my ($C) = @_;
+
+ my $s;
+ my $v;
+
+ foreach $s ( keys %$C ) {
+ print "[" . $s . "]\n";
+ Print_v( $C->{$s}, "" );
+ print "\n";
+ }
+}
+
+sub Print_v {
+ my ( $o, $var ) = @_;
+ my $v;
+
+ foreach $v ( keys %$o ) {
+ if ( ref( $o->{$v} ) ) {
+ Print_v( $o->{$v}, $var . $v . "." );
+ }
+ else {
+ print $var. $v . " = ", $o->{$v}, "\n";
+ }
+ }
+}
+
+#Print_conf (Load_conf ("/config/config/network")) ;
+
+1;
+
Added: trunk/lib/PFTools/Net.pm
URL: http://svn.debian.org/wsvn/pf-tools/trunk/lib/PFTools/Net.pm?rev=441&op=file
==============================================================================
--- trunk/lib/PFTools/Net.pm (added)
+++ trunk/lib/PFTools/Net.pm Mon Mar 5 14:16:45 2007
@@ -1,0 +1,2199 @@
+package PFTools::Net ;
+##
+## $Id$
+##
+## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+##
+## This program is free software; you can redistribute it and/or
+## modify it under the terms of the GNU General Public License
+## as published by the Free Software Foundation; either version 2
+## of the License, or (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+##
+
+use Exporter ;
+
+ at ISA = ( 'Exporter' ) ;
+
+ at EXPORT = qw (
+ Init_lib_net
+
+ Get_dns_from_hostname
+
+ Mk_dhcp
+ Mk_pxelinuxcfg
+ Mk_interfaces
+ Mk_zone
+) ;
+
+ at EXPORT_OK = qw (
+) ;
+
+
+use strict;
+use warnings;
+
+use Fcntl ':mode';
+use POSIX qw(ceil floor);
+
+#use Data::Dumper;
+#$Data::Dumper::Sortkeys = 1;
+#$Data::Dumper::Useperl = 1;
+
+my @DEFAULTDHCPVLAN = ('vlan-7');
+
+my $UMLTRUNKINGWORKS = 0;
+my $UMLTRUNKFACTORIZE = 1;
+
+my $VMWARE = 0;
+our $UML;
+if ( !defined $UML ) {
+ $UML = 0;
+}
+my $NOETH3 = 0;
+
+# Error code
+my $ERR_OPEN = 1 ;
+my $ERR_SYNTAX = 2 ;
+
+#=======================================================#
+# #
+# lib-net #
+# #
+# Fonctions de configuration de la conf reseau #
+# #
+# * Generation de fichier zone BIND #
+# * Generation de fichier zone DHCP #
+# * Generation de fichiers interfaces #
+# #
+#=======================================================#
+
+sub node2index {
+ my ( $node, $pad ) = @_;
+ my $index = '';
+
+ while ( $node > 0 ) {
+ $index = chr( ord('a') + $node % 26 ) . $index;
+ $node = floor( $node / 26 );
+ }
+
+ if ( defined $pad && $pad > length($index) ) {
+ $index .= 'a' x ( $pad - length($index) );
+ }
+
+ return ($index);
+}
+
+sub rotate {
+ my ( $array, $num ) = @_;
+
+ while ( $num > 0 ) {
+ push @{$array}, shift @{$array};
+ $num--;
+ }
+
+ return @{$array};
+}
+
+sub cmpif {
+ my ( $a, $b ) = @_;
+ my $ai;
+ my $an;
+ my $av;
+ my $aa;
+ my $bi;
+ my $bn;
+ my $bv;
+ my $ba;
+
+ $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 }
+ }
+ $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 }
+ }
+ ( $ai cmp $bi ) || ( $an <=> $bn ) || ( $av <=> $bv ) || ( $aa <=> $ba );
+}
+
+sub isipaddr {
+ my ($ip) = @_;
+
+ my @sub = split ( '\.', $ip );
+
+ if ( $#sub != 3 ) {
+ return 0;
+ }
+
+ my $i;
+
+ foreach $i ( 0 .. 3 ) {
+ if ( $sub[$i] < 0 || $sub[$i] > 255 ) {
+ return 0;
+ }
+ }
+
+ return -1;
+}
+
+sub netmask2prefix {
+ my ($netmask) = @_;
+
+ my $prefix = 32;
+
+ 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--;
+ }
+
+ return $prefix;
+}
+
+# $interface Get_If ( $Zone, $host, $vlan )
+sub Get_If {
+ my ( $Z, $host, $vlan ) = @_;
+
+ my $host2 = $host;
+ $host2 =~ s/^(.+)\.$Z->{SOA}->{name}$/$1/;
+ $host2 =~ m/^([^.]+)(\.([^.]+))?$/;
+ my $hostshort = $1;
+ my $hostvlan = $3;
+ my $hostclass = Host_class( $hostshort, $Z );
+ my $N = $Z->{SERVERS}->{BY_NAME}->{$hostclass};
+ my $M = $N->{SRVLIST}->{$hostshort};
+
+ if ( !defined($M) ) {
+ Abort( $ERR_SYNTAX, "Get_If: " . $host . " not found" );
+ }
+
+ return ( $M->{ifup}->{ $host . "." . $vlan } );
+}
+
+# ($dhcpif, $dhcpaddr) Get_Dhcp_Infos ( $Zone, $host )
+sub Get_Dhcp_Infos {
+ my ( $Z, $host ) = @_;
+
+ my $dhcpvlanregex = '^(' . join ( '|', @{ $Z->{SOA}->{dhcpvlan} } ) . ')$';
+
+ my $host2 = $host;
+ $host2 =~ s/^(.+)\.$Z->{SOA}->{name}$/$1/;
+ $host2 =~ m/^([^.]+)(\.([^.]+))?$/;
+ my $hostshort = $1;
+ my $hostvlan = $3;
+ my $hostclass = Host_class( $hostshort, $Z );
+ my $N = $Z->{SERVERS}->{BY_NAME}->{$hostclass};
+ 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} } )
+ {
+ 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;
+}
+
+sub Get_Ordered_Filtered_Hosts {
+ my ( $Z, @hostsfilter ) = @_;
+
+ 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} }
+ )
+ {
+ 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;
+}
+
+# HASREF Get_UM_If ( $Zone, $host )
+sub Get_UM_If {
+ my ( $Z, $host ) = @_;
+
+ my $umif = {};
+
+ my $host2 = $host;
+ $host2 =~ s/^(.+)\.$Z->{SOA}->{name}$/$1/;
+ $host2 =~ m/^([^.]+)(\.([^.]+))?$/;
+ my $hostshort = $1;
+ my $hostvlan = $3;
+ my $hostclass = Host_class( $hostshort, $Z );
+ my $N = $Z->{SERVERS}->{BY_NAME}->{$hostclass};
+ 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} } )
+ {
+ 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;
+}
+
+sub UMRemap_If {
+ my ( $Z, $host ) = @_;
+
+ #Debug "UMRemap_If called for $host";
+
+ my %umif;
+ my %umvlan;
+ my %iforphan;
+ my %ifmap;
+ my $lastused = -1;
+ my %umtap;
+
+ my $host2 = $host;
+ $host2 =~ s/^(.+)\.$Z->{SOA}->{name}$/$1/;
+ $host2 =~ m/^([^.]+)(\.([^.]+))?$/;
+ my $hostshort = $1;
+ my $hostvlan = $3;
+ my $hostclass = Host_class( $hostshort, $Z );
+ my $N = $Z->{SERVERS}->{BY_NAME}->{$hostclass};
+ 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} } )
+ {
+ 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 ) {
+
+#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 {
+
+#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} )
+ {
+
+#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 )
+ {
+
+#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" );
+ }
+ }
+
+ #if ( scalar( keys %ifmap ) != 0 || scalar( keys %iforphan ) != 0 ) {
+ # Warn( $ERR_SYNTAX, "UMRemap_If[" . $host
+ # . "]: 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' ]
+ # )
+ #
+# 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 )
+ {
+ 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 {
+
+#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} }++;
+ }
+ }
+
+# Debug "iforphan : "; warn Dumper(\%iforphan); Debug "ifmap : "; warn Dumper(\%ifmap);
+ }
+ }
+
+ 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} };
+ }
+ }
+ }
+
+ delete $M->{ifup};
+ delete $M->{route};
+ delete $M->{delroute};
+ $M->{ifup} = $M->{ifupremapped};
+ $M->{route} = $M->{routeremapped};
+ $M->{delroute} = $M->{delrouteremapped};
+ delete $M->{ifupremapped};
+ delete $M->{routeremapped};
+ delete $M->{delrouteremapped};
+}
+
+sub Get_UM_Filename {
+ my ( $Z, $host ) = @_;
+
+ my $host2 = $host;
+ $host2 =~ s/^(.+)\.$Z->{SOA}->{name}$/$1/;
+ $host2 =~ m/^([^.]+)(\.([^.]+))?$/;
+ my $hostshort = $1;
+ my $hostvlan = $3;
+
+ if ( !defined $hostshort ) {
+ return undef;
+ }
+
+ my $hostclass = Host_class( $hostshort, $Z );
+ my $N = $Z->{SERVERS}->{BY_NAME}->{$hostclass};
+ my $M = $N->{SRVLIST}->{$hostshort};
+
+ if ( !defined($M) ) {
+ return undef;
+ }
+
+ return ( $M->{umlfilename} );
+
+}
+
+sub Get_Initrd_Filename ($$) {
+ my ( $Z, $host ) = @_;
+
+ my $host2 = $host;
+ $host2 =~ s/^(.+)\.$Z->{SOA}->{name}$/$1/;
+ $host2 =~ m/^([^.]+)(\.([^.]+))?$/;
+ my $hostshort = $1;
+ my $hostvlan = $3;
+
+ if ( !defined $hostshort ) {
+ return undef;
+ }
+
+ my $hostclass = Host_class( $hostshort, $Z );
+ my $N = $Z->{SERVERS}->{BY_NAME}->{$hostclass};
+ my $M = $N->{SRVLIST}->{$hostshort};
+
+ if ( !defined($M) ) {
+ return undef;
+ }
+
+ return ( $M->{initrd} );
+}
+
+sub Get_Ramdisk_size_from_Initrd ($) {
+ my ($initrd) = @_;
+ $initrd = "/distrib/tftpboot/$initrd";
+
+ # 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): $!");
+ }
+
+ return $st_initrd[7] / 1024;
+}
+
+sub Get_Cmdline ($$) {
+ my ( $Z, $host ) = @_;
+
+ my $host2 = $host;
+ $host2 =~ s/^(.+)\.$Z->{SOA}->{name}$/$1/;
+ $host2 =~ m/^([^.]+)(\.([^.]+))?$/;
+ my $hostshort = $1;
+ my $hostvlan = $3;
+
+ if ( !defined $hostshort ) {
+ return undef;
+ }
+
+ my $hostclass = Host_class( $hostshort, $Z );
+ my $N = $Z->{SERVERS}->{BY_NAME}->{$hostclass};
+ my $M = $N->{SRVLIST}->{$hostshort};
+
+ if ( !defined($M) ) {
+ return undef;
+ }
+
+ return ( $M->{cmdline} );
+}
+
+sub Get_Active_Filename {
+ my ( $Z, $host ) = @_;
+
+ my $host2 = $host;
+ $host2 =~ s/^(.+)\.$Z->{SOA}->{name}$/$1/;
+ $host2 =~ m/^([^.]+)(\.([^.]+))?$/;
+ my $hostshort = $1;
+ my $hostvlan = $3;
+
+ if ( !defined $hostshort ) {
+ return undef;
+ }
+
+ my $hostclass = Host_class( $hostshort, $Z );
+ my $N = $Z->{SERVERS}->{BY_NAME}->{$hostclass};
+ my $M = $N->{SRVLIST}->{$hostshort};
+
+ if ( !defined($M) ) {
+ return undef;
+ }
+
+ return ( $M->{umlfilename} ) if ($UML);
+ return ( $M->{vmwfilename} ) if ($VMWARE);
+ return ( $M->{pxefilename} );
+
+}
+
+sub Get_dns_from_hostname {
+ my ( $Z, $host ) = @_;
+
+ my $host2 = $host;
+ $host2 =~ s/^(.+)\.$Z->{SOA}->{name}$/$1/;
+ $host2 =~ m/^([^.]+)(\.([^.]+))?$/;
+ my $hostshort = $1;
+ my $hostvlan = $3;
+ my $hostnum = $hostshort;
+ $hostnum =~ s/^.*?(\d*)[a-z]*$/$1/;
+ $hostnum =~ s/^0*//;
+ if ( $hostnum eq "" ) {
+ $hostnum = 0;
+ }
+
+ if ( !defined $hostshort ) {
+ return undef;
+ }
+
+ my $hostclass = Host_class( $hostshort, $Z );
+ my $N = $Z->{SERVERS}->{BY_NAME}->{$hostclass};
+ my $M = $N->{SRVLIST}->{$hostshort};
+
+ return Get_dns_from_zone( $Z, $M, $hostnum );
+}
+
+sub Get_dns_from_zone {
+ my ( $Z, $M, $hostnum ) = @_;
+
+ if ( !defined($M) ) {
+ return undef;
+ }
+
+ my $rawdns;
+ if ( defined $M->{dns} && $M->{dns} ne "" ) {
+ $rawdns = $M->{dns};
+ }
+ else {
+ $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;
+ }
+ }
+ return @dns;
+}
+
+#
+# HASHREF Init_lib_net (STRING $fic_conf)
+#
+# Initialisation de la structure de donnees a partir du fichier $fic_conf
+# Une reference sur la structure est retournee.
+#
+#=============================================================================================
+sub Init_lib_net {
+ my ($fic_conf) = @_;
+
+ my $C;
+ my $Z;
+ my $s;
+
+ # Initialisation de la structure de donnees
+ $Z = {};
+ $Z->{NETWORK} = { { 'BY_ADDR', {} }, { 'BY_NAME', {} } };
+ $Z->{SERVERS} = { { 'BY_ADDR', {} }, { 'BY_NAME', {} } };
+ $Z->{SOA} = {};
+ $Z->{NS} = [];
+ $Z->{MX} = [];
+ $Z->{ALIAS} = {};
+
+ # Chargement du fichier de configuration reseau
+ $C = Load_conf( $fic_conf, 0 );
+
+ # 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 );
+ }
+ }
+
+ # 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 );
+ }
+ }
+
+ # Retour de la structure de donnees
+ return ($Z);
+}
+
+#
+# VOID Add_server (HASHREF $Z, HASHREF $S, STRING $srv)
+#
+# Ajoute une description de serveur a la structure de donnee $Z
+# En entree $S contient les informations sur les serveurs de type $srv
+#
+#===================================================================================
+sub Add_server {
+ my ( $Z, $S, $srv ) = @_;
+ my $start;
+ my $s;
+
+ # Calcul de la plage d'adresse alouee et du nombre de serveurs a definir
+
+ if ( !defined( $S->{nodes} ) ) {
+ $S->{nodes} = 1;
+ }
+ my $nodeslast = $S->{nodes} - 1;
+ if ( $nodeslast < 0 ) {
+ $nodeslast = 0;
+ }
+
+ if ( !defined( $S->{number} ) ) {
+ $S->{number} = 1;
+ }
+ my $last = $S->{number} - 1;
+ if ( $last < 0 ) {
+ $last = 0;
+ }
+
+ $srv =~ s/(_*)$//;
+ my $nodes = length($1);
+ $srv =~ s/(%*)$//;
+ my $digit = length($1);
+
+ # 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!" );
+ }
+
+ # 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!" );
+ }
+
+ # 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!" );
+ }
+
+ # 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!" );
+ }
+
+ # Initialisation de la structure pour ces serveurs
+ my $N = {};
+ $N->{comment} = $S->{comment};
+ $N->{type} = $S->{type};
+
+ #$N->{range} = $S->{range};
+ $N->{number} = $S->{number};
+ $N->{nodes} = $S->{nodes};
+
+ $N->{order} = $S->{order};
+
+ $N->{SRVLIST} = {};
+
+ my $ipincrement = 1;
+ if ( defined $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};
+ }
+
+ if ( defined( $S->{initrd}->{$mnamindexnum} ) ) {
+ $M->{initrd} = $S->{initrd}->{$mnamindexnum};
+ }
+ elsif ( defined( $S->{initrd}->{default} ) ) {
+ $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
+ $M->{initrd} = 'initrd';
+ }
+
+ if ( defined( $S->{cmdline}->{$mnamindexnum} ) ) {
+ $M->{cmdline} = $S->{cmdline}->{$mnamindexnum};
+ }
+ elsif ( defined( $S->{cmdline}->{default} ) ) {
+ $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
+ }
+
+ # Insertion de la classe de serveurs dans la structure principale
+ if ( defined $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;
+ $Z->{SERVERS}->{BY_NAME}->{$srv} = $N;
+
+ # Remapping UM
+ if ($UML) {
+ my $mnam;
+ foreach $mnam ( keys %{ $N->{SRVLIST} } ) {
+ UMRemap_If( $Z, $mnam );
+ }
+ }
+}
+
+#
+# VOID Add_zone (HASHREF $Z, HASHREF $S, STRING $zone)
+#
+# Ajoute la description de la zone $zone (SOA MX et NS) a la
+# structure de donnees $Z a partir des informations contenues
+# dans la section $S
+#
+#================================================================================
+sub Add_zone {
+ my ( $Z, $S, $zone ) = @_;
+
+ my $c;
+ my $t_secs;
+ my $t_text;
+ my $mail;
+ my $soa;
+
+ # Verification de l'unicite de la declaration
+ if ( defined( $Z->{SOA}->{name} ) ) {
+ Abort( $ERR_SYNTAX,
+ "Declaration zone dupliquee ("
+ . $Z->{SOA}->{name} . ") et (" . $zone . ")" );
+ }
+
+ # Ajout des informations SOA
+ # Le numero de serie est genere automatiquement, on prends
+ # l'heure system en seconde.
+ # l'adresse mail est corrigee si besoin (@ => .)
+ # Les adresse SOA et Mail sont complettes (.$)
+
+ $t_secs = time();
+ $t_text = localtime($t_secs);
+
+ $mail = $S->{mail};
+ $mail =~ s/@/\./;
+ $mail =~ s/([^\.])$/$1./;
+
+ $soa = $S->{soa};
+ $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} . ")";
+ }
+ else {
+ $Z->{SOA}->{serial} = $t_secs . "\t; Serial (" . $t_text . ")";
+ }
+ $Z->{SOA}->{name} = $zone;
+ $Z->{SOA}->{comment} = $S->{comment};
+ $Z->{SOA}->{soa} = $soa;
+ $Z->{SOA}->{mail} = $mail;
+ $Z->{SOA}->{refresh} = $S->{refresh};
+ $Z->{SOA}->{retry} = $S->{retry};
+ $Z->{SOA}->{expire} = $S->{expire};
+ $Z->{SOA}->{negttl} = $S->{negttl};
+ $Z->{SOA}->{ttl} = $S->{ttl};
+
+ if ( defined $S->{dhcpvlan} ) {
+ @{ $Z->{SOA}->{dhcpvlan} } = split ( /[,\s]+/, $S->{dhcpvlan} );
+ }
+ else {
+ @{ $Z->{SOA}->{dhcpvlan} } = @DEFAULTDHCPVLAN;
+ }
+
+ # Ajout des champs NS
+ foreach $c ( sort ( keys %{ $S->{ns} } ) ) {
+ push ( @{ $Z->{NS} }, $S->{ns}->{$c} );
+ }
+
+ # Ajout des champs MX
+ foreach $c ( sort ( keys %{ $S->{mx} } ) ) {
+ push ( @{ $Z->{MX} }, $S->{mx}->{$c} );
+ }
+}
+
+#
+# VOID Add_network (HASHREF $Z, HASHREF $S, STRING $net)
+#
+# Ajoute une description de reseau a la structure de donnee $Z
+# En entree $S contient les informations sur les reseaux de type $net
+#
+#===================================================================================
+sub Add_network {
+ my ( $Z, $S, $net ) = @_;
+
+ my $N = {};
+
+ # Verification des declarations
+ if ( !defined( $S->{network} ) ) {
+ 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 );
+ }
+ if ( defined( $Z->{NETWORK}->{ $S->{network} } ) ) {
+ Abort( $ERR_SYNTAX,
+ "Adresse de reseau dupliquee ("
+ . $S->{network}
+ . ") pour le reseau " . $net );
+ }
+
+ # Calcul des adresses, netmasks et broadcasts
+ $N->{name} = $net;
+ $N->{network} = $S->{network};
+ $N->{netmask} = $S->{netmask};
+ $N->{broadcast} = Broadcast( $N->{network}, $N->{netmask} );
+ $N->{prefix} = netmask2prefix( $S->{netmask} );
+ $N->{mtu} = $S->{mtu};
+ $N->{tag} = $S->{tag};
+ $N->{media} = $S->{media};
+ $N->{comment} = $S->{comment};
+
+ # Insertion dans la structure principale
+ $Z->{NETWORK}->{BY_ADDR}->{ $N->{network} } = $N;
+ $Z->{NETWORK}->{BY_NAME}->{ $N->{name} } = $N;
+}
+
+#
+# STRING Host_class (STRING $host)
+#
+# Retourne la classe de serveur a laquelle appartient le serveur $h
+#
+#================================================================================
+sub Host_class {
+ my ( $h, $Z ) = @_;
+
+# !!!!!! Attention ne marchera pas si la classe se termine par de chiffres !!!!
+ # Gros fix qui tache
+ if ( defined $Z->{SERVERS}->{BY_NAME}->{$h} ) {
+ return ($h);
+ }
+
+ # Gros fix qui tache encore plus...
+ $h =~ s/(\d)[a-z]+$/$1/;
+ if ( defined $Z->{SERVERS}->{BY_NAME}->{$h} ) {
+ return ($h);
+ }
+
+ $h =~ s/\d+$//;
+ return ($h);
+}
+
+#
+# STRING Broadcast (STRING $a, STRING $s)
+#
+# Retourne l'adresse de broadcast correspondant
+# au reseau d'adresse $a et au netmask $n
+#
+#==================================================================
+sub Broadcast {
+ my ( $a, $n ) = @_;
+
+ my $i;
+
+ 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 );
+
+}
+
+#
+# STRING Address (STRING $b, STRING $o)
+#
+# Retourne l'adresse correspondant
+# a la base $b et a l'offset $o
+# ex: $b=192.168.22.0 $o=102 => 192.168.22.102
+#
+#============================================================
+#sub Address {
+# my ( $b, $o ) = @_;
+#
+# ## Cette fonction ne fonctionne que pour les /24, a refaire si autre !!
+#
+# $b =~ s/[^\.]+$//;
+# return ( $b . $o );
+#}
+
+sub Address {
+ my ( $b, $o, $n ) = @_;
+
+ my @b = split ( '\.', $b );
+ my @o = split ( '\.', $o );
+ my @r;
+
+ while ( $#o < $#b ) {
+ unshift @o, 0;
+ }
+
+ while ( $#o > 0 && $o[0] == 0 ) {
+ push @r, shift @b;
+ shift @o;
+ }
+
+ while ( $#o >= 0 ) {
+ push @r, $o[0];
+ shift @b;
+ shift @o;
+ }
+
+ $r[3] += $n;
+
+ my $i = 3;
+ my $c = 0;
+ while ( $i >= 0 ) {
+ $r[$i] += $c;
+ $c = $r[$i] / 256;
+ $r[$i] %= 256;
+ $i--;
+ }
+
+ return ( join ( '.', @r ) );
+}
+
+sub Mk_dhcp {
+ my ( $head, $fic, $Z ) = @_;
+ my $oldout;
+ my $vlan;
+ my $s;
+
+ my $dhcpvlanregex =
+ '^([^.]+)\.(' . join ( '|', @{ $Z->{SOA}->{dhcpvlan} } ) . ')(\.*)?$';
+
+ open( FIC, ">" . $fic ) || die "Cannot open " . $fic . " : " . $!;
+ $oldout = select(FIC);
+
+ open( HEAD, "<" . $head ) || die "Cannot open " . $head . " : " . $!;
+
+ while (<HEAD>) {
+ print;
+ }
+
+ close(HEAD);
+
+ 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}
+ );
+ }
+
+ 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} ) {
+ printf qq{# initrd "%s";\n}, $M->{initrd};
+ }
+
+ 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";
+ }
+
+ $| = 1;
+ select($oldout);
+ close(FIC);
+}
+
+sub Mk_pxelinuxcfg {
+ my ( $template, $Z ) = @_;
+ my $oldout;
+ my $s;
+ my $pxelinuxconfdir = dirname($template);
+ my @templatecontent;
+
+ open( PXETEMPLATE, "$template" )
+ || die "impossible d'ouvrir " . $template . ": " . $!;
+ @templatecontent = <PXETEMPLATE>;
+ close(PXETEMPLATE);
+
+ 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 $cmdline = $M->{cmdline} || '';
+ $temptemplatecontent =~
+ s/%CMDLINE%/$cmdline/gs;
+ print PXELINUXCFG $temptemplatecontent;
+ close(PXELINUXCFG);
+ }
+ }
+ }
+ }
+ }
+ }
+}
+
+sub Mk_zoneheader {
+ my ( $fic_zone, $Z ) = @_;
+ my $m;
+ my $n;
+
+ # Ouverture du fichier de destination
+ open( FIC_ZONE, "> " . $fic_zone )
+ || Abort( $ERR_OPEN, "Impossible d'ouvrir " . $fic_zone );
+ my $old_STDOUT = select(FIC_ZONE);
+
+ ### Zone
+ print ";;\n";
+ print ";; Fichier de configuration BIND\n";
+ print ";;\n";
+ print ";; ", $Z->{SOA}->{comment}, "\n";
+ print
+";;============================================================================\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 "%-30s%s\n", '', $Z->{SOA}->{serial};
+ printf "%-30s%s\n", '', $Z->{SOA}->{refresh};
+ printf "%-30s%s\n", '', $Z->{SOA}->{retry};
+ printf "%-30s%s\n", '', $Z->{SOA}->{expire};
+ printf "%-30s%s\n", '', $Z->{SOA}->{negttl};
+ printf "%-30s%s\n\n", '', ')';
+
+ foreach $n ( @{ $Z->{NS} } ) {
+ printf "%-29s IN NS\t%s\n", '', $n;
+ }
+ print "\n";
+
+ foreach $m ( @{ $Z->{MX} } ) {
+ 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)
+#
+# Construit un le fichier $fic_zone pour la zone DNS decrite par la structure $Z
+#
+#==============================================================================================
+sub Mk_zone {
+ my ( $fic_zone, $Z ) = @_;
+
+ Mk_zoneheader( $fic_zone, $Z );
+
+ # Ouverture du fichier de destination
+ open( FIC_ZONE, ">> " . $fic_zone )
+ || Abort( $ERR_OPEN, "Impossible d'ouvrir " . $fic_zone );
+ my $old_STDOUT = select(FIC_ZONE);
+
+ my $s;
+ my $n;
+ my $m;
+ my $j;
+
+ ### Reseaux
+ print "\n\n;;\n";
+ print ";; Networks\n";
+ print
+";;============================================================================\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";
+ }
+
+ ### Servers
+ print "\n\n;;\n";
+ print ";; Servers\n";
+ print
+";;============================================================================\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";
+ }
+ }
+
+ ### Alias
+ print "\n\n;;\n";
+ print ";; Alias (round robin)\n";
+ print
+";;============================================================================\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 );
+ }
+ }
+
+ # Fermeture du fichier de destination
+ $| = 1;
+ select($old_STDOUT);
+ close(FIC_ZONE);
+
+}
+
+#
+# VOID Mk_interfaces (STRING $host, STRING $fic_iface, HASHREF $Z)
+#
+# Construit le fichier de declaration d'interfaces $fic_iface pour la
+# machine $host a partir des informations contenues dans la structure $Z
+#
+#======================================================================================
+sub Mk_interfaces {
+ my ( $host, $fic_iface, $Z ) = @_;
+
+ # Calcul de la classe d'appartenance du serveur
+ my $hostclass = Host_class( $host, $Z );
+ 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" );
+ }
+ my $M = $N->{SRVLIST}->{$host};
+
+ if ( !ref($M) ) {
+ 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 );
+ my $old_STDOUT = select(FIC_IFACE);
+
+ # Ajout de l'interface de bouclage
+ print "auto lo\n";
+ print "iface lo inet loopback\n";
+
+ # 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} );
+ }
+ else {
+ $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} } )
+ {
+ 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";
+
+ # Fermeture du fichier de destination
+ close(FIC_IFACE);
+ select($old_STDOUT);
+}
+
+#
+# STRING/ARRAY Resolv (STRING $host, HASHREF $Z)
+#
+# Resout un nom
+#
+#======================================================================================
+sub Resolv {
+ my ( $host, $Z ) = @_;
+
+ my $i;
+ my $j;
+
+ my $host2 = $host;
+ $host2 =~ s/^(.+)\.$Z->{SOA}->{name}\.?$/$1/;
+ $host2 =~ m/^([^.]+)(\.([^.]+))?$/;
+ my $hostshort = $1;
+ my $hostvlan = $3;
+
+ if ( !defined $hostshort ) {
+ return undef;
+ }
+
+ my $hostclass = Host_class( $hostshort, $Z );
+ if ( !defined $hostclass ) {
+ return undef;
+ }
+
+ my $N = $Z->{SERVERS}->{BY_NAME}->{$hostclass};
+
+ 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} );
+ }
+ }
+
+ 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} );
+ }
+ }
+ }
+ }
+
+ 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} ) )
+ {
+ return ( $Z->{NETWORK}->{BY_NAME}->{$hostvlan}->{$hostshort} );
+ }
+
+ return undef;
+}
+
+#
+# VOID Mk_routes (HASHREF $M, HASHREF $Z, STRING $iface)
+#
+# Calcule les commandes routes du fichier interface
+#
+#======================================================================================
+sub Mk_routes {
+ my ( $M, $Z, $iface ) = @_;
+
+ 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";
+ }
+ }
+ }
+
+ 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";
+ }
+ }
+}
+
+if ( `grep -e '^host[ ]*:' /proc/cpuinfo 2>/dev/null` ne "" ) {
+ $UML = 1;
+}
+
+if ( !$UML
+ && `LANG=C LC_ALL=C /sbin/ifconfig eth0 2>>/dev/null | grep HWaddr | awk '{print \$5}'`
+ =~ "^00:50:56:" )
+{
+ $VMWARE = 1;
+}
+
+if ( !$UML && `/sbin/ifconfig eth3 2>>/dev/null` eq "" ) {
+ $NOETH3 = 1;
+}
+
+1;
+
Propchange: trunk/lib/PFTools/Net.pm
------------------------------------------------------------------------------
svn:executable = *
Added: trunk/lib/PFTools/Update.pm
URL: http://svn.debian.org/wsvn/pf-tools/trunk/lib/PFTools/Update.pm?rev=441&op=file
==============================================================================
--- trunk/lib/PFTools/Update.pm (added)
+++ trunk/lib/PFTools/Update.pm Mon Mar 5 14:16:45 2007
@@ -1,0 +1,1886 @@
+package PFTools::Update ;
+##
+## $Id$
+##
+## Copyright (C) 2005 Olivier MOLTENI <olivier at molteni.net>
+##
+## This program is free software; you can redistribute it and/or
+## modify it under the terms of the GNU General Public License
+## as published by the Free Software Foundation; either version 2
+## of the License, or (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+##
+
+ at ISA = ( 'Exporter' ) ;
+
+ at EXPORT = qw (
+ Get_source
+
+ Do_update
+) ;
+
+ at EXPORT_OK = qw (
+) ;
+
+use strict;
+use warnings;
+
+use PFTools::Conf ;
+use PFTools::Net ;
+
+use Getopt::Long;
+use Fcntl ':mode';
+
+#Librairies Debconf
+use Debconf::Db;
+use Debconf::Template;
+use Debconf::ConfModule;
+
+# Error code
+my $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 ;
+
+# Constantes
+my $PFTOOLSCONF = "/etc/pf-tools.conf";
+my $CVS_CHECKOUT = "/var/lib/cvsguest";
+my $HOSTNAME = $SUBST{HOSTNAME};
+my $HOSTTYPE = $SUBST{HOSTTYPE};
+my $CVS_UMASK = 0077;
+my $COMMON = "update-common";
+my $DEFAULT_MODE = '0640';
+my $DEFAULT_DIRMODE = '0750';
+my $DEFAULT_OWNER = 'root';
+my $DEFAULT_GROUP = 'root';
+my $DEFAULT_FSTYPE = 'nfs';
+my $DEFAULT_OPTIONS = 'defaults,noexec,nosuid,nodev,hard,intr';
+my $APT_GET = 'LANG=C LC_ALL=C /usr/bin/apt-get -y --force-yes';
+my $APT_GET_DEPENDS = 'LANG=C LC_ALL=C /usr/bin/apt-get -y --force-yes -s -u';
+my $APT_POLICY = 'LANG=C LC_ALL=C /usr/bin/apt-cache policy';
+my $APT_UPDATE = 1;
+my $DPKG = 'LANG=C LC_ALL=C /usr/bin/dpkg';
+
+#$PKGLIST = "/var/lib/apt/lists";
+
+# Conf Par Defaut
+my $PF_STATUS_DIR = "/var/lib/pftools";
+
+my $CVS_USER = "cvsguest";
+my $CVS_RSH = "/usr/local/sbin/cvs_rsh";
+my $CVS_SERVER = "cvs.private";
+my $CVS_ROOT = "/var/lib/cvs";
+my $CVS_REPOSITORY = $CVS_ROOT . "/repository";
+my $CVS_CONFIG = "config";
+my $CVS_COMMAND ;
+my $CVS_BRANCHE ;
+
+# End Conf Par Defaut!
+
+if ( -r $PFTOOLSCONF ) {
+ my $newuid;
+ my $newgid;
+ my $dev;
+ my $ino;
+ my $mode;
+ my $nlink;
+ my $uid;
+ my $gid;
+ my $rdev;
+ my $size;
+ my $atime;
+ my $mtime;
+ my $ctime;
+ 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;
+ }
+ }
+ else {
+ print STDERR "Ignoring weak config (check owner/group/mode)\n";
+ }
+}
+
+
+
+# Constantes deduites de la conf
+my $CVS_WORKING_DIR = $CVS_CHECKOUT . "/" . $HOSTNAME;
+my $CVS_TMP_DIR = $CVS_CHECKOUT . "/" . $HOSTNAME . "/tmp";
+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
+
+sub fullchown {
+ my ( $owner, $group, $dest, $options ) = @_;
+ my $newuid;
+ my $newgid;
+ my $dev;
+ my $ino;
+ my $mode;
+ my $nlink;
+ my $uid;
+ my $gid;
+ my $rdev;
+ my $size;
+ my $atime;
+ my $mtime;
+ my $ctime;
+ my $blksize;
+ my $blocks;
+
+ $newuid = getpwnam($owner);
+ $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 0;
+ }
+
+ if ( $options->{verbose} || $options->{simul} ) {
+ Log("(chown needed)");
+ }
+
+ if ( $options->{simul} ) {
+ return 0;
+ }
+
+ return !chown( $newuid, $newgid, $dest );
+};
+
+sub fullchmod {
+ my ( $newmode, $dest, $options ) = @_;
+ my $newuid;
+ my $newgid;
+ my $dev;
+ my $ino;
+ my $mode;
+ my $nlink;
+ my $uid;
+ my $gid;
+ my $rdev;
+ my $size;
+ my $atime;
+ my $mtime;
+ my $ctime;
+ my $blksize;
+ my $blocks;
+
+ ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
+ $size, $atime, $mtime, $ctime, $blksize, $blocks )
+ = stat($dest);
+
+ if ( defined($mode) && ( $mode & 07777 ) == $newmode ) {
+ return 0;
+ }
+
+ if ( $options->{verbose} || $options->{simul} ) {
+ Log("(chmod needed)");
+ }
+
+ if ( $options->{simul} ) {
+ return 0;
+ }
+
+ return !chmod( $newmode, $dest );
+}
+
+sub ln_sfn {
+ my ( $source, $dest ) = @_;
+
+ unlink($dest);
+ rmdir($dest);
+ return !symlink( $source, $dest );
+}
+
+sub dirname {
+ my ($file) = @_;
+
+ $file =~ s://:/:g;
+
+ if ( $file =~ m|/| ) {
+ $file =~ s|^(.*)/[^/]+/?$|$1|;
+ }
+ else {
+ $file = '.';
+ }
+
+ return $file;
+}
+
+sub Do_moveold {
+ 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 . "'" );
+ }
+ }
+}
+
+sub Do_chownmod {
+ my ( $S, $dest, $options ) = @_;
+
+ my $owner;
+ my $group;
+ my $mode;
+
+ $owner = defined( $S->{owner} ) ? $S->{owner} : $DEFAULT_OWNER;
+ $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 );
+ $mode =~ s/^[^0]/0$&/;
+
+ if ( fullchmod( eval($mode), $dest, $options ) ) {
+ Warn( $ERR_OPEN,
+ "Impossible d'attribuer les droits " . $mode . " a " . $dest );
+ return 1;
+ }
+}
+
+sub Do_on_config {
+ 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;
+ }
+ }
+ return 0;
+}
+
+sub Do_before_change {
+ my ( $S, $options ) = @_;
+
+ 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;
+ }
+ }
+ return 0;
+}
+
+sub Do_after_change {
+ my ( $S, $options ) = @_;
+
+ 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;
+ }
+ }
+ return 0;
+}
+
+sub Do_on_noaction {
+ my ( $S, $options ) = @_;
+
+ 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;
+ }
+ }
+ return 0;
+}
+
+my %DEPENDS ;
+my %FUNCTIONS ;
+
+$DEPENDS{addfile} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ while ( $dest ne '/' && $dest ne '.' ) {
+ $S->{depends} .= " " . dirname($dest);
+ $dest = dirname($dest);
+ }
+};
+
+$FUNCTIONS{addfile} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ my $source;
+ my $tmp;
+ my $cmp;
+
+ if ( !defined( $S->{source} ) ) {
+ 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;
+ }
+ }
+ }
+ else {
+ $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;
+ }
+ }
+ 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;
+ }
+
+ $cmp = 0;
+ 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;
+ }
+ }
+ }
+
+ Do_chownmod( $S, $dest, $options );
+
+ if ($cmp) {
+ Do_after_change( $S, $options ) && return 1;
+
+ Do_on_noaction( $S, $options ) && return 1;
+ }
+
+ return 0;
+};
+
+$FUNCTIONS{'dpkg-purge'} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ my $name_filter = $S->{name_filter};
+ 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" );
+ return 1;
+ }
+ unless ($newdest) {
+ Warn( $ERR_OPEN, "Resultat vide pour name_filter $name_filter" );
+ return 1;
+ }
+ $dest = $newdest;
+ }
+
+ my $installed_version;
+
+ 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;
+ }
+ }
+ 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;
+ }
+
+ return 0;
+};
+
+sub aptupdate {
+ my $pkg;
+
+ if ($APT_UPDATE) {
+ if ( deferredlogsystem( $APT_GET . " update" ) ) {
+ Warn( $ERR_OPEN, "apt-get update failed!" );
+ return 1;
+ }
+ $APT_UPDATE = 0;
+ }
+
+ return 0;
+}
+
+$DEPENDS{'apt-get'} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ if ( aptupdate() ) {
+ 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;
+ }
+ }
+ }
+ }
+ close(APTDEP);
+};
+
+$FUNCTIONS{'apt-get'} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ my $installed_version;
+ my $available_version;
+ my $install;
+
+ my $name_filter = $S->{name_filter};
+ 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" );
+ return 1;
+ }
+ unless ($newdest) {
+ Warn( $ERR_OPEN, "Resultat vide pour name_filter $name_filter" );
+ return 1;
+ }
+ $dest = $newdest;
+ }
+
+ aptupdate();
+
+ 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;
+ }
+ }
+ 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 ) )
+ {
+ $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;
+ }
+
+ return 0;
+};
+
+$DEPENDS{addmount} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ while ( $dest ne '/' && $dest ne '.' ) {
+ $S->{depends} .= " " . dirname($dest);
+ $dest = dirname($dest);
+ }
+};
+
+$FUNCTIONS{'addmount'} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ my $addmount;
+ my $source;
+ my $fstype;
+ my $opts;
+ my $sortedopts;
+
+ my $oldsource;
+ my $olddest;
+ my $oldfstype;
+ my $oldopts;
+ my $oldresolvedopts;
+
+ my $oldmsource;
+ my $oldmresolvedsource;
+ my $oldmdest;
+ my $oldmfstype;
+ my $oldmopts;
+
+ my $addmountfstab = 0;
+ my $addmountmounts = 0;
+
+ my $Z;
+
+ if ( !defined( $S->{source} ) ) {
+ 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/;
+ }
+ }
+
+ $SUBST{SOURCE} = $source;
+
+ $opts = defined( $S->{options} ) ? $S->{options} : $DEFAULT_OPTIONS;
+
+ 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/;
+ }
+ }
+
+ $SUBST{OPTIONS} = $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;
+ }
+ 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 ) );
+ }
+ }
+ }
+ 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 )
+ {
+ $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 ( $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;
+ }
+
+ return 0;
+};
+
+$FUNCTIONS{ignore} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ return 0;
+};
+
+$DEPENDS{addlink} = sub {
+ my ( $S, $dest, $options ) = @_;
+ my $source = Subst_vars( $S->{source} );
+
+ while ( $source ne '/' && $source ne '.' ) {
+ $S->{depends} .= " " . dirname($source);
+ $source = dirname($source);
+ }
+ while ( $dest ne '/' && $dest ne '.' ) {
+ $S->{depends} .= " " . dirname($dest);
+ $dest = dirname($dest);
+ }
+};
+
+$FUNCTIONS{addlink} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ my $cmp = 0;
+
+ if ( !defined( $S->{source} ) ) {
+ 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;
+ }
+
+ return 0;
+};
+
+$DEPENDS{createfile} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ while ( $dest ne '/' && $dest ne '.' ) {
+ $S->{depends} .= " " . dirname($dest);
+ $dest = dirname($dest);
+ }
+};
+
+$FUNCTIONS{createfile} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ 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;
+ }
+ }
+ }
+ }
+ 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;
+ }
+ }
+ }
+ }
+
+ Do_chownmod( $S, $dest, $options );
+
+ if ($cmp) {
+ Do_after_change( $S, $options ) && return 1;
+
+ Do_on_noaction( $S, $options ) && return 1;
+ }
+
+ return 0;
+};
+
+$DEPENDS{mkdir} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ while ( $dest ne '/' && $dest ne '.' ) {
+ $S->{depends} .= " " . dirname($dest);
+ $dest = dirname($dest);
+ }
+};
+
+$FUNCTIONS{mkdir} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ 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;
+ }
+ }
+ }
+
+ Do_chownmod( $S, $dest, $options );
+
+ if ($cmp) {
+ Do_after_change( $S, $options ) && return 1;
+
+ Do_on_noaction( $S, $options ) && return 1;
+ }
+
+ return 0;
+};
+
+$FUNCTIONS{removefile} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ my $cmp = 0;
+ if ( -d $dest ) {
+ 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;
+ #}
+ }
+ }
+
+ # Mais bien sur
+ #Do_chownmod( $S, $dest, $options );
+
+ if ($cmp) {
+ Do_after_change( $S, $options ) && return 1;
+
+ Do_on_noaction( $S, $options ) && return 1;
+ }
+
+ return 0;
+};
+
+$FUNCTIONS{removedir} = sub {
+ my ( $S, $dest, $options ) = @_;
+
+ my $cmp = 0;
+ if ( -e $dest && !-d $dest ) {
+ 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;
+ #}
+ }
+ }
+
+ # Mais bien sur
+ #Do_chownmod( $S, $dest, $options );
+
+ if ($cmp) {
+ Do_after_change( $S, $options ) && return 1;
+
+ Do_on_noaction( $S, $options ) && return 1;
+ }
+
+ return 0;
+};
+
+sub Mk_dest_dir {
+ my ($dir) = @_;
+
+ $dir =~ s://:/:g; # supprimer // sinon ca marche moins bien
+
+ $dir =~ s:/[^/]+/*$::;
+
+ # 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:/[^/]+/*$::;
+ }
+ if ( $dir2 ne "" && -e $dir2 && !-d $dir2 ) {
+ unlink($dir2);
+ }
+
+ $dir && return system( "/bin/mkdir -p '" . $dir . "' >/dev/null 2>&1" );
+}
+
+sub Get_tmp_dest {
+ my ($dest) = @_;
+
+ my $tmp = $CVS_TMP_DIR . "/" . $dest;
+
+ Mk_dest_dir($tmp);
+
+ if ( -d $tmp ) {
+ rmdir($tmp);
+ }
+ elsif ( -e $tmp ) {
+ unlink($tmp);
+ }
+
+ return $tmp;
+}
+
+sub Get_source {
+ my ($source) = @_;
+
+ $source =~ s!^HOST:!$CVS_WORKING_DIR/$CVS_CONFIG/$HOSTTYPE!;
+ $source =~ s!^CONFIG:!$CVS_WORKING_DIR/$CVS_CONFIG/!;
+ $source =~ s!^CVS:!$CVS_WORKING_DIR/!;
+ $source =~ s!^GLOBAL:!$GLOBAL_CONF/!;
+ return $source;
+}
+
+sub Trie_prio {
+ my ( $C, $a ) = @_;
+
+ my $prio = 0;
+
+ if ( $a eq "/etc/passwd" ) {
+ return $prio;
+ }
+ $prio++;
+ if ( $a eq "/etc/group" ) {
+ return $prio;
+ }
+ $prio++;
+
+ if ( $a eq "/etc/shadow" ) {
+ return $prio;
+ }
+ $prio++;
+ if ( $a eq "/etc/gshadow" ) {
+ return $prio;
+ }
+ $prio++;
+
+ if ( $C->{$a}->{action} eq 'mkdir' ) {
+ return $prio;
+ }
+ $prio++;
+ if ( $C->{$a}->{action} eq 'addmount' ) {
+ return $prio;
+ }
+ $prio++;
+
+ if ( $a =~ m|^/etc/apt/| ) {
+ return $prio;
+ }
+ $prio++;
+ if ( $a eq "pf-tools" ) {
+ return $prio;
+ }
+ $prio++;
+
+ if ( $C->{$a}->{action} eq 'dpkg-purge' ) {
+ return $prio;
+ }
+ $prio++;
+ if ( $C->{$a}->{action} eq 'apt-get' ) {
+ return $prio;
+ }
+ $prio++;
+
+ if ( $C->{$a}->{action} eq 'createfile' ) {
+ return $prio;
+ }
+ $prio++;
+ if ( $C->{$a}->{action} eq 'addfile' ) {
+ return $prio;
+ }
+ $prio++;
+
+ if ( $C->{$a}->{action} eq 'addlink' ) {
+ return $prio;
+ }
+
+ if ( $C->{$a}->{action} eq 'removefile' ) {
+ return $prio;
+ }
+ if ( $C->{$a}->{action} eq 'removedir' ) {
+ return $prio;
+ }
+ $prio++;
+ return $prio;
+}
+
+sub Trie_dependances {
+ my ( $C, $a, $b ) = @_;
+
+ my $prioa = Trie_prio( $C, $a );
+ my $priob = Trie_prio( $C, $b );
+
+ if ( $prioa != $priob ) {
+ return $prioa <=> $priob;
+ }
+ else {
+ return $a cmp $b;
+ }
+}
+
+sub Do_updateloop {
+ my ( $C, $options, @sortedkeys ) = @_;
+ my $s;
+ 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;
+ }
+ }
+
+ return $errorcount;
+}
+
+sub Do_update {
+ my (@options) = @_;
+
+ my $C;
+ my $s;
+ my $options;
+ my @sortedkeys;
+ my $errorcount = 0;
+
+
+
+ $options = Get_options(@options);
+
+ if ( $options->{help} ) {
+ Do_help();
+ exit;
+ }
+
+ my $branchecvs ;
+ # Si le demande a ma machine une branche precise
+ $branchecvs = ($options->{"branche-cvs"})?$options->{"branche-cvs"}:GetBrancheFromCmdLine();
+# Sinon je repart sur celle d'avant
+ $branchecvs = GetRunningBrancheName() unless $branchecvs;
+
+
+ if ( CVS_update($branchecvs, $options) || ( !( $C = Get_conf() ) ) ) {
+ Abort( $ERR_OPEN, "Impossible de charger la configuration\n" );
+ }
+
+ SaveRunningBrancheName($branchecvs);
+
+
+ if ( defined( $options->{noupdate} ) ) {
+ Abort( $ERR_OPEN, "Configuration desactivee [noupdate]" );
+ }
+
+ @sortedkeys = sort { Trie_dependances( $C, $a, $b ) } keys %$C;
+
+ $| = 1;
+ $errorcount = Do_updateloop( $C, $options, @sortedkeys );
+
+ Log( $errorcount . " error(s) detected." );
+ FlushLog();
+}
+
+sub Do_help {
+
+ print STDERR << "# ENDHELP";
+Usage: $0 [options]
+# -d --debug: print debug info
+ -u --diff: diff files, versions, mountpoints, links => --simul
+ -h --help: print help and exit
+# -i --install: install mode
+ -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;
+ }
+ if ( defined( $ARGV[0] ) && $ARGV[0] eq ':NO-UPDATE:' ) {
+ Warn( $ERR_OPEN, ":NO-UPDATE: depreciated, please use --noupdate" );
+ $options->{noupdate} = 1;
+ }
+
+ return $options;
+}
+
+sub Get_conf {
+
+ my $C = {};
+ my $template;
+ my $conf;
+
+ $HOSTNAME =~ /^(.*?)(\d*)([a-z]*)$/;
+ #$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->{$_};
+ }
+ }
+ 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
+# 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;
+
+}
+
+
+# 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;
+}
+
+1;
+
Propchange: trunk/lib/PFTools/Update.pm
------------------------------------------------------------------------------
svn:executable = *
More information about the Pf-tools-commits
mailing list