pf-tools commit: r536 [parmelan-guest] - /branches/0.32-stable/pflaunch
parmelan-guest at users.alioth.debian.org
parmelan-guest at users.alioth.debian.org
Fri Jun 15 13:21:10 UTC 2007
Author: parmelan-guest
Date: Fri Jun 15 13:21:10 2007
New Revision: 536
URL: http://svn.debian.org/wsvn/pf-tools/?sc=1&rev=536
Log:
perltidy
Modified:
branches/0.32-stable/pflaunch
Modified: branches/0.32-stable/pflaunch
URL: http://svn.debian.org/wsvn/pf-tools/branches/0.32-stable/pflaunch?rev=536&op=diff
==============================================================================
--- branches/0.32-stable/pflaunch (original)
+++ branches/0.32-stable/pflaunch Fri Jun 15 13:21:10 2007
@@ -30,7 +30,6 @@
# il va chercher la conf dans config/GLOBAL/PF/«hostname».cfg
#
-
use Expect;
use File::Temp;
use Getopt::Long;
@@ -41,50 +40,48 @@
use Sitalibs::Config;
-require "lib-net"; # pour Address()
+require "lib-net"; # pour Address()
require "lib-update";
-my $HOSTNAME = hostname;
+my $HOSTNAME = hostname;
# paths
-my $umlaunch = "/usr/local/sbin/umlaunch";
-my $cfgpath = "/var/lib/cvsguest/$HOSTNAME/config/GLOBAL";
-my $configfile = "$cfgpath/PF/$HOSTNAME.cfg";
-my $privatenetworkfile = "$cfgpath/private-network";
-my $PF_STATUS_DIR = "/var/lib/pftools";
-my $CVS_CHECKOUT = "/var/lib/cvsguest";
-my $uml_switch_pipe = "/var/run/uml-utilities/uml_switch.ctl";
-my $logfile = "/var/log/pflaunch";
+my $umlaunch = "/usr/local/sbin/umlaunch";
+my $cfgpath = "/var/lib/cvsguest/$HOSTNAME/config/GLOBAL";
+my $configfile = "$cfgpath/PF/$HOSTNAME.cfg";
+my $privatenetworkfile = "$cfgpath/private-network";
+my $PF_STATUS_DIR = "/var/lib/pftools";
+my $CVS_CHECKOUT = "/var/lib/cvsguest";
+my $uml_switch_pipe = "/var/run/uml-utilities/uml_switch.ctl";
+my $logfile = "/var/log/pflaunch";
# constantes
my $vlan_default_mtu = "1468";
-my $IFNAMSIZ = 16;
-
-my $HALTED=0;
-my $HALTING=1;
-my $RUNNING=2;
-
+my $IFNAMSIZ = 16;
+
+my $HALTED = 0;
+my $HALTING = 1;
+my $RUNNING = 2;
####### GLOBAL
my $cache;
my $options;
-my $cvsupdated = 0;
-my $private_network = undef; # hash correspondant à $privatenetworkfile
+my $cvsupdated = 0;
+my $private_network = undef; # hash correspondant à $privatenetworkfile
# Compte les alias créés
my %ifAliasCpt;
-Config_Need_Preproc ($privatenetworkfile);
-Config_Set_Var ($privatenetworkfile, ["UML"]);
-
-if ( `which vconfig 2>/dev/null` eq ""
- || `which brctl 2>/dev/null` eq ""
- || `which tunctl 2>/dev/null` eq ""
- || `which screen 2>/dev/null` eq "" )
+Config_Need_Preproc($privatenetworkfile);
+Config_Set_Var( $privatenetworkfile, ["UML"] );
+
+if ( `which vconfig 2>/dev/null` eq ""
+ || `which brctl 2>/dev/null` eq ""
+ || `which tunctl 2>/dev/null` eq ""
+ || `which screen 2>/dev/null` eq "" )
{
- __Fault( "Sorry, I need vlan, bridge-utils, uml-utilities and screen");
-}
-
+ __Fault("Sorry, I need vlan, bridge-utils, uml-utilities and screen");
+}
#
# update-config vire les commentaires, mais pas Sitalbis::Config ...
@@ -94,15 +91,14 @@
return unless $a and ref $a eq 'HASH';
- foreach my $section (keys %$a) {
- foreach my $key (keys %{$a->{$section}}) {
+ foreach my $section ( keys %$a ) {
+ foreach my $key ( keys %{ $a->{$section} } ) {
$a->{$section}->{$key} =~ s/\s+#\s+.*$//;
}
}
return $a;
}
-
#
# Pour les noms d'interfaces trop longs (lvswebmail00.101 par exemple),
@@ -120,562 +116,537 @@
return $if;
}
-
# Lance une ou plusieurs commande
# parametres :
# string ou ref sur tab de strings
# 1 ou undef :afficher les retours d'erreur ou pas
-sub __runCmds ($;$)
-{
- my $cmds;
- if (ref $_[0] eq 'ARRAY')
- {
- $cmds = shift;
- }
- else
- {
- push @$cmds, shift;
- }
- return unless defined $cmds;
- my $quiet = shift;
-
- my $ok = 1; # OK
- foreach my $cmd (@$cmds)
- {
- my @ret = `$cmd 2>&1`;
-
-
- if ($?)
- {
- $ok = 0;
- }
- elsif ($quiet)
- {
- __Debug(@ret);
- }
- else
- {
- __Debug(@ret);
- }
- }
- return $ok;
+sub __runCmds ($;$) {
+ my $cmds;
+ if ( ref $_[0] eq 'ARRAY' ) {
+ $cmds = shift;
+ }
+ else {
+ push @$cmds, shift;
+ }
+ return unless defined $cmds;
+ my $quiet = shift;
+
+ my $ok = 1; # OK
+ foreach my $cmd (@$cmds) {
+ my @ret = `$cmd 2>&1`;
+
+ if ($?) {
+ $ok = 0;
+ }
+ elsif ($quiet) {
+ __Debug(@ret);
+ }
+ else {
+ __Debug(@ret);
+ }
+ }
+ return $ok;
}
# A partir d'un nom de machine sour la forme machine01,
# retourne un tableau contenant le nom et le numéro de
# la machine
-sub __FamillyNumFromVM ($)
-{
- my $vm = shift;
-
- unless (defined $vm and $vm) {
- __Err ("__FamillyNumFromVM appelé sans parametre");
- return;
- }
-
- if (defined $cache->{'FamillyNumFromVM '}->{$vm} and
- $cache->{'FamillyNumFromVM '}->{$vm}) {
- return (
- $cache->{'FamillyNumFromVM '}->{$vm}->{f},
- $cache->{'FamillyNumFromVM '}->{$vm}->{n},
- $cache->{'FamillyNumFromVM '}->{$vm}->{s}
- );
- }
-
- my $famille;
- my $num;
- my $section;
-
- if ( $vm =~ /^(\S+)(\d\d)$/) {
- $famille = $1;
- $num = $2;
- $section = $famille."%%";
- unless (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");
- }
- } else {
- __Fault("L'entrée `$vm' de votre fichier de configuration de correspond pas a un\n
- nom de machine valide.");
- }
- $cache->{'FamillyNumFromVM '}->{$vm}->{f} = $famille;
- $cache->{'FamillyNumFromVM '}->{$vm}->{n} = $num;
- $cache->{'FamillyNumFromVM '}->{$vm}->{s} = $section;
-
- return ($famille, $num, $section);
-}
-
+sub __FamillyNumFromVM ($) {
+ my $vm = shift;
+
+ unless ( defined $vm and $vm ) {
+ __Err("__FamillyNumFromVM appelé sans parametre");
+ return;
+ }
+
+ if ( defined $cache->{'FamillyNumFromVM '}->{$vm}
+ and $cache->{'FamillyNumFromVM '}->{$vm} )
+ {
+ return (
+ $cache->{'FamillyNumFromVM '}->{$vm}->{f},
+ $cache->{'FamillyNumFromVM '}->{$vm}->{n},
+ $cache->{'FamillyNumFromVM '}->{$vm}->{s}
+ );
+ }
+
+ my $famille;
+ my $num;
+ my $section;
+
+ if ( $vm =~ /^(\S+)(\d\d)$/ ) {
+ $famille = $1;
+ $num = $2;
+ $section = $famille . "%%";
+ unless ( 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"
+ );
+ }
+ }
+ else {
+ __Fault(
+ "L'entrée `$vm' de votre fichier de configuration de correspond pas a un\n
+ nom de machine valide."
+ );
+ }
+ $cache->{'FamillyNumFromVM '}->{$vm}->{f} = $famille;
+ $cache->{'FamillyNumFromVM '}->{$vm}->{n} = $num;
+ $cache->{'FamillyNumFromVM '}->{$vm}->{s} = $section;
+
+ return ( $famille, $num, $section );
+}
# Retourne les alias pour une vm sour la forme familleXX
-sub __GetVMAlias ($)
-{
- my ($famille, $num, $section) = __FamillyNumFromVM (shift);
-
-
- my $s = $private_network->{$section};
-
- __Fault("Familly '$famille' NOT found !") unless (defined ($s) and ($section));
- __Fault("VM $famille$num out of range.") if ($s->{number} <= $num);
-
-
- my $listalias;
- foreach my $key (keys %$s)
- {
- if ($key =~ /^alias\.(\S+)/)
- {
- push @$listalias, $1 if ($num == 0);
- push @$listalias, $1.$num;
- }
- }
-
- return $listalias;
-}
-
-
-# Retourne les IP pour une vm sous la fome familleXX
-sub __GetVMnet ($)
-{
- my $vm = shift;
-
- my $listip;
- my $ipstart;
-
-
- my ($famille, $num, $section) = __FamillyNumFromVM ($vm);
-
- my $s = $private_network->{$section};
- __Fault("Familly '$famille' NOT found !") unless (defined ($s) and ($s));
-
- # Recherche des ipstart
- $ipstart->{default} = (defined ($s->{"ipstart.default"})) ? $s->{"ipstart.default"} : -1;
-
- foreach my $key (keys %$s)
- {
- if ($key =~ /^ipstart\.(\S+)/)
- {
- # ATTENTION ce calcul est faux si on ne travaille pas que sur des /24. Et
- # c'est justement le cas avec le nouvel adressage !
- # Donc je vire cette vérification.
- #die "$famille, $num : ipstart.$1 out of range (".$s->{$key}.")\n"
- # if (($s->{$key} > 254) or ($s->{$key} < 1));
-
- $ipstart->{$1} = $s->{$key};
- }
- }
-
- # Creation des adresses
- foreach my $key (keys %$s) {
- if ($key =~ /^interface\.\S+/) {
- my $vlan = $s->{$key};
- my $network = $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;
-}
-
+sub __GetVMAlias ($) {
+ my ( $famille, $num, $section ) = __FamillyNumFromVM(shift);
+
+ my $s = $private_network->{$section};
+
+ __Fault("Familly '$famille' NOT found !")
+ unless ( defined($s) and ($section) );
+ __Fault("VM $famille$num out of range.") if ( $s->{number} <= $num );
+
+ my $listalias;
+ foreach my $key ( keys %$s ) {
+ if ( $key =~ /^alias\.(\S+)/ ) {
+ push @$listalias, $1 if ( $num == 0 );
+ push @$listalias, $1 . $num;
+ }
+ }
+
+ return $listalias;
+}
+
+# Retourne les IP pour une vm sous la fome familleXX
+sub __GetVMnet ($) {
+ my $vm = shift;
+
+ my $listip;
+ my $ipstart;
+
+ my ( $famille, $num, $section ) = __FamillyNumFromVM($vm);
+
+ my $s = $private_network->{$section};
+ __Fault("Familly '$famille' NOT found !") unless ( defined($s) and ($s) );
+
+ # Recherche des ipstart
+ $ipstart->{default}
+ = ( defined( $s->{"ipstart.default"} ) )
+ ? $s->{"ipstart.default"}
+ : -1;
+
+ foreach my $key ( keys %$s ) {
+ if ( $key =~ /^ipstart\.(\S+)/ ) {
+
+ # ATTENTION ce calcul est faux si on ne travaille pas que sur des /24. Et
+ # c'est justement le cas avec le nouvel adressage !
+ # Donc je vire cette vérification.
+ #die "$famille, $num : ipstart.$1 out of range (".$s->{$key}.")\n"
+ # if (($s->{$key} > 254) or ($s->{$key} < 1));
+
+ $ipstart->{$1} = $s->{$key};
+ }
+ }
+
+ # Creation des adresses
+ foreach my $key ( keys %$s ) {
+ if ( $key =~ /^interface\.\S+/ ) {
+ my $vlan = $s->{$key};
+ my $network = $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;
+}
# Retourne une ref sur la liste des noms des VLANs qui doivent être
# lancés pour les UML inscrites dans le fichier de conf
-sub __GetVLanList
-{
-
- my $listlan;
- my $h;
-
- my $l = Config_Key($configfile, "init", '@vlan');
-
- if ($l)
- {
- foreach (@{$l})
- {
- $h->{"vlan-$_"} = 1 if defined $_;
- }
- }
-
-
- my $section_start = Config_Key($configfile, "init", '@start');
-
- if (!$section_start)
- {
- __Fault( "Je ne trouve pas l'entrée \@start dans $configfile, (section [init])");
- }
-
- foreach my $vm ( @$section_start )
- {
- my ($famille, $num, $section) = __FamillyNumFromVM($vm);
-
- my $s = $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
- # c'est beaucoup plus facile pour les bidouilles double-adressage
- @$listlan = sort keys %$h;
- return $listlan;
-}
-
-
-# Donne la liste des bridges up
-sub __GetListBridgeUp ()
-{
- my $listbr = [];
- my $b;
- my $h;
-
- my @brshow = `brctl show`;
- shift @brshow; # ligne d'entete
- foreach my $line (@brshow)
- {
- $h->{$1}=1 if ($line =~ /^(\S+)\s+/);
- }
-
- # Dans le cas ou la configuration a changé entre temps
- if (opendir(DIR, $PF_STATUS_DIR."/bridge/"))
- {
- foreach (readdir DIR)
- {
- next if /^\./;
- $h->{$_}=1;
- }
- closedir DIR;
- }
- else
- {
- __Err("Can't open dir ".$PF_STATUS_DIR."/bridge/");
- }
-
- @$listbr = sort keys %$h;
-
- return $listbr;
+sub __GetVLanList {
+
+ my $listlan;
+ my $h;
+
+ my $l = Config_Key( $configfile, "init", '@vlan' );
+
+ if ($l) {
+ foreach ( @{$l} ) {
+ $h->{"vlan-$_"} = 1 if defined $_;
+ }
+ }
+
+ my $section_start = Config_Key( $configfile, "init", '@start' );
+
+ if ( !$section_start ) {
+ __Fault(
+ "Je ne trouve pas l'entrée \@start dans $configfile, (section [init])"
+ );
+ }
+
+ foreach my $vm (@$section_start) {
+ my ( $famille, $num, $section ) = __FamillyNumFromVM($vm);
+
+ my $s = $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
+ # c'est beaucoup plus facile pour les bidouilles double-adressage
+ @$listlan = sort keys %$h;
+ return $listlan;
+}
+
+# Donne la liste des bridges up
+sub __GetListBridgeUp () {
+ my $listbr = [];
+ my $b;
+ my $h;
+
+ my @brshow = `brctl show`;
+ shift @brshow; # ligne d'entete
+ foreach my $line (@brshow) {
+ $h->{$1} = 1 if ( $line =~ /^(\S+)\s+/ );
+ }
+
+ # Dans le cas ou la configuration a changé entre temps
+ if ( opendir( DIR, $PF_STATUS_DIR . "/bridge/" ) ) {
+ foreach ( readdir DIR ) {
+ next if /^\./;
+ $h->{$_} = 1;
+ }
+ closedir DIR;
+ }
+ else {
+ __Err( "Can't open dir " . $PF_STATUS_DIR . "/bridge/" );
+ }
+
+ @$listbr = sort keys %$h;
+
+ return $listbr;
}
# Retourne la configuration d'un vlan.
# Parametre :
# vlan sous la forme vlan-nom
-sub __GetVLanSetup ($)
-{
- my $vlan = shift;
-
-
- my $section = $private_network->{$vlan};
-
- __Err("Can't read section [$vlan] from `$privatenetworkfile'") unless (defined ($section) and ($section));
- return $section;
-}
-
+sub __GetVLanSetup ($) {
+ my $vlan = shift;
+
+ my $section = $private_network->{$vlan};
+
+ __Err("Can't read section [$vlan] from `$privatenetworkfile'")
+ unless ( defined($section) and ($section) );
+ return $section;
+}
# retourne une liste ordonnée des UML qui doivent être lancées
# triées par priorité
-sub __GetUMLtoLaunch ()
-{
- my $umlToLaunch;
-
- my $listVM = Config_Key($configfile, "init", "\@start");
-
-
- foreach my $vm (@$listVM)
- {
- my $uml_cfg = Config_Section($configfile, "uml-$vm");
-
- my $priorite = 10; # Val par defaut
- $priorite = $uml_cfg->{priorite}
- if (defined ($uml_cfg->{priorite}));
-
- __Fault( "Mauvaise priorite pour la section [uml-$vm]")
- if ($priorite < 0 or $priorite >255);
-
- $umlToLaunch->[$priorite] .= " $vm";
- }
-
- return $umlToLaunch;
+sub __GetUMLtoLaunch () {
+ my $umlToLaunch;
+
+ my $listVM = Config_Key( $configfile, "init", "\@start" );
+
+ foreach my $vm (@$listVM) {
+ my $uml_cfg = Config_Section( $configfile, "uml-$vm" );
+
+ my $priorite = 10; # Val par defaut
+ $priorite = $uml_cfg->{priorite}
+ if ( defined( $uml_cfg->{priorite} ) );
+
+ __Fault("Mauvaise priorite pour la section [uml-$vm]")
+ if ( $priorite < 0 or $priorite > 255 );
+
+ $umlToLaunch->[$priorite] .= " $vm";
+ }
+
+ return $umlToLaunch;
}
# Retourne l'ip d'une machine sur un vlan
# paramtre :
# vm : nom de la vm
# vlan : nom du vlan sous la forme vlan-nom
-sub __GetVMip ($$)
-{
-
- my ( $vm, $vlan ) = @_;
-
- return unless $vm and $vlan;
-
- my ($famille, $num, $section) = __FamillyNumFromVM ($vm);
-
- my $s = $private_network->{$section};
-
- my @ipstart;
- if ($s->{"ipstart.".$vlan}) {
- @ipstart = split(/\./,$s->{"ipstart.".$vlan});
- } else {
- @ipstart = split(/\./,$s->{"ipstart.default"}) unless @ipstart;
- }
-
- unless (@ipstart)
- {
- __Err("can't find ipstart for `$section'");
+sub __GetVMip ($$) {
+
+ my ( $vm, $vlan ) = @_;
+
+ return unless $vm and $vlan;
+
+ my ( $famille, $num, $section ) = __FamillyNumFromVM($vm);
+
+ my $s = $private_network->{$section};
+
+ my @ipstart;
+ if ( $s->{ "ipstart." . $vlan } ) {
+ @ipstart = split( /\./, $s->{ "ipstart." . $vlan } );
+ }
+ else {
+ @ipstart = split( /\./, $s->{"ipstart.default"} ) unless @ipstart;
+ }
+
+ unless (@ipstart) {
+ __Err("can't find ipstart for `$section'");
+ return;
+ }
+ @ipstart = reverse @ipstart;
+ push @ipstart, "0" while ( @ipstart < 4 );
+ @ipstart = reverse @ipstart;
+
+ my $n = $private_network->{$vlan}->{'network'};
+ __Fault( "Je ne peux pas lire la s network du "
+ . "vlan `$vlan' dans le private-network" )
+ unless $n;
+
+ my @n_ip;
+ @n_ip = split( /\./, $n );
+
+ my @ip;
+ $ip[$_] = ( $n_ip[$_] + $ipstart[$_] ) foreach ( 0 .. 3 );
+
+ unless ( @n_ip == 4 ) {
+ __Err("Ip invalide pour `$vm', `$vlan'");
+ return;
+ }
+ $n_ip[3] += $num;
+ my $ip = join ".", @ip;
+ return $ip if ($ip);
+
+ __Err("can't find network for `$vlan'");
+
return;
- }
- @ipstart = reverse @ipstart;
- push @ipstart,"0" while (@ipstart<4);
- @ipstart = reverse @ipstart;
-
- my $n = $private_network->{$vlan}->{'network'};
- __Fault("Je ne peux pas lire la s network du "
- ."vlan `$vlan' dans le private-network") unless $n;
-
- my @n_ip;
- @n_ip = split (/\./,$n);
-
- my @ip;
- $ip[$_] = ($n_ip[$_] + $ipstart[$_]) foreach (0..3);
-
- unless (@n_ip == 4)
- {
- __Err("Ip invalide pour `$vm', `$vlan'");
- return;
- }
- $n_ip[3] += $num;
- my $ip = join ".", at ip;
- return $ip if ($ip);
-
-
- __Err("can't find network for `$vlan'");
-
- return;
-
-}
-
+
+}
# Adresse le bridge d'un vlan
# parametre :
# vlan : sous la forme vlan-nom
-sub __BridgeSetAddr ($)
-{
- my $vlan = shift;
- my @ip;
-
- my $vlan_setup = __GetVLanSetup ($vlan);
- my $brname = "br".$vlan_setup->{tag};
-
-
- my $mtu = Config_Key($configfile, $vlan, "mtu");
- $mtu = Config_Key($configfile, "vlan-default", "mtu") unless $mtu;
-
- unless ($mtu)
- {
- __Err("Can't read mtu from vlan-* section, using default (`$vlan_default_mtu')");
- $mtu = $vlan_default_mtu;
- }
- if ($mtu > 1496)
- {
- __Err("$vlan : mtu de `$mtu' > à 1496");
- }
-
- my $t = Config_Key($configfile, $vlan, "\@ip");
- $t = Config_Key($configfile, "vlan-default", "\@ip") unless $t;
-
-
- my $arp = "";
- my $settingarp = Config_Key($configfile, $vlan, "arp");
- $settingarp = Config_Key($configfile, "vlan-default", "arp") unless $settingarp;
- if ($settingarp)
- {
- if ($settingarp eq "true")
- {
- $arp = "arp";
- }
- elsif ($settingarp eq "false")
- {
- $arp = "-arp";
- }
- else
- {
- __Err("Mauvaise valeur pour la clef arp (true/false)");
- }
- }
-
-
-
- __Info("Attention vous n'avez pas d'\@ip ni dans la section [vlan-default] ni".
- "dans [vlan-$vlan] pour le vlan `$vlan'") unless $t;
-
-
- foreach my $v (@$t) {
- next unless defined $v;
- if ($v =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(?:\/[\d.]+)?$/) {
- # une IP et éventuellement un préfixe ou un netmask : 1.2.3.4/24 ou 1.2.3.4/255.255.255.0
- # si pas de préfixe ou netmask : le netmask du vlan
- my ($ip, $cidr) = ipv4_parse($v); # 1.2.3.4, 24
- my $mask = $cidr ? ipv4_cidr2msk($cidr) : $vlan_setup->{netmask}; # 255.255.255.0
- __Debug( "DEBUG: v=$v ip=$ip mask=$mask");
- push @ip, [ $ip, $mask ];
- }
- elsif ($v ne 'none') {
- # un nom de machine (juste un hostname et on le prend dans le vlan courant)
- my $vn = __GetVMnet($v);
-
- unless ($vn)
- {
- __Err("Mauvaise valeur : `$_' dans le fichier de conf dans une section \@ip");
- }
-
- foreach (@$vn) {
- push @ip, [ $_->{ip}, $vlan_setup->{netmask} ]
- if $_->{lan} eq $vlan and $_->{ip};
- }
- }
- }
-
- my $i;
- my $cmds;
- # retrouver les interfaces que j'ai déja lancée
- if (open STATUS_IFBR, "<".$PF_STATUS_DIR."/ifbr")
- {
- foreach (<STATUS_IFBR>)
- {
- $i++ if (/^($brname|$brname:\d+)$/);
+sub __BridgeSetAddr ($) {
+ my $vlan = shift;
+ my @ip;
+
+ my $vlan_setup = __GetVLanSetup($vlan);
+ my $brname = "br" . $vlan_setup->{tag};
+
+ my $mtu = Config_Key( $configfile, $vlan, "mtu" );
+ $mtu = Config_Key( $configfile, "vlan-default", "mtu" ) unless $mtu;
+
+ unless ($mtu) {
+ __Err(
+ "Can't read mtu from vlan-* section, using default (`$vlan_default_mtu')"
+ );
+ $mtu = $vlan_default_mtu;
+ }
+ if ( $mtu > 1496 ) {
+ __Err("$vlan : mtu de `$mtu' > à 1496");
+ }
+
+ my $t = Config_Key( $configfile, $vlan, "\@ip" );
+ $t = Config_Key( $configfile, "vlan-default", "\@ip" ) unless $t;
+
+ my $arp = "";
+ my $settingarp = Config_Key( $configfile, $vlan, "arp" );
+ $settingarp = Config_Key( $configfile, "vlan-default", "arp" )
+ unless $settingarp;
+ if ($settingarp) {
+ if ( $settingarp eq "true" ) {
+ $arp = "arp";
+ }
+ elsif ( $settingarp eq "false" ) {
+ $arp = "-arp";
+ }
+ else {
+ __Err("Mauvaise valeur pour la clef arp (true/false)");
+ }
+ }
+
+ __Info(
+ "Attention vous n'avez pas d'\@ip ni dans la section [vlan-default] ni"
+ . "dans [vlan-$vlan] pour le vlan `$vlan'" )
+ unless $t;
+
+ foreach my $v (@$t) {
+ next unless defined $v;
+ if ( $v =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(?:\/[\d.]+)?$/ ) {
+
+# une IP et éventuellement un préfixe ou un netmask : 1.2.3.4/24 ou 1.2.3.4/255.255.255.0
+# si pas de préfixe ou netmask : le netmask du vlan
+ my ( $ip, $cidr ) = ipv4_parse($v); # 1.2.3.4, 24
+ my $mask
+ = $cidr
+ ? ipv4_cidr2msk($cidr)
+ : $vlan_setup->{netmask}; # 255.255.255.0
+ __Debug("DEBUG: v=$v ip=$ip mask=$mask");
+ push @ip, [ $ip, $mask ];
+ }
+ elsif ( $v ne 'none' ) {
+
+ # un nom de machine (juste un hostname et on le prend dans le vlan courant)
+ my $vn = __GetVMnet($v);
+
+ unless ($vn) {
+ __Err(
+ "Mauvaise valeur : `$_' dans le fichier de conf dans une section \@ip"
+ );
+ }
+
+ foreach (@$vn) {
+ push @ip, [ $_->{ip}, $vlan_setup->{netmask} ]
+ if $_->{lan} eq $vlan and $_->{ip};
+ }
+ }
+ }
+
+ my $i;
+ my $cmds;
+
+ # retrouver les interfaces que j'ai déja lancée
+ if ( open STATUS_IFBR, "<" . $PF_STATUS_DIR . "/ifbr" ) {
+ foreach (<STATUS_IFBR>) {
+ $i++ if (/^($brname|$brname:\d+)$/);
+ }
+ close STATUS_IFBR;
+ }
+ open STATUS_IFBR, ">>" . $PF_STATUS_DIR . "/ifbr";
+ foreach my $cidr (@ip) {
+ my ( $ip, $mask ) = @$cidr;
+
+ my $ifbr = $brname;
+ $ifbr .= ":" if ($i);
+ $ifbr .= $i - 1 if ($i);
+ print STATUS_IFBR $ifbr . "\n";
+
+ my $cmd = "ifconfig $ifbr";
+ $cmd .= " $ip";
+ $cmd .= " netmask $mask";
+ $cmd .= " $arp";
+ $cmd .= " mtu $mtu";
+ $cmd .= " promisc" unless $i;
+ $cmd .= " up";
+
+ push @$cmds, $cmd;
+ $i++;
}
close STATUS_IFBR;
- }
- open STATUS_IFBR, ">>".$PF_STATUS_DIR."/ifbr";
- foreach my $cidr (@ip)
- {
- my ($ip, $mask) = @$cidr;
-
- my $ifbr = $brname;
- $ifbr .= ":" if ($i);
- $ifbr .= $i-1 if ($i);
- print STATUS_IFBR $ifbr."\n";
-
- my $cmd = "ifconfig $ifbr";
- $cmd .= " $ip";
- $cmd .= " netmask $mask";
- $cmd .= " $arp";
- $cmd .= " mtu $mtu";
- $cmd .= " promisc" unless $i;
- $cmd .= " up";
-
- push @$cmds, $cmd;
- $i++;
- }
- close STATUS_IFBR;
-
- push @$cmds, "ifconfig $brname up";
- # Execution
- __runCmds ($cmds,1);
+
+ push @$cmds, "ifconfig $brname up";
+
+ # Execution
+ __runCmds( $cmds, 1 );
}
# Ajout le bridge d'un vlan, lien le trunk et les pates des vm
# parametre :
# vlan sous la form vlan-nom
-sub __BridgeAdd ($)
-{
- my $vlan = shift;
- my $vlan_setup = __GetVLanSetup($vlan);
- my $br_setting;
- my $para;
- my $cmd;
- my $tag = $vlan_setup->{tag};
- my $brname = "br".$tag;
-
- __Info(" Mise en place de '".$vlan."` (".$vlan_setup->{comment}.")");
- __Debug(" bridge `".$brname." @ ".$vlan_setup->{network}."'");
-
-# `ifconfig $brname 2>/dev/null`;
- __runCmds (["brctl addbr $brname"],1);# unless ($?);
-
- # J'applique les réglages pour le bridge,
- # s'il y a un réglage particulier pour un bridge je l'utilise
-
- my $sdef = Config_Section($configfile, "vlan-default");
- my $svlan = Config_Section($configfile, $vlan);
-
-
- foreach (keys %$sdef)
- {
- $br_setting->{$1} = $sdef->{"br-".$1}
- if (/^br-(.+)$/);
- }
- foreach (keys %$svlan)
- {
- $br_setting->{$1} = $svlan->{"br-".$1}
- if (/^br-(.+)$/);
- }
-
-
- unless ($br_setting)
- {
- __Debug(" Je ne trouve pas de réglage pour le br, j'utilise ce par defaut.");
- $br_setting = {stp => 'off', setfd => 1, sethello => 1};
- }
-
- foreach $para (keys %{$br_setting} )
- {
- __Debug(" $brname : $para = $br_setting->{$para}");
- __runCmds([ "brctl $para $brname ".$br_setting->{$para}],"1");
-
- }
-
- # Trunk
- my $trunk = Config_Key($configfile,"global","trunk");
- $trunk = "eth1" unless ($trunk);
- `ifconfig $trunk up 2>/dev/null`;
- unless ($?)
- {
- __Info(" Upping `$trunk.$tag'");
- __runCmds ([
- "vconfig set_name_type DEV_PLUS_VID_NO_PAD",
- "vconfig add $trunk $tag",
- "ifconfig $trunk.$tag 0.0.0.0 mtu 1496 promisc up",
- ]);
- __BridgeAttacheIf($brname,$trunk.".".$tag);
- }
-
- # J'attache les pates des vm (dans le cas d'un restart)
- my $tmp = __GetIfByVlan ($vlan);
- foreach (@$tmp)
- {
- __BridgeAttacheIf($brname, __sanitize_ifname($_.".".$vlan_setup->{tag}));
- }
-
- unless (-f $PF_STATUS_DIR."/bridge/".$brname)
- {
- `touch $PF_STATUS_DIR"/bridge/"$brname`;
- }
+sub __BridgeAdd ($) {
+ my $vlan = shift;
+ my $vlan_setup = __GetVLanSetup($vlan);
+ my $br_setting;
+ my $para;
+ my $cmd;
+ my $tag = $vlan_setup->{tag};
+ my $brname = "br" . $tag;
+
+ __Info( " Mise en place de '"
+ . $vlan . "` ("
+ . $vlan_setup->{comment}
+ . ")" );
+ __Debug( " bridge `" . $brname . " @ " . $vlan_setup->{network} . "'" );
+
+ # `ifconfig $brname 2>/dev/null`;
+ __runCmds( ["brctl addbr $brname"], 1 ); # unless ($?);
+
+ # J'applique les réglages pour le bridge,
+ # s'il y a un réglage particulier pour un bridge je l'utilise
+
+ my $sdef = Config_Section( $configfile, "vlan-default" );
+ my $svlan = Config_Section( $configfile, $vlan );
+
+ foreach ( keys %$sdef ) {
+ $br_setting->{$1} = $sdef->{ "br-" . $1 }
+ if (/^br-(.+)$/);
+ }
+ foreach ( keys %$svlan ) {
+ $br_setting->{$1} = $svlan->{ "br-" . $1 }
+ if (/^br-(.+)$/);
+ }
+
+ unless ($br_setting) {
+ __Debug(
+ " Je ne trouve pas de réglage pour le br, j'utilise ce par defaut."
+ );
+ $br_setting = { stp => 'off', setfd => 1, sethello => 1 };
+ }
+
+ foreach $para ( keys %{$br_setting} ) {
+ __Debug(" $brname : $para = $br_setting->{$para}");
+ __runCmds( [ "brctl $para $brname " . $br_setting->{$para} ], "1" );
+
+ }
+
+ # Trunk
+ my $trunk = Config_Key( $configfile, "global", "trunk" );
+ $trunk = "eth1" unless ($trunk);
+ `ifconfig $trunk up 2>/dev/null`;
+ unless ($?) {
+ __Info(" Upping `$trunk.$tag'");
+ __runCmds(
+ [ "vconfig set_name_type DEV_PLUS_VID_NO_PAD",
+ "vconfig add $trunk $tag",
+ "ifconfig $trunk.$tag 0.0.0.0 mtu 1496 promisc up",
+ ]
+ );
+ __BridgeAttacheIf( $brname, $trunk . "." . $tag );
+ }
+
+ # J'attache les pates des vm (dans le cas d'un restart)
+ my $tmp = __GetIfByVlan($vlan);
+ foreach (@$tmp) {
+ __BridgeAttacheIf( $brname,
+ __sanitize_ifname( $_ . "." . $vlan_setup->{tag} ) );
+ }
+
+ unless ( -f $PF_STATUS_DIR . "/bridge/" . $brname ) {
+ `touch $PF_STATUS_DIR"/bridge/"$brname`;
+ }
}
# Supprime un bridge
@@ -684,1097 +655,1046 @@
# XXX TODO Armoniser en utilisant le nom du vlan plutot
# en meme temps, il y pas mal de chose a reprendre dans ce
# cas
-sub __BridgeDel ($)
-{
- my $brname = shift;
-
- unless ( $brname )
- {
- __Debug("__BridgeDel: pas de valeur en parametre");
- return;
- }
-
- my $ifattached = __BridgeGetIfAttached($brname);
- if (@$ifattached)
- {
- __Debug("Vous avez ".@$ifattached. " interface(s) attachée(s) à $brname");
- __Debug("Je les détache...");
-
- __BridgeDetacheIf($brname,$_) foreach (@$ifattached);
- }
-
- __Info(" J'arrete le bridge `$brname'");
-
- # Je vire les alias du br
- if (open STATUS_IFBR, "<".$PF_STATUS_DIR."/ifbr")
- {
- foreach(<STATUS_IFBR>)
- {
- next unless (/^$brname:/);
- chomp;
- `ifconfig $_ 2>/dev/null`;
- __runCmds("ifconfig $_ down",1) unless $?;
- }
- close STATUS_IFBR;
- }
- else
- {
- __Err("Can't open ".$PF_STATUS_DIR."/ifbr");
- }
-
- __runCmds (["ifconfig $brname down","brctl delbr $brname"],1);
- # trunk
- my $trunk = Config_Key($configfile,"global","trunk");
- $trunk = "eth1" unless ($trunk);
- `ifconfig $trunk up 2>/dev/null`;
-# descend les $trunk.$tag
- __runCmds(["ifconfig $trunk.$1 down","vconfig rem $trunk.$1"],"1")
- if (!$? and $brname =~ /(\d+)$/);
-
- if (-f $PF_STATUS_DIR."/bridge/".$brname)
- {
- unlink $PF_STATUS_DIR."/bridge/".$brname;
- }
-}
-
+sub __BridgeDel ($) {
+ my $brname = shift;
+
+ unless ($brname) {
+ __Debug("__BridgeDel: pas de valeur en parametre");
+ return;
+ }
+
+ my $ifattached = __BridgeGetIfAttached($brname);
+ if (@$ifattached) {
+ __Debug( "Vous avez "
+ . @$ifattached
+ . " interface(s) attachée(s) à $brname" );
+ __Debug("Je les détache...");
+
+ __BridgeDetacheIf( $brname, $_ ) foreach (@$ifattached);
+ }
+
+ __Info(" J'arrete le bridge `$brname'");
+
+ # Je vire les alias du br
+ if ( open STATUS_IFBR, "<" . $PF_STATUS_DIR . "/ifbr" ) {
+ foreach (<STATUS_IFBR>) {
+ next unless (/^$brname:/);
+ chomp;
+ `ifconfig $_ 2>/dev/null`;
+ __runCmds( "ifconfig $_ down", 1 ) unless $?;
+ }
+ close STATUS_IFBR;
+ }
+ else {
+ __Err( "Can't open " . $PF_STATUS_DIR . "/ifbr" );
+ }
+
+ __runCmds( [ "ifconfig $brname down", "brctl delbr $brname" ], 1 );
+
+ # trunk
+ my $trunk = Config_Key( $configfile, "global", "trunk" );
+ $trunk = "eth1" unless ($trunk);
+ `ifconfig $trunk up 2>/dev/null`;
+
+ # descend les $trunk.$tag
+ __runCmds( [ "ifconfig $trunk.$1 down", "vconfig rem $trunk.$1" ], "1" )
+ if ( !$? and $brname =~ /(\d+)$/ );
+
+ if ( -f $PF_STATUS_DIR . "/bridge/" . $brname ) {
+ unlink $PF_STATUS_DIR . "/bridge/" . $brname;
+ }
+}
# Donne la liste des interfaces attachées à un bridge
# parametre :
# le nom du bridge
-sub __BridgeGetIfAttached ($)
-{
- my $brname = shift;
- my $list = [];
-
- return $list unless defined $brname; # éviter du travail inutile et des warnings
-
- my @brshow = `brctl show`;
- shift @brshow; # ligne d'entete
-
- my $b;
- foreach my $line (@brshow)
- {
- $b = $1 if ($line =~ /^(\S+)\s+/);
-
- if ($b eq $brname)
- {
- push @$list, $1
- if ($line =~ /^\S+\s+\S+\s+\S+\s+(\S+)$/);
- }
- }
-
- return $list;
-}
-
+sub __BridgeGetIfAttached ($) {
+ my $brname = shift;
+ my $list = [];
+
+ return $list
+ unless defined $brname; # éviter du travail inutile et des warnings
+
+ my @brshow = `brctl show`;
+ shift @brshow; # ligne d'entete
+
+ my $b;
+ foreach my $line (@brshow) {
+ $b = $1 if ( $line =~ /^(\S+)\s+/ );
+
+ if ( $b eq $brname ) {
+ push @$list, $1
+ if ( $line =~ /^\S+\s+\S+\s+\S+\s+(\S+)$/ );
+ }
+ }
+
+ return $list;
+}
# Cette fonction permet de savoir quelles interfaces doivent être attachées au
# bridge.
-sub __GetIfByVlan ($)
-{
- my $vlan = shift;
- my $list = [];
-
- return $list unless defined $vlan; # éviter du travail inutile et des warnings
-
- my $ListVM = Config_Key($configfile, "init", "\@start");
-
- foreach my $vm (@{$ListVM})
- {
- foreach (@{__GetVMnet ($vm)})
- {
- push (@$list, $vm) if ($_->{lan} eq $vlan);
- }
- }
-
- return $list;
-}
-
-
-# Attache une interface à un bridge
-sub __BridgeAttacheIf ($$)
-{
- my ($bridge, $if) = @_;
-
- unless ($bridge and $if) {
- __Err("__BridgeAttacheIf called with undef or empty bridge and/or if");
- return undef;
- }
-
- `ifconfig $if 2>&1`;
- if ($?)
- {
- # Pourquoi
- __Debug("L'interface `$if' ne semble pas dispo, l'UML n'est sans doute pas lancée");
- return;
- }
- else
- {
- __runCmds(["brctl addif $bridge $if"],"1");
- }
- __runCmds(["ifconfig $if up"],"1");
-
-
- return 1;
-}
-
+sub __GetIfByVlan ($) {
+ my $vlan = shift;
+ my $list = [];
+
+ return $list
+ unless defined $vlan; # éviter du travail inutile et des warnings
+
+ my $ListVM = Config_Key( $configfile, "init", "\@start" );
+
+ foreach my $vm ( @{$ListVM} ) {
+ foreach ( @{ __GetVMnet($vm) } ) {
+ push( @$list, $vm ) if ( $_->{lan} eq $vlan );
+ }
+ }
+
+ return $list;
+}
+
+# Attache une interface à un bridge
+sub __BridgeAttacheIf ($$) {
+ my ( $bridge, $if ) = @_;
+
+ unless ( $bridge and $if ) {
+ __Err(
+ "__BridgeAttacheIf called with undef or empty bridge and/or if");
+ return undef;
+ }
+
+ `ifconfig $if 2>&1`;
+ if ($?) {
+
+ # Pourquoi
+ __Debug(
+ "L'interface `$if' ne semble pas dispo, l'UML n'est sans doute pas lancée"
+ );
+ return;
+ }
+ else {
+ __runCmds( ["brctl addif $bridge $if"], "1" );
+ }
+ __runCmds( ["ifconfig $if up"], "1" );
+
+ return 1;
+}
# Détache une interface d'un bridge
# parametre :
# nom du bridge
# interface
-sub __BridgeDetacheIf ($$)
-{
- my ($bridge, $if) = @_;
-
- unless ($bridge and $if) {
- __Err("__BridgeDetacheIf called with undef or empty bridge and/or if");
- return;
- }
-
- unless (__runCmds(["brctl delif $bridge $if"], 1))
- {
- __Err("Attention : Je n'arrive pas à détacher `$if' du bridge `$bridge'");
- return;
- }
-
- return 1;
-}
-
+sub __BridgeDetacheIf ($$) {
+ my ( $bridge, $if ) = @_;
+
+ unless ( $bridge and $if ) {
+ __Err(
+ "__BridgeDetacheIf called with undef or empty bridge and/or if");
+ return;
+ }
+
+ unless ( __runCmds( ["brctl delif $bridge $if"], 1 ) ) {
+ __Err(
+ "Attention : Je n'arrive pas à détacher `$if' du bridge `$bridge'"
+ );
+ return;
+ }
+
+ return 1;
+}
#####
# Appele umlaunch
# parametre :
# reference sur un tableau contenant les noms des machines a lancer
# $umls = ["machine00 bidule01 truc00", "truc01";]
-sub __Umlaunch ($)
-{
- my $umls = shift;
- return unless $umls;
-
- __Info("Utilisez screen pour suivre le lancement des UMLs");
-
- __Info(" Lancement des vm");
- foreach my $i (0 .. 255)
- {
- next unless $umls->[$i];
-
- foreach my $host (split / /,$umls->[$i])
+sub __Umlaunch ($) {
+ my $umls = shift;
+ return unless $umls;
+
+ __Info("Utilisez screen pour suivre le lancement des UMLs");
+
+ __Info(" Lancement des vm");
+ foreach my $i ( 0 .. 255 ) {
+ next unless $umls->[$i];
+
+ foreach my $host ( split / /, $umls->[$i] ) {
+ next unless $host;
+
+ my ( undef, undef, $section ) = __FamillyNumFromVM($host);
+ unless (
+ 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] ) );
+ }
+ }
+}
+
+# dépermine si un pid est utilisé
+sub __PidRunning($) {
+ my $pid = shift;
+
+ foreach (`ps ax`) {
+ if (/^\s*(\d+)/) {
+ return 1 if ( $1 == $pid );
+
+ }
+ }
+ return 0;
+}
+
+# Retourne le mot de pass d'une vm
+sub __GetVMPasswd ($) {
+
+ my $vm = shift;
+
+ return unless $vm;
+
+ my $pass = Config_Key( $configfile, "uml-global", "passwd" );
+ $pass = Config_Key( $configfile, "uml-" . $vm, "passwd" );
+
+ $pass = "l&f|cn|!" unless $pass;
+ return $pass;
+}
+
+sub __SendHalt ($$) {
+
+ my ( $hostname, $shutdowndelay ) = @_;
+
+ return unless $hostname;
+ return unless __Umlrunning($hostname);
+
+ my $screen = new Expect;
+ $screen->log_stdout(0);
+ $screen->log_file( \&__expectoutput );
+ $screen->slave->clone_winsize_from( \*STDIN );
+ $screen->spawn("screen -r $hostname");
+ unless ($screen) {
+ __Err("Pas réussi à récupérer le screen: `$!'");
+ return;
+ }
+
+ #$screen->raw_pty(1);
+ $screen->send("\n"); # Réveillez-moi cet UML !
+
+ # Tester si une session est ouverte ici
+
+#### A améliorer
+ if ( $screen->expect( 2, "# " ) ) {
+ $screen->send("exit\n");
+ }
+
+ if ( $screen->expect( 2, /login/ ) ) {
+ $screen->send("\n");
+ }
+ else {
+ __Debug("Never got login prompt on $hostname");
+ return;
+ }
+
+ $screen->send("root\n");
+ sleep 1;
+
+ unless ( $screen->expect( 15, "Password:" ) ) {
+ __Debug("Never got password prompt on $hostname");
+ return;
+ }
+
+ $screen->send("l&f|cn|!\n");
+ sleep 1;
+
+ $shutdowndelay = "now" unless $shutdowndelay;
+ $screen->send(
+ "\nshutdown -h $shutdowndelay \"shutdown via pflaunch...\"");
+ $screen->send("\nexit\n");
+
+ $screen->soft_close();
+ return 1;
+}
+
+sub __expectoutput {
+ my $input = shift;
+
+ $input =~ s/\n//g;
+ __Debug("\nexpect : $input\n");
+ return;
+}
+
+sub __Umlshalt ($) {
+
+ # Firestarter !
+ my $umls = shift;
+
+ # Recupération de la liste des umls
+ my $v = [];
+ foreach my $i ( reverse( 0 .. 255 ) ) {
+ next unless $umls->[$i];
+ foreach ( split / /, $umls->[$i] ) {
+ next unless $_;
+
+ my $vm;
+ $vm->{vm} = $_;
+ $vm->{status} = __Umlrunning($_) ? $RUNNING : $HALTED;
+
+ $vm->{shutdowndelay}
+ = Config_Key( $configfile, "uml-$_", "shutdowndelay" );
+ $vm->{shutdowndelay}
+ = Config_Key( $configfile, "uml-default", "shutdowndelay" )
+ unless $vm->{shutdowndelay};
+
+ push @$v, $vm;
+ }
+ }
+
+ foreach (@$v) {
+ next if ( $_->{status} == $HALTED );
+ $_->{t} = Thread->new( \&__SendHalt, $_->{vm}, $_->{shutdowndelay} );
+ }
+
+ my $sdd = 0;
+ my $vm_running_cpt = 0;
+ foreach (@$v) {
+ next if ( $_->{status} == $HALTED );
+ $_->{status} = $HALTING if ( $_->{t}->join );
+
+ $sdd = $_->{shutdowndelay}
+ if ( $_->{shutdowndelay} and ( $sdd < $_->{shutdowndelay} ) );
+ $vm_running_cpt++;
+ }
+
+ # Inutile de lancer cette procédure couteuse en tps si aucune uml ne tourne
+ if ($vm_running_cpt) {
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n" }; # N.B. : \n obligatoire
+
+ alarm( 60 + $sdd * 60 );
+
+ while (1) {
+ foreach (@$v) {
+ next if ( $_->{status} == $HALTED );
+ $_->{status} = $HALTED
+ unless ( __Umlrunning( $_->{vm} ) );
+
+ sleep 1;
+ }
+ }
+
+ alarm 0;
+ };
+ }
+
+ foreach (@$v) {
+ next if ( $_->{status} == $HALTED );
+
+ my $failed = 0;
+
+ if ( -r "$ENV{HOME}/.uml/" . $_->{vm} . "/pid" ) {
+ __Info( " -Arrete force de `" . $_->{vm} . "'" );
+
+ eval {
+ local $SIG{ALRM}
+ = sub { die "alarm\n" }; # N.B. : \n obligatoire
+ alarm 15;
+ `uml_mconsole $_->{vm} halt 2>&1`;
+ $_->{status} = $HALTED unless $?;
+ alarm 0;
+ };
+ $failed = 1 if ($@);
+ }
+ elsif ( __Umlrunning( $_->{vm} ) ) {
+ $failed = 1;
+ }
+
+ __Err( "Je n'arrive pas a arreter : `" . $_->{vm} . "'" );
+ }
+}
+
+# Test pour voir si une uml tourne retourne 1 si oui, sinon undef
+sub __Umlrunning ($) {
+
+ my $vm = shift;
+ return unless $vm;
+
+ my $r;
+ my $fichier;
+ return unless ( -d "/var/run/screen/S-root" );
+ opendir( SCREENDIR, "/var/run/screen/S-root" )
+ or __Fault("can't open $!");
+ while ( defined( $fichier = readdir(SCREENDIR) ) ) {
+ next if ( $fichier =~ /^\./ );
+
+ if ( $fichier =~ /^\d+\.([^\.]+)/ ) {
+ $r = 1 if ( $vm eq $1 );
+ }
+
+ }
+
+ closedir(SCREENDIR);
+ return $r;
+}
+
+sub __GetIptablesTagets() {
+
+ my $ret;
+ return $cache->{ipt}->{target}
+ if $cache->{ipt}->{target};
+
+ open IPTABLESTARGETS, "</proc/net/ip_tables_targets";
+ foreach (<IPTABLESTARGETS>) {
+ chomp;
+ $ret->{$_} = 1;
+ }
+ close IPTABLESTARGETS;
+
+ $cache->{ipt}->{target} = $ret;
+ return $ret;
+}
+
+sub __SetNetmapByVlan ($) {
+ my $vlan = shift;
+
+ unless ($vlan) {
+ __Debug("__SetNetmapByVlan : pas de vlan en parametre !");
+ return;
+ }
+
+ my $ipt = __GetIptablesTagets();
+ unless ( defined $ipt->{NETMAP} ) {
+ __Info(
+ "Votre Kernel semble ne pas supporter la target iptables NETMAP, j'ignore la partie vlan de '$vlan'"
+ );
+ return;
+ }
+
+ my $vlan_if = Config_Key( $configfile, $vlan, "if" );
+ $vlan_if = Config_Key( $configfile, "vlan-default", "if" )
+ unless $vlan_if;
+
+ __Fault(
+ "Erreur pour '$vlan' : la présence d'une clef 'if' est obligatoire au moins dans la section [vlan-default]"
+ ) unless $vlan_if;
+
+ my $vlandata = $private_network->{$vlan};
+ unless ($vlandata) {
+ __Debug(
+ "Erreur je n'arrive pas a lire dans private-network les infos du vlan `$vlan'"
+ );
+ next;
+ }
+
+ my $addrNetExt = Config_Key( $configfile, $vlan, 'netmap' );
+ if ($addrNetExt) {
+
+# Je vaias chercher dans private-network la conf du vlan pour savoir comment il est adressé
+
+ unless ( $vlandata->{network} ) {
+ __Err(
+ "Je n'ai pas la key network de la section [$vlan] de private-networ"
+ );
+ next;
+ }
+
+ unless ( $vlandata->{netmask} ) {
+ __Err(
+ "Je n'ai pas la clef 'netmask' de la section [$vlan] de private-network"
+ );
+ next;
+ }
+
+ my $addrNetInt = $vlandata->{network} . '/' . $vlandata->{netmask};
+
+ my $postrouting
+ = "POSTROUTING -o $vlan_if -s $addrNetInt -j NETMAP --to $addrNetExt";
+ my $prerouting
+ = "PREROUTING -i $vlan_if -d $addrNetExt -j NETMAP --to $addrNetInt";
+ __IptAddChange( "nat", $postrouting );
+ __IptAddChange( "nat", $prerouting );
+
+ }
+ else {
+ __Debug("Pas de NETMAP pour $vlan");
+ }
+
+}
+
+sub __SetAliasByVlan ($) {
+ my $vlan = shift;
+
+ unless ($vlan) {
+ __Debug("__SetAliasByVlan : pas de vlan en parametre !");
+ return;
+ }
+
+ my $vlan_if = Config_Key( $configfile, $vlan, "if" );
+ $vlan_if = Config_Key( $configfile, "vlan-default", "if" )
+ unless $vlan_if;
+
+ if ( Config_Key( $configfile, $vlan, "alias_begin" )
+ or Config_Key( $configfile, $vlan, "alias_end" ) )
{
- next unless $host;
-
- my (undef,undef,$section) = __FamillyNumFromVM ($host);
- unless (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]));
- }
- }
-}
-
-
-# dépermine si un pid est utilisé
-sub __PidRunning($)
-{
- my $pid = shift;
-
- foreach (`ps ax`)
- {
- if (/^\s*(\d+)/)
- {
- return 1 if ($1 == $pid);
-
- }
- }
- return 0;
-}
-
-# Retourne le mot de pass d'une vm
-sub __GetVMPasswd ($)
-{
-
- my $vm = shift;
-
- return unless $vm;
-
- my $pass = Config_Key($configfile,"uml-global", "passwd");
- $pass = Config_Key($configfile,"uml-".$vm, "passwd");
-
- $pass = "l&f|cn|!" unless $pass;
- return $pass;
-}
-
-
-
-sub __SendHalt ($$)
-{
-
- my ($hostname, $shutdowndelay) = @_;
-
- return unless $hostname;
- return unless __Umlrunning($hostname);
-
- my $screen = new Expect;
- $screen->log_stdout(0);
- $screen->log_file(\&__expectoutput);
- $screen->slave->clone_winsize_from(\*STDIN);
- $screen->spawn("screen -r $hostname");
- unless ($screen) {
- __Err("Pas réussi à récupérer le screen: `$!'");
- return;
- }
-
- #$screen->raw_pty(1);
- $screen->send("\n"); # Réveillez-moi cet UML !
-
-# Tester si une session est ouverte ici
-
-#### A améliorer
- if ($screen->expect(2, "# "))
- {
- $screen->send("exit\n");
- }
-
- if ($screen->expect(2, /login/))
- {
- $screen->send("\n");
- }
- else
- {
- __Debug("Never got login prompt on $hostname");
- return;
- }
-
- $screen->send("root\n");
- sleep 1;
-
- unless ($screen->expect(15, "Password:"))
- {
- __Debug("Never got password prompt on $hostname");
- return;
- }
-
- $screen->send("l&f|cn|!\n");
- sleep 1;
-
- $shutdowndelay = "now" unless $shutdowndelay;
- $screen->send("\nshutdown -h $shutdowndelay \"shutdown via pflaunch...\"");
- $screen->send("\nexit\n");
-
- $screen->soft_close();
- return 1;
-}
-
-sub __expectoutput {
- my $input = shift;
-
- $input =~ s/\n//g;
- __Debug ("\nexpect : $input\n");
- return;
-}
-
-
-sub __Umlshalt ($)
-{
- # Firestarter !
- my $umls = shift;
-
- # Recupération de la liste des umls
- my $v = [];
- foreach my $i (reverse(0 .. 255))
- {
- next unless $umls->[$i];
- foreach (split / /, $umls->[$i] )
- {
- next unless $_;
-
- my $vm;
- $vm->{vm} = $_;
- $vm->{status} = __Umlrunning($_) ? $RUNNING : $HALTED;
-
- $vm->{shutdowndelay} = Config_Key($configfile, "uml-$_", "shutdowndelay");
- $vm->{shutdowndelay} = Config_Key($configfile, "uml-default", "shutdowndelay")
- unless $vm->{shutdowndelay};
-
- push @$v, $vm;
- }
- }
-
-
- foreach (@$v)
- {
- next if ($_->{status} == $HALTED);
- $_->{t} = Thread->new(\&__SendHalt, $_->{vm}, $_->{shutdowndelay});
- }
-
- my $sdd = 0;
- my $vm_running_cpt = 0;
- foreach (@$v)
- {
- next if ($_->{status} == $HALTED);
- $_->{status} = $HALTING if ($_->{t}->join);
-
- $sdd = $_->{shutdowndelay}
- if ($_->{shutdowndelay} and ($sdd < $_->{shutdowndelay}));
- $vm_running_cpt++;
- }
-
- # Inutile de lancer cette procédure couteuse en tps si aucune uml ne tourne
- if($vm_running_cpt)
- {
- eval
- {
- local $SIG{ALRM} = sub { die "alarm\n" }; # N.B. : \n obligatoire
-
- alarm (60 + $sdd * 60);
-
- while(1)
- {
- foreach (@$v)
- {
- next if ($_->{status} == $HALTED);
- $_->{status} = $HALTED
- unless (__Umlrunning($_->{vm}));
-
- sleep 1;
- }
- }
-
- alarm 0;
- };
- }
-
-
- foreach (@$v)
- {
- next if ($_->{status} == $HALTED);
-
- my $failed = 0;
-
- if (-r "$ENV{HOME}/.uml/".$_->{vm}."/pid" )
- {
- __Info(" -Arrete force de `".$_->{vm}."'");
-
- eval
- {
- local $SIG{ALRM} = sub { die "alarm\n" }; # N.B. : \n obligatoire
- alarm 15;
- `uml_mconsole $_->{vm} halt 2>&1`;
- $_->{status} = $HALTED unless $?;
- alarm 0;
- };
- $failed = 1 if ($@);
- }
- elsif (__Umlrunning($_->{vm}))
- {
- $failed = 1;
- }
-
- __Err("Je n'arrive pas a arreter : `".$_->{vm}."'");
- }
-}
-
-
-# Test pour voir si une uml tourne retourne 1 si oui, sinon undef
-sub __Umlrunning ($)
-{
-
- my $vm = shift;
- return unless $vm;
-
- my $r;
- my $fichier;
- return unless ( -d "/var/run/screen/S-root" );
- opendir( SCREENDIR, "/var/run/screen/S-root" )
- or __Fault("can't open $!");
- while ( defined( $fichier = readdir(SCREENDIR) ) )
- {
- next if ($fichier =~ /^\./);
-
- if ($fichier =~ /^\d+\.([^\.]+)/)
- {
- $r = 1 if ($vm eq $1);
- }
-
- }
-
- closedir (SCREENDIR);
- return $r;
-}
-
-
-sub __GetIptablesTagets()
-{
-
- my $ret;
- return $cache->{ipt}->{target}
- if $cache->{ipt}->{target};
-
-
- open IPTABLESTARGETS, "</proc/net/ip_tables_targets";
- foreach (<IPTABLESTARGETS>)
- {
- chomp;
- $ret->{$_} = 1;
- }
- close IPTABLESTARGETS;
-
- $cache->{ipt}->{target} = $ret;
- return $ret;
-}
-
-
-sub __SetNetmapByVlan ($)
-{
- my $vlan = shift;
-
- unless ($vlan)
- {
- __Debug("__SetNetmapByVlan : pas de vlan en parametre !");
- return;
- }
-
-
- my $ipt = __GetIptablesTagets();
- unless ( defined $ipt->{NETMAP} )
- {
- __Info("Votre Kernel semble ne pas supporter la target iptables NETMAP, j'ignore la partie vlan de '$vlan'");
- return;
- }
-
- my $vlan_if = Config_Key($configfile, $vlan, "if");
- $vlan_if = Config_Key($configfile, "vlan-default", "if") unless $vlan_if;
-
- __Fault("Erreur pour '$vlan' : la présence d'une clef 'if' est obligatoire au moins dans la section [vlan-default]")
- unless $vlan_if;
-
-
- my $vlandata = $private_network->{$vlan};
- unless ($vlandata)
- {
- __Debug("Erreur je n'arrive pas a lire dans private-network les infos du vlan `$vlan'");
- next;
- }
-
-
- my $addrNetExt = Config_Key($configfile, $vlan, 'netmap');
- if ( $addrNetExt )
- {
-
- # Je vaias chercher dans private-network la conf du vlan pour savoir comment il est adressé
-
- unless ($vlandata->{network})
- {
- __Err("Je n'ai pas la key network de la section [$vlan] de private-networ");
- next;
- }
-
- unless ($vlandata->{netmask}) {
- __Err("Je n'ai pas la clef 'netmask' de la section [$vlan] de private-network");
- next;
- }
-
- my $addrNetInt = $vlandata->{network} . '/' . $vlandata->{netmask};
-
- my $postrouting = "POSTROUTING -o $vlan_if -s $addrNetInt -j NETMAP --to $addrNetExt";
- my $prerouting = "PREROUTING -i $vlan_if -d $addrNetExt -j NETMAP --to $addrNetInt";
- __IptAddChange ("nat",$postrouting);
- __IptAddChange ("nat",$prerouting);
-
- }
- else {
- __Debug("Pas de NETMAP pour $vlan");
- }
-
-}
-
-
-sub __SetAliasByVlan ($)
-{
- my $vlan = shift;
-
- unless ($vlan)
- {
- __Debug("__SetAliasByVlan : pas de vlan en parametre !");
- return;
- }
-
- my $vlan_if = Config_Key($configfile, $vlan, "if");
- $vlan_if = Config_Key($configfile, "vlan-default", "if") unless $vlan_if;
-
- if ( Config_Key($configfile, $vlan, "alias_begin") or
- Config_Key($configfile, $vlan, "alias_end"))
- {
- __Info ("`$vlan' : Les clef alias_begin et alias_end ne sont plus utilisées,".
- "vous avez juste a mettre alias=true");
- }
-
- return unless (defined (Config_Key($configfile, $vlan, "alias"))
- and Config_Key($configfile, $vlan, "alias") eq 'true');
-
-
- # On va essayer de calculer les alias_begin/alias_end en fonction du netmask
- # du netmap de ce VLAN. Si pas de netmap défini, on cherche dans private-network.
- my $nm = Config_Key($configfile, $vlan, 'netmap');
-
- unless ($nm) {
- __Info ("Pas de variable netmap pour `$vlan', je cherche dans private-network");
- my $vlan_setup = __GetVLanSetup ($vlan);
- unless ($vlan_setup->{network} and $vlan_setup->{netmask}) {
- __Err("Pas assez d'information (network et netmask) dans private-network pour le vlan '$vlan'");
- return;
- }
- my ($ip, $cidr) = ipv4_parse($vlan_setup->{network}, $vlan_setup->{netmask});
- $nm = "$ip/$cidr"; # Et voilà !
- }
-
- my $netmap = new Net::IP ($nm) || die "$?";
- unless ($netmap) {
- __Err ("`$nm' n'est pas une adresse réseau valide");
- return;
- }
-
- my $ipz = new Net::IP ($netmap->ip . " - " . $netmap->last_ip);
- unless ($ipz) {
- __Err ("Je n'arrive pas a trouver les ip entre ".$netmap->ip." et ".$netmap->last_ip);
- return;
- }
-
-
- my $cmd = [];
- unless (defined $ifAliasCpt{$vlan_if}) {
- $ifAliasCpt{$vlan_if} = 0;
- }
- open STATUS_ALIAS, ">>".$PF_STATUS_DIR."/aliases";
- do {
- print STATUS_ALIAS "$vlan_if:$ifAliasCpt{$vlan_if}\n";
- push @$cmd, "ifconfig $vlan_if:".$ifAliasCpt{$vlan_if} ." ".$ipz->ip();
- $ifAliasCpt{$vlan_if}++;
- $ipz = $ipz->ip_add_num(1);
- } while ($ipz);
-
- __runCmds($cmd,"1") if @$cmd;
- close STATUS_ALIAS;
-
-}
-
-sub __SetDNATs
-{
- my $dnats = shift;
-
- unless ($dnats)
- {
- __Debug("__SetDNATs () appelé sans parametre");
- return;
- }
-
- my $ipt = __GetIptablesTagets();
- unless (defined $ipt->{DNAT})
- {
- __Info("Votre Kernel semble ne pas supporter la tarjet iptables DNAT");
- __Info("J'ignore la clef \@dnat de la section [init]");
- return;
- }
-
- foreach my $dnat (@{$dnats})
- {
- my $dnat_config = Config_Section($configfile,"dnat-$dnat");
- unless ($dnat_config)
- {
- __Err("`$dnat' est dans la section [init] mais n'a pas de [dnat-$dnat],".
- "le dnat $dnat n'est pas initialisé...");
- return;
- }
- unless ($dnat_config->{'original-dest'} && $dnat_config->{'rewrite-dest-to'})
- {
- __Err("La section [dnat-`$dnat'] n'est pas valide, la section doit contenir les clefs original-dest et rewrite-dest-to");
- return;
- }
-
- __Info(" dnat `$dnat' (`".$dnat_config->{'original-dest'}."' -> `".$dnat_config->{'rewrite-dest-to'}."')");
-
- __IptAddChange ("nat","PREROUTING -d ".$dnat_config->{'original-dest'}." -j DNAT --to-destination ".
- $dnat_config->{'rewrite-dest-to'});
- }
-}
-
-sub __SetMasqueradeByVlan
-{
- my $masquerades = shift;
-
- unless ($masquerades)
- {
- __Debug("__SetMasqueradeByVlan () appelé sans parametre");
- return;
- }
-
- my $ipt = __GetIptablesTagets();
- unless (defined $ipt->{MASQUERADE})
- {
- __Info("Votre Kernel semble ne pas supporter la tarjet iptables MASQUERADE");
- __Info("J'ignore la clef \@masquerade de la section [init]");
- return;
- }
-
- foreach my $masquerade (@{$masquerades})
- {
- my $masquerade_config = Config_Section($configfile,"masquerade-$masquerade");
- unless ($masquerade_config)
- {
- __Err("`$masquerade' est dans la section [init] mais n'a pas de [masquerade-$masquerade],".
- "le masquerade $masquerade n'est pas initialisé...");
- return;
- }
- unless ($masquerade_config->{from})
- {
- __Err("La section [masquerade-`$masquerade'] n'est pas valide, la section doit contenir une clef from et if_out");
- return;
- }
-
- __Info(" masquerade `$masquerade' (`".$masquerade_config->{if_out}."' / `".$masquerade_config->{from}."')");
-
- __IptAddChange ("nat","POSTROUTING -o ".$masquerade_config->{if_out}." -s ".$masquerade_config->{from}." -j MASQUERADE");
- }
+ __Info(
+ "`$vlan' : Les clef alias_begin et alias_end ne sont plus utilisées,"
+ . "vous avez juste a mettre alias=true" );
+ }
+
+ return
+ unless ( defined( Config_Key( $configfile, $vlan, "alias" ) )
+ and Config_Key( $configfile, $vlan, "alias" ) eq 'true' );
+
+# On va essayer de calculer les alias_begin/alias_end en fonction du netmask
+# du netmap de ce VLAN. Si pas de netmap défini, on cherche dans private-network.
+ my $nm = Config_Key( $configfile, $vlan, 'netmap' );
+
+ unless ($nm) {
+ __Info(
+ "Pas de variable netmap pour `$vlan', je cherche dans private-network"
+ );
+ my $vlan_setup = __GetVLanSetup($vlan);
+ unless ( $vlan_setup->{network} and $vlan_setup->{netmask} ) {
+ __Err(
+ "Pas assez d'information (network et netmask) dans private-network pour le vlan '$vlan'"
+ );
+ return;
+ }
+ my ( $ip, $cidr )
+ = ipv4_parse( $vlan_setup->{network}, $vlan_setup->{netmask} );
+ $nm = "$ip/$cidr"; # Et voilà !
+ }
+
+ my $netmap = new Net::IP($nm) || die "$?";
+ unless ($netmap) {
+ __Err("`$nm' n'est pas une adresse réseau valide");
+ return;
+ }
+
+ my $ipz = new Net::IP( $netmap->ip . " - " . $netmap->last_ip );
+ unless ($ipz) {
+ __Err( "Je n'arrive pas a trouver les ip entre "
+ . $netmap->ip . " et "
+ . $netmap->last_ip );
+ return;
+ }
+
+ my $cmd = [];
+ unless ( defined $ifAliasCpt{$vlan_if} ) {
+ $ifAliasCpt{$vlan_if} = 0;
+ }
+ open STATUS_ALIAS, ">>" . $PF_STATUS_DIR . "/aliases";
+ do {
+ print STATUS_ALIAS "$vlan_if:$ifAliasCpt{$vlan_if}\n";
+ push @$cmd,
+ "ifconfig $vlan_if:" . $ifAliasCpt{$vlan_if} . " " . $ipz->ip();
+ $ifAliasCpt{$vlan_if}++;
+ $ipz = $ipz->ip_add_num(1);
+ } while ($ipz);
+
+ __runCmds( $cmd, "1" ) if @$cmd;
+ close STATUS_ALIAS;
+
+}
+
+sub __SetDNATs {
+ my $dnats = shift;
+
+ unless ($dnats) {
+ __Debug("__SetDNATs () appelé sans parametre");
+ return;
+ }
+
+ my $ipt = __GetIptablesTagets();
+ unless ( defined $ipt->{DNAT} ) {
+ __Info(
+ "Votre Kernel semble ne pas supporter la tarjet iptables DNAT");
+ __Info("J'ignore la clef \@dnat de la section [init]");
+ return;
+ }
+
+ foreach my $dnat ( @{$dnats} ) {
+ my $dnat_config = Config_Section( $configfile, "dnat-$dnat" );
+ unless ($dnat_config) {
+ __Err(
+ "`$dnat' est dans la section [init] mais n'a pas de [dnat-$dnat],"
+ . "le dnat $dnat n'est pas initialisé..." );
+ return;
+ }
+ unless ( $dnat_config->{'original-dest'}
+ && $dnat_config->{'rewrite-dest-to'} )
+ {
+ __Err(
+ "La section [dnat-`$dnat'] n'est pas valide, la section doit contenir les clefs original-dest et rewrite-dest-to"
+ );
+ return;
+ }
+
+ __Info( " dnat `$dnat' (`"
+ . $dnat_config->{'original-dest'}
+ . "' -> `"
+ . $dnat_config->{'rewrite-dest-to'}
+ . "')" );
+
+ __IptAddChange( "nat",
+ "PREROUTING -d "
+ . $dnat_config->{'original-dest'}
+ . " -j DNAT --to-destination "
+ . $dnat_config->{'rewrite-dest-to'} );
+ }
+}
+
+sub __SetMasqueradeByVlan {
+ my $masquerades = shift;
+
+ unless ($masquerades) {
+ __Debug("__SetMasqueradeByVlan () appelé sans parametre");
+ return;
+ }
+
+ my $ipt = __GetIptablesTagets();
+ unless ( defined $ipt->{MASQUERADE} ) {
+ __Info(
+ "Votre Kernel semble ne pas supporter la tarjet iptables MASQUERADE"
+ );
+ __Info("J'ignore la clef \@masquerade de la section [init]");
+ return;
+ }
+
+ foreach my $masquerade ( @{$masquerades} ) {
+ my $masquerade_config
+ = Config_Section( $configfile, "masquerade-$masquerade" );
+ unless ($masquerade_config) {
+ __Err(
+ "`$masquerade' est dans la section [init] mais n'a pas de [masquerade-$masquerade],"
+ . "le masquerade $masquerade n'est pas initialisé..." );
+ return;
+ }
+ unless ( $masquerade_config->{from} ) {
+ __Err(
+ "La section [masquerade-`$masquerade'] n'est pas valide, la section doit contenir une clef from et if_out"
+ );
+ return;
+ }
+
+ __Info( " masquerade `$masquerade' (`"
+ . $masquerade_config->{if_out} . "' / `"
+ . $masquerade_config->{from}
+ . "')" );
+
+ __IptAddChange( "nat",
+ "POSTROUTING -o "
+ . $masquerade_config->{if_out} . " -s "
+ . $masquerade_config->{from}
+ . " -j MASQUERADE" );
+ }
}
# Test si une route existe déjà pour un reseau
# oui = 1
# non = undef
-sub __RouteExiste($)
-{
- return unless @_;
- my $procf = "/proc/net/route";
-
- my $p = join ('.',reverse split (/\./,shift));
-
- my $ip = new Net::IP ($p) or __Fault (Net::IP::Error());
-
-
- my $hex = sprintf("%x",$ip->intip());
-
-
- if (open RT, "<".$procf) {
- my @r = <RT>;
- close RT or __Err ("Can't close `$procf'");
- shift @r;
- foreach (@r) {
- if (/^\S+\s+0+(\S+)/) {
- return 1 if (lc($1) eq lc($hex));
- }
- }
- } else {
- __Err ( "Can't open `$procf'" );
- }
- return;
-}
-
-
+sub __RouteExiste($) {
+ return unless @_;
+ my $procf = "/proc/net/route";
+
+ my $p = join( '.', reverse split( /\./, shift ) );
+
+ my $ip = new Net::IP($p) or __Fault( Net::IP::Error() );
+
+ my $hex = sprintf( "%x", $ip->intip() );
+
+ if ( open RT, "<" . $procf ) {
+ my @r = <RT>;
+ close RT or __Err("Can't close `$procf'");
+ shift @r;
+ foreach (@r) {
+ if (/^\S+\s+0+(\S+)/) {
+ return 1 if ( lc($1) eq lc($hex) );
+ }
+ }
+ }
+ else {
+ __Err("Can't open `$procf'");
+ }
+ return;
+}
# Cree les routes si il y a lieu de le faire
sub __RoutesInit {
-# my @net = ();
- my $routes;
-
- foreach my $vlan (@{__GetVLanList()}) {
- my $gws = Config_Key($configfile,"$vlan","gateway");
- $gws = Config_Key($configfile,"vlan-default","gateway") unless $gws;
-
- my $vs = __GetVLanSetup ($vlan);
- unless ($vs->{network} and $vs->{netmask}) {
- __Fault("Je ne trouve pas assez d'information pour le vlan `$vlan'".
- "network = `".$vs->{network}."'".
- "netmask = `".$vs->{netmask}."'");
- next;
- }
- next if (__RouteExiste ($vs->{network}));
- my $dest = "";
- if (defined $gws and $gws) {
- if ($gws =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) {
- $dest = "gateway ".$gws; # une IP a ete rentré
- } else {
- $dest = "gateway ".__GetVMip ($gws,$vlan);
- }
- } elsif (defined ($vs->{tag}) and ($vs->{tag})) {
- $dest = "dev br".$vs->{tag};
- } else {
- __Debug ("Je n'ai pas de sortie pour `$vlan'");
- next;
- }
-
- $routes->{"-net $vs->{network} netmask $vs->{netmask} $dest"} = 1;
- }
- __Debug($_) foreach (`route`);
- if (open (STATUS_ROUTE, ">>".$PF_STATUS_DIR."/route")) {
- foreach my $r (keys %$routes) {
- if (__runCmds("route add ".$r)) {
- print STATUS_ROUTE $r."\n";
- }
- }
- } else {
- __Fault("Can't open ".$PF_STATUS_DIR."/route");
- }
- close STATUS_ROUTE or __Err("Je n'arrive pas a fermer STATUS_ROUTE");
-}
-
-
-sub __RoutesFlush
-{
-
- return unless (-r $PF_STATUS_DIR."/route");
-
- open STATUS_ROUTE, "<".$PF_STATUS_DIR."/route";
-
- my $cmds;
- foreach (<STATUS_ROUTE>)
- {
- chomp;
- push @$cmds, "route del $_";
- }
-
- __runCmds ($cmds,"stfu");
- close STATUS_ROUTE;
- unlink $PF_STATUS_DIR."/route";
-
-}
-
-
-
-sub __AliasFlush
-{
-
- return unless (-r $PF_STATUS_DIR."/aliases");
-
- open STATUS_ALIAS, "<".$PF_STATUS_DIR."/aliases";
-
- my $cmds;
- foreach my $if (<STATUS_ALIAS>)
- {
- chomp $if;
- push @$cmds, "ifconfig $if down" if $if;
- }
-
- __runCmds ($cmds,"stfu");
- close STATUS_ALIAS;
- unlink $PF_STATUS_DIR."/aliases";
-}
-
-
+ # my @net = ();
+ my $routes;
+
+ foreach my $vlan ( @{ __GetVLanList() } ) {
+ my $gws = Config_Key( $configfile, "$vlan", "gateway" );
+ $gws = Config_Key( $configfile, "vlan-default", "gateway" )
+ unless $gws;
+
+ my $vs = __GetVLanSetup($vlan);
+ unless ( $vs->{network} and $vs->{netmask} ) {
+ __Fault(
+ "Je ne trouve pas assez d'information pour le vlan `$vlan'"
+ . "network = `"
+ . $vs->{network} . "'"
+ . "netmask = `"
+ . $vs->{netmask}
+ . "'" );
+ next;
+ }
+ next if ( __RouteExiste( $vs->{network} ) );
+ my $dest = "";
+ if ( defined $gws and $gws ) {
+ if ( $gws =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ ) {
+ $dest = "gateway " . $gws; # une IP a ete rentré
+ }
+ else {
+ $dest = "gateway " . __GetVMip( $gws, $vlan );
+ }
+ }
+ elsif ( defined( $vs->{tag} ) and ( $vs->{tag} ) ) {
+ $dest = "dev br" . $vs->{tag};
+ }
+ else {
+ __Debug("Je n'ai pas de sortie pour `$vlan'");
+ next;
+ }
+
+ $routes->{"-net $vs->{network} netmask $vs->{netmask} $dest"} = 1;
+ }
+ __Debug($_) foreach (`route`);
+ if ( open( STATUS_ROUTE, ">>" . $PF_STATUS_DIR . "/route" ) ) {
+ foreach my $r ( keys %$routes ) {
+ if ( __runCmds( "route add " . $r ) ) {
+ print STATUS_ROUTE $r . "\n";
+ }
+ }
+ }
+ else {
+ __Fault( "Can't open " . $PF_STATUS_DIR . "/route" );
+ }
+ close STATUS_ROUTE or __Err("Je n'arrive pas a fermer STATUS_ROUTE");
+}
+
+sub __RoutesFlush {
+
+ return unless ( -r $PF_STATUS_DIR . "/route" );
+
+ open STATUS_ROUTE, "<" . $PF_STATUS_DIR . "/route";
+
+ my $cmds;
+ foreach (<STATUS_ROUTE>) {
+ chomp;
+ push @$cmds, "route del $_";
+ }
+
+ __runCmds( $cmds, "stfu" );
+ close STATUS_ROUTE;
+ unlink $PF_STATUS_DIR . "/route";
+
+}
+
+sub __AliasFlush {
+
+ return unless ( -r $PF_STATUS_DIR . "/aliases" );
+
+ open STATUS_ALIAS, "<" . $PF_STATUS_DIR . "/aliases";
+
+ my $cmds;
+ foreach my $if (<STATUS_ALIAS>) {
+ chomp $if;
+ push @$cmds, "ifconfig $if down" if $if;
+ }
+
+ __runCmds( $cmds, "stfu" );
+ close STATUS_ALIAS;
+ unlink $PF_STATUS_DIR . "/aliases";
+}
# Retourne la branche CVS sur laquelle on marche en fonction du paramètre
# passé ou du contenu de /var/lib/pf-tools/branche
-sub __GetBrancheCVS
-{
- my $vm = shift;
-
- # 1/ Le fichier de config
- if ($vm)
- {
- my $branche = Config_Key($configfile, "uml-$vm", "branche");
- return $branche if $branche;
- }
-
- # 2/ le paramètre de la ligne de commande
- return $options->{branchecvs}
- if $options->{branchecvs};
-
- # 3/ Le contenu de $PF_STATUS_DIR/branche
- if (-r $PF_STATUS_DIR."/branche")
- {
- if (open STATUSBRANCHE, "<$PF_STATUS_DIR"."/branche")
- {
- my @STATUSBRANCHE = <STATUSBRANCHE>;
- close STATUSBRANCHE;
- return shift @STATUSBRANCHE;
- }
- else
- {
- __Err("je n'arrive pas a ouvrir ".$PF_STATUS_DIR."/branche");
- }
-
- }
-
- # If all else failed ...
- return undef; # 'HEAD'
-}
-
-
-sub __UpdateConfig
-{
- if ($cvsupdated or $options->{nocvsupdate})
- {
- __Debug("Pas d'update du CVS");
-
- }
- else
- {
-
- my $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);
- }
+sub __GetBrancheCVS {
+ my $vm = shift;
+
+ # 1/ Le fichier de config
+ if ($vm) {
+ my $branche = Config_Key( $configfile, "uml-$vm", "branche" );
+ return $branche if $branche;
+ }
+
+ # 2/ le paramètre de la ligne de commande
+ return $options->{branchecvs}
+ if $options->{branchecvs};
+
+ # 3/ Le contenu de $PF_STATUS_DIR/branche
+ if ( -r $PF_STATUS_DIR . "/branche" ) {
+ if ( open STATUSBRANCHE, "<$PF_STATUS_DIR" . "/branche" ) {
+ my @STATUSBRANCHE = <STATUSBRANCHE>;
+ close STATUSBRANCHE;
+ return shift @STATUSBRANCHE;
+ }
+ else {
+ __Err(
+ "je n'arrive pas a ouvrir " . $PF_STATUS_DIR . "/branche" );
+ }
+
+ }
+
+ # If all else failed ...
+ return undef; # 'HEAD'
+}
+
+sub __UpdateConfig {
+ if ( $cvsupdated or $options->{nocvsupdate} ) {
+ __Debug("Pas d'update du CVS");
+
+ }
+ else {
+
+ my $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);
+ }
}
# Active le lock, et fait mourrir plfaunch si
# il y a un pflaunch déjà tournant
-sub __GetLock
-{
-
- return unless (-f $PF_STATUS_DIR . "/lock");
- open (LOCK, "<". $PF_STATUS_DIR . "/lock") or __Fault("Can't open lock file $!");
- my $pid = <LOCK>;
- close LOCK;
-
- return unless $pid;
-
-
- if ( __PidRunning($pid) )
- {
- __Fault("Vous avez provablement un plfaunch ".
- " déjà lancé, si ne n'est pas la cas effacé ".
- "le fichier de lock ".$PF_STATUS_DIR . "/lock");
- }
- else
- {
-
- unlink $PF_STATUS_DIR . "/lock";
-
- }
-}
-
-sub __SetLock
-{
-
- open (LOCK, ">". $PF_STATUS_DIR . "/lock") or __Fault("Can't open lock file $!");
- print LOCK $$;
- close LOCK;
-
-}
-
-sub __RemoveLock
-{
-
- unlink ($PF_STATUS_DIR . "/lock") or __Err("Can't remove lock file : ".$PF_STATUS_DIR . "/lock");
+sub __GetLock {
+
+ return unless ( -f $PF_STATUS_DIR . "/lock" );
+ open( LOCK, "<" . $PF_STATUS_DIR . "/lock" )
+ or __Fault("Can't open lock file $!");
+ my $pid = <LOCK>;
+ close LOCK;
+
+ return unless $pid;
+
+ if ( __PidRunning($pid) ) {
+ __Fault( "Vous avez provablement un plfaunch "
+ . " déjà lancé, si ne n'est pas la cas effacé "
+ . "le fichier de lock "
+ . $PF_STATUS_DIR
+ . "/lock" );
+ }
+ else {
+
+ unlink $PF_STATUS_DIR . "/lock";
+
+ }
+}
+
+sub __SetLock {
+
+ open( LOCK, ">" . $PF_STATUS_DIR . "/lock" )
+ or __Fault("Can't open lock file $!");
+ print LOCK $$;
+ close LOCK;
+
+}
+
+sub __RemoveLock {
+
+ unlink( $PF_STATUS_DIR . "/lock" )
+ or __Err( "Can't remove lock file : " . $PF_STATUS_DIR . "/lock" );
}
# utilisé pour déterminer si l'on doit faire des la places avant
# de lancer une vm
-sub __GetDiskSpaceLeft
-{
- my $path = shift;
- $path = "/" unless $path;
- my @dfr = `/bin/df -P $path`;
-
- if ($?)
- {
- __Err("df failed");
- return;
- }
-
- my @dfs = split /\ +/,$dfr[1];
- unless ($dfs[3])
- {
- __Err("__GetDiskSpaceLeft:je n'arrive pas trouver l'espace disque...");
- return 0;
- }
- return int $dfs[3]/1024;
-
-}
-
-sub __PrintTime
-{
- my ($s, $m, $h, $j, $mois, $y)= localtime(time);
- $s = "0$s" if ($s < 10);
- $m = "0$m" if ($m < 10);
- $mois += 1;
- $y += 1900;
- return "le $j/$mois/$y à $h:$m:$s";
-}
-
-sub __Fault
-{
- foreach (@_)
- {
- __Print("FAULT>".$_,1);
- }
- exit 1;
-}
-
-sub __Err
-{
- return unless @_;
- foreach (@_)
- {
- __Print("ERROR>".$_,1);
- }
-}
-
-sub __Debug
-{
- return unless ($options->{debug});
- return unless @_;
- foreach (@_)
- {
- __Print("DEBUG>".$_,$options->{debug});
- }
-}
-
-sub __Info
-{
- return unless @_;
- foreach (@_)
- {
- __Print(" INFO>".$_,$options->{verbose});
- }
+sub __GetDiskSpaceLeft {
+ my $path = shift;
+ $path = "/" unless $path;
+ my @dfr = `/bin/df -P $path`;
+
+ if ($?) {
+ __Err("df failed");
+ return;
+ }
+
+ my @dfs = split /\ +/, $dfr[1];
+ unless ( $dfs[3] ) {
+ __Err(
+ "__GetDiskSpaceLeft:je n'arrive pas trouver l'espace disque...");
+ return 0;
+ }
+ return int $dfs[3] / 1024;
+
+}
+
+sub __PrintTime {
+ my ( $s, $m, $h, $j, $mois, $y ) = localtime(time);
+ $s = "0$s" if ( $s < 10 );
+ $m = "0$m" if ( $m < 10 );
+ $mois += 1;
+ $y += 1900;
+ return "le $j/$mois/$y à $h:$m:$s";
+}
+
+sub __Fault {
+ foreach (@_) {
+ __Print( "FAULT>" . $_, 1 );
+ }
+ exit 1;
+}
+
+sub __Err {
+ return unless @_;
+ foreach (@_) {
+ __Print( "ERROR>" . $_, 1 );
+ }
+}
+
+sub __Debug {
+ return unless ( $options->{debug} );
+ return unless @_;
+ foreach (@_) {
+ __Print( "DEBUG>" . $_, $options->{debug} );
+ }
+}
+
+sub __Info {
+ return unless @_;
+ foreach (@_) {
+ __Print( " INFO>" . $_, $options->{verbose} );
+ }
}
# Parametre :
# string
# print, si vrais, alors les msgs sont affichés a l'écran
-sub __Print
-{
- my ($str, $p) = @_;
- return unless $str;
- $str .="\n" unless ($str =~ /\n$/);
-
-
- print $str if ($p);
-
- if ($logfile)
- {
- if (open (LOG, ">>$logfile"))
+sub __Print {
+ my ( $str, $p ) = @_;
+ return unless $str;
+ $str .= "\n" unless ( $str =~ /\n$/ );
+
+ print $str if ($p);
+
+ if ($logfile) {
+ if ( open( LOG, ">>$logfile" ) ) {
+ print LOG $str;
+ close LOG;
+ }
+ else {
+ print STDERR "Can't open log file : `$logfile'\n";
+ }
+ }
+}
+
+# Enregistre les changements fait par iptables pour pouvoir les effacer plus facilement
+sub __IptAddChange ($$) {
+ return unless @_;
+ my ( $table, $change ) = @_;
+
+ return unless ( defined $table and $table );
+ return unless ( defined $change and $change );
+
+ unless ( $table =~ /^nat$/ ) # filter, mangle
{
- print LOG $str;
- close LOG;
- }
- else
- {
- print STDERR "Can't open log file : `$logfile'\n";
- }
- }
-}
-
-# Enregistre les changements fait par iptables pour pouvoir les effacer plus facilement
-sub __IptAddChange ($$)
-{
- return unless @_;
- my ($table, $change) = @_;
-
- return unless (defined $table and $table);
- return unless (defined $change and $change);
-
- unless ($table =~ /^nat$/) # filter, mangle
- {
- __Err ("Table invalide");
- return;
- }
-
- return unless __runCmds("iptables -t $table -A ".$change);
-
-
- if (!(open STATUS_IPT, ">>".$PF_STATUS_DIR."/ipt_".$table))
- {
- __Err("Can't record iptables rules changes");
- return;
- }
- else
- {
- __Debug("Enregistrement d'une regle iptables (nat)");
- print STATUS_IPT $change."\n";
- if (!close STATUS_IPT)
- {
- __Err ("Can't close STATUS_IPT");
- return;
- }
- }
- return 1;
-}
-
-sub __IptCleanChange ()
-{
- foreach my $table ("nat","mangle")
- {
- my $file = $PF_STATUS_DIR."/ipt_".$table;
- next unless (-f $file);
- if (!(open STATUS_IPT, "<".$file))
- {
- __Err("Can't open ".$file);
- next;
- }
- else
- {
- __Debug("Suppression des regles iptables ajoutes par pflaunch : ($table)");
- __runCmds("iptables -t $table -D ".$_) foreach (<STATUS_IPT>);
- close STATUS_IPT;
- if (!unlink($file))
- {
- __Err("Je ne peux pas effacer $file");
- return;
- }
- }
- }
- return 1;
-}
-
+ __Err("Table invalide");
+ return;
+ }
+
+ return unless __runCmds( "iptables -t $table -A " . $change );
+
+ if ( !( open STATUS_IPT, ">>" . $PF_STATUS_DIR . "/ipt_" . $table ) ) {
+ __Err("Can't record iptables rules changes");
+ return;
+ }
+ else {
+ __Debug("Enregistrement d'une regle iptables (nat)");
+ print STATUS_IPT $change . "\n";
+ if ( !close STATUS_IPT ) {
+ __Err("Can't close STATUS_IPT");
+ return;
+ }
+ }
+ return 1;
+}
+
+sub __IptCleanChange () {
+ foreach my $table ( "nat", "mangle" ) {
+ my $file = $PF_STATUS_DIR . "/ipt_" . $table;
+ next unless ( -f $file );
+ if ( !( open STATUS_IPT, "<" . $file ) ) {
+ __Err( "Can't open " . $file );
+ next;
+ }
+ else {
+ __Debug(
+ "Suppression des regles iptables ajoutes par pflaunch : ($table)"
+ );
+ __runCmds( "iptables -t $table -D " . $_ ) foreach (<STATUS_IPT>);
+ close STATUS_IPT;
+ if ( !unlink($file) ) {
+ __Err("Je ne peux pas effacer $file");
+ return;
+ }
+ }
+ }
+ return 1;
+}
#############################################################
#############################################################
@@ -1782,236 +1702,226 @@
#############################################################
#############################################################
-
my $main = {};
-$main->{start_nets} = sub ()
-{
-
- __UpdateConfig();
-
- __Info ("Starting Network...");
-
- `modprobe ipt_NETMAP 2>&1`;`modprobe ipt_MASQUERADE 2>&1`;
- ### Reglage de /proc/sys/net/ipv4/ip_forward
- my $forward = ( defined (Config_Key($configfile,"global","router")) and
- Config_Key($configfile,"global","router") =~ "true" )?
- 1 : 0;
- __Debug(" /proc/sys/net/ipv4/ip_forward = $forward");
- open IP_FORWARD,">/proc/sys/net/ipv4/ip_forward" or __Err("Can't open /proc/sys/net/ipv4/ip_forward (w mode)");
- print IP_FORWARD $forward;
- close IP_FORWARD;
-
- # peut-être aussi bridge-nf-call-arptables et bridge-nf-call-ip6tables ?
- foreach my $procfile (map { "/proc/sys/net/bridge/$_" } qw'bridge-nf-call-iptables bridge-nf-filter-vlan-tagged') {
- if (-f $procfile) {
- __Debug(" $procfile = 0");
- open (EBTABLE, "> $procfile") or __Err("Can't open $procfile for writing: $!");
- print EBTABLE 0;
- close (EBTABLE) or __Fault("Can't close $procfile after writing: $!");
- }
+$main->{start_nets} = sub () {
+
+ __UpdateConfig();
+
+ __Info("Starting Network...");
+
+ `modprobe ipt_NETMAP 2>&1`;
+ `modprobe ipt_MASQUERADE 2>&1`;
+ ### Reglage de /proc/sys/net/ipv4/ip_forward
+ my $forward
+ = ( defined( Config_Key( $configfile, "global", "router" ) )
+ and Config_Key( $configfile, "global", "router" ) =~ "true" )
+ ? 1
+ : 0;
+ __Debug(" /proc/sys/net/ipv4/ip_forward = $forward");
+ open IP_FORWARD, ">/proc/sys/net/ipv4/ip_forward"
+ or __Err("Can't open /proc/sys/net/ipv4/ip_forward (w mode)");
+ print IP_FORWARD $forward;
+ close IP_FORWARD;
+
+ # peut-être aussi bridge-nf-call-arptables et bridge-nf-call-ip6tables ?
+ foreach my $procfile ( map {"/proc/sys/net/bridge/$_"}
+ qw'bridge-nf-call-iptables bridge-nf-filter-vlan-tagged' )
+ {
+ if ( -f $procfile ) {
+ __Debug(" $procfile = 0");
+ open( EBTABLE, "> $procfile" )
+ or __Err("Can't open $procfile for writing: $!");
+ print EBTABLE 0;
+ close(EBTABLE)
+ or __Fault("Can't close $procfile after writing: $!");
+ }
+
# else {
- # Ces machins n'existent pas en 2.4
+# Ces machins n'existent pas en 2.4
# __Debug(" $procfile n'existe pas, donc pas besoin de le désactiver.");
# }
- }
-
-# my $listbrup = __GetListBridgeUp();
- foreach my $lan (@{__GetVLanList()})
- {
- __BridgeAdd ($lan);
- __BridgeSetAddr($lan);
- }
-
-
- __Info(" setting netmap rules and alias...");
- foreach my $vlan (@{__GetVLanList()})
- {
- __Info (" $vlan");
- __SetNetmapByVlan ($vlan);
- __SetAliasByVlan ($vlan);
- }
-
- # On fait les routes après les alias pour faciliter les bidouilles double-adressage
- __Info(" setting routes...");
- __RoutesInit();
-
- __Info(" setting masquerading rules...");
- my $masquerades = Config_Key($configfile, 'init', '@masquerade');
- __SetMasqueradeByVlan ($masquerades) if $masquerades;
-
- __Info(" setting dnat rules...");
- my $dnat = Config_Key($configfile, 'init', '@dnat');
- __SetDNATs ($dnat) if $dnat;
+ }
+
+ # my $listbrup = __GetListBridgeUp();
+ foreach my $lan ( @{ __GetVLanList() } ) {
+ __BridgeAdd($lan);
+ __BridgeSetAddr($lan);
+ }
+
+ __Info(" setting netmap rules and alias...");
+ foreach my $vlan ( @{ __GetVLanList() } ) {
+ __Info(" $vlan");
+ __SetNetmapByVlan($vlan);
+ __SetAliasByVlan($vlan);
+ }
+
+# On fait les routes après les alias pour faciliter les bidouilles double-adressage
+ __Info(" setting routes...");
+ __RoutesInit();
+
+ __Info(" setting masquerading rules...");
+ my $masquerades = Config_Key( $configfile, 'init', '@masquerade' );
+ __SetMasqueradeByVlan($masquerades) if $masquerades;
+
+ __Info(" setting dnat rules...");
+ my $dnat = Config_Key( $configfile, 'init', '@dnat' );
+ __SetDNATs($dnat) if $dnat;
};
-
-$main->{start_umls} = sub ()
-{
- __UpdateConfig();
- __Info("Starting umls...");
- __Umlaunch(__GetUMLtoLaunch());
+$main->{start_umls} = sub () {
+ __UpdateConfig();
+ __Info("Starting umls...");
+ __Umlaunch( __GetUMLtoLaunch() );
};
-
-$main->{start} = sub ()
-{
- $main->{start_nets}();
- $main->{start_umls}();
+$main->{start} = sub () {
+ $main->{start_nets}();
+ $main->{start_umls}();
};
-
-$main->{stop_umls} = sub ()
-{
- __UpdateConfig(); # TODO, Eviter l'updateconfig avant un arrete...
- # continuer l'enregistrement de toutes les modifs faite
- # dans /var/lib/pflaunch et partir de la pour savoir quoi
- # arreter
- __Info("Halting UMLs...");
- __Umlshalt(__GetUMLtoLaunch());
+$main->{stop_umls} = sub () {
+ __UpdateConfig(); # TODO, Eviter l'updateconfig avant un arrete...
+ # continuer l'enregistrement de toutes les modifs faite
+ # dans /var/lib/pflaunch et partir de la pour savoir quoi
+ # arreter
+ __Info("Halting UMLs...");
+ __Umlshalt( __GetUMLtoLaunch() );
};
-
-$main->{stop_nets} = sub ()
-{
- __UpdateConfig();
- # Arrête les bridges définis dans la cfg et qui sont lancés (__GetListBridgeUp)
-
- my $listbrup = __GetListBridgeUp();
-
- __Info(" Flushing route...");
- __RoutesFlush();
-
- __Info(" Halting Bridges...");
-
- foreach my $brname (@$listbrup)
- {
- __BridgeDel ($brname);
- }
-
- __Info(" Flushing iptables rules...");
- &__IptCleanChange();
- __Info(" Flushing Aliases...\n");
- &__AliasFlush();
-
- __Info(" Arrêt des interfaces");
-
- foreach (@{__GetVLanList()})
- {
- my $vs = __GetVLanSetup ($_);
- __runCmds (["ifconfig $_.".$vs->{tag}." down"],1) foreach (@{__GetIfByVlan($_)});
- }
-
- unlink $PF_STATUS_DIR."/ifbr";
+$main->{stop_nets} = sub () {
+ __UpdateConfig();
+
+# Arrête les bridges définis dans la cfg et qui sont lancés (__GetListBridgeUp)
+
+ my $listbrup = __GetListBridgeUp();
+
+ __Info(" Flushing route...");
+ __RoutesFlush();
+
+ __Info(" Halting Bridges...");
+
+ foreach my $brname (@$listbrup) {
+ __BridgeDel($brname);
+ }
+
+ __Info(" Flushing iptables rules...");
+ &__IptCleanChange();
+ __Info(" Flushing Aliases...\n");
+ &__AliasFlush();
+
+ __Info(" Arrêt des interfaces");
+
+ foreach ( @{ __GetVLanList() } ) {
+ my $vs = __GetVLanSetup($_);
+ __runCmds( [ "ifconfig $_." . $vs->{tag} . " down" ], 1 )
+ foreach ( @{ __GetIfByVlan($_) } );
+ }
+
+ unlink $PF_STATUS_DIR . "/ifbr";
};
-
-$main->{stop} = sub ()
-{
- $main->{stop_umls}();
- $main->{stop_nets}();
+$main->{stop} = sub () {
+ $main->{stop_umls}();
+ $main->{stop_nets}();
};
-
-$main->{restart} = sub ()
-{
- $main->{stop}();
- $main->{start}();
+$main->{restart} = sub () {
+ $main->{stop}();
+ $main->{start}();
};
-
-$main->{restart_nets} = sub ()
-{
- $main->{stop_nets}();
- $main->{start_nets}();
+$main->{restart_nets} = sub () {
+ $main->{stop_nets}();
+ $main->{start_nets}();
};
-
-sub __usage
-{
- print "Usage : flags commande\n";
- print "\n";
- print "Commande\n";
- print " * start : Lance tous\n";
- print " * start_nets : Lance les bridges\n";
- print " * start_umls : Lance les UMLs\n";
- print " * stop : Arrete tous\n";
- print " * stop_nets : Arrete les bridges\n";
- print " * stop_umls : Arrete les UMLs\n";
- print " * restart : restart\n";
- print " * restart_nets : restart bridges\n";
- print "\n";
- print "Flags\n";
- print " * -h --help : Aide\n";
- print " * -v --verbose : Bavard...\n";
- print " * -d --debug : Debug...\n";
- print " * -f --fork : Fork\n";
-# print " * -l --log : log dans /var/log/pflaunch (verbose par défaut)\n";
- print " * --nocvsupdate : pas d'update CVS lors du lancement d'une commande\n";
- print " * --branche-cvs=BRANCHE : Possiblité de forcer une branche CVS\n";
- print " * --dontcheckdf : Ne controle pas l'espace dispo avant de créer un disque\n";
- print "\n";
- print " En cas de probleme ou de souhait, n'hésitez pas a utiliser Bugzilla\n";
- exit;
+sub __usage {
+ print "Usage : flags commande\n";
+ print "\n";
+ print "Commande\n";
+ print " * start : Lance tous\n";
+ print " * start_nets : Lance les bridges\n";
+ print " * start_umls : Lance les UMLs\n";
+ print " * stop : Arrete tous\n";
+ print " * stop_nets : Arrete les bridges\n";
+ print " * stop_umls : Arrete les UMLs\n";
+ print " * restart : restart\n";
+ print " * restart_nets : restart bridges\n";
+ print "\n";
+ print "Flags\n";
+ print " * -h --help : Aide\n";
+ print " * -v --verbose : Bavard...\n";
+ print " * -d --debug : Debug...\n";
+ print " * -f --fork : Fork\n";
+
+ # print " * -l --log : log dans /var/log/pflaunch (verbose par défaut)\n";
+ print
+ " * --nocvsupdate : pas d'update CVS lors du lancement d'une commande\n";
+ print
+ " * --branche-cvs=BRANCHE : Possiblité de forcer une branche CVS\n";
+ print
+ " * --dontcheckdf : Ne controle pas l'espace dispo avant de créer un disque\n";
+ print "\n";
+ print
+ " En cas de probleme ou de souhait, n'hésitez pas a utiliser Bugzilla\n";
+ exit;
}
__usage() unless @ARGV;
# Run baby run !
-my $cmd = $ARGV[@ARGV - 1];
-undef $ARGV[@ARGV - 1];
-
-GetOptions (
- 'help|h' => \$options->{help},
- 'branche-cvs=s' => \$options->{branchecvs},
- 'nocvsupdate' => \$options->{nocvsupdate},
- 'verbose|v' => \$options->{verbose},
- 'debug|d' => \$options->{debug},
- 'fork|f' => \$options->{"fork"},
-# 'log|l' => \$options->{"log"},
- 'dontcheckdf' => \$options->{dontcheckdf},
+my $cmd = $ARGV[ @ARGV - 1 ];
+undef $ARGV[ @ARGV - 1 ];
+
+GetOptions(
+ 'help|h' => \$options->{help},
+ 'branche-cvs=s' => \$options->{branchecvs},
+ 'nocvsupdate' => \$options->{nocvsupdate},
+ 'verbose|v' => \$options->{verbose},
+ 'debug|d' => \$options->{debug},
+ 'fork|f' => \$options->{"fork"},
+
+ # 'log|l' => \$options->{"log"},
+ 'dontcheckdf' => \$options->{dontcheckdf},
);
-
__usage() if $options->{help};
# Tests divers
-if ( $ENV{'USER'} and $ENV{'USER'} ne "root" )
-{
- __Fault("Vous devez lancer ce script en root");
-}
-
+if ( $ENV{'USER'} and $ENV{'USER'} ne "root" ) {
+ __Fault("Vous devez lancer ce script en root");
+}
# Paramètres
$options->{verbose} = 1
-if $options->{debug};
-
-
-if ($options->{nocvsupdate} and $options->{branchecvs})
+ if $options->{debug};
+
+if ( $options->{nocvsupdate} and $options->{branchecvs} ) {
+ __Fault(
+ "Hum Hum, vous demandez une branche CVS précise avec en même temps le "
+ . "flag '--nocvsupdate' !" );
+}
+
+mkdir($PF_STATUS_DIR) unless ( -d $PF_STATUS_DIR );
+mkdir( $PF_STATUS_DIR . "/bridge" ) unless ( -d $PF_STATUS_DIR . "/bridge" );
+__Fault("uml_switch est il lancé ? (Paquage uml-utilities)")
+ unless ( -S $uml_switch_pipe );
+
+# Main !!
+if ( defined $cmd
+ and defined $main->{$cmd}
+ and ( !defined $options->{help} ) )
{
- __Fault("Hum Hum, vous demandez une branche CVS précise avec en même temps le ".
- "flag '--nocvsupdate' !");
-}
-
-
-mkdir ($PF_STATUS_DIR) unless (-d $PF_STATUS_DIR);
-mkdir ($PF_STATUS_DIR."/bridge") unless (-d $PF_STATUS_DIR."/bridge");
-__Fault("uml_switch est il lancé ? (Paquage uml-utilities)") unless ( -S $uml_switch_pipe );
-
-
-# Main !!
-if (defined $cmd and defined $main->{$cmd} and (! defined $options->{help}))
-{
- __Info("\n<------------------->\n".__PrintTime());
- __GetLock();
- __SetLock();
-
- exit () if ($options->{"fork"} and fork());
- $main->{$cmd}();
- __RemoveLock();
-}
-else
-{
- __usage();
-}
+ __Info( "\n<------------------->\n" . __PrintTime() );
+ __GetLock();
+ __SetLock();
+
+ exit() if ( $options->{"fork"} and fork() );
+ $main->{$cmd}();
+ __RemoveLock();
+}
+else {
+ __usage();
+}
More information about the Pf-tools-commits
mailing list