pf-tools commit: r881 [parmelan-guest] - in /branches/next-gen/tools: Display_IP_config Translate_old_config dumpiplist.pl kvmlaunch pflaunch umlaunch xenlaunch
parmelan-guest at users.alioth.debian.org
parmelan-guest at users.alioth.debian.org
Tue Sep 7 08:55:04 UTC 2010
Author: parmelan-guest
Date: Tue Sep 7 08:55:02 2010
New Revision: 881
URL: http://svn.debian.org/wsvn/pf-tools/?sc=1&rev=881
Log:
perltidy tools
Modified:
branches/next-gen/tools/Display_IP_config
branches/next-gen/tools/Translate_old_config (contents, props changed)
branches/next-gen/tools/dumpiplist.pl (contents, props changed)
branches/next-gen/tools/kvmlaunch (contents, props changed)
branches/next-gen/tools/pflaunch (contents, props changed)
branches/next-gen/tools/umlaunch (contents, props changed)
branches/next-gen/tools/xenlaunch (contents, props changed)
Modified: branches/next-gen/tools/Display_IP_config
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/tools/Display_IP_config?rev=881&op=diff
==============================================================================
--- branches/next-gen/tools/Display_IP_config (original)
+++ branches/next-gen/tools/Display_IP_config Tue Sep 7 08:55:02 2010
@@ -31,23 +31,23 @@
use PFTools::Utils;
use NetAddr::IP;
-use Getopt::Long qw ( :config ignore_case_always bundling ) ;
+use Getopt::Long qw ( :config ignore_case_always bundling );
####################################################
# Vars
-my $HOSTCLASS = "";
-my $SITE = "";
-my $OUTPUT = "";
-my $IP_TYPE = 'ipv4';
-my $HELP = 0 ;
-my $GLOBAL_STORE_FILE = '';
-my $PF_CONFIG_FILE = '';
-my $PF_CONFIG = {};
-my $GLOBAL_STRUCT = {};
+my $HOSTCLASS = "";
+my $SITE = "";
+my $OUTPUT = "";
+my $IP_TYPE = 'ipv4';
+my $HELP = 0;
+my $GLOBAL_STORE_FILE = '';
+my $PF_CONFIG_FILE = '';
+my $PF_CONFIG = {};
+my $GLOBAL_STRUCT = {};
my $program = $0;
-$program =~ s%.*/%%; # cheap basename
+$program =~ s%.*/%%; # cheap basename
my $version = sprintf( "svn-r%s", q$Revision$ =~ /([\d.]+)/ );
@@ -55,7 +55,7 @@
# Functions
sub Do_help () {
-print STDERR << "# ENDHELP";
+ print STDERR << "# ENDHELP";
$program - version $version
Usage: $0 [options]
@@ -72,172 +72,204 @@
sub _ipcomp {
my ( $ip1, $ip2 ) = @_;
- my $ip_obj1 = new NetAddr::IP ( $ip1 );
- my $ip_obj2 = new NetAddr::IP ( $ip2 );
-
- if ( $ip_obj1 < $ip_obj2 ) {
- return -1;
- }
- elsif ( $ip_obj1 > $ip_obj2 ) {
- return 1;
- }
- return 0;
+ my $ip_obj1 = new NetAddr::IP($ip1);
+ my $ip_obj2 = new NetAddr::IP($ip2);
+
+ if ( $ip_obj1 < $ip_obj2 ) {
+ return -1;
+ }
+ elsif ( $ip_obj1 > $ip_obj2 ) {
+ return 1;
+ }
+ return 0;
}
sub order_servers ($) {
- my ( $host_part ) = @_ ;
-
- foreach my $hostclass ( keys %{$host_part} ) {
- foreach my $hostname ( keys %{$host_part->{$hostclass}} ) {
- my $srv_order =
- $host_part->{$hostclass}->{$hostname}->{'deployment'}->{'order'}
- || 999;
- push ( @{$order->{$srv_order}}, $hostname );
- }
- }
- return $order ;
+ my ($host_part) = @_;
+
+ foreach my $hostclass ( keys %{$host_part} ) {
+ foreach my $hostname ( keys %{ $host_part->{$hostclass} } ) {
+ my $srv_order
+ = $host_part->{$hostclass}->{$hostname}->{'deployment'}
+ ->{'order'}
+ || 999;
+ push( @{ $order->{$srv_order} }, $hostname );
+ }
+ }
+ return $order;
}
sub get_srv_iface ($$$$) {
- my ( $ip_type, $srv_name, $global_config, $site ) = @_ ;
- my $result = {} ;
-
- return undef if ( ! $pf_config->{'features'}->{$ip_type} );
- my $host_props = Get_host_config_from_CONFIG ( $srv_name, $global_config, $site );
- if ( ! defined $host_props ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unknown hostname ".$hostname." in global configuration" );
- }
- foreach my $iface ( keys %{$host_props->{'interfaces'}} ) {
- $result->{$iface}->{'addr'} = $host_props->{'interfaces'}->{$iface}->{$ip_type};
- $result->{$iface}->{'vlan'} = $host_props->{'interfaces'}->{$iface}->{'vlan'};
- }
- return $result ;
+ my ( $ip_type, $srv_name, $global_config, $site ) = @_;
+ my $result = {};
+
+ return undef if ( !$pf_config->{'features'}->{$ip_type} );
+ my $host_props
+ = Get_host_config_from_CONFIG( $srv_name, $global_config, $site );
+ if ( !defined $host_props ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unknown hostname " . $hostname . " in global configuration" );
+ }
+ foreach my $iface ( keys %{ $host_props->{'interfaces'} } ) {
+ $result->{$iface}->{'addr'}
+ = $host_props->{'interfaces'}->{$iface}->{$ip_type};
+ $result->{$iface}->{'vlan'}
+ = $host_props->{'interfaces'}->{$iface}->{'vlan'};
+ }
+ return $result;
}
sub get_srv_ip ($$$$) {
- my ( $ip_type, $hostclass, $host_part, $pf_config ) = @_ ;
- my $result = {} ;
-
- return undef if ( ! $pf_config->{'features'}->{$ip_type} );
- foreach my $srv ( keys %{$host_part->{$hostclass}} ) {
- my $ref_srv = $$host_part->{$hostclass}->{$srv} ;
- foreach my $iface ( keys %{$ref_srv->{'interfaces'}} ) {
- my $ip_if = $ref_srv->{'interfaces'}->{$iface}->{$ip_type};
- $result->{$ip_if}->{'hostname'} = $srv ;
- $result->{$ip_if}->{'iface'} = $$iface ;
- }
- }
- return $result ;
+ my ( $ip_type, $hostclass, $host_part, $pf_config ) = @_;
+ my $result = {};
+
+ return undef if ( !$pf_config->{'features'}->{$ip_type} );
+ foreach my $srv ( keys %{ $host_part->{$hostclass} } ) {
+ my $ref_srv = $$host_part->{$hostclass}->{$srv};
+ foreach my $iface ( keys %{ $ref_srv->{'interfaces'} } ) {
+ my $ip_if = $ref_srv->{'interfaces'}->{$iface}->{$ip_type};
+ $result->{$ip_if}->{'hostname'} = $srv;
+ $result->{$ip_if}->{'iface'} = $$iface;
+ }
+ }
+ return $result;
}
sub get_all_ip ($$) {
- my ( $ip_type, $host_part, $pf_config ) = @_ ;
- my $result = {} ;
-
- return undef if ( ! $pf_config->{'features'}->{$ip_type} );
- foreach my $hostclass ( keys %{$host_part} ) {
- foreach my $hostname ( keys %{$host_part->{$hostclass}} ) {
- my $ref_srv = $host_part->{$hostclass}->{$srv} ;
- foreach my $iface ( keys %{$ref_srv->{'interfaces'}} ) {
- my $entry = {
- 'hostname' => $srv,
- 'iface' => $iface
- } ;
- push ( @{$result->{$ref_srv->{'interfaces'}->{$iface}->{$ip_type}}}, $entry ) ;
- }
- }
- }
- return $result ;
-}
-
+ my ( $ip_type, $host_part, $pf_config ) = @_;
+ my $result = {};
+
+ return undef if ( !$pf_config->{'features'}->{$ip_type} );
+ foreach my $hostclass ( keys %{$host_part} ) {
+ foreach my $hostname ( keys %{ $host_part->{$hostclass} } ) {
+ my $ref_srv = $host_part->{$hostclass}->{$srv};
+ foreach my $iface ( keys %{ $ref_srv->{'interfaces'} } ) {
+ my $entry = {
+ 'hostname' => $srv,
+ 'iface' => $iface
+ };
+ push(
+ @{ $result->{
+ $ref_srv->{'interfaces'}->{$iface}->{$ip_type}
+ }
+ },
+ $entry
+ );
+ }
+ }
+ }
+ return $result;
+}
#######################################################""
### MAIN
-GetOptions (
- 'help' => \$HELP,
- 'h|host=s' => \$HOSTCLASS,
- 'site|s=s' => \$SITE,
- 't|type=s' => \$IP_TYPE,
- 'o|output=s' => \$OUTPUT,
- 'config|c=s' => \$PF_CONFIG_FILE,
- 'store=s' => \$GLOBAL_STORE_FILE,
+GetOptions(
+ 'help' => \$HELP,
+ 'h|host=s' => \$HOSTCLASS,
+ 'site|s=s' => \$SITE,
+ 't|type=s' => \$IP_TYPE,
+ 'o|output=s' => \$OUTPUT,
+ 'config|c=s' => \$PF_CONFIG_FILE,
+ 'store=s' => \$GLOBAL_STORE_FILE,
) or die "Didn't grok options (see --help).\n";
-if ( $HELP ) {
- Do_help ();
- exit 0;
-}
-
-( $PF_CONFIG, $GLOBAL_STRUCT ) = Init_TOOLS ( "", $PF_CONFIG_FILE, $GLOBAL_STORE_FILE );
-
-if ( $SITE eq '' && ! defined $PF_CONFIG->{'location'}->{'site'} ) {
- my $site_list = Get_site_from_hostname ( $HOSTNAME, $GLOBAL_STRUCT );
- if ( ! defined $site_list ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unable to retrieve site for hostname ".$HOSTNAME." : hostname not defined" );
- }
- elsif ( scalar @{$site_list} > 1 ) {
- Abort ( $CODE->{'DUPLICATE_VALUE'},
- "Unable to retrieve site for hostname ".$HOSTNAME." : hostname appeared in multiple sites : "
- .join ( ",", @{$site_list} ).".\n"
- ."Please relaunch this command with the right site" );
- }
- else {
- ( $SITE ) = @{$site_list};
- }
-}
-
-my $host_part = $GLOBAL_STRUCT->{'SITE'}->{'BY_NAME'}->{$SITE}->{'HOST'}->{'BY_NAME'};
-if ( $HOSTCLASS ne "" && ! defined $$host_part->{$HOSTCLASS} ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "Unexistant hostclass in global configuration" );
-}
-if ( $HOSTCLASS ) {
- if ( $read ) {
- foreach my $hostname ( sort keys %{$host_part->{$HOSTCLASS}} ) {
- print "\t".$srv."\n" ;
- my $srv_net = get_srv_iface ( $IP_TYPE, $hostname, $host_part->{$HOSTCLASS}->{$srv} ) ;
- if ( ! defined $srv_net ) {
- Abort ( $CODE->{'UNDEF_KEY'},
- "IP feature ".$IP_TYPE." is deactivated in pf-tools configuration file" );
- }
- foreach my $iface ( sort keys %{$srv_net} ) {
- print "\t\t".$iface."(".$srv_net->{$iface}->{'vlan'}.")\t: ".$srv_net->{$iface}->{'addr'}."\n" ;
- }
- }
- }
- else {
- my $srv_ip = get_srv_ip ( $IP_TYPE, $HOSTCLASS, $host_part->{$HOSTCLASS} ) ;
- foreach my $ip ( sort { _ipcomp ( $a, $b ) } keys %{$srv_ip} ) {
- print $ip."\t".$srv_ip->{$ip}->{'hostname'}."(".$srv_ip->{$ip}->{'iface'}.")\n" ;
- }
- }
-} else {
- if ( $read ) {
- my $srv_type_list = order_servers ( $host_part ) ;
- foreach my $prio ( sort keys %{$srv_type_list} ) {
- print "Server with deployment priority : ".$prio."\n" ;
- foreach my $srv_type ( sort @{$srv_type_list->{$prio}} ) {
- foreach my $srv ( sort keys %{$host_part->{$srv_type}} ) {
- print "\t".$srv."\n" ;
- my $srv_net = get_srv_iface ( $srv, $host_part->{$srv_type}->{$srv} ) ;
- foreach my $iface ( sort keys %{$srv_net} ) {
- print "\t\t".$iface."(".$srv_net->{$iface}->{'vlan'}.")\t: ".$srv_net->{$iface}->{'addr'}."\n" ;
- }
- }
- print "\n" ;
- }
- print "\n" ;
- }
- }
- else {
- my $ip_list = get_all_ip ( $host_part ) ;
- foreach my $ip ( sort { _ipcomp ( $a, $b ) } keys %{$ip_list} ) {
- print "$ip\t" . join(' ', map { "$_->{'hostname'}($_->{'iface'})" } @{ $ip_list->{$ip} }) . "\n" ;
- }
- }
+if ($HELP) {
+ Do_help();
+ exit 0;
+}
+
+( $PF_CONFIG, $GLOBAL_STRUCT )
+ = Init_TOOLS( "", $PF_CONFIG_FILE, $GLOBAL_STORE_FILE );
+
+if ( $SITE eq '' && !defined $PF_CONFIG->{'location'}->{'site'} ) {
+ my $site_list = Get_site_from_hostname( $HOSTNAME, $GLOBAL_STRUCT );
+ if ( !defined $site_list ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unable to retrieve site for hostname "
+ . $HOSTNAME
+ . " : hostname not defined" );
+ }
+ elsif ( scalar @{$site_list} > 1 ) {
+ Abort( $CODE->{'DUPLICATE_VALUE'},
+ "Unable to retrieve site for hostname "
+ . $HOSTNAME
+ . " : hostname appeared in multiple sites : "
+ . join( ",", @{$site_list} ) . ".\n"
+ . "Please relaunch this command with the right site" );
+ }
+ else {
+ ($SITE) = @{$site_list};
+ }
+}
+
+my $host_part
+ = $GLOBAL_STRUCT->{'SITE'}->{'BY_NAME'}->{$SITE}->{'HOST'}->{'BY_NAME'};
+if ( $HOSTCLASS ne "" && !defined $$host_part->{$HOSTCLASS} ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "Unexistant hostclass in global configuration" );
+}
+if ($HOSTCLASS) {
+ if ($read) {
+ foreach my $hostname ( sort keys %{ $host_part->{$HOSTCLASS} } ) {
+ print "\t" . $srv . "\n";
+ my $srv_net = get_srv_iface( $IP_TYPE, $hostname,
+ $host_part->{$HOSTCLASS}->{$srv} );
+ if ( !defined $srv_net ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "IP feature "
+ . $IP_TYPE
+ . " is deactivated in pf-tools configuration file" );
+ }
+ foreach my $iface ( sort keys %{$srv_net} ) {
+ print "\t\t"
+ . $iface . "("
+ . $srv_net->{$iface}->{'vlan'} . ")\t: "
+ . $srv_net->{$iface}->{'addr'} . "\n";
+ }
+ }
+ }
+ else {
+ my $srv_ip
+ = get_srv_ip( $IP_TYPE, $HOSTCLASS, $host_part->{$HOSTCLASS} );
+ foreach my $ip ( sort { _ipcomp( $a, $b ) } keys %{$srv_ip} ) {
+ print $ip. "\t"
+ . $srv_ip->{$ip}->{'hostname'} . "("
+ . $srv_ip->{$ip}->{'iface'} . ")\n";
+ }
+ }
+}
+else {
+ if ($read) {
+ my $srv_type_list = order_servers($host_part);
+ foreach my $prio ( sort keys %{$srv_type_list} ) {
+ print "Server with deployment priority : " . $prio . "\n";
+ foreach my $srv_type ( sort @{ $srv_type_list->{$prio} } ) {
+ foreach my $srv ( sort keys %{ $host_part->{$srv_type} } ) {
+ print "\t" . $srv . "\n";
+ my $srv_net = get_srv_iface( $srv,
+ $host_part->{$srv_type}->{$srv} );
+ foreach my $iface ( sort keys %{$srv_net} ) {
+ print "\t\t"
+ . $iface . "("
+ . $srv_net->{$iface}->{'vlan'} . ")\t: "
+ . $srv_net->{$iface}->{'addr'} . "\n";
+ }
+ }
+ print "\n";
+ }
+ print "\n";
+ }
+ }
+ else {
+ my $ip_list = get_all_ip($host_part);
+ foreach my $ip ( sort { _ipcomp( $a, $b ) } keys %{$ip_list} ) {
+ print "$ip\t"
+ . join( ' ',
+ map {"$_->{'hostname'}($_->{'iface'})"} @{ $ip_list->{$ip} } )
+ . "\n";
+ }
+ }
}
exit 0;
Modified: branches/next-gen/tools/Translate_old_config
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/tools/Translate_old_config?rev=881&op=diff
==============================================================================
--- branches/next-gen/tools/Translate_old_config (original)
+++ branches/next-gen/tools/Translate_old_config Tue Sep 7 08:55:02 2010
@@ -31,18 +31,18 @@
use PFTools::Logger;
use PFTools::Compat::Parser;
use PFTools::Compat::Translation;
-use Getopt::Long qw ( :config ignore_case_always bundling ) ;
+use Getopt::Long qw ( :config ignore_case_always bundling );
#################################
# Global vars
-my $INPUT = "";
-my $OUTPUT = "";
-my $INCLUDE = 0;
-my $TYPE = "config";
-my $HELP = 0;
+my $INPUT = "";
+my $OUTPUT = "";
+my $INCLUDE = 0;
+my $TYPE = "config";
+my $HELP = 0;
my $program = $0;
-$program =~ s%.*/%%; # cheap basename
+$program =~ s%.*/%%; # cheap basename
my $version = sprintf( "svn-r%s", q$Revision$ =~ /([\d.]+)/ );
@@ -50,7 +50,7 @@
# Functions
sub Do_help () {
-print STDERR << "# ENDHELP";
+ print STDERR << "# ENDHELP";
$program - version $version
Usage: $0 [options]
@@ -66,69 +66,81 @@
#######################################################""
### MAIN
-GetOptions (
- 'help' => \$HELP,
- 'include' => \$INCLUDE,
- 't|type=s' => \$TYPE,
- 'i|input=s' => \$INPUT,
- 'o|output=s' => \$OUTPUT
+GetOptions(
+ 'help' => \$HELP,
+ 'include' => \$INCLUDE,
+ 't|type=s' => \$TYPE,
+ 'i|input=s' => \$INPUT,
+ 'o|output=s' => \$OUTPUT
) or die "Didn't grok options (see --help).\n";
-if ( $HELP ) {
- Do_help ();
- exit 0;
+if ($HELP) {
+ Do_help();
+ exit 0;
}
-if ( ! -e $INPUT ) {
- Abort ( $CODE->{'UNDEF_KEY'}, "File ".$INPUT." doesn't exist : unable to translate old configuration" );
+if ( !-e $INPUT ) {
+ Abort( $CODE->{'UNDEF_KEY'},
+ "File "
+ . $INPUT
+ . " doesn't exist : unable to translate old configuration" );
}
-my $old_parsing = Parser_pftools ( $INPUT, {}, $INCLUDE );
-my $trans = {};
+my $old_parsing = Parser_pftools( $INPUT, {}, $INCLUDE );
+my $trans = {};
if ( $TYPE eq 'config' ) {
- $trans = Translate_old2new_config ( $old_parsing );
+ $trans = Translate_old2new_config($old_parsing);
}
else {
- foreach my $section ( keys %{$old_parsing} ) {
- if ( $old_parsing->{$section}->{'type'} eq 'network' ) {
- $trans->{$section} = Translate_old2new_network ( $old_parsing->{$section}, $section );
- }
- elsif ( $old_parsing->{$section}->{'type'} =~ /-server$/ ) {
- my $pftools = 0;
- # Need to see if it is a "virtual pf-tools" host or a "real pf-tools" host
- foreach my $key ( keys %{$old_parsing->{$section}} ) {
- if ( $key =~ /^ether\.\d+$/ ) {
- $pftools++;
- last;
- }
- }
- if ( $pftools ) {
- # We need to translate into a hostfile configuration
- $trans->{'__hostfile'} = {
- $section => Translate_old2new_host ( $old_parsing->{$section}, $section )
- };
- }
- }
- }
+ foreach my $section ( keys %{$old_parsing} ) {
+ if ( $old_parsing->{$section}->{'type'} eq 'network' ) {
+ $trans->{$section}
+ = Translate_old2new_network( $old_parsing->{$section},
+ $section );
+ }
+ elsif ( $old_parsing->{$section}->{'type'} =~ /-server$/ ) {
+ my $pftools = 0;
+
+ # Need to see if it is a "virtual pf-tools" host or a "real pf-tools" host
+ foreach my $key ( keys %{ $old_parsing->{$section} } ) {
+ if ( $key =~ /^ether\.\d+$/ ) {
+ $pftools++;
+ last;
+ }
+ }
+ if ($pftools) {
+
+ # We need to translate into a hostfile configuration
+ $trans->{'__hostfile'} = {
+ $section => Translate_old2new_host(
+ $old_parsing->{$section}, $section
+ )
+ };
+ }
+ }
+ }
}
-unless ( open OUTPUT, ">".$OUTPUT ) {
- Abort ( $CODE->{'OPEN'}, "Unable to open ".$OUTPUT." for translation" );
+unless ( open OUTPUT, ">" . $OUTPUT ) {
+ Abort( $CODE->{'OPEN'},
+ "Unable to open " . $OUTPUT . " for translation" );
}
if ( $TYPE eq 'config' ) {
- foreach my $section ( keys %{$trans} ) {
- next if ( $section =~ /^@/ );
- print OUTPUT "[".$section."]\n";
- foreach my $key ( keys %{$trans->{$section}} ) {
- next if ( $key =~ /^__/ );
- print OUTPUT "\t".$key."\t= ".$trans->{$section}->{$key}."\n";
- }
- print OUTPUT "\n";
- }
+ foreach my $section ( keys %{$trans} ) {
+ next if ( $section =~ /^@/ );
+ print OUTPUT "[" . $section . "]\n";
+ foreach my $key ( keys %{ $trans->{$section} } ) {
+ next if ( $key =~ /^__/ );
+ print OUTPUT "\t"
+ . $key . "\t= "
+ . $trans->{$section}->{$key} . "\n";
+ }
+ print OUTPUT "\n";
+ }
}
else {
- print "Need to implement the output for other type ".$TYPE;
- print Dumper $trans;
+ print "Need to implement the output for other type " . $TYPE;
+ print Dumper $trans;
}
-close ( OUTPUT );
+close(OUTPUT);
exit 0;
Modified: branches/next-gen/tools/dumpiplist.pl
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/tools/dumpiplist.pl?rev=881&op=diff
==============================================================================
--- branches/next-gen/tools/dumpiplist.pl (original)
+++ branches/next-gen/tools/dumpiplist.pl Tue Sep 7 08:55:02 2010
@@ -31,15 +31,15 @@
use PFTools::Net;
use PFTools::Update;
-use Getopt::Long qw ( :config ignore_case_always bundling ) ;
-
-my $help = 0 ;
-my $type = '' ;
-my $src = '' ;
-my $read = 0 ;
-my $program = $0;
-$program =~ s%.*/%%; # cheap basename
-my $version = sprintf( "svn-r%s", q$Revision$ =~ /([\d.]+)/ );
+use Getopt::Long qw ( :config ignore_case_always bundling );
+
+my $help = 0;
+my $type = '';
+my $src = '';
+my $read = 0;
+my $program = $0;
+$program =~ s%.*/%%; # cheap basename
+my $version = sprintf( "svn-r%s", q$Revision$ =~ /([\d.]+)/ );
sub _ipcomp {
my ( $a, $b ) = @_;
@@ -75,143 +75,168 @@
}
sub order_servers ($) {
- my ( $ref_net ) = @_ ;
- my $result = [] ;
- my $order = {} ;
-
- foreach my $srv ( keys %{$ref_net} ) {
- my $srv_order ;
- if ( ! defined $ref_net->{$srv}->{'order'} ) {
- $srv_order = 999 ;
- }
- else {
- $srv_order = $ref_net->{$srv}->{'order'} ;
- }
- push ( @{$order->{$srv_order}}, $srv ) ;
- }
-# foreach my $prio ( sort keys %{$order} ) {
-# foreach my $srv ( @{$order->{$prio}} ) {
-# push ( @{$result}, $srv ) ;
-# }
-# }
- return $order ;
+ my ($ref_net) = @_;
+ my $result = [];
+ my $order = {};
+
+ foreach my $srv ( keys %{$ref_net} ) {
+ my $srv_order;
+ if ( !defined $ref_net->{$srv}->{'order'} ) {
+ $srv_order = 999;
+ }
+ else {
+ $srv_order = $ref_net->{$srv}->{'order'};
+ }
+ push( @{ $order->{$srv_order} }, $srv );
+ }
+
+ # foreach my $prio ( sort keys %{$order} ) {
+ # foreach my $srv ( @{$order->{$prio}} ) {
+ # push ( @{$result}, $srv ) ;
+ # }
+ # }
+ return $order;
}
sub get_srv_iface ($$) {
- my ( $srv_name, $ref_srv ) = @_ ;
- my $ordered_vlan = {} ;
- my $result = {} ;
- foreach my $vlan ( keys %{$ref_srv->{'ifup'}} ) {
- my $vlan_name = $vlan ;
- $vlan_name =~ s/^$srv_name\.//;
- $ordered_vlan->{$ref_srv->{'ifup'}->{$vlan}} = $vlan_name ;
- }
- foreach my $iface ( sort keys %{$ordered_vlan} ) {
- $result->{$iface}->{'addr'} = $ref_srv->{'zone'}->{$srv_name.".".$ordered_vlan->{$iface}}->{'FIELD'} ;
- $result->{$iface}->{'vlan'} = $ordered_vlan->{$iface} ;
- }
- return $result ;
+ my ( $srv_name, $ref_srv ) = @_;
+ my $ordered_vlan = {};
+ my $result = {};
+ foreach my $vlan ( keys %{ $ref_srv->{'ifup'} } ) {
+ my $vlan_name = $vlan;
+ $vlan_name =~ s/^$srv_name\.//;
+ $ordered_vlan->{ $ref_srv->{'ifup'}->{$vlan} } = $vlan_name;
+ }
+ foreach my $iface ( sort keys %{$ordered_vlan} ) {
+ $result->{$iface}->{'addr'} = $ref_srv->{'zone'}
+ ->{ $srv_name . "." . $ordered_vlan->{$iface} }->{'FIELD'};
+ $result->{$iface}->{'vlan'} = $ordered_vlan->{$iface};
+ }
+ return $result;
}
sub get_srv_ip ($$) {
- my ( $srv_type, $ref_net ) = @_ ;
- my $result = {} ;
-
- foreach my $srv ( keys %{$ref_net->{$srv_type}->{'SRVLIST'}} ) {
- my $ref_srv = $ref_net->{$srv_type}->{'SRVLIST'}->{$srv} ;
- foreach my $iface ( keys %{$ref_srv->{'zone'}} ) {
- next if ( $iface !~ /^$srv\./ ) ;
- $result->{$ref_srv->{'zone'}->{$iface}->{'FIELD'}}->{'hostname'} = $srv ;
- $result->{$ref_srv->{'zone'}->{$iface}->{'FIELD'}}->{'iface'} = $ref_srv->{'ifup'}->{$iface} ;
- }
- }
- return $result ;
+ my ( $srv_type, $ref_net ) = @_;
+ my $result = {};
+
+ foreach my $srv ( keys %{ $ref_net->{$srv_type}->{'SRVLIST'} } ) {
+ my $ref_srv = $ref_net->{$srv_type}->{'SRVLIST'}->{$srv};
+ foreach my $iface ( keys %{ $ref_srv->{'zone'} } ) {
+ next if ( $iface !~ /^$srv\./ );
+ $result->{ $ref_srv->{'zone'}->{$iface}->{'FIELD'} }->{'hostname'}
+ = $srv;
+ $result->{ $ref_srv->{'zone'}->{$iface}->{'FIELD'} }->{'iface'}
+ = $ref_srv->{'ifup'}->{$iface};
+ }
+ }
+ return $result;
}
sub get_all_ip ($) {
- my ( $ref_net ) = @_ ;
- my $result = {} ;
-
- foreach my $srv_type ( keys %{$ref_net} ) {
- foreach my $srv ( keys %{$ref_net->{$srv_type}->{'SRVLIST'}} ) {
- my $ref_srv = $ref_net->{$srv_type}->{'SRVLIST'}->{$srv} ;
- foreach my $iface ( keys %{$ref_srv->{'zone'}} ) {
- next if ( $iface !~ /^$srv\./ ) ;
- my $entry = {
- 'hostname' => $srv,
- 'iface' => $ref_srv->{'ifup'}->{$iface}
- } ;
- push ( @{$result->{$ref_srv->{'zone'}->{$iface}->{'FIELD'}}}, $entry ) ;
- }
- }
- }
- return $result ;
-}
-
-GetOptions (
- 'help|h' => \$help,
- 'type|t=s' => \$type,
- 'read|r' => \$read,
- 'src|s=s' => \$src
-) || die "Didn't grok options on CLI\n" ;
-
-if ( $help ) {
- Do_help () ;
- exit 0 ;
-}
-
-if ( ! $src ) {
- die "Source file for network description is not defined\n" ;
-} elsif ( ! -e $src ) {
- die $src." source file doesn't exist\n" ;
-}
-
-my $PF_NET = Init_lib_net ( Get_source ( $src ) );
-my $SRV_LIST = $PF_NET->{'SERVERS'}->{'BY_NAME'} ;
-
-if ( $type && ! defined $SRV_LIST->{$type} ) {
- die "Non existant server type ".$type."\n" ;
+ my ($ref_net) = @_;
+ my $result = {};
+
+ foreach my $srv_type ( keys %{$ref_net} ) {
+ foreach my $srv ( keys %{ $ref_net->{$srv_type}->{'SRVLIST'} } ) {
+ my $ref_srv = $ref_net->{$srv_type}->{'SRVLIST'}->{$srv};
+ foreach my $iface ( keys %{ $ref_srv->{'zone'} } ) {
+ next if ( $iface !~ /^$srv\./ );
+ my $entry = {
+ 'hostname' => $srv,
+ 'iface' => $ref_srv->{'ifup'}->{$iface}
+ };
+ push(
+ @{ $result->{ $ref_srv->{'zone'}->{$iface}->{'FIELD'} }
+ },
+ $entry
+ );
+ }
+ }
+ }
+ return $result;
+}
+
+GetOptions(
+ 'help|h' => \$help,
+ 'type|t=s' => \$type,
+ 'read|r' => \$read,
+ 'src|s=s' => \$src
+) || die "Didn't grok options on CLI\n";
+
+if ($help) {
+ Do_help();
+ exit 0;
+}
+
+if ( !$src ) {
+ die "Source file for network description is not defined\n";
+}
+elsif ( !-e $src ) {
+ die $src . " source file doesn't exist\n";
+}
+
+my $PF_NET = Init_lib_net( Get_source($src) );
+my $SRV_LIST = $PF_NET->{'SERVERS'}->{'BY_NAME'};
+
+if ( $type && !defined $SRV_LIST->{$type} ) {
+ die "Non existant server type " . $type . "\n";
}
# print Dumper $PF_NET;
-if ( $type ) {
- if ( $read ) {
- foreach my $srv ( sort keys %{$SRV_LIST->{$type}->{'SRVLIST'}} ) {
- print "\t".$srv."\n" ;
- my $srv_net = get_srv_iface ( $srv, $SRV_LIST->{$type}->{'SRVLIST'}->{$srv} ) ;
- foreach my $iface ( sort keys %{$srv_net} ) {
- print "\t\t".$iface."(".$srv_net->{$iface}->{'vlan'}.")\t: ".$srv_net->{$iface}->{'addr'}."\n" ;
- }
- }
- }
- else {
- my $srv_ip = get_srv_ip ( $type, $SRV_LIST ) ;
- foreach my $ip ( sort { _ipcomp ( $a, $b ) } keys %{$srv_ip} ) {
- print $ip."\t".$srv_ip->{$ip}->{'hostname'}."(".$srv_ip->{$ip}->{'iface'}.")\n" ;
- }
- }
-} else {
- if ( $read ) {
- my $srv_type_list = order_servers ( $SRV_LIST ) ;
- foreach my $prio ( sort keys %{$srv_type_list} ) {
- print "Server with deployment priority : ".$prio."\n" ;
- foreach my $srv_type ( sort @{$srv_type_list->{$prio}} ) {
- foreach my $srv ( sort keys %{$SRV_LIST->{$srv_type}->{'SRVLIST'}} ) {
- print "\t".$srv."\n" ;
- my $srv_net = get_srv_iface ( $srv, $SRV_LIST->{$srv_type}->{'SRVLIST'}->{$srv} ) ;
- foreach my $iface ( sort keys %{$srv_net} ) {
- print "\t\t".$iface."(".$srv_net->{$iface}->{'vlan'}.")\t: ".$srv_net->{$iface}->{'addr'}."\n" ;
- }
- }
- print "\n" ;
- }
- print "\n" ;
- }
- }
- else {
- my $ip_list = get_all_ip ( $SRV_LIST ) ;
- foreach my $ip ( sort { _ipcomp ( $a, $b ) } keys %{$ip_list} ) {
- print "$ip\t" . join(' ', map { "$_->{'hostname'}($_->{'iface'})" } @{ $ip_list->{$ip} }) . "\n" ;
- }
- }
-}
+if ($type) {
+ if ($read) {
+ foreach my $srv ( sort keys %{ $SRV_LIST->{$type}->{'SRVLIST'} } ) {
+ print "\t" . $srv . "\n";
+ my $srv_net = get_srv_iface( $srv,
+ $SRV_LIST->{$type}->{'SRVLIST'}->{$srv} );
+ foreach my $iface ( sort keys %{$srv_net} ) {
+ print "\t\t"
+ . $iface . "("
+ . $srv_net->{$iface}->{'vlan'} . ")\t: "
+ . $srv_net->{$iface}->{'addr'} . "\n";
+ }
+ }
+ }
+ else {
+ my $srv_ip = get_srv_ip( $type, $SRV_LIST );
+ foreach my $ip ( sort { _ipcomp( $a, $b ) } keys %{$srv_ip} ) {
+ print $ip. "\t"
+ . $srv_ip->{$ip}->{'hostname'} . "("
+ . $srv_ip->{$ip}->{'iface'} . ")\n";
+ }
+ }
+}
+else {
+ if ($read) {
+ my $srv_type_list = order_servers($SRV_LIST);
+ foreach my $prio ( sort keys %{$srv_type_list} ) {
+ print "Server with deployment priority : " . $prio . "\n";
+ foreach my $srv_type ( sort @{ $srv_type_list->{$prio} } ) {
+ foreach my $srv (
+ sort keys %{ $SRV_LIST->{$srv_type}->{'SRVLIST'} } )
+ {
+ print "\t" . $srv . "\n";
+ my $srv_net = get_srv_iface( $srv,
+ $SRV_LIST->{$srv_type}->{'SRVLIST'}->{$srv} );
+ foreach my $iface ( sort keys %{$srv_net} ) {
+ print "\t\t"
+ . $iface . "("
+ . $srv_net->{$iface}->{'vlan'} . ")\t: "
+ . $srv_net->{$iface}->{'addr'} . "\n";
+ }
+ }
+ print "\n";
+ }
+ print "\n";
+ }
+ }
+ else {
+ my $ip_list = get_all_ip($SRV_LIST);
+ foreach my $ip ( sort { _ipcomp( $a, $b ) } keys %{$ip_list} ) {
+ print "$ip\t"
+ . join( ' ',
+ map {"$_->{'hostname'}($_->{'iface'})"} @{ $ip_list->{$ip} } )
+ . "\n";
+ }
+ }
+}
Modified: branches/next-gen/tools/kvmlaunch
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/tools/kvmlaunch?rev=881&op=diff
==============================================================================
--- branches/next-gen/tools/kvmlaunch (original)
+++ branches/next-gen/tools/kvmlaunch Tue Sep 7 08:55:02 2010
@@ -33,7 +33,7 @@
use Carp;
use Digest::CRC qw( crc32_hex );
-use English qw( -no_match_vars ); # Avoids regex performance penalty
+use English qw( -no_match_vars ); # Avoids regex performance penalty
use File::Path;
use Getopt::Long;
@@ -53,136 +53,125 @@
#}
my $option = {
- 'cvs-update' => 1,
- debug => 0,
- detached => 0,
- 'disk-size' => 1024,
- errors => 1,
- mode => 'boot',
- 'ram-size' => 256,
- verbose => 0,
+ 'cvs-update' => 1,
+ debug => 0,
+ detached => 0,
+ 'disk-size' => 1024,
+ errors => 1,
+ mode => 'boot',
+ 'ram-size' => 256,
+ verbose => 0,
};
Getopt::Long::Configure("bundling");
-GetOptions( $option,
- 'cvs-update!',
- 'debug|d+',
- 'detached!',
- 'disk-size=s',
- 'errors!',
- 'help|h',
- 'mode|m=s',
- 'oneeach|1',
- 'ram-size=s',
- 'regex|e',
- 'verbose|v+',
+GetOptions(
+ $option, 'cvs-update!', 'debug|d+', 'detached!',
+ 'disk-size=s', 'errors!', 'help|h', 'mode|m=s',
+ 'oneeach|1', 'ram-size=s', 'regex|e', 'verbose|v+',
) or die "FATAL: GetOptions error, try --help";
-if ($option->{'help'} or not @ARGV) {
+if ( $option->{'help'} or not @ARGV ) {
usage();
exit 1;
}
-if ($option->{'oneeach'}) {
+if ( $option->{'oneeach'} ) {
$option->{'detached'} = 1;
$option->{'errors'} = 0;
}
-if ($option->{'debug'}) {
- $option->{'verbose'} = 1;
-}
-
-
-if ($option->{'cvs-update'}) {
+if ( $option->{'debug'} ) {
+ $option->{'verbose'} = 1;
+}
+
+if ( $option->{'cvs-update'} ) {
CVS_update( undef, $option )
- && die "FATAL: Unable to load configuration.\n";
+ && die "FATAL: Unable to load configuration.\n";
}
my $Z = Init_lib_net( Get_source("GLOBAL:private-network") );
-my @hosts = __get_hosts($Z, $option, @ARGV);
+my @hosts = __get_hosts( $Z, $option, @ARGV );
while ( defined( my $vm_hostname = shift @hosts ) ) {
- eval { __handle_vm($vm_hostname, $Z, $option); };
+ eval { __handle_vm( $vm_hostname, $Z, $option ); };
if ($EVAL_ERROR) {
- die "FATAL: $vm_hostname: $EVAL_ERROR\n"
- if $option->{'errors'};
-
- warn "IGNORED: $vm_hostname: $EVAL_ERROR\n";
+ die "FATAL: $vm_hostname: $EVAL_ERROR\n"
+ if $option->{'errors'};
+
+ warn "IGNORED: $vm_hostname: $EVAL_ERROR\n";
}
}
exit 0;
# End of program: only functions below.
-
# Return the list of host names to launch
sub __get_hosts {
- my ($Z, $option, @argv) = @_;
-
- my @hosts_pattern =
- $option->{'oneeach'} ? ('00$')
- : $option->{'regex'} ? @argv
- : map { '^' . $_ . '$' } @argv;
+ my ( $Z, $option, @argv ) = @_;
+
+ my @hosts_pattern
+ = $option->{'oneeach'} ? ('00$')
+ : $option->{'regex'} ? @argv
+ : map { '^' . $_ . '$' } @argv;
my @hosts = Get_Ordered_Filtered_Hosts( $Z, @hosts_pattern );
die "FATAL: No matching host found.\n"
- unless @hosts;
-
+ unless @hosts;
+
warn "DEBUG: hosts: @hosts\n"
- if $option->{'debug'};
+ if $option->{'debug'};
return @hosts;
}
-
# Do the magic for one VM
sub __handle_vm {
- my ($vm_hostname, $Z, $option) = @_;
+ my ( $vm_hostname, $Z, $option ) = @_;
warn "INFO: handling host $vm_hostname\n"
- if $option->{'verbose'};
+ if $option->{'verbose'};
my $vm_dir = "/home/kvm/vm/$vm_hostname";
- unless (-d $vm_dir) {
- warn "INFO: creating $vm_dir\n"
- if $option->{'verbose'};
-
- mkpath($vm_dir); # will properly croak() if needed
+ unless ( -d $vm_dir ) {
+ warn "INFO: creating $vm_dir\n"
+ if $option->{'verbose'};
+
+ mkpath($vm_dir); # will properly croak() if needed
}
my $vm_disk_file = "$vm_dir/$vm_hostname.qcow";
- unless (-f $vm_disk_file) {
- warn "INFO: no disk file, forcing install mode\n"
- if $option->{'verbose'};
-
- $option->{'mode'} = 'install';
- }
-
- my @interfaces = __get_list_of_interfaces($Z, $vm_hostname);
- my @net_args =
- map { ('-net', $_) }
- map { (
- "nic,vlan=$_->{'vlan'},macaddr=$_->{'mac'},model=e1000",
- "tap,vlan=$_->{'vlan'},ifname=$_->{'ifname'},script=no",
- ) }
- @interfaces;
-
- my @screen_args = ('-S', $vm_hostname);
+ unless ( -f $vm_disk_file ) {
+ warn "INFO: no disk file, forcing install mode\n"
+ if $option->{'verbose'};
+
+ $option->{'mode'} = 'install';
+ }
+
+ my @interfaces = __get_list_of_interfaces( $Z, $vm_hostname );
+ my @net_args
+ = map { ( '-net', $_ ) }
+ map {
+ ( "nic,vlan=$_->{'vlan'},macaddr=$_->{'mac'},model=e1000",
+ "tap,vlan=$_->{'vlan'},ifname=$_->{'ifname'},script=no",
+ )
+ } @interfaces;
+
+ my @screen_args = ( '-S', $vm_hostname );
push @screen_args, qw( -d -m )
- if $option->{'detached'};
-
- if ($option->{'mode'} eq 'stop-net') {
- __remove_tap_interfaces($option, @interfaces);
- exit 0;
- }
-
- __install_tap_interfaces($option, @interfaces);
- if ($option->{'mode'} eq 'start-net') {
- exit 0;
+ if $option->{'detached'};
+
+ if ( $option->{'mode'} eq 'stop-net' ) {
+ __remove_tap_interfaces( $option, @interfaces );
+ exit 0;
+ }
+
+ __install_tap_interfaces( $option, @interfaces );
+ if ( $option->{'mode'} eq 'start-net' ) {
+ exit 0;
}
# TODO: prepend console=ttyS0.... to the cmdline in order to use kvm's
@@ -195,53 +184,54 @@
# (yet?) how to do that.
my @kvm_cmd = (
- 'screen', @screen_args,
- 'kvm',
- '-drive', "file=$vm_disk_file,if=scsi,boot=on",
- '-m', $option->{'ram-size'},
- @net_args,
- '-curses', '-k', 'fr',
-# '-nographic', '-monitor', qx{tty},
+ 'screen', @screen_args,
+ 'kvm',
+ '-drive', "file=$vm_disk_file,if=scsi,boot=on",
+ '-m', $option->{'ram-size'},
+ @net_args,
+ '-curses', '-k', 'fr',
+
+ # '-nographic', '-monitor', qx{tty},
);
- if ($option->{'mode'} eq 'install') {
- __system_or_croak("kvm-img create $vm_disk_file $option->{'disk-size'}M");
-
- # TODO: To fix the two following "FIXME" markers: extract the necessary
- # parts from mk_pxelinuxcfg and put them in a package in order to be
- # able to use here $SUBST (for ARCH PRESEED_URL CMDLINE etc.)
- #
- # kernel debian-installer/%ARCH%/linux initrd
- # debian-installer/%ARCH%/initrd.gz append DEBCONF_PRIORITY=critical
- # vga=normal auto=true initrd=debian-installer/%ARCH%/initrd.gz
- # interface=eth0 netcfg/no_default_route=true url=%PRESEED_URL%
- # url/checksum=%PRESEED_MD5% -- %CONSOLE% %CMDLINE%
-
- # FIXME: 'amd64' hardcoded
- my $kernel = '/distrib/tftpboot/debian-installer/amd64/linux';
- my $initrd = '/distrib/tftpboot/debian-installer/amd64/initrd.gz';
-
- # FIXME: this is a dirty hack to get the cmdline from the PXE config file.
- my $vm_ip_in_hex = __get_host_ip_in_hex($Z, $vm_hostname);
- my $pxe_cfg_file = "/distrib/tftpboot/pxelinux.cfg/$vm_ip_in_hex";
- my $cmdline = qx{grep DEBCONF_PRIORITY $pxe_cfg_file};
- chomp $cmdline;
- $cmdline =~ s{\A \s* append \s* (.*) \s* \z}{$1}xms;
-
- # Disable framebuffer for the installation, I prefer the good old text mode,
- # especially when connected via the "curses" or "monitor" KVM modes!
- $cmdline =~ s{vga=normal}{fb=false}xms;
-
- push @kvm_cmd,
- '-no-reboot',
- '-kernel', $kernel,
- '-initrd', $initrd,
- '-append', $cmdline;
+ if ( $option->{'mode'} eq 'install' ) {
+ __system_or_croak(
+ "kvm-img create $vm_disk_file $option->{'disk-size'}M");
+
+ # TODO: To fix the two following "FIXME" markers: extract the necessary
+ # parts from mk_pxelinuxcfg and put them in a package in order to be
+ # able to use here $SUBST (for ARCH PRESEED_URL CMDLINE etc.)
+ #
+ # kernel debian-installer/%ARCH%/linux initrd
+ # debian-installer/%ARCH%/initrd.gz append DEBCONF_PRIORITY=critical
+ # vga=normal auto=true initrd=debian-installer/%ARCH%/initrd.gz
+ # interface=eth0 netcfg/no_default_route=true url=%PRESEED_URL%
+ # url/checksum=%PRESEED_MD5% -- %CONSOLE% %CMDLINE%
+
+ # FIXME: 'amd64' hardcoded
+ my $kernel = '/distrib/tftpboot/debian-installer/amd64/linux';
+ my $initrd = '/distrib/tftpboot/debian-installer/amd64/initrd.gz';
+
+ # FIXME: this is a dirty hack to get the cmdline from the PXE config file.
+ my $vm_ip_in_hex = __get_host_ip_in_hex( $Z, $vm_hostname );
+ my $pxe_cfg_file = "/distrib/tftpboot/pxelinux.cfg/$vm_ip_in_hex";
+ my $cmdline = qx{grep DEBCONF_PRIORITY $pxe_cfg_file};
+ chomp $cmdline;
+ $cmdline =~ s{\A \s* append \s* (.*) \s* \z}{$1}xms;
+
+ # Disable framebuffer for the installation, I prefer the good old text mode,
+ # especially when connected via the "curses" or "monitor" KVM modes!
+ $cmdline =~ s{vga=normal}{fb=false}xms;
+
+ push @kvm_cmd,
+ '-no-reboot',
+ '-kernel', $kernel,
+ '-initrd', $initrd,
+ '-append', $cmdline;
}
__system_or_croak(@kvm_cmd);
}
-
sub usage {
warn <<"EOH";
@@ -291,98 +281,98 @@
EOH
}
-
# Get the IP address for iface $iface of host $host
sub __get_iface_ip {
- my ($Z, $host, $iface) = @_;
-
- my $hostclass = Host_class( $host, $Z );
- my $N = $Z->{'SERVERS'}->{'BY_NAME'}->{$hostclass};
- my $M = $N->{'SRVLIST'}->{$host};
+ my ( $Z, $host, $iface ) = @_;
+
+ my $hostclass = Host_class( $host, $Z );
+ my $N = $Z->{'SERVERS'}->{'BY_NAME'}->{$hostclass};
+ my $M = $N->{'SRVLIST'}->{$host};
my $host_dot_vlan = '';
- foreach my $hdv (keys %{ $M->{'ifup'} }) {
- $host_dot_vlan = $hdv
- if $M->{'ifup'}->{$hdv} eq $iface;
+ foreach my $hdv ( keys %{ $M->{'ifup'} } ) {
+ $host_dot_vlan = $hdv
+ if $M->{'ifup'}->{$hdv} eq $iface;
}
croak "FATAL: Unable to find iface $iface"
- unless $host_dot_vlan;
+ unless $host_dot_vlan;
my $ip = $M->{'zone'}->{$host_dot_vlan}->{'FIELD'};
return $ip;
}
-
# Same as __get_iface_ip(), but give the IP address in hexadecimal format
sub __get_host_ip_in_hex {
- my ($Z, $host) = @_;
-
- my $ip = __get_iface_ip($Z, $host, 'eth0');
+ my ( $Z, $host ) = @_;
+
+ my $ip = __get_iface_ip( $Z, $host, 'eth0' );
return sprintf '%02X%02X%02X%02X', split '\.', $ip;
}
-
# Return a list of anonymous hashrefs describing the $host interfaces
sub __get_list_of_interfaces {
- my ($Z, $host) = @_;
-
- my ($dhcpif, $dhcp_address) = Get_Dhcp_Infos( $Z, $host );
+ my ( $Z, $host ) = @_;
+
+ my ( $dhcpif, $dhcp_address ) = Get_Dhcp_Infos( $Z, $host );
my @interfaces = ();
-# #UMRemap_If( $Z, $host );
+
+ # #UMRemap_If( $Z, $host );
my $umif = Get_UM_If( $Z, $host );
foreach my $ifname ( sort { cmpif( $a, $b ) } keys %{$umif} ) {
- my $tag = $umif->{$ifname};
- next unless defined $tag;
-
- my $virtual_ifname = __get_virtual_ifname($host, $ifname);
- my $ip_address = __get_iface_ip($Z, $host, $ifname);
-
- warn "DEBUG: iface $ifname <-> tag $tag <-> vif $virtual_ifname <-> IP $ip_address\n"
- if $option->{'debug'};
-
- my ($bridge_name, $mac_address);
- if ($tag == 13) {
-# $bridge_name = 'brsystem2'; # FIXME gruik temporaire
- $mac_address = uc $dhcp_address;
- }
- else {
- if ($tag eq 'TRUNK') {
- $tag = 0;
- }
-
- $bridge_name = "br$tag";
-
- my @mac_address = qw( AC DE 48 ); # private
- # Ajouter les 3 derniers octets de l'adresse IP de cette interface
- my @ip_address = split '\.', $ip_address;
- shift @ip_address;
- push @mac_address, map { sprintf "%02X", $_ } @ip_address;
-
- $mac_address = join ':', @mac_address;
- }
-
- push @interfaces, {
- bridge => $bridge_name,
- ifname => $virtual_ifname,
- ip => $ip_address,
- mac => $mac_address,
- vlan => $tag,
- };
+ my $tag = $umif->{$ifname};
+ next unless defined $tag;
+
+ my $virtual_ifname = __get_virtual_ifname( $host, $ifname );
+ my $ip_address = __get_iface_ip( $Z, $host, $ifname );
+
+ warn
+ "DEBUG: iface $ifname <-> tag $tag <-> vif $virtual_ifname <-> IP $ip_address\n"
+ if $option->{'debug'};
+
+ my ( $bridge_name, $mac_address );
+ if ( $tag == 13 ) {
+
+ # $bridge_name = 'brsystem2'; # FIXME gruik temporaire
+ $mac_address = uc $dhcp_address;
+ }
+ else {
+ if ( $tag eq 'TRUNK' ) {
+ $tag = 0;
+ }
+
+ $bridge_name = "br$tag";
+
+ my @mac_address = qw( AC DE 48 ); # private
+ # Ajouter les 3 derniers octets de l'adresse IP de cette interface
+ my @ip_address = split '\.', $ip_address;
+ shift @ip_address;
+ push @mac_address, map { sprintf "%02X", $_ } @ip_address;
+
+ $mac_address = join ':', @mac_address;
+ }
+
+ push @interfaces,
+ {
+ bridge => $bridge_name,
+ ifname => $virtual_ifname,
+ ip => $ip_address,
+ mac => $mac_address,
+ vlan => $tag,
+ };
}
return @interfaces;
}
-
#
# In our model, the virtual interfaces (the tun devices) are named as
# "$hostname.$number", where $hostname is the VM name and $number is the VM
# network interface number. For instance, the tun device for host admstream00
# interface eth2 would be "admstream00.2".
-#
+#
# However, a network interface name has a maximum size of $IFNAMESIZ - 1
# characters. So, the tun device for host abv1-ncdn-varnish00 interfaces eth0
# and eth1, "abv1-ncdn-varnish00.0" and "abv1-ncdn-varnish00.1", would both be
@@ -394,13 +384,17 @@
# gives us short enough names, such as "m-8f6aac88.0" and "m-8f6aac88.1"
# instead of "abv1-ncdn-varnish00.0" and "abv1-ncdn-varnish00.1".
#
-sub __get_virtual_ifname { my ($host, $ifname) = @_;
-
- my $IFNAMESIZ = 16; # <linux/if.h>
- my $MAX_HOSTNAME_SIZE = $IFNAMESIZ - 3; # '.' + one digit + NULL
+sub __get_virtual_ifname {
+ my ( $host, $ifname ) = @_;
+
+ my $IFNAMESIZ = 16; # <linux/if.h>
+ my $MAX_HOSTNAME_SIZE = $IFNAMESIZ - 3; # '.' + one digit + NULL
my ($iface_number) = $ifname =~ m{\A \D+ (\d+) \z}xms;
- my $mangled_hostname = length($host) > $MAX_HOSTNAME_SIZE ? "m-" . crc32_hex($host) : $host;
+ my $mangled_hostname
+ = length($host) > $MAX_HOSTNAME_SIZE
+ ? "m-" . crc32_hex($host)
+ : $host;
my $virtual_ifname = join '.', $mangled_hostname, $iface_number;
@@ -408,65 +402,66 @@
}
sub __install_tap_interfaces {
- my ($option, @interfaces) = @_;
+ my ( $option, @interfaces ) = @_;
foreach my $iface (@interfaces) {
- # create the TUN/TAP device
- __create_tun_device($option, $iface->{'ifname'});
-
- # add it to the bridge hosting the corresponding VLAN
- __brctl_addif($option, $iface->{'vlan'}, $iface->{'ifname'});
+
+ # create the TUN/TAP device
+ __create_tun_device( $option, $iface->{'ifname'} );
+
+ # add it to the bridge hosting the corresponding VLAN
+ __brctl_addif( $option, $iface->{'vlan'}, $iface->{'ifname'} );
}
}
sub __remove_tap_interfaces {
- my ($option, @interfaces) = @_;
+ my ( $option, @interfaces ) = @_;
foreach my $iface (@interfaces) {
- __brctl_delif($option, $iface->{'vlan'}, $iface->{'ifname'});
- __delete_tun_device($option, $iface->{'ifname'});
+ __brctl_delif( $option, $iface->{'vlan'}, $iface->{'ifname'} );
+ __delete_tun_device( $option, $iface->{'ifname'} );
}
}
sub __create_tun_device {
- my ($option, $ifname) = @_;
+ my ( $option, $ifname ) = @_;
warn "INFO: creating tun device $ifname\n"
- if $option->{'verbose'};
+ if $option->{'verbose'};
__system_or_carp("tunctl -b -t $ifname");
__system_or_carp("ifconfig $ifname up");
}
sub __delete_tun_device {
- my ($option, $ifname) = @_;
+ my ( $option, $ifname ) = @_;
warn "INFO: deleting tun device $ifname\n"
- if $option->{'verbose'};
+ if $option->{'verbose'};
__system_or_carp("ifconfig $ifname down");
__system_or_carp("tunctl -d $ifname");
}
sub __brctl_addif {
- my ($option, $vlan_tag, $ifname) = @_;
+ my ( $option, $vlan_tag, $ifname ) = @_;
my $brname = "br$vlan_tag";
warn "INFO: adding tun device $ifname to bridge $brname\n"
- if $option->{'verbose'};
+ if $option->{'verbose'};
my $cmd = "brctl addif $brname $ifname";
__system_or_carp($cmd);
}
sub __brctl_delif {
- my ($option, $vlan_tag, $ifname) = @_;
+ my ( $option, $vlan_tag, $ifname ) = @_;
my $brname = "br$vlan_tag";
warn "INFO: removing tun device $ifname from bridge $brname\n"
- if $option->{'verbose'};
+ if $option->{'verbose'};
my $cmd = "brctl delif $brname $ifname";
__system_or_carp($cmd);
@@ -476,13 +471,13 @@
my @cmd = @_;
system(@cmd) == 0
- or croak "FATAL: system(@cmd): $OS_ERROR";
+ or croak "FATAL: system(@cmd): $OS_ERROR";
}
sub __system_or_carp {
my @cmd = @_;
system(@cmd) == 0
- or carp "IGNORED: system(@cmd): $OS_ERROR\nGo check manually!";
-}
-
+ or carp "IGNORED: system(@cmd): $OS_ERROR\nGo check manually!";
+}
+
Modified: branches/next-gen/tools/pflaunch
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/tools/pflaunch?rev=881&op=diff
==============================================================================
--- branches/next-gen/tools/pflaunch (original)
+++ branches/next-gen/tools/pflaunch Tue Sep 7 08:55:02 2010
@@ -93,9 +93,9 @@
return unless $a and ref $a eq 'HASH';
foreach my $section ( keys %$a ) {
- foreach my $key ( keys %{ $a->{$section} } ) {
- $a->{$section}->{$key} =~ s/\s+#\s+.*$//;
- }
+ foreach my $key ( keys %{ $a->{$section} } ) {
+ $a->{$section}->{$key} =~ s/\s+#\s+.*$//;
+ }
}
return $a;
@@ -109,9 +109,9 @@
my ($if) = @_;
if ( length($if) > $IFNAMSIZ - 1 ) {
- my $oldif = $if;
- $if = substr( $if, length($if) - $IFNAMSIZ + 1 );
- __Debug("ifname trop long : $oldif -> $if");
+ my $oldif = $if;
+ $if = substr( $if, length($if) - $IFNAMSIZ + 1 );
+ __Debug("ifname trop long : $oldif -> $if");
}
return $if;
@@ -124,27 +124,27 @@
sub __runCmds ($;$) {
my $cmds;
if ( ref $_[0] eq 'ARRAY' ) {
- $cmds = shift;
+ $cmds = shift;
}
else {
- push @$cmds, shift;
+ push @$cmds, shift;
}
return unless defined $cmds;
my $quiet = shift;
my $ok = 1; # OK
foreach my $cmd (@$cmds) {
- my @ret = `$cmd 2>&1`;
-
- if ($?) {
- $ok = 0;
- }
- elsif ($quiet) {
- __Debug(@ret);
- }
- else {
- __Debug(@ret);
- }
+ my @ret = `$cmd 2>&1`;
+
+ if ($?) {
+ $ok = 0;
+ }
+ elsif ($quiet) {
+ __Debug(@ret);
+ }
+ else {
+ __Debug(@ret);
+ }
}
return $ok;
}
@@ -156,18 +156,18 @@
my $vm = shift;
unless ( defined $vm and $vm ) {
- __Err("__FamillyNumFromVM appelé sans parametre");
- return;
+ __Err("__FamillyNumFromVM appelé sans parametre");
+ return;
}
if ( defined $cache->{'FamillyNumFromVM '}->{$vm}
- and $cache->{'FamillyNumFromVM '}->{$vm} )
+ and $cache->{'FamillyNumFromVM '}->{$vm} )
{
- return (
- $cache->{'FamillyNumFromVM '}->{$vm}->{f},
- $cache->{'FamillyNumFromVM '}->{$vm}->{n},
- $cache->{'FamillyNumFromVM '}->{$vm}->{s}
- );
+ return (
+ $cache->{'FamillyNumFromVM '}->{$vm}->{f},
+ $cache->{'FamillyNumFromVM '}->{$vm}->{n},
+ $cache->{'FamillyNumFromVM '}->{$vm}->{s}
+ );
}
my $famille;
@@ -175,41 +175,41 @@
my $section;
if ( $vm =~ /^(\S+)(\d\d)$/ ) {
- $famille = $1;
- $num = $2;
- $section = $famille . "%%";
- unless ( exists $private_network->{$section} ) {
- if ( exists $private_network->{$vm} ) {
- __Info(
- "La section $section n'existe pas, c'est $vm qui sera prise à la place"
- );
- $section = $vm;
- }
- else {
- __Err(
- "La section $section n'existe pas, et pas de section $vm à la place. Problème a venir ..."
- );
- }
- }
+ $famille = $1;
+ $num = $2;
+ $section = $famille . "%%";
+ unless ( exists $private_network->{$section} ) {
+ if ( exists $private_network->{$vm} ) {
+ __Info(
+ "La section $section n'existe pas, c'est $vm qui sera prise à la place"
+ );
+ $section = $vm;
+ }
+ else {
+ __Err(
+ "La section $section n'existe pas, et pas de section $vm à la place. Problème a venir ..."
+ );
+ }
+ }
}
elsif ( $vm =~ /^(\S+)$/ ) {
- __Info(
- "Attention, nom de machine sans extension numerique, c'est bien ce que vous voulez ?"
- );
- $famille = $1;
- $num = 0;
- $section = $famille;
- unless ( $private_network->{$section}->{'umlfilename.default'} ) {
- __Info(
- "Attention, la machine `$vm' n'a pas de clef umlfilename.default, elle ne sera donc pas lancée"
- );
- }
+ __Info(
+ "Attention, nom de machine sans extension numerique, c'est bien ce que vous voulez ?"
+ );
+ $famille = $1;
+ $num = 0;
+ $section = $famille;
+ unless ( $private_network->{$section}->{'umlfilename.default'} ) {
+ __Info(
+ "Attention, la machine `$vm' n'a pas de clef umlfilename.default, elle ne sera donc pas lancée"
+ );
+ }
}
else {
- __Fault(
- "L'entrée `$vm' de votre fichier de configuration de correspond pas a un\n
+ __Fault(
+ "L'entrée `$vm' de votre fichier de configuration de correspond pas a un\n
nom de machine valide."
- );
+ );
}
$cache->{'FamillyNumFromVM '}->{$vm}->{f} = $famille;
$cache->{'FamillyNumFromVM '}->{$vm}->{n} = $num;
@@ -225,15 +225,15 @@
my $s = $private_network->{$section};
__Fault("Familly '$famille' NOT found !")
- unless ( defined($s) and ($section) );
+ unless ( defined($s) and ($section) );
__Fault("VM $famille$num out of range.") if ( $s->{number} <= $num );
my $listalias;
foreach my $key ( keys %$s ) {
- if ( $key =~ /^alias\.(\S+)/ ) {
- push @$listalias, $1 if ( $num == 0 );
- push @$listalias, $1 . $num;
- }
+ if ( $key =~ /^alias\.(\S+)/ ) {
+ push @$listalias, $1 if ( $num == 0 );
+ push @$listalias, $1 . $num;
+ }
}
return $listalias;
@@ -253,12 +253,12 @@
# Recherche des ipstart
$ipstart->{default}
- = ( defined( $s->{"ipstart.default"} ) )
- ? $s->{"ipstart.default"}
- : -1;
+ = ( defined( $s->{"ipstart.default"} ) )
+ ? $s->{"ipstart.default"}
+ : -1;
foreach my $key ( keys %$s ) {
- if ( $key =~ /^ipstart\.(\S+)/ ) {
+ if ( $key =~ /^ipstart\.(\S+)/ ) {
# ATTENTION ce calcul est faux si on ne travaille pas que sur des /24. Et
# c'est justement le cas avec le nouvel adressage !
@@ -266,26 +266,26 @@
#die "$famille, $num : ipstart.$1 out of range (".$s->{$key}.")\n"
# if (($s->{$key} > 254) or ($s->{$key} < 1));
- $ipstart->{$1} = $s->{$key};
- }
+ $ipstart->{$1} = $s->{$key};
+ }
}
# Creation des adresses
foreach my $key ( keys %$s ) {
- if ( $key =~ /^interface\.\S+/ ) {
- my $vlan = $s->{$key};
- my $network = $private_network->{$vlan}->{'network'};
- __Err("Can't get IP of vlan $vlan") unless defined $network;
- my $ip = Address(
- $network,
- ( defined $ipstart->{$vlan} )
- ? $ipstart->{$vlan}
- : $ipstart->{default},
- $num
- );
-
- push @$listip, { lan => $vlan, ip => $ip };
- }
+ if ( $key =~ /^interface\.\S+/ ) {
+ my $vlan = $s->{$key};
+ my $network = $private_network->{$vlan}->{'network'};
+ __Err("Can't get IP of vlan $vlan") unless defined $network;
+ my $ip = Address(
+ $network,
+ ( defined $ipstart->{$vlan} )
+ ? $ipstart->{$vlan}
+ : $ipstart->{default},
+ $num
+ );
+
+ push @$listip, { lan => $vlan, ip => $ip };
+ }
}
return $listip;
@@ -301,33 +301,33 @@
my $l = Config_Key( $configfile, "init", '@vlan' );
if ($l) {
- foreach ( @{$l} ) {
- $h->{"vlan-$_"} = 1 if defined $_;
- }
+ foreach ( @{$l} ) {
+ $h->{"vlan-$_"} = 1 if defined $_;
+ }
}
my $section_start = Config_Key( $configfile, "init", '@start' );
if ( !$section_start ) {
- __Fault(
- "Je ne trouve pas l'entrée \@start dans $configfile, (section [init])"
- );
+ __Fault(
+ "Je ne trouve pas l'entrée \@start dans $configfile, (section [init])"
+ );
}
foreach my $vm (@$section_start) {
- my ( $famille, $num, $section ) = __FamillyNumFromVM($vm);
-
- my $s = $private_network->{$section};
-
- unless ($s) {
- __Fault(
- "(Je ne peux pas lire la section `$section` from $privatenetworkfile pour la vm `$vm'"
- );
- }
-
- foreach my $lan ( %{$s} ) {
- $h->{ $s->{$lan} } = 1 if ( $lan =~ /^interface\./ );
- }
+ my ( $famille, $num, $section ) = __FamillyNumFromVM($vm);
+
+ my $s = $private_network->{$section};
+
+ unless ($s) {
+ __Fault(
+ "(Je ne peux pas lire la section `$section` from $privatenetworkfile pour la vm `$vm'"
+ );
+ }
+
+ foreach my $lan ( %{$s} ) {
+ $h->{ $s->{$lan} } = 1 if ( $lan =~ /^interface\./ );
+ }
}
# le sort, c'est juste pour ce que soit toujours traité dans le même ordre
@@ -345,19 +345,19 @@
my @brshow = `brctl show`;
shift @brshow; # ligne d'entete
foreach my $line (@brshow) {
- $h->{$1} = 1 if ( $line =~ /^(\S+)\s+/ );
+ $h->{$1} = 1 if ( $line =~ /^(\S+)\s+/ );
}
# Dans le cas ou la configuration a changé entre temps
if ( opendir( DIR, $PF_STATUS_DIR . "/bridge/" ) ) {
- foreach ( readdir DIR ) {
- next if /^\./;
- $h->{$_} = 1;
- }
- closedir DIR;
+ foreach ( readdir DIR ) {
+ next if /^\./;
+ $h->{$_} = 1;
+ }
+ closedir DIR;
}
else {
- __Err( "Can't open dir " . $PF_STATUS_DIR . "/bridge/" );
+ __Err( "Can't open dir " . $PF_STATUS_DIR . "/bridge/" );
}
@$listbr = sort keys %$h;
@@ -374,7 +374,7 @@
my $section = $private_network->{$vlan};
__Err("Can't read section [$vlan] from `$privatenetworkfile'")
- unless ( defined($section) and ($section) );
+ unless ( defined($section) and ($section) );
return $section;
}
@@ -386,16 +386,16 @@
my $listVM = Config_Key( $configfile, "init", "\@start" );
foreach my $vm (@$listVM) {
- my $uml_cfg = Config_Section( $configfile, "uml-$vm" );
-
- my $priorite = 10; # Val par defaut
- $priorite = $uml_cfg->{priorite}
- if ( defined( $uml_cfg->{priorite} ) );
-
- __Fault("Mauvaise priorite pour la section [uml-$vm]")
- if ( $priorite < 0 or $priorite > 255 );
-
- $umlToLaunch->[$priorite] .= " $vm";
+ my $uml_cfg = Config_Section( $configfile, "uml-$vm" );
+
+ my $priorite = 10; # Val par defaut
+ $priorite = $uml_cfg->{priorite}
+ if ( defined( $uml_cfg->{priorite} ) );
+
+ __Fault("Mauvaise priorite pour la section [uml-$vm]")
+ if ( $priorite < 0 or $priorite > 255 );
+
+ $umlToLaunch->[$priorite] .= " $vm";
}
return $umlToLaunch;
@@ -417,15 +417,15 @@
my @ipstart;
if ( $s->{ "ipstart." . $vlan } ) {
- @ipstart = split( /\./, $s->{ "ipstart." . $vlan } );
+ @ipstart = split( /\./, $s->{ "ipstart." . $vlan } );
}
else {
- @ipstart = split( /\./, $s->{"ipstart.default"} ) unless @ipstart;
+ @ipstart = split( /\./, $s->{"ipstart.default"} ) unless @ipstart;
}
unless (@ipstart) {
- __Err("can't find ipstart for `$section'");
- return;
+ __Err("can't find ipstart for `$section'");
+ return;
}
@ipstart = reverse @ipstart;
push @ipstart, "0" while ( @ipstart < 4 );
@@ -433,8 +433,8 @@
my $n = $private_network->{$vlan}->{'network'};
__Fault( "Je ne peux pas lire la s network du "
- . "vlan `$vlan' dans '$privatenetworkfile'" )
- unless $n;
+ . "vlan `$vlan' dans '$privatenetworkfile'" )
+ unless $n;
my @n_ip;
@n_ip = split( /\./, $n );
@@ -443,8 +443,8 @@
$ip[$_] = ( $n_ip[$_] + $ipstart[$_] ) foreach ( 0 .. 3 );
unless ( @n_ip == 4 ) {
- __Err("Ip invalide pour `$vm', `$vlan'");
- return;
+ __Err("Ip invalide pour `$vm', `$vlan'");
+ return;
}
$n_ip[3] += $num;
my $ip = join ".", @ip;
@@ -470,13 +470,13 @@
$mtu = Config_Key( $configfile, "vlan-default", "mtu" ) unless $mtu;
unless ($mtu) {
- __Err(
- "Can't read mtu from vlan-* section, using default (`$vlan_default_mtu')"
- );
- $mtu = $vlan_default_mtu;
+ __Err(
+ "Can't read mtu from vlan-* section, using default (`$vlan_default_mtu')"
+ );
+ $mtu = $vlan_default_mtu;
}
if ( $mtu > 1496 ) {
- __Err("$vlan : mtu de `$mtu' > à 1496");
+ __Err("$vlan : mtu de `$mtu' > à 1496");
}
my $t = Config_Key( $configfile, $vlan, "\@ip" );
@@ -485,54 +485,54 @@
my $arp = "";
my $settingarp = Config_Key( $configfile, $vlan, "arp" );
$settingarp = Config_Key( $configfile, "vlan-default", "arp" )
- unless $settingarp;
+ unless $settingarp;
if ($settingarp) {
- if ( $settingarp eq "true" ) {
- $arp = "arp";
- }
- elsif ( $settingarp eq "false" ) {
- $arp = "-arp";
- }
- else {
- __Err("Mauvaise valeur pour la clef arp (true/false)");
- }
+ if ( $settingarp eq "true" ) {
+ $arp = "arp";
+ }
+ elsif ( $settingarp eq "false" ) {
+ $arp = "-arp";
+ }
+ else {
+ __Err("Mauvaise valeur pour la clef arp (true/false)");
+ }
}
__Info(
- "Attention vous n'avez pas d'\@ip ni dans la section [vlan-default] ni"
- . "dans [vlan-$vlan] pour le vlan `$vlan'" )
- unless $t;
+ "Attention vous n'avez pas d'\@ip ni dans la section [vlan-default] ni"
+ . "dans [vlan-$vlan] pour le vlan `$vlan'" )
+ unless $t;
foreach my $v (@$t) {
- next unless defined $v;
- if ( $v =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(?:\/[\d.]+)?$/ ) {
+ next unless defined $v;
+ if ( $v =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(?:\/[\d.]+)?$/ ) {
# une IP et éventuellement un préfixe ou un netmask : 1.2.3.4/24 ou 1.2.3.4/255.255.255.0
# si pas de préfixe ou netmask : le netmask du vlan
- my ( $ip, $cidr ) = ipv4_parse($v); # 1.2.3.4, 24
- my $mask
- = $cidr
- ? ipv4_cidr2msk($cidr)
- : $vlan_setup->{netmask}; # 255.255.255.0
- __Debug("DEBUG: v=$v ip=$ip mask=$mask");
- push @ip, [ $ip, $mask ];
- }
- elsif ( $v ne 'none' ) {
+ my ( $ip, $cidr ) = ipv4_parse($v); # 1.2.3.4, 24
+ my $mask
+ = $cidr
+ ? ipv4_cidr2msk($cidr)
+ : $vlan_setup->{netmask}; # 255.255.255.0
+ __Debug("DEBUG: v=$v ip=$ip mask=$mask");
+ push @ip, [ $ip, $mask ];
+ }
+ elsif ( $v ne 'none' ) {
# un nom de machine (juste un hostname et on le prend dans le vlan courant)
- my $vn = __GetVMnet($v);
-
- unless ($vn) {
- __Err(
- "Mauvaise valeur : `$_' dans le fichier de conf dans une section \@ip"
- );
- }
-
- foreach (@$vn) {
- push @ip, [ $_->{ip}, $vlan_setup->{netmask} ]
- if $_->{lan} eq $vlan and $_->{ip};
- }
- }
+ my $vn = __GetVMnet($v);
+
+ unless ($vn) {
+ __Err(
+ "Mauvaise valeur : `$_' dans le fichier de conf dans une section \@ip"
+ );
+ }
+
+ foreach (@$vn) {
+ push @ip, [ $_->{ip}, $vlan_setup->{netmask} ]
+ if $_->{lan} eq $vlan and $_->{ip};
+ }
+ }
}
my $i;
@@ -540,30 +540,30 @@
# retrouver les interfaces que j'ai déja lancée
if ( open STATUS_IFBR, "<" . $PF_STATUS_DIR . "/ifbr" ) {
- foreach (<STATUS_IFBR>) {
- $i++ if (/^($brname|$brname:\d+)$/);
- }
- close STATUS_IFBR;
+ foreach (<STATUS_IFBR>) {
+ $i++ if (/^($brname|$brname:\d+)$/);
+ }
+ close STATUS_IFBR;
}
open STATUS_IFBR, ">>" . $PF_STATUS_DIR . "/ifbr";
foreach my $cidr (@ip) {
- my ( $ip, $mask ) = @$cidr;
-
- my $ifbr = $brname;
- $ifbr .= ":" if ($i);
- $ifbr .= $i - 1 if ($i);
- print STATUS_IFBR $ifbr . "\n";
-
- my $cmd = "ifconfig $ifbr";
- $cmd .= " $ip";
- $cmd .= " netmask $mask";
- $cmd .= " $arp";
- $cmd .= " mtu $mtu";
- $cmd .= " promisc" unless $i;
- $cmd .= " up";
-
- push @$cmds, $cmd;
- $i++;
+ my ( $ip, $mask ) = @$cidr;
+
+ my $ifbr = $brname;
+ $ifbr .= ":" if ($i);
+ $ifbr .= $i - 1 if ($i);
+ print STATUS_IFBR $ifbr . "\n";
+
+ my $cmd = "ifconfig $ifbr";
+ $cmd .= " $ip";
+ $cmd .= " netmask $mask";
+ $cmd .= " $arp";
+ $cmd .= " mtu $mtu";
+ $cmd .= " promisc" unless $i;
+ $cmd .= " up";
+
+ push @$cmds, $cmd;
+ $i++;
}
close STATUS_IFBR;
@@ -587,9 +587,9 @@
my $brname = "br" . $tag;
__Info( " Mise en place de '"
- . $vlan . "` ("
- . $vlan_setup->{comment}
- . ")" );
+ . $vlan . "` ("
+ . $vlan_setup->{comment}
+ . ")" );
__Debug( " bridge `" . $brname . " @ " . $vlan_setup->{network} . "'" );
# `ifconfig $brname 2>/dev/null`;
@@ -602,24 +602,24 @@
my $svlan = Config_Section( $configfile, $vlan );
foreach ( keys %$sdef ) {
- $br_setting->{$1} = $sdef->{ "br-" . $1 }
- if (/^br-(.+)$/);
+ $br_setting->{$1} = $sdef->{ "br-" . $1 }
+ if (/^br-(.+)$/);
}
foreach ( keys %$svlan ) {
- $br_setting->{$1} = $svlan->{ "br-" . $1 }
- if (/^br-(.+)$/);
+ $br_setting->{$1} = $svlan->{ "br-" . $1 }
+ if (/^br-(.+)$/);
}
unless ($br_setting) {
- __Debug(
- " Je ne trouve pas de réglage pour le br, j'utilise ce par defaut."
- );
- $br_setting = { stp => 'off', setfd => 1, sethello => 1 };
+ __Debug(
+ " Je ne trouve pas de réglage pour le br, j'utilise ce par defaut."
+ );
+ $br_setting = { stp => 'off', setfd => 1, sethello => 1 };
}
foreach $para ( keys %{$br_setting} ) {
- __Debug(" $brname : $para = $br_setting->{$para}");
- __runCmds( [ "brctl $para $brname " . $br_setting->{$para} ], "1" );
+ __Debug(" $brname : $para = $br_setting->{$para}");
+ __runCmds( [ "brctl $para $brname " . $br_setting->{$para} ], "1" );
}
@@ -628,25 +628,25 @@
$trunk = "eth1" unless ($trunk);
`ifconfig $trunk up 2>/dev/null`;
unless ($?) {
- __Info(" Upping `$trunk.$tag'");
- __runCmds(
- [ "vconfig set_name_type DEV_PLUS_VID_NO_PAD",
- "vconfig add $trunk $tag",
- "ifconfig $trunk.$tag 0.0.0.0 mtu 1496 promisc up",
- ]
- );
- __BridgeAttacheIf( $brname, $trunk . "." . $tag );
+ __Info(" Upping `$trunk.$tag'");
+ __runCmds(
+ [ "vconfig set_name_type DEV_PLUS_VID_NO_PAD",
+ "vconfig add $trunk $tag",
+ "ifconfig $trunk.$tag 0.0.0.0 mtu 1496 promisc up",
+ ]
+ );
+ __BridgeAttacheIf( $brname, $trunk . "." . $tag );
}
# J'attache les pates des vm (dans le cas d'un restart)
my $tmp = __GetIfByVlan($vlan);
foreach (@$tmp) {
- __BridgeAttacheIf( $brname,
- __sanitize_ifname( $_ . "." . $vlan_setup->{tag} ) );
+ __BridgeAttacheIf( $brname,
+ __sanitize_ifname( $_ . "." . $vlan_setup->{tag} ) );
}
unless ( -f $PF_STATUS_DIR . "/bridge/" . $brname ) {
- `touch $PF_STATUS_DIR"/bridge/"$brname`;
+ `touch $PF_STATUS_DIR"/bridge/"$brname`;
}
}
@@ -660,34 +660,34 @@
my $brname = shift;
unless ($brname) {
- __Debug("__BridgeDel: pas de valeur en parametre");
- return;
+ __Debug("__BridgeDel: pas de valeur en parametre");
+ return;
}
my $ifattached = __BridgeGetIfAttached($brname);
if (@$ifattached) {
- __Debug( "Vous avez "
- . @$ifattached
- . " interface(s) attachée(s) à $brname" );
- __Debug("Je les détache...");
-
- __BridgeDetacheIf( $brname, $_ ) foreach (@$ifattached);
+ __Debug( "Vous avez "
+ . @$ifattached
+ . " interface(s) attachée(s) à $brname" );
+ __Debug("Je les détache...");
+
+ __BridgeDetacheIf( $brname, $_ ) foreach (@$ifattached);
}
__Info(" J'arrete le bridge `$brname'");
# Je vire les alias du br
if ( open STATUS_IFBR, "<" . $PF_STATUS_DIR . "/ifbr" ) {
- foreach (<STATUS_IFBR>) {
- next unless (/^$brname:/);
- chomp;
- `ifconfig $_ 2>/dev/null`;
- __runCmds( "ifconfig $_ down", 1 ) unless $?;
- }
- close STATUS_IFBR;
+ foreach (<STATUS_IFBR>) {
+ next unless (/^$brname:/);
+ chomp;
+ `ifconfig $_ 2>/dev/null`;
+ __runCmds( "ifconfig $_ down", 1 ) unless $?;
+ }
+ close STATUS_IFBR;
}
else {
- __Err( "Can't open " . $PF_STATUS_DIR . "/ifbr" );
+ __Err( "Can't open " . $PF_STATUS_DIR . "/ifbr" );
}
__runCmds( [ "ifconfig $brname down", "brctl delbr $brname" ], 1 );
@@ -699,10 +699,10 @@
# descend les $trunk.$tag
__runCmds( [ "ifconfig $trunk.$1 down", "vconfig rem $trunk.$1" ], "1" )
- if ( !$? and $brname =~ /(\d+)$/ );
+ if ( !$? and $brname =~ /(\d+)$/ );
if ( -f $PF_STATUS_DIR . "/bridge/" . $brname ) {
- unlink $PF_STATUS_DIR . "/bridge/" . $brname;
+ unlink $PF_STATUS_DIR . "/bridge/" . $brname;
}
}
@@ -714,19 +714,19 @@
my $list = [];
return $list
- unless defined $brname; # éviter du travail inutile et des warnings
+ unless defined $brname; # éviter du travail inutile et des warnings
my @brshow = `brctl show`;
shift @brshow; # ligne d'entete
my $b;
foreach my $line (@brshow) {
- $b = $1 if ( $line =~ /^(\S+)\s+/ );
-
- if ( $b eq $brname ) {
- push @$list, $1
- if ( $line =~ /^\S+\s+\S+\s+\S+\s+(\S+)$/ );
- }
+ $b = $1 if ( $line =~ /^(\S+)\s+/ );
+
+ if ( $b eq $brname ) {
+ push @$list, $1
+ if ( $line =~ /^\S+\s+\S+\s+\S+\s+(\S+)$/ );
+ }
}
return $list;
@@ -739,14 +739,14 @@
my $list = [];
return $list
- unless defined $vlan; # éviter du travail inutile et des warnings
+ unless defined $vlan; # éviter du travail inutile et des warnings
my $ListVM = Config_Key( $configfile, "init", "\@start" );
foreach my $vm ( @{$ListVM} ) {
- foreach ( @{ __GetVMnet($vm) } ) {
- push( @$list, $vm ) if ( $_->{lan} eq $vlan );
- }
+ foreach ( @{ __GetVMnet($vm) } ) {
+ push( @$list, $vm ) if ( $_->{lan} eq $vlan );
+ }
}
return $list;
@@ -757,22 +757,22 @@
my ( $bridge, $if ) = @_;
unless ( $bridge and $if ) {
- __Err(
- "__BridgeAttacheIf called with undef or empty bridge and/or if");
- return undef;
+ __Err(
+ "__BridgeAttacheIf called with undef or empty bridge and/or if");
+ return undef;
}
`ifconfig $if 2>&1`;
if ($?) {
- # Pourquoi
- __Debug(
- "L'interface `$if' ne semble pas dispo, l'UML n'est sans doute pas lancée"
- );
- return;
+ # Pourquoi
+ __Debug(
+ "L'interface `$if' ne semble pas dispo, l'UML n'est sans doute pas lancée"
+ );
+ return;
}
else {
- __runCmds( ["brctl addif $bridge $if"], "1" );
+ __runCmds( ["brctl addif $bridge $if"], "1" );
}
__runCmds( ["ifconfig $if up"], "1" );
@@ -787,16 +787,16 @@
my ( $bridge, $if ) = @_;
unless ( $bridge and $if ) {
- __Err(
- "__BridgeDetacheIf called with undef or empty bridge and/or if");
- return;
+ __Err(
+ "__BridgeDetacheIf called with undef or empty bridge and/or if");
+ return;
}
unless ( __runCmds( ["brctl delif $bridge $if"], 1 ) ) {
- __Err(
- "Attention : Je n'arrive pas à détacher `$if' du bridge `$bridge'"
- );
- return;
+ __Err(
+ "Attention : Je n'arrive pas à détacher `$if' du bridge `$bridge'"
+ );
+ return;
}
return 1;
@@ -815,65 +815,65 @@
__Info(" Lancement des vm");
foreach my $i ( 0 .. 255 ) {
- next unless $umls->[$i];
-
- foreach my $host ( split / /, $umls->[$i] ) {
- next unless $host;
-
- my ( undef, undef, $section ) = __FamillyNumFromVM($host);
- unless (
- exists $private_network->{$section}->{'umlfilename.default'} )
- {
- __Info(
- "Attention, la machine `$host' n'a pas de clef umlfilename.default,"
- . "elle ne sera donc pas lancée" );
- next;
- }
-
- if ( __Umlrunning($host) ) {
- __Info("`$host' est déjà lancé...");
- next;
- }
- my $branche = __GetBrancheCVS($host);
-
- my $mem = Config_Key( $configfile, "uml-" . $host, "mem" );
- my $disksize
- = Config_Key( $configfile, "uml-" . $host, "disksize" );
- $disksize = Config_Key( $configfile, "uml-default", "disksize" )
- unless $disksize;
- $disksize = 768 unless $disksize;
-
- unless ( ( -f $ENV{HOME} . "/.uml/$host.disk0" )
- or ( $options->{dontcheckdf} ) )
- {
- while (
- __GetDiskSpaceLeft( $ENV{HOME} . "/.uml/" ) < $disksize )
- {
- __Err(
- "Probleme d'espace disque... Il me faut `$disksize' Mo pour lancer `$host'"
- );
- sleep 5;
- }
- }
-
- if ( $mem and $mem < 16 ) {
- __Debug(
- "$host : memoire $mem trop faible (< 16Mo), je la passe à 16Mo"
- );
- $mem = 16;
- }
- __Info( " " . __PrintTime() );
- __Debug(" priorité : `$i'");
- __Info(" vm : `$host'");
- __Info(" branche : `$branche'") if ($branche);
-
- my $cmd = "$umlaunch --wait --detached ";
- $cmd .= "--branche-cvs=" . $branche . " " if $branche;
- $cmd .= "--mem=" . $mem . " " if $mem;
- $cmd .= "--disksize=" . $disksize . " " if $disksize;
- $cmd .= $host;
- __Fault("$cmd failed") unless ( __runCmds( [$cmd] ) );
- }
+ next unless $umls->[$i];
+
+ foreach my $host ( split / /, $umls->[$i] ) {
+ next unless $host;
+
+ my ( undef, undef, $section ) = __FamillyNumFromVM($host);
+ unless (
+ exists $private_network->{$section}->{'umlfilename.default'} )
+ {
+ __Info(
+ "Attention, la machine `$host' n'a pas de clef umlfilename.default,"
+ . "elle ne sera donc pas lancée" );
+ next;
+ }
+
+ if ( __Umlrunning($host) ) {
+ __Info("`$host' est déjà lancé...");
+ next;
+ }
+ my $branche = __GetBrancheCVS($host);
+
+ my $mem = Config_Key( $configfile, "uml-" . $host, "mem" );
+ my $disksize
+ = Config_Key( $configfile, "uml-" . $host, "disksize" );
+ $disksize = Config_Key( $configfile, "uml-default", "disksize" )
+ unless $disksize;
+ $disksize = 768 unless $disksize;
+
+ unless ( ( -f $ENV{HOME} . "/.uml/$host.disk0" )
+ or ( $options->{dontcheckdf} ) )
+ {
+ while (
+ __GetDiskSpaceLeft( $ENV{HOME} . "/.uml/" ) < $disksize )
+ {
+ __Err(
+ "Probleme d'espace disque... Il me faut `$disksize' Mo pour lancer `$host'"
+ );
+ sleep 5;
+ }
+ }
+
+ if ( $mem and $mem < 16 ) {
+ __Debug(
+ "$host : memoire $mem trop faible (< 16Mo), je la passe à 16Mo"
+ );
+ $mem = 16;
+ }
+ __Info( " " . __PrintTime() );
+ __Debug(" priorité : `$i'");
+ __Info(" vm : `$host'");
+ __Info(" branche : `$branche'") if ($branche);
+
+ my $cmd = "$umlaunch --wait --detached ";
+ $cmd .= "--branche-cvs=" . $branche . " " if $branche;
+ $cmd .= "--mem=" . $mem . " " if $mem;
+ $cmd .= "--disksize=" . $disksize . " " if $disksize;
+ $cmd .= $host;
+ __Fault("$cmd failed") unless ( __runCmds( [$cmd] ) );
+ }
}
}
@@ -882,10 +882,10 @@
my $pid = shift;
foreach (`ps ax`) {
- if (/^\s*(\d+)/) {
- return 1 if ( $1 == $pid );
-
- }
+ if (/^\s*(\d+)/) {
+ return 1 if ( $1 == $pid );
+
+ }
}
return 0;
}
@@ -917,8 +917,8 @@
$screen->slave->clone_winsize_from( \*STDIN );
$screen->spawn("screen -r $hostname");
unless ($screen) {
- __Err("Pas réussi à récupérer le screen: `$!'");
- return;
+ __Err("Pas réussi à récupérer le screen: `$!'");
+ return;
}
#$screen->raw_pty(1);
@@ -928,23 +928,23 @@
#### A améliorer
if ( $screen->expect( 2, "# " ) ) {
- $screen->send("exit\n");
+ $screen->send("exit\n");
}
if ( $screen->expect( 2, /login/ ) ) {
- $screen->send("\n");
+ $screen->send("\n");
}
else {
- __Debug("Never got login prompt on $hostname");
- return;
+ __Debug("Never got login prompt on $hostname");
+ return;
}
$screen->send("root\n");
sleep 1;
unless ( $screen->expect( 15, "Password:" ) ) {
- __Debug("Never got password prompt on $hostname");
- return;
+ __Debug("Never got password prompt on $hostname");
+ return;
}
$screen->send("l&f|cn|!\n");
@@ -952,7 +952,7 @@
$shutdowndelay = "now" unless $shutdowndelay;
$screen->send(
- "\nshutdown -h $shutdowndelay \"shutdown via pflaunch...\"");
+ "\nshutdown -h $shutdowndelay \"shutdown via pflaunch...\"");
$screen->send("\nexit\n");
$screen->soft_close();
@@ -975,84 +975,84 @@
# Recupération de la liste des umls
my $v = [];
foreach my $i ( reverse( 0 .. 255 ) ) {
- next unless $umls->[$i];
- foreach ( split / /, $umls->[$i] ) {
- next unless $_;
-
- my $vm;
- $vm->{vm} = $_;
- $vm->{status} = __Umlrunning($_) ? $RUNNING : $HALTED;
-
- $vm->{shutdowndelay}
- = Config_Key( $configfile, "uml-$_", "shutdowndelay" );
- $vm->{shutdowndelay}
- = Config_Key( $configfile, "uml-default", "shutdowndelay" )
- unless $vm->{shutdowndelay};
-
- push @$v, $vm;
- }
+ next unless $umls->[$i];
+ foreach ( split / /, $umls->[$i] ) {
+ next unless $_;
+
+ my $vm;
+ $vm->{vm} = $_;
+ $vm->{status} = __Umlrunning($_) ? $RUNNING : $HALTED;
+
+ $vm->{shutdowndelay}
+ = Config_Key( $configfile, "uml-$_", "shutdowndelay" );
+ $vm->{shutdowndelay}
+ = Config_Key( $configfile, "uml-default", "shutdowndelay" )
+ unless $vm->{shutdowndelay};
+
+ push @$v, $vm;
+ }
}
foreach (@$v) {
- next if ( $_->{status} == $HALTED );
- $_->{t} = Thread->new( \&__SendHalt, $_->{vm}, $_->{shutdowndelay} );
+ next if ( $_->{status} == $HALTED );
+ $_->{t} = Thread->new( \&__SendHalt, $_->{vm}, $_->{shutdowndelay} );
}
my $sdd = 0;
my $vm_running_cpt = 0;
foreach (@$v) {
- next if ( $_->{status} == $HALTED );
- $_->{status} = $HALTING if ( $_->{t}->join );
-
- $sdd = $_->{shutdowndelay}
- if ( $_->{shutdowndelay} and ( $sdd < $_->{shutdowndelay} ) );
- $vm_running_cpt++;
+ next if ( $_->{status} == $HALTED );
+ $_->{status} = $HALTING if ( $_->{t}->join );
+
+ $sdd = $_->{shutdowndelay}
+ if ( $_->{shutdowndelay} and ( $sdd < $_->{shutdowndelay} ) );
+ $vm_running_cpt++;
}
# Inutile de lancer cette procédure couteuse en tps si aucune uml ne tourne
if ($vm_running_cpt) {
- eval {
- local $SIG{ALRM} = sub { die "alarm\n" }; # N.B. : \n obligatoire
-
- alarm( 60 + $sdd * 60 );
-
- while (1) {
- foreach (@$v) {
- next if ( $_->{status} == $HALTED );
- $_->{status} = $HALTED
- unless ( __Umlrunning( $_->{vm} ) );
-
- sleep 1;
- }
- }
-
- alarm 0;
- };
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n" }; # N.B. : \n obligatoire
+
+ alarm( 60 + $sdd * 60 );
+
+ while (1) {
+ foreach (@$v) {
+ next if ( $_->{status} == $HALTED );
+ $_->{status} = $HALTED
+ unless ( __Umlrunning( $_->{vm} ) );
+
+ sleep 1;
+ }
+ }
+
+ alarm 0;
+ };
}
foreach (@$v) {
- next if ( $_->{status} == $HALTED );
-
- my $failed = 0;
-
- if ( -r "$ENV{HOME}/.uml/" . $_->{vm} . "/pid" ) {
- __Info( " -Arrete force de `" . $_->{vm} . "'" );
-
- eval {
- local $SIG{ALRM}
- = sub { die "alarm\n" }; # N.B. : \n obligatoire
- alarm 15;
- `uml_mconsole $_->{vm} halt 2>&1`;
- $_->{status} = $HALTED unless $?;
- alarm 0;
- };
- $failed = 1 if ($@);
- }
- elsif ( __Umlrunning( $_->{vm} ) ) {
- $failed = 1;
- }
-
- __Err( "Je n'arrive pas a arreter : `" . $_->{vm} . "'" );
+ next if ( $_->{status} == $HALTED );
+
+ my $failed = 0;
+
+ if ( -r "$ENV{HOME}/.uml/" . $_->{vm} . "/pid" ) {
+ __Info( " -Arrete force de `" . $_->{vm} . "'" );
+
+ eval {
+ local $SIG{ALRM}
+ = sub { die "alarm\n" }; # N.B. : \n obligatoire
+ alarm 15;
+ `uml_mconsole $_->{vm} halt 2>&1`;
+ $_->{status} = $HALTED unless $?;
+ alarm 0;
+ };
+ $failed = 1 if ($@);
+ }
+ elsif ( __Umlrunning( $_->{vm} ) ) {
+ $failed = 1;
+ }
+
+ __Err( "Je n'arrive pas a arreter : `" . $_->{vm} . "'" );
}
}
@@ -1066,13 +1066,13 @@
my $fichier;
return unless ( -d "/var/run/screen/S-root" );
opendir( SCREENDIR, "/var/run/screen/S-root" )
- or __Fault("can't open $!");
+ or __Fault("can't open $!");
while ( defined( $fichier = readdir(SCREENDIR) ) ) {
- next if ( $fichier =~ /^\./ );
-
- if ( $fichier =~ /^\d+\.([^\.]+)/ ) {
- $r = 1 if ( $vm eq $1 );
- }
+ next if ( $fichier =~ /^\./ );
+
+ if ( $fichier =~ /^\d+\.([^\.]+)/ ) {
+ $r = 1 if ( $vm eq $1 );
+ }
}
@@ -1084,12 +1084,12 @@
my $ret;
return $cache->{ipt}->{target}
- if $cache->{ipt}->{target};
+ if $cache->{ipt}->{target};
open IPTABLESTARGETS, "</proc/net/ip_tables_targets";
foreach (<IPTABLESTARGETS>) {
- chomp;
- $ret->{$_} = 1;
+ chomp;
+ $ret->{$_} = 1;
}
close IPTABLESTARGETS;
@@ -1101,32 +1101,32 @@
my $vlan = shift;
unless ($vlan) {
- __Debug("__SetNetmapByVlan : pas de vlan en parametre !");
- return;
+ __Debug("__SetNetmapByVlan : pas de vlan en parametre !");
+ return;
}
my $ipt = __GetIptablesTagets();
unless ( defined $ipt->{NETMAP} ) {
- __Info(
- "Votre Kernel semble ne pas supporter la target iptables NETMAP, j'ignore la partie vlan de '$vlan'"
- );
- return;
+ __Info(
+ "Votre Kernel semble ne pas supporter la target iptables NETMAP, j'ignore la partie vlan de '$vlan'"
+ );
+ return;
}
my $vlan_if = Config_Key( $configfile, $vlan, "if" );
$vlan_if = Config_Key( $configfile, "vlan-default", "if" )
- unless $vlan_if;
+ unless $vlan_if;
__Fault(
- "Erreur pour '$vlan' : la présence d'une clef 'if' est obligatoire au moins dans la section [vlan-default]"
+ "Erreur pour '$vlan' : la présence d'une clef 'if' est obligatoire au moins dans la section [vlan-default]"
) unless $vlan_if;
my $vlandata = $private_network->{$vlan};
unless ($vlandata) {
- __Debug(
- "Erreur je n'arrive pas a lire dans private-network les infos du vlan `$vlan'"
- );
- next;
+ __Debug(
+ "Erreur je n'arrive pas a lire dans private-network les infos du vlan `$vlan'"
+ );
+ next;
}
my $addrNetExt = Config_Key( $configfile, $vlan, 'netmap' );
@@ -1134,32 +1134,32 @@
# Je vaias chercher dans private-network la conf du vlan pour savoir comment il est adressé
- unless ( $vlandata->{network} ) {
- __Err(
- "Je n'ai pas la key network de la section [$vlan] de private-networ"
- );
- next;
- }
-
- unless ( $vlandata->{netmask} ) {
- __Err(
- "Je n'ai pas la clef 'netmask' de la section [$vlan] de private-network"
- );
- next;
- }
-
- my $addrNetInt = $vlandata->{network} . '/' . $vlandata->{netmask};
-
- my $postrouting
- = "POSTROUTING -o $vlan_if -s $addrNetInt -j NETMAP --to $addrNetExt";
- my $prerouting
- = "PREROUTING -i $vlan_if -d $addrNetExt -j NETMAP --to $addrNetInt";
- __IptAddChange( "nat", $postrouting );
- __IptAddChange( "nat", $prerouting );
+ unless ( $vlandata->{network} ) {
+ __Err(
+ "Je n'ai pas la key network de la section [$vlan] de private-networ"
+ );
+ next;
+ }
+
+ unless ( $vlandata->{netmask} ) {
+ __Err(
+ "Je n'ai pas la clef 'netmask' de la section [$vlan] de private-network"
+ );
+ next;
+ }
+
+ my $addrNetInt = $vlandata->{network} . '/' . $vlandata->{netmask};
+
+ my $postrouting
+ = "POSTROUTING -o $vlan_if -s $addrNetInt -j NETMAP --to $addrNetExt";
+ my $prerouting
+ = "PREROUTING -i $vlan_if -d $addrNetExt -j NETMAP --to $addrNetInt";
+ __IptAddChange( "nat", $postrouting );
+ __IptAddChange( "nat", $prerouting );
}
else {
- __Debug("Pas de NETMAP pour $vlan");
+ __Debug("Pas de NETMAP pour $vlan");
}
}
@@ -1168,71 +1168,71 @@
my $vlan = shift;
unless ($vlan) {
- __Debug("__SetAliasByVlan : pas de vlan en parametre !");
- return;
+ __Debug("__SetAliasByVlan : pas de vlan en parametre !");
+ return;
}
my $vlan_if = Config_Key( $configfile, $vlan, "if" );
$vlan_if = Config_Key( $configfile, "vlan-default", "if" )
- unless $vlan_if;
+ unless $vlan_if;
if ( Config_Key( $configfile, $vlan, "alias_begin" )
- or Config_Key( $configfile, $vlan, "alias_end" ) )
+ or Config_Key( $configfile, $vlan, "alias_end" ) )
{
- __Info(
- "`$vlan' : Les clef alias_begin et alias_end ne sont plus utilisées,"
- . "vous avez juste a mettre alias=true" );
+ __Info(
+ "`$vlan' : Les clef alias_begin et alias_end ne sont plus utilisées,"
+ . "vous avez juste a mettre alias=true" );
}
return
- unless ( defined( Config_Key( $configfile, $vlan, "alias" ) )
- and Config_Key( $configfile, $vlan, "alias" ) eq 'true' );
+ unless ( defined( Config_Key( $configfile, $vlan, "alias" ) )
+ and Config_Key( $configfile, $vlan, "alias" ) eq 'true' );
# On va essayer de calculer les alias_begin/alias_end en fonction du netmask
# du netmap de ce VLAN. Si pas de netmap défini, on cherche dans private-network.
my $nm = Config_Key( $configfile, $vlan, 'netmap' );
unless ($nm) {
- __Info(
- "Pas de variable netmap pour `$vlan', je cherche dans private-network"
- );
- my $vlan_setup = __GetVLanSetup($vlan);
- unless ( $vlan_setup->{network} and $vlan_setup->{netmask} ) {
- __Err(
- "Pas assez d'information (network et netmask) dans private-network pour le vlan '$vlan'"
- );
- return;
- }
- my ( $ip, $cidr )
- = ipv4_parse( $vlan_setup->{network}, $vlan_setup->{netmask} );
- $nm = "$ip/$cidr"; # Et voilà !
+ __Info(
+ "Pas de variable netmap pour `$vlan', je cherche dans private-network"
+ );
+ my $vlan_setup = __GetVLanSetup($vlan);
+ unless ( $vlan_setup->{network} and $vlan_setup->{netmask} ) {
+ __Err(
+ "Pas assez d'information (network et netmask) dans private-network pour le vlan '$vlan'"
+ );
+ return;
+ }
+ my ( $ip, $cidr )
+ = ipv4_parse( $vlan_setup->{network}, $vlan_setup->{netmask} );
+ $nm = "$ip/$cidr"; # Et voilà !
}
my $netmap = new Net::IP($nm) || die "$?";
unless ($netmap) {
- __Err("`$nm' n'est pas une adresse réseau valide");
- return;
+ __Err("`$nm' n'est pas une adresse réseau valide");
+ return;
}
my $ipz = new Net::IP( $netmap->ip . " - " . $netmap->last_ip );
unless ($ipz) {
- __Err( "Je n'arrive pas a trouver les ip entre "
- . $netmap->ip . " et "
- . $netmap->last_ip );
- return;
+ __Err( "Je n'arrive pas a trouver les ip entre "
+ . $netmap->ip . " et "
+ . $netmap->last_ip );
+ return;
}
my $cmd = [];
unless ( defined $ifAliasCpt{$vlan_if} ) {
- $ifAliasCpt{$vlan_if} = 0;
+ $ifAliasCpt{$vlan_if} = 0;
}
open STATUS_ALIAS, ">>" . $PF_STATUS_DIR . "/aliases";
do {
- print STATUS_ALIAS "$vlan_if:$ifAliasCpt{$vlan_if}\n";
- push @$cmd,
- "ifconfig $vlan_if:" . $ifAliasCpt{$vlan_if} . " " . $ipz->ip();
- $ifAliasCpt{$vlan_if}++;
- $ipz = $ipz->ip_add_num(1);
+ print STATUS_ALIAS "$vlan_if:$ifAliasCpt{$vlan_if}\n";
+ push @$cmd,
+ "ifconfig $vlan_if:" . $ifAliasCpt{$vlan_if} . " " . $ipz->ip();
+ $ifAliasCpt{$vlan_if}++;
+ $ipz = $ipz->ip_add_num(1);
} while ($ipz);
__runCmds( $cmd, "1" ) if @$cmd;
@@ -1244,46 +1244,46 @@
my $dnats = shift;
unless ($dnats) {
- __Debug("__SetDNATs () appelé sans parametre");
- return;
+ __Debug("__SetDNATs () appelé sans parametre");
+ return;
}
my $ipt = __GetIptablesTagets();
unless ( defined $ipt->{DNAT} ) {
- __Info(
- "Votre Kernel semble ne pas supporter la tarjet iptables DNAT");
- __Info("J'ignore la clef \@dnat de la section [init]");
- return;
+ __Info(
+ "Votre Kernel semble ne pas supporter la tarjet iptables DNAT");
+ __Info("J'ignore la clef \@dnat de la section [init]");
+ return;
}
foreach my $dnat ( @{$dnats} ) {
- my $dnat_config = Config_Section( $configfile, "dnat-$dnat" );
- unless ($dnat_config) {
- __Err(
- "`$dnat' est dans la section [init] mais n'a pas de [dnat-$dnat],"
- . "le dnat $dnat n'est pas initialisé..." );
- return;
- }
- unless ( $dnat_config->{'original-dest'}
- && $dnat_config->{'rewrite-dest-to'} )
- {
- __Err(
- "La section [dnat-`$dnat'] n'est pas valide, la section doit contenir les clefs original-dest et rewrite-dest-to"
- );
- return;
- }
-
- __Info( " dnat `$dnat' (`"
- . $dnat_config->{'original-dest'}
- . "' -> `"
- . $dnat_config->{'rewrite-dest-to'}
- . "')" );
-
- __IptAddChange( "nat",
- "PREROUTING -d "
- . $dnat_config->{'original-dest'}
- . " -j DNAT --to-destination "
- . $dnat_config->{'rewrite-dest-to'} );
+ my $dnat_config = Config_Section( $configfile, "dnat-$dnat" );
+ unless ($dnat_config) {
+ __Err(
+ "`$dnat' est dans la section [init] mais n'a pas de [dnat-$dnat],"
+ . "le dnat $dnat n'est pas initialisé..." );
+ return;
+ }
+ unless ( $dnat_config->{'original-dest'}
+ && $dnat_config->{'rewrite-dest-to'} )
+ {
+ __Err(
+ "La section [dnat-`$dnat'] n'est pas valide, la section doit contenir les clefs original-dest et rewrite-dest-to"
+ );
+ return;
+ }
+
+ __Info( " dnat `$dnat' (`"
+ . $dnat_config->{'original-dest'}
+ . "' -> `"
+ . $dnat_config->{'rewrite-dest-to'}
+ . "')" );
+
+ __IptAddChange( "nat",
+ "PREROUTING -d "
+ . $dnat_config->{'original-dest'}
+ . " -j DNAT --to-destination "
+ . $dnat_config->{'rewrite-dest-to'} );
}
}
@@ -1291,45 +1291,45 @@
my $masquerades = shift;
unless ($masquerades) {
- __Debug("__SetMasqueradeByVlan () appelé sans parametre");
- return;
+ __Debug("__SetMasqueradeByVlan () appelé sans parametre");
+ return;
}
my $ipt = __GetIptablesTagets();
unless ( defined $ipt->{MASQUERADE} ) {
- __Info(
- "Votre Kernel semble ne pas supporter la tarjet iptables MASQUERADE"
- );
- __Info("J'ignore la clef \@masquerade de la section [init]");
- return;
+ __Info(
+ "Votre Kernel semble ne pas supporter la tarjet iptables MASQUERADE"
+ );
+ __Info("J'ignore la clef \@masquerade de la section [init]");
+ return;
}
foreach my $masquerade ( @{$masquerades} ) {
- my $masquerade_config
- = Config_Section( $configfile, "masquerade-$masquerade" );
- unless ($masquerade_config) {
- __Err(
- "`$masquerade' est dans la section [init] mais n'a pas de [masquerade-$masquerade],"
- . "le masquerade $masquerade n'est pas initialisé..." );
- return;
- }
- unless ( $masquerade_config->{from} ) {
- __Err(
- "La section [masquerade-`$masquerade'] n'est pas valide, la section doit contenir une clef from et if_out"
- );
- return;
- }
-
- __Info( " masquerade `$masquerade' (`"
- . $masquerade_config->{if_out} . "' / `"
- . $masquerade_config->{from}
- . "')" );
-
- __IptAddChange( "nat",
- "POSTROUTING -o "
- . $masquerade_config->{if_out} . " -s "
- . $masquerade_config->{from}
- . " -j MASQUERADE" );
+ my $masquerade_config
+ = Config_Section( $configfile, "masquerade-$masquerade" );
+ unless ($masquerade_config) {
+ __Err(
+ "`$masquerade' est dans la section [init] mais n'a pas de [masquerade-$masquerade],"
+ . "le masquerade $masquerade n'est pas initialisé..." );
+ return;
+ }
+ unless ( $masquerade_config->{from} ) {
+ __Err(
+ "La section [masquerade-`$masquerade'] n'est pas valide, la section doit contenir une clef from et if_out"
+ );
+ return;
+ }
+
+ __Info( " masquerade `$masquerade' (`"
+ . $masquerade_config->{if_out} . "' / `"
+ . $masquerade_config->{from}
+ . "')" );
+
+ __IptAddChange( "nat",
+ "POSTROUTING -o "
+ . $masquerade_config->{if_out} . " -s "
+ . $masquerade_config->{from}
+ . " -j MASQUERADE" );
}
}
@@ -1347,17 +1347,17 @@
my $hex = sprintf( "%x", $ip->intip() );
if ( open RT, "<" . $procf ) {
- my @r = <RT>;
- close RT or __Err("Can't close `$procf'");
- shift @r;
- foreach (@r) {
- if (/^\S+\s+0+(\S+)/) {
- return 1 if ( lc($1) eq lc($hex) );
- }
- }
+ my @r = <RT>;
+ close RT or __Err("Can't close `$procf'");
+ shift @r;
+ foreach (@r) {
+ if (/^\S+\s+0+(\S+)/) {
+ return 1 if ( lc($1) eq lc($hex) );
+ }
+ }
}
else {
- __Err("Can't open `$procf'");
+ __Err("Can't open `$procf'");
}
return;
}
@@ -1369,51 +1369,51 @@
my $routes;
foreach my $vlan ( @{ __GetVLanList() } ) {
- my $gws = Config_Key( $configfile, "$vlan", "gateway" );
- $gws = Config_Key( $configfile, "vlan-default", "gateway" )
- unless $gws;
-
- my $vs = __GetVLanSetup($vlan);
- unless ( $vs->{network} and $vs->{netmask} ) {
- __Fault(
- "Je ne trouve pas assez d'information pour le vlan `$vlan'"
- . "network = `"
- . $vs->{network} . "'"
- . "netmask = `"
- . $vs->{netmask}
- . "'" );
- next;
- }
- next if ( __RouteExiste( $vs->{network} ) );
- my $dest = "";
- if ( defined $gws and $gws ) {
- if ( $gws =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ ) {
- $dest = "gateway " . $gws; # une IP a ete rentré
- }
- else {
- $dest = "gateway " . __GetVMip( $gws, $vlan );
- }
- }
- elsif ( defined( $vs->{tag} ) and ( $vs->{tag} ) ) {
- $dest = "dev br" . $vs->{tag};
- }
- else {
- __Debug("Je n'ai pas de sortie pour `$vlan'");
- next;
- }
-
- $routes->{"-net $vs->{network} netmask $vs->{netmask} $dest"} = 1;
+ my $gws = Config_Key( $configfile, "$vlan", "gateway" );
+ $gws = Config_Key( $configfile, "vlan-default", "gateway" )
+ unless $gws;
+
+ my $vs = __GetVLanSetup($vlan);
+ unless ( $vs->{network} and $vs->{netmask} ) {
+ __Fault(
+ "Je ne trouve pas assez d'information pour le vlan `$vlan'"
+ . "network = `"
+ . $vs->{network} . "'"
+ . "netmask = `"
+ . $vs->{netmask}
+ . "'" );
+ next;
+ }
+ next if ( __RouteExiste( $vs->{network} ) );
+ my $dest = "";
+ if ( defined $gws and $gws ) {
+ if ( $gws =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ ) {
+ $dest = "gateway " . $gws; # une IP a ete rentré
+ }
+ else {
+ $dest = "gateway " . __GetVMip( $gws, $vlan );
+ }
+ }
+ elsif ( defined( $vs->{tag} ) and ( $vs->{tag} ) ) {
+ $dest = "dev br" . $vs->{tag};
+ }
+ else {
+ __Debug("Je n'ai pas de sortie pour `$vlan'");
+ next;
+ }
+
+ $routes->{"-net $vs->{network} netmask $vs->{netmask} $dest"} = 1;
}
__Debug($_) foreach (`route`);
if ( open( STATUS_ROUTE, ">>" . $PF_STATUS_DIR . "/route" ) ) {
- foreach my $r ( keys %$routes ) {
- if ( __runCmds( "route add " . $r ) ) {
- print STATUS_ROUTE $r . "\n";
- }
- }
+ foreach my $r ( keys %$routes ) {
+ if ( __runCmds( "route add " . $r ) ) {
+ print STATUS_ROUTE $r . "\n";
+ }
+ }
}
else {
- __Fault( "Can't open " . $PF_STATUS_DIR . "/route" );
+ __Fault( "Can't open " . $PF_STATUS_DIR . "/route" );
}
close STATUS_ROUTE or __Err("Je n'arrive pas a fermer STATUS_ROUTE");
}
@@ -1426,8 +1426,8 @@
my $cmds;
foreach (<STATUS_ROUTE>) {
- chomp;
- push @$cmds, "route del $_";
+ chomp;
+ push @$cmds, "route del $_";
}
__runCmds( $cmds, "stfu" );
@@ -1444,8 +1444,8 @@
my $cmds;
foreach my $if (<STATUS_ALIAS>) {
- chomp $if;
- push @$cmds, "ifconfig $if down" if $if;
+ chomp $if;
+ push @$cmds, "ifconfig $if down" if $if;
}
__runCmds( $cmds, "stfu" );
@@ -1460,25 +1460,25 @@
# 1/ Le fichier de config
if ($vm) {
- my $branche = Config_Key( $configfile, "uml-$vm", "branche" );
- return $branche if $branche;
+ my $branche = Config_Key( $configfile, "uml-$vm", "branche" );
+ return $branche if $branche;
}
# 2/ le paramètre de la ligne de commande
return $options->{branchecvs}
- if $options->{branchecvs};
+ if $options->{branchecvs};
# 3/ Le contenu de $PF_STATUS_DIR/branche
if ( -r $PF_STATUS_DIR . "/branche" ) {
- if ( open STATUSBRANCHE, "<$PF_STATUS_DIR" . "/branche" ) {
- my @STATUSBRANCHE = <STATUSBRANCHE>;
- close STATUSBRANCHE;
- return shift @STATUSBRANCHE;
- }
- else {
- __Err(
- "je n'arrive pas a ouvrir " . $PF_STATUS_DIR . "/branche" );
- }
+ if ( open STATUSBRANCHE, "<$PF_STATUS_DIR" . "/branche" ) {
+ my @STATUSBRANCHE = <STATUSBRANCHE>;
+ close STATUSBRANCHE;
+ return shift @STATUSBRANCHE;
+ }
+ else {
+ __Err(
+ "je n'arrive pas a ouvrir " . $PF_STATUS_DIR . "/branche" );
+ }
}
@@ -1488,34 +1488,34 @@
sub __UpdateConfig {
if ( $cvsupdated or $options->{nocvsupdate} ) {
- __Debug("Pas d'update du CVS");
+ __Debug("Pas d'update du CVS");
}
else {
- my $branchecvs = __GetBrancheCVS();
-
- __Info("Getting config from CVS");
- __Info( " branche CVS `" . $branchecvs . "'" ) if ($branchecvs);
-
- CVS_update( $branchecvs, $options );
- $cvsupdated = 1;
-
- # J'enregistre la branche utilisée pour la prochaine utilisation
- SaveRunningBrancheName($branchecvs) if $branchecvs;
-
- unless ( -r $configfile ) {
- __Fault(
- "Je n'arrive pas a lire $configfile, vérifiez votre installation"
- );
- }
- unless ( -r $privatenetworkfile ) {
- __Fault(
- "Je n'arrive pas a lire $privatenetworkfile, vérifiez votre installation"
- );
- }
-
- $private_network = Load_Config($privatenetworkfile);
- __suppress_comments_in_keys($private_network);
+ my $branchecvs = __GetBrancheCVS();
+
+ __Info("Getting config from CVS");
+ __Info( " branche CVS `" . $branchecvs . "'" ) if ($branchecvs);
+
+ CVS_update( $branchecvs, $options );
+ $cvsupdated = 1;
+
+ # J'enregistre la branche utilisée pour la prochaine utilisation
+ SaveRunningBrancheName($branchecvs) if $branchecvs;
+
+ unless ( -r $configfile ) {
+ __Fault(
+ "Je n'arrive pas a lire $configfile, vérifiez votre installation"
+ );
+ }
+ unless ( -r $privatenetworkfile ) {
+ __Fault(
+ "Je n'arrive pas a lire $privatenetworkfile, vérifiez votre installation"
+ );
+ }
+
+ $private_network = Load_Config($privatenetworkfile);
+ __suppress_comments_in_keys($private_network);
}
}
@@ -1526,22 +1526,22 @@
return unless ( -f $PF_STATUS_DIR . "/lock" );
open( LOCK, "<" . $PF_STATUS_DIR . "/lock" )
- or __Fault("Can't open lock file $!");
+ or __Fault("Can't open lock file $!");
my $pid = <LOCK>;
close LOCK;
return unless $pid;
if ( __PidRunning($pid) ) {
- __Fault( "Vous avez provablement un plfaunch "
- . " déjà lancé, si ne n'est pas la cas effacé "
- . "le fichier de lock "
- . $PF_STATUS_DIR
- . "/lock" );
+ __Fault( "Vous avez provablement un plfaunch "
+ . " déjà lancé, si ne n'est pas la cas effacé "
+ . "le fichier de lock "
+ . $PF_STATUS_DIR
+ . "/lock" );
}
else {
- unlink $PF_STATUS_DIR . "/lock";
+ unlink $PF_STATUS_DIR . "/lock";
}
}
@@ -1549,7 +1549,7 @@
sub __SetLock {
open( LOCK, ">" . $PF_STATUS_DIR . "/lock" )
- or __Fault("Can't open lock file $!");
+ or __Fault("Can't open lock file $!");
print LOCK $$;
close LOCK;
@@ -1558,7 +1558,7 @@
sub __RemoveLock {
unlink( $PF_STATUS_DIR . "/lock" )
- or __Err( "Can't remove lock file : " . $PF_STATUS_DIR . "/lock" );
+ or __Err( "Can't remove lock file : " . $PF_STATUS_DIR . "/lock" );
}
@@ -1570,15 +1570,15 @@
my @dfr = `/bin/df -P $path`;
if ($?) {
- __Err("df failed");
- return;
+ __Err("df failed");
+ return;
}
my @dfs = split /\ +/, $dfr[1];
unless ( $dfs[3] ) {
- __Err(
- "__GetDiskSpaceLeft:je n'arrive pas trouver l'espace disque...");
- return 0;
+ __Err(
+ "__GetDiskSpaceLeft:je n'arrive pas trouver l'espace disque...");
+ return 0;
}
return int $dfs[3] / 1024;
@@ -1595,7 +1595,7 @@
sub __Fault {
foreach (@_) {
- __Print( "FAULT>" . $_, 1 );
+ __Print( "FAULT>" . $_, 1 );
}
exit 1;
}
@@ -1603,7 +1603,7 @@
sub __Err {
return unless @_;
foreach (@_) {
- __Print( "ERROR>" . $_, 1 );
+ __Print( "ERROR>" . $_, 1 );
}
}
@@ -1611,14 +1611,14 @@
return unless ( $options->{debug} );
return unless @_;
foreach (@_) {
- __Print( "DEBUG>" . $_, $options->{debug} );
+ __Print( "DEBUG>" . $_, $options->{debug} );
}
}
sub __Info {
return unless @_;
foreach (@_) {
- __Print( " INFO>" . $_, $options->{verbose} );
+ __Print( " INFO>" . $_, $options->{verbose} );
}
}
@@ -1633,13 +1633,13 @@
print $str if ($p);
if ($logfile) {
- if ( open( LOG, ">>$logfile" ) ) {
- print LOG $str;
- close LOG;
- }
- else {
- print STDERR "Can't open log file : `$logfile'\n";
- }
+ if ( open( LOG, ">>$logfile" ) ) {
+ print LOG $str;
+ close LOG;
+ }
+ else {
+ print STDERR "Can't open log file : `$logfile'\n";
+ }
}
}
@@ -1653,46 +1653,46 @@
unless ( $table =~ /^nat$/ ) # filter, mangle
{
- __Err("Table invalide");
- return;
+ __Err("Table invalide");
+ return;
}
return unless __runCmds( "iptables -t $table -A " . $change );
if ( !( open STATUS_IPT, ">>" . $PF_STATUS_DIR . "/ipt_" . $table ) ) {
- __Err("Can't record iptables rules changes");
- return;
+ __Err("Can't record iptables rules changes");
+ return;
}
else {
- __Debug("Enregistrement d'une regle iptables (nat)");
- print STATUS_IPT $change . "\n";
- if ( !close STATUS_IPT ) {
- __Err("Can't close STATUS_IPT");
- return;
- }
+ __Debug("Enregistrement d'une regle iptables (nat)");
+ print STATUS_IPT $change . "\n";
+ if ( !close STATUS_IPT ) {
+ __Err("Can't close STATUS_IPT");
+ return;
+ }
}
return 1;
}
sub __IptCleanChange () {
foreach my $table ( "nat", "mangle" ) {
- my $file = $PF_STATUS_DIR . "/ipt_" . $table;
- next unless ( -f $file );
- if ( !( open STATUS_IPT, "<" . $file ) ) {
- __Err( "Can't open " . $file );
- next;
- }
- else {
- __Debug(
- "Suppression des regles iptables ajoutes par pflaunch : ($table)"
- );
- __runCmds( "iptables -t $table -D " . $_ ) foreach (<STATUS_IPT>);
- close STATUS_IPT;
- if ( !unlink($file) ) {
- __Err("Je ne peux pas effacer $file");
- return;
- }
- }
+ my $file = $PF_STATUS_DIR . "/ipt_" . $table;
+ next unless ( -f $file );
+ if ( !( open STATUS_IPT, "<" . $file ) ) {
+ __Err( "Can't open " . $file );
+ next;
+ }
+ else {
+ __Debug(
+ "Suppression des regles iptables ajoutes par pflaunch : ($table)"
+ );
+ __runCmds( "iptables -t $table -D " . $_ ) foreach (<STATUS_IPT>);
+ close STATUS_IPT;
+ if ( !unlink($file) ) {
+ __Err("Je ne peux pas effacer $file");
+ return;
+ }
+ }
}
return 1;
}
@@ -1715,28 +1715,28 @@
`modprobe ipt_MASQUERADE 2>&1`;
### Reglage de /proc/sys/net/ipv4/ip_forward
my $forward
- = ( defined( Config_Key( $configfile, "global", "router" ) )
- and Config_Key( $configfile, "global", "router" ) =~ "true" )
- ? 1
- : 0;
+ = ( defined( Config_Key( $configfile, "global", "router" ) )
+ and Config_Key( $configfile, "global", "router" ) =~ "true" )
+ ? 1
+ : 0;
__Debug(" /proc/sys/net/ipv4/ip_forward = $forward");
open IP_FORWARD, ">/proc/sys/net/ipv4/ip_forward"
- or __Err("Can't open /proc/sys/net/ipv4/ip_forward (w mode)");
+ or __Err("Can't open /proc/sys/net/ipv4/ip_forward (w mode)");
print IP_FORWARD $forward;
close IP_FORWARD;
# peut-être aussi bridge-nf-call-arptables et bridge-nf-call-ip6tables ?
foreach my $procfile ( map {"/proc/sys/net/bridge/$_"}
- qw'bridge-nf-call-iptables bridge-nf-filter-vlan-tagged' )
+ qw'bridge-nf-call-iptables bridge-nf-filter-vlan-tagged' )
{
- if ( -f $procfile ) {
- __Debug(" $procfile = 0");
- open( EBTABLE, "> $procfile" )
- or __Err("Can't open $procfile for writing: $!");
- print EBTABLE 0;
- close(EBTABLE)
- or __Fault("Can't close $procfile after writing: $!");
- }
+ if ( -f $procfile ) {
+ __Debug(" $procfile = 0");
+ open( EBTABLE, "> $procfile" )
+ or __Err("Can't open $procfile for writing: $!");
+ print EBTABLE 0;
+ close(EBTABLE)
+ or __Fault("Can't close $procfile after writing: $!");
+ }
# else {
# Ces machins n'existent pas en 2.4
@@ -1746,15 +1746,15 @@
# my $listbrup = __GetListBridgeUp();
foreach my $lan ( @{ __GetVLanList() } ) {
- __BridgeAdd($lan);
- __BridgeSetAddr($lan);
+ __BridgeAdd($lan);
+ __BridgeSetAddr($lan);
}
__Info(" setting netmap rules and alias...");
foreach my $vlan ( @{ __GetVLanList() } ) {
- __Info(" $vlan");
- __SetNetmapByVlan($vlan);
- __SetAliasByVlan($vlan);
+ __Info(" $vlan");
+ __SetNetmapByVlan($vlan);
+ __SetAliasByVlan($vlan);
}
# On fait les routes après les alias pour faciliter les bidouilles double-adressage
@@ -1804,7 +1804,7 @@
__Info(" Halting Bridges...");
foreach my $brname (@$listbrup) {
- __BridgeDel($brname);
+ __BridgeDel($brname);
}
__Info(" Flushing iptables rules...");
@@ -1815,9 +1815,9 @@
__Info(" Arrêt des interfaces");
foreach ( @{ __GetVLanList() } ) {
- my $vs = __GetVLanSetup($_);
- __runCmds( [ "ifconfig $_." . $vs->{tag} . " down" ], 1 )
- foreach ( @{ __GetIfByVlan($_) } );
+ my $vs = __GetVLanSetup($_);
+ __runCmds( [ "ifconfig $_." . $vs->{tag} . " down" ], 1 )
+ foreach ( @{ __GetIfByVlan($_) } );
}
unlink $PF_STATUS_DIR . "/ifbr";
@@ -1859,14 +1859,14 @@
# print " * -l --log : log dans /var/log/pflaunch (verbose par défaut)\n";
print
- " * --nocvsupdate : pas d'update CVS lors du lancement d'une commande\n";
+ " * --nocvsupdate : pas d'update CVS lors du lancement d'une commande\n";
print
- " * --branche-cvs=BRANCHE : Possiblité de forcer une branche CVS\n";
+ " * --branche-cvs=BRANCHE : Possiblité de forcer une branche CVS\n";
print
- " * --dontcheckdf : Ne controle pas l'espace dispo avant de créer un disque\n";
+ " * --dontcheckdf : Ne controle pas l'espace dispo avant de créer un disque\n";
print "\n";
print
- " En cas de probleme ou de souhait, n'hésitez pas a utiliser Bugzilla\n";
+ " En cas de probleme ou de souhait, n'hésitez pas a utiliser Bugzilla\n";
exit;
}
@@ -1901,8 +1901,8 @@
if ( $options->{nocvsupdate} and $options->{branchecvs} ) {
__Fault(
- "Hum Hum, vous demandez une branche CVS précise avec en même temps le "
- . "flag '--nocvsupdate' !" );
+ "Hum Hum, vous demandez une branche CVS précise avec en même temps le "
+ . "flag '--nocvsupdate' !" );
}
mkdir($PF_STATUS_DIR) unless ( -d $PF_STATUS_DIR );
Modified: branches/next-gen/tools/umlaunch
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/tools/umlaunch?rev=881&op=diff
==============================================================================
--- branches/next-gen/tools/umlaunch (original)
+++ branches/next-gen/tools/umlaunch Tue Sep 7 08:55:02 2010
@@ -34,8 +34,8 @@
$PFTools::Conf::PFTOOLS_VARS->{'UML'} = 1;
-my $mem = "128"; # Default RAM size (MB)
-my $disksize = "768"; # Default disz size (MB)
+my $mem = "128"; # Default RAM size (MB)
+my $disksize = "768"; # Default disz size (MB)
my $ETHTRUNK = 'eth1';
@@ -47,7 +47,7 @@
|| `which screen 2>/dev/null` eq "" )
{
print STDERR
- "Sorry, I need vlan, bridge-utils, uml-utilities and screen\n";
+ "Sorry, I need vlan, bridge-utils, uml-utilities and screen\n";
exit 1;
}
@@ -80,13 +80,13 @@
print STDERR "\t --wait attendre la fin du deploiement\n";
print STDERR "\t --regex specification des uml par regex\n";
print STDERR
- "\t --no-errors passer a la machine suivante meme en cas d'erreur\n";
- print STDERR
- "\t --branche-cvs permet l'utilisation d'une branche specifique\n";
- print STDERR
- "\t-m --mem=XXX volume de RAM pour l'UML en Mo, defaut ($mem Mo)\n";
- print STDERR
- "\t --disksize=XXX taille de l'image disque en Mo, defaut ($disksize Mo)\n";
+ "\t --no-errors passer a la machine suivante meme en cas d'erreur\n";
+ print STDERR
+ "\t --branche-cvs permet l'utilisation d'une branche specifique\n";
+ print STDERR
+ "\t-m --mem=XXX volume de RAM pour l'UML en Mo, defaut ($mem Mo)\n";
+ print STDERR
+ "\t --disksize=XXX taille de l'image disque en Mo, defaut ($disksize Mo)\n";
exit 1;
}
@@ -128,14 +128,14 @@
my $umlfilename = Get_UM_Filename( $Z, $host );
if ( !defined($umlfilename) ) {
- print STDERR $host . ": no umlfilename\n";
-
- if ( !$options->{'errors'} ) {
- next;
- }
- exit 1;
-
- #$umlfilename = 'linux-uml-elf-2.4.21-gr1.9.11';
+ print STDERR $host . ": no umlfilename\n";
+
+ if ( !$options->{'errors'} ) {
+ next;
+ }
+ exit 1;
+
+ #$umlfilename = 'linux-uml-elf-2.4.21-gr1.9.11';
}
#UMRemap_If( $Z, $host );
@@ -148,177 +148,177 @@
my $disk0 = $ENV{HOME} . "/.uml/" . $host . ".disk0";
my ( $dhcpif, $dhcpaddr ) = Get_Dhcp_Infos( $Z, $host );
if ($dhcpif) {
- $dhcpif =~ s/:.*$//
- ; # FIX pour vlan-truc sur ethN:M au lieu de ethN (� cause du double adressage)
+ $dhcpif =~ s/:.*$//
+ ; # FIX pour vlan-truc sur ethN:M au lieu de ethN (� cause du double adressage)
}
if ( !-f $disk0 ) {
- print STDERR "Cannot find disk $disk0, creating empty one\n";
- system("mkdir -p -m 750 `dirname $disk0`");
- system("dd if=/dev/zero of=$disk0 seek=$disksize count=0 bs=1M");
+ print STDERR "Cannot find disk $disk0, creating empty one\n";
+ system("mkdir -p -m 750 `dirname $disk0`");
+ system("dd if=/dev/zero of=$disk0 seek=$disksize count=0 bs=1M");
}
my $cmdline;
if ( $options->{'detached'} ) {
- $cmdline = "screen -S $host -d -m ";
+ $cmdline = "screen -S $host -d -m ";
}
else {
- $cmdline = "screen -S $host ";
+ $cmdline = "screen -S $host ";
}
$cmdline
- .= "/distrib/tftpboot/$umlfilename umid=$host mconsole=notify:$ENV{HOME}/.uml/$host.notify con0=fd:0,fd:1 con=null ssl=null mem="
- . $mem
- . "M fakehd fake_ide ubd=3 root=/dev/ram0 initrd=$initrd ramdisk_size=$ramdisk_size init=/linuxrc ubd0=$disk0";
+ .= "/distrib/tftpboot/$umlfilename umid=$host mconsole=notify:$ENV{HOME}/.uml/$host.notify con0=fd:0,fd:1 con=null ssl=null mem="
+ . $mem
+ . "M fakehd fake_ide ubd=3 root=/dev/ram0 initrd=$initrd ramdisk_size=$ramdisk_size init=/linuxrc ubd0=$disk0";
$cmdline .= " pfbcvs=" . $options->{branchecvs}
- if ( $options->{branchecvs} );
+ if ( $options->{branchecvs} );
my $optcmdline = Get_Cmdline( $Z, $host );
if ($optcmdline) {
- $cmdline .= ' ' . $optcmdline;
+ $cmdline .= ' ' . $optcmdline;
}
foreach my $nam ( sort { cmpif( $a, $b ) } keys %{$umif} ) {
- my $tapaddr;
- my @tapaddr;
-
- if ( !defined $umif->{$nam} ) {
- next;
- }
-
- print STDERR $nam . " <-> " . $umif->{$nam} . "\n";
-
- my $tag = $umif->{$nam};
- if ( $tag eq 'TRUNK' ) {
- $tag = 0;
- }
-
- if ( `ifconfig br$tag 2>/dev/null` eq "" ) {
- print STDERR "Upping br" . $tag . "...\n";
-
- system( "brctl addbr br" . $tag );
- system( "ifconfig br"
- . $tag
- . " 169.254."
- . ( $tag >> 8 ) . "."
- . ( $tag & 255 )
- . " netmask 255.255.255.255 mtu "
- . ( ($tag) ? 1496 : 1500 )
- . " promisc up" );
-
- system( "brctl stp br" . $tag . " off" );
- system( "brctl setfd br" . $tag . " 1" );
- system( "brctl sethello br" . $tag . " 1" );
- }
-
- if ( defined $ETHTRUNK and $ETHTRUNK ) {
- system("ifconfig $ETHTRUNK 0.0.0.0 mtu 1500 promisc up");
- if ( $tag != 0 ) {
- if ( `ifconfig $ETHTRUNK.$tag 2>/dev/null` eq "" ) {
- print STDERR "Upping $ETHTRUNK." . $tag . "...\n";
- system("vconfig set_name_type DEV_PLUS_VID_NO_PAD");
- system("vconfig add $ETHTRUNK $tag");
- system(
- "ifconfig $ETHTRUNK.$tag 0.0.0.0 mtu 1496 promisc up"
- );
- }
- }
-
- if ( $tag == 0 ) {
- system("brctl addif br$tag $ETHTRUNK 2>/dev/null");
- }
- else {
- system("brctl addif br$tag $ETHTRUNK.$tag 2>/dev/null");
- }
- }
-
- my $tap = "$host.$tag";
- if ( length($tap) > $IFNAMSIZ - 1 ) {
- $tap = substr( $tap, length($tap) - $IFNAMSIZ + 1 );
- }
-
- if ( system("tunctl -b -d $tap 1>/dev/null 2>/dev/null") ) {
- print STDERR
- "tunctl refused to free tap device (already running?), aborting\n";
- if ( !$options->{'errors'} ) {
- next;
- }
- exit 1;
- }
- chomp( $tap = `tunctl -b -u 0 -t $tap` );
- if ( $tap eq '' ) {
- print STDERR
- "tunctl returned no tap devices (already running?), aborting\n";
- if ( !$options->{'errors'} ) {
- next;
- }
- exit 1;
- }
-
- system( "ifconfig " . $tap . " 0.0.0.0 promisc up" );
-
- # addresse generee aleatoirement, on s'embete pas, on la prend
- chomp( $tapaddr = `LANG=C LC_ALL=C ifconfig $tap | grep HWaddr` );
- $tapaddr =~ s/^.* HWaddr ([0-9A-F:]+).*/$1/;
- @tapaddr = split( ':', $tapaddr );
- $tapaddr[1] = 'FE';
- $tapaddr = join( ':', @tapaddr );
-
- system( "brctl addif br" . $tag . " " . $tap );
-
- print STDERR $nam . " <-> " . $tap . "\n";
-
- if ( defined $dhcpif && $nam eq $dhcpif ) {
- $cmdline .= " " . $nam . "=tuntap," . $tap . "," . $dhcpaddr;
- }
- else {
- $cmdline .= " " . $nam . "=tuntap," . $tap . "," . $tapaddr;
- }
+ my $tapaddr;
+ my @tapaddr;
+
+ if ( !defined $umif->{$nam} ) {
+ next;
+ }
+
+ print STDERR $nam . " <-> " . $umif->{$nam} . "\n";
+
+ my $tag = $umif->{$nam};
+ if ( $tag eq 'TRUNK' ) {
+ $tag = 0;
+ }
+
+ if ( `ifconfig br$tag 2>/dev/null` eq "" ) {
+ print STDERR "Upping br" . $tag . "...\n";
+
+ system( "brctl addbr br" . $tag );
+ system( "ifconfig br"
+ . $tag
+ . " 169.254."
+ . ( $tag >> 8 ) . "."
+ . ( $tag & 255 )
+ . " netmask 255.255.255.255 mtu "
+ . ( ($tag) ? 1496 : 1500 )
+ . " promisc up" );
+
+ system( "brctl stp br" . $tag . " off" );
+ system( "brctl setfd br" . $tag . " 1" );
+ system( "brctl sethello br" . $tag . " 1" );
+ }
+
+ if ( defined $ETHTRUNK and $ETHTRUNK ) {
+ system("ifconfig $ETHTRUNK 0.0.0.0 mtu 1500 promisc up");
+ if ( $tag != 0 ) {
+ if ( `ifconfig $ETHTRUNK.$tag 2>/dev/null` eq "" ) {
+ print STDERR "Upping $ETHTRUNK." . $tag . "...\n";
+ system("vconfig set_name_type DEV_PLUS_VID_NO_PAD");
+ system("vconfig add $ETHTRUNK $tag");
+ system(
+ "ifconfig $ETHTRUNK.$tag 0.0.0.0 mtu 1496 promisc up"
+ );
+ }
+ }
+
+ if ( $tag == 0 ) {
+ system("brctl addif br$tag $ETHTRUNK 2>/dev/null");
+ }
+ else {
+ system("brctl addif br$tag $ETHTRUNK.$tag 2>/dev/null");
+ }
+ }
+
+ my $tap = "$host.$tag";
+ if ( length($tap) > $IFNAMSIZ - 1 ) {
+ $tap = substr( $tap, length($tap) - $IFNAMSIZ + 1 );
+ }
+
+ if ( system("tunctl -b -d $tap 1>/dev/null 2>/dev/null") ) {
+ print STDERR
+ "tunctl refused to free tap device (already running?), aborting\n";
+ if ( !$options->{'errors'} ) {
+ next;
+ }
+ exit 1;
+ }
+ chomp( $tap = `tunctl -b -u 0 -t $tap` );
+ if ( $tap eq '' ) {
+ print STDERR
+ "tunctl returned no tap devices (already running?), aborting\n";
+ if ( !$options->{'errors'} ) {
+ next;
+ }
+ exit 1;
+ }
+
+ system( "ifconfig " . $tap . " 0.0.0.0 promisc up" );
+
+ # addresse generee aleatoirement, on s'embete pas, on la prend
+ chomp( $tapaddr = `LANG=C LC_ALL=C ifconfig $tap | grep HWaddr` );
+ $tapaddr =~ s/^.* HWaddr ([0-9A-F:]+).*/$1/;
+ @tapaddr = split( ':', $tapaddr );
+ $tapaddr[1] = 'FE';
+ $tapaddr = join( ':', @tapaddr );
+
+ system( "brctl addif br" . $tag . " " . $tap );
+
+ print STDERR $nam . " <-> " . $tap . "\n";
+
+ if ( defined $dhcpif && $nam eq $dhcpif ) {
+ $cmdline .= " " . $nam . "=tuntap," . $tap . "," . $dhcpaddr;
+ }
+ else {
+ $cmdline .= " " . $nam . "=tuntap," . $tap . "," . $tapaddr;
+ }
}
if ( -e "$ENV{HOME}/.uml/$host/mconsole"
- && `uml_mconsole $ENV{HOME}/.uml/$host/mconsole version 2>/dev/null`
- ne '' )
+ && `uml_mconsole $ENV{HOME}/.uml/$host/mconsole version 2>/dev/null`
+ ne '' )
{
- printf STDERR "uml already running!\n";
- if ( !$options->{'errors'} ) {
- next;
- }
- exit 1;
+ printf STDERR "uml already running!\n";
+ if ( !$options->{'errors'} ) {
+ next;
+ }
+ exit 1;
}
my $notify;
socket( $notify, AF_UNIX, SOCK_DGRAM, 0 ) || die "socket: $!\n";
unlink("$ENV{HOME}/.uml/$host.notify");
bind( $notify, sockaddr_un("$ENV{HOME}/.uml/$host.notify") )
- || die "bind: $!\n";
+ || die "bind: $!\n";
print $cmdline . "\n";
system($cmdline);
if ( $options->{'wait'} ) {
- print STDERR "Waiting for host ready notification... ";
- while (1) {
- my $data;
-
- if ( !defined recv( $notify, $data, 4096, 0 ) ) {
- last;
- }
-
- my ( $magic, $version, $type, $len, $message )
- = unpack( "LiiiA*", $data );
-
- if ( $magic != 0xcafebabe || $version != 2 ) {
- die "Sorry, I don't understand this notification version\n";
- }
- if ( $type == 3 ) { # user notify
- if ( $message eq "$host ready" ) {
- print STDERR "ready!\n";
- last;
- }
- }
- }
+ print STDERR "Waiting for host ready notification... ";
+ while (1) {
+ my $data;
+
+ if ( !defined recv( $notify, $data, 4096, 0 ) ) {
+ last;
+ }
+
+ my ( $magic, $version, $type, $len, $message )
+ = unpack( "LiiiA*", $data );
+
+ if ( $magic != 0xcafebabe || $version != 2 ) {
+ die "Sorry, I don't understand this notification version\n";
+ }
+ if ( $type == 3 ) { # user notify
+ if ( $message eq "$host ready" ) {
+ print STDERR "ready!\n";
+ last;
+ }
+ }
+ }
}
close($notify);
Modified: branches/next-gen/tools/xenlaunch
URL: http://svn.debian.org/wsvn/pf-tools/branches/next-gen/tools/xenlaunch?rev=881&op=diff
==============================================================================
--- branches/next-gen/tools/xenlaunch (original)
+++ branches/next-gen/tools/xenlaunch Tue Sep 7 08:55:02 2010
@@ -44,7 +44,7 @@
my ( $famille, $num ) = ( "unknowedonedfamilly", 0 );
if ( defined $vm and $vm =~ m/^([a-zA-Z0-9-]+)(\d\d)$/ ) {
- ( $famille, $num ) = ( $1, $2 );
+ ( $famille, $num ) = ( $1, $2 );
}
return ( $famille, $num );
@@ -56,7 +56,7 @@
my $section = Config_Section( $privatenetwork, $vlan );
print STDERR "ERROR : Can't read section [$vlan%%] from $privatenetwork\n"
- unless ( defined($section) and ($section) );
+ unless ( defined($section) and ($section) );
return $section;
}
@@ -68,36 +68,36 @@
my @ret;
my $mac = Config_Key( $privatenetwork, $famille . "%%", "ether." . $num );
unless ($mac) {
- $mac = Config_Key( $privatenetwork, $famille . "%%",
- "vmether." . $num );
+ $mac = Config_Key( $privatenetwork, $famille . "%%",
+ "vmether." . $num );
}
unless ($mac) {
- warn "Can't find first if mac addr ($famille, $num)";
+ warn "Can't find first if mac addr ($famille, $num)";
}
my $shortname
- = Config_Key( $privatenetwork, $famille . "%%", "shortname" );
+ = Config_Key( $privatenetwork, $famille . "%%", "shortname" );
unless ($shortname) {
- $shortname = "vlan-7";
- warn
- "Attention $famille%% n'a pas de shortname ! J'utilise vlan-7 par defaut\n";
+ $shortname = "vlan-7";
+ warn
+ "Attention $famille%% n'a pas de shortname ! J'utilise vlan-7 par defaut\n";
}
my $section = Config_Section( $privatenetwork, $famille . "%%" );
foreach my $key ( keys %$section ) {
- if ( $key =~ /^interface\.eth(\d+)/ ) {
- my $ifnum = $1;
- $ret[$ifnum]->{vlan} = $section->{$key};
-
- my $vlan_setup = __GetVLanSetup( $section->{$key} );
- $ret[$ifnum]->{tag} = $vlan_setup->{tag};
-
- $ret[$ifnum]->{mac} = $mac
- if ( $ret[$ifnum]->{vlan} eq $shortname );
-
- }
+ if ( $key =~ /^interface\.eth(\d+)/ ) {
+ my $ifnum = $1;
+ $ret[$ifnum]->{vlan} = $section->{$key};
+
+ my $vlan_setup = __GetVLanSetup( $section->{$key} );
+ $ret[$ifnum]->{tag} = $vlan_setup->{tag};
+
+ $ret[$ifnum]->{mac} = $mac
+ if ( $ret[$ifnum]->{vlan} eq $shortname );
+
+ }
}
return @ret;
}
@@ -117,10 +117,10 @@
$ret .= "vif = [ '";
foreach (@ifsetup) {
- $ret .= "','" if $count;
- $ret .= "mac=" . $_->{mac} . "," if $_->{mac};
- $ret .= "bridge=br" . $_->{tag};
- $count++;
+ $ret .= "','" if $count;
+ $ret .= "mac=" . $_->{mac} . "," if $_->{mac};
+ $ret .= "bridge=br" . $_->{tag};
+ $count++;
}
$ret .= "' ]";
@@ -142,15 +142,15 @@
my @viflist = `xm vif-list $vm`;
foreach (@viflist) {
- if (/\(vif\ (\d+)\)/) {
-
- my $vifnum = $1;
- print "vif$domid.$vifnum -> $vm.$ifsetup[$vifnum]->{tag}\n";
-
- `ifconfig vif$domid.$vifnum down`;
- `ifrename -i vif$domid.$vifnum -n $vm.$ifsetup[$vifnum]->{tag}`;
- `ifconfig $vm.$ifsetup[$vifnum]->{tag} up`;
- }
+ if (/\(vif\ (\d+)\)/) {
+
+ my $vifnum = $1;
+ print "vif$domid.$vifnum -> $vm.$ifsetup[$vifnum]->{tag}\n";
+
+ `ifconfig vif$domid.$vifnum down`;
+ `ifrename -i vif$domid.$vifnum -n $vm.$ifsetup[$vifnum]->{tag}`;
+ `ifconfig $vm.$ifsetup[$vifnum]->{tag} up`;
+ }
}
}
@@ -185,11 +185,11 @@
# print STDERR "\t --regex specification des uml par regex\n";
# print STDERR "\t --no-errors passer a la machine suivante meme en cas d'erreur\n";
print STDERR
- "\t --branche-cvs permet l'utilisation d'une branche specifique\n";
+ "\t --branche-cvs permet l'utilisation d'une branche specifique\n";
print STDERR
- "\t-m --mem=XXX volume de RAM pour l'UML en Mo, défaut ($mem Mo)\n";
+ "\t-m --mem=XXX volume de RAM pour l'UML en Mo, défaut ($mem Mo)\n";
print STDERR
- "\t --disksize=XXX taille de l'image disque en Mo, défaut ($disksize Mo)\n";
+ "\t --disksize=XXX taille de l'image disque en Mo, défaut ($disksize Mo)\n";
exit 1;
}
@@ -247,12 +247,12 @@
unless ( -d $DISKDIR . "/" . $vm ) {
`mkdir -p $DISKDIR/$vm`;
die "Probleme lors de la cration du dossier " . $DISKDIR . "/" . $vm
- if ($!);
+ if ($!);
}
unless ( -f $DISKDIR . "/" . $vm . "/swap.img" ) {
print "Creation du l'image swap\n";
system(
- "dd if=/dev/zero of=$DISKDIR/$vm/swap.img seek=200 count=0 bs=1M 2>/dev/null"
+ "dd if=/dev/zero of=$DISKDIR/$vm/swap.img seek=200 count=0 bs=1M 2>/dev/null"
);
system("mksawp -f -v1 /dev/zero of=$DISKDIR/$vm/swap.img 2>/dev/null");
@@ -260,14 +260,14 @@
unless ( -f $DISKDIR . "/" . $vm . "/hda1.img" ) {
print "Creation du l'image disk boot\n";
system(
- "dd if=/dev/zero of=$DISKDIR/$vm/hda1.img seek=15 count=0 bs=1M 2>/dev/null"
+ "dd if=/dev/zero of=$DISKDIR/$vm/hda1.img seek=15 count=0 bs=1M 2>/dev/null"
);
system("mkfs.ext2 -F $DISKDIR/$vm/hda1.img 2>/dev/null");
}
unless ( -f $DISKDIR . "/" . $vm . "/hda2.img" ) {
print "Creation du l'image disk systeme\n";
system(
- "dd if=/dev/zero of=$DISKDIR/$vm/hda2.img seek=$disksize count=0 bs=1M 2>/dev/null"
+ "dd if=/dev/zero of=$DISKDIR/$vm/hda2.img seek=$disksize count=0 bs=1M 2>/dev/null"
);
system("mkfs.ext2 -F $DISKDIR/$vm/hda2.img 2>/dev/null");
}
More information about the pf-tools-commits
mailing list