pf-tools commit: r697 [parmelan-guest] - in /branches/0.33-stable: TODO debian/changelog debian/control lib/PFTools/Net.pm lib/PFTools/Update.pm tools/kvmlaunch

parmelan-guest at users.alioth.debian.org parmelan-guest at users.alioth.debian.org
Tue Mar 10 22:50:25 UTC 2009


Author: parmelan-guest
Date: Tue Mar 10 22:50:24 2009
New Revision: 697

URL: http://svn.debian.org/wsvn/pf-tools/?sc=1&rev=697
Log:
* WORK IN PROGRESS, DO NOT RELEASE!
* debian/control: added myself as uploader, to please dch.
* lib/PFTools/Net.pm:
  - also export cmpif() and Host_class().
  - corrected a few typos in error messages, and a few indentation cases.
  - don't force bonding interfaces names to start with "bond".
* lib/PFTools/Update.pm:
  - also export CVS_update().
* tools/kvmlaunch:
  - new script.

Added:
    branches/0.33-stable/tools/kvmlaunch   (with props)
Modified:
    branches/0.33-stable/TODO
    branches/0.33-stable/debian/changelog
    branches/0.33-stable/debian/control
    branches/0.33-stable/lib/PFTools/Net.pm
    branches/0.33-stable/lib/PFTools/Update.pm

Modified: branches/0.33-stable/TODO
URL: http://svn.debian.org/wsvn/pf-tools/branches/0.33-stable/TODO?rev=697&op=diff
==============================================================================
--- branches/0.33-stable/TODO (original)
+++ branches/0.33-stable/TODO Tue Mar 10 22:50:24 2009
@@ -3,7 +3,6 @@
 ||
 UE check that all mandatory entries are defined (ie: tag)
 UM use Net::IP for ipstart.* and check it is ok wrt the subnet declaration
-MM [Need validation] source = CVS:config/%HOST_TYPE%/%SECTIONNAME%
 LE Add %SERIAL% in addition to %CONSOLE% for PXE, if it is really interesting ("serial 0 115200" by default)
 LE Obsolete mk_packages and update-links (just have to be sure no one uses them anymore)
 

Modified: branches/0.33-stable/debian/changelog
URL: http://svn.debian.org/wsvn/pf-tools/branches/0.33-stable/debian/changelog?rev=697&op=diff
==============================================================================
--- branches/0.33-stable/debian/changelog (original)
+++ branches/0.33-stable/debian/changelog Tue Mar 10 22:50:24 2009
@@ -1,3 +1,22 @@
+pf-tools (0.33.17-0.WIP) unstable; urgency=low
+
+  * WORK IN PROGRESS, DO NOT RELEASE!
+
+  * debian/control: added myself as uploader, to please dch.
+
+  * lib/PFTools/Net.pm:
+    - also export cmpif() and Host_class().
+    - corrected a few typos in error messages, and a few indentation cases.
+    - don't force bonding interfaces names to start with "bond".
+
+  * lib/PFTools/Update.pm:
+    - also export CVS_update().
+
+  * tools/kvmlaunch:
+    - new script.
+
+ -- Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>  Tue, 10 Mar 2009 23:49:02 +0100
+
 pf-tools (0.33.16-1) unstable; urgency=low
 
   * Minor feature enhancement release

Modified: branches/0.33-stable/debian/control
URL: http://svn.debian.org/wsvn/pf-tools/branches/0.33-stable/debian/control?rev=697&op=diff
==============================================================================
--- branches/0.33-stable/debian/control (original)
+++ branches/0.33-stable/debian/control Tue Mar 10 22:50:24 2009
@@ -2,6 +2,7 @@
 Section: perl
 Priority: optional
 Maintainer: Damien Clermonte <damien at sitadelle.com>
+Uploaders: Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
 Build-Depends-Indep: perl
 Standards-Version: 3.0.1
 

Modified: branches/0.33-stable/lib/PFTools/Net.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/0.33-stable/lib/PFTools/Net.pm?rev=697&op=diff
==============================================================================
--- branches/0.33-stable/lib/PFTools/Net.pm (original)
+++ branches/0.33-stable/lib/PFTools/Net.pm Tue Mar 10 22:50:24 2009
@@ -49,6 +49,9 @@
 
     Mk_interfaces
     Mk_zone
+
+    cmpif
+    Host_class
 );
 
 our @EXPORT_OK = qw();
@@ -989,10 +992,12 @@
 		elsif ( defined ( $S->{$key}->{'default'} ) ) {
 		    if ( $key eq 'arch' && $S->{$key}->{'default'} !~ /^$ALLOWED_ARCH$/ ) {
 			Abort( $ERR_SYNTAX, "Invalid default architecture for host ".$srv." : ".$S->{$key}->{'default'} ) ;
-		    } elsif ( $key eq 'deploymode' ) {
-			Abort ( $ERR_SYNTAX, "Invalid default deploymode key ".$S->{$key}->{'default'} )
-				if ( $S->{$key}->{'default'} !~ /^$ALLOWED_DEPLOYMODE$/ ) ;
-			Warn ( $ERR_SYNTAX, "No need to defined initrd for host ".$srv ) if ( defined $S->{'initrd'}->{'default'} ) ;
+		    }
+		    elsif ( $key eq 'deploymode' ) {
+			Abort( $ERR_SYNTAX, "Invalid default deploymode key $S->{$key}->{'default'}" )
+			    if $S->{$key}->{'default'} !~ m/^$ALLOWED_DEPLOYMODE$/;
+			Warn( $ERR_SYNTAX, "No need to define initrd for host $srv" )
+			    if defined $S->{'initrd'}->{'default'};
 		    }
 		    $M->{$key} = $S->{$key}->{'default'} ;
 		}
@@ -1010,7 +1015,8 @@
 		}
 	    }
 
-	    delete $M->{'console'} if $M->{'console'} and $M->{'console'} eq 'default';
+	    delete $M->{'console'}
+		if $M->{'console'} and $M->{'console'} eq 'default';
 
 	    if ( defined $S->{'bonding'} ) {
 		foreach my $bond ( keys %{$S->{'bonding'}} ) {
@@ -1025,7 +1031,7 @@
 		    }
 		    foreach my $iface ( @{$M->{'bonding'}->{$bond}} ) {
 			if ( defined $S->{'interface'}->{$iface} ) {
-			    Abort ( $ERR_SYNTAX, "Cannot defined interface ".$iface." which is already on bonding definition ".$bond ) ;
+			    Abort( $ERR_SYNTAX, "Cannot define interface $iface: already used in bonding definition $bond" );
 			}
 		    }
 		}
@@ -1761,8 +1767,12 @@
 	$net =~ s/^[^\.]+\.//;
 	my $NET = $Z->{'NETWORK'}->{'BY_NAME'}->{$net};
 
-	if ( $M->{'ifup'}->{$nam} =~ /^bond/ ) {
-		print "\tslaves          ".join ( " ", @{$M->{'bonding'}->{$M->{'ifup'}->{$nam}}} )."\n" ;
+#	if ( $M->{'ifup'}->{$nam} =~ /^bond/ ) {
+	if ( $M->{'bonding'}->{ $M->{'ifup'}->{$nam} } ) {
+	    print
+		"\tslaves          ",
+		join (' ', @{ $M->{'bonding'}->{ $M->{'ifup'}->{$nam} } } ),
+		"\n";
 	}
 
 	if ($resolve) {
@@ -1876,11 +1886,12 @@
 	}
 
 	if ( !$mediaerror ) {
-	    my $ifname = $M->{ifup}->{$nam};
+	    my $ifname = $M->{'ifup'}->{$nam};
 	    if ( $ifname =~ m/^([^:.]+)\.(\d+)(:\d+)?$/ ) {
 		$ifname = $1;
 	    }
-	    unless ( $ifname =~ /^bond/ ) {
+#	    unless ( $ifname =~ /^bond/ ) {
+	    unless ( $M->{'bonding'}->{$ifname} ) {
 		print "\tup              ethtool -s " 
 		    . $ifname . " "
 		    . $defaultmedia

Modified: branches/0.33-stable/lib/PFTools/Update.pm
URL: http://svn.debian.org/wsvn/pf-tools/branches/0.33-stable/lib/PFTools/Update.pm?rev=697&op=diff
==============================================================================
--- branches/0.33-stable/lib/PFTools/Update.pm (original)
+++ branches/0.33-stable/lib/PFTools/Update.pm Tue Mar 10 22:50:24 2009
@@ -34,9 +34,10 @@
     $ERR_OPEN
     $ERR_SYNTAX
 
-    Get_source
+    CVS_update
     dirname
     Do_update
+    Get_source
 );
 
 our @EXPORT_OK = qw();

Added: branches/0.33-stable/tools/kvmlaunch
URL: http://svn.debian.org/wsvn/pf-tools/branches/0.33-stable/tools/kvmlaunch?rev=697&op=file
==============================================================================
--- branches/0.33-stable/tools/kvmlaunch (added)
+++ branches/0.33-stable/tools/kvmlaunch Tue Mar 10 22:50:24 2009
@@ -1,0 +1,488 @@
+#!/usr/bin/perl
+#
+#   $Id$
+#
+
+#
+#  Copyright (C) 2009      Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
+#
+#  This program is free software; you can redistribute it and/or
+#  modify it under the terms of the GNU General Public License
+#  as published by the Free Software Foundation; either version 2
+#  of the License, or (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
+#
+
+#
+# TODO:
+# - fix all the TODO and FIXME notes
+# - move all the utility functions in the appropriate packages
+# - try libvirt?
+#
+
+use strict;
+use warnings;
+
+use Carp;
+use Digest::CRC qw( crc32_hex );
+use English qw( -no_match_vars ); # Avoids regex performance penalty
+use File::Path;
+use Getopt::Long;
+
+use PFTools::Conf;
+use PFTools::Net;
+use PFTools::Update;
+
+#$PFTools::Conf::PFTOOLS_VARS->{'UML'} = 1;
+
+#if (   `which vconfig 2>/dev/null` eq ""
+#    || `which brctl 2>/dev/null`  eq ""
+#    || `which screen 2>/dev/null` eq "" )
+#{
+#    print STDERR
+#	"Sorry, I need vlan, bridge-utils and screen\n";
+#    exit 1;
+#}
+
+my $option = {
+    '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+',
+) or die "FATAL: GetOptions error, try --help";
+
+if ($option->{'help'} or not @ARGV) {
+    usage();
+    exit 1;
+}
+
+if ($option->{'oneeach'}) {
+    $option->{'detached'} = 1;
+    $option->{'errors'}   = 0;
+}
+
+if ($option->{'debug'}) {
+    $option->{'verbose'}  = 1;
+}
+
+
+if ($option->{'cvs-update'}) {
+    CVS_update( undef, $option )
+	&& die "FATAL: Unable to load configuration.\n";
+}
+
+my $Z = Init_lib_net( Get_source("GLOBAL:private-network") );
+
+my @hosts = __get_hosts($Z, $option, @ARGV);
+
+while ( defined( my $vm_hostname = shift @hosts ) ) {
+    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";
+    }
+}
+
+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 @hosts = Get_Ordered_Filtered_Hosts( $Z, @hosts_pattern );
+    die "FATAL: No matching host found.\n"
+	unless @hosts;
+    
+    warn "DEBUG: hosts: @hosts\n"
+	if $option->{'debug'};
+
+    return @hosts;
+}
+
+
+# Do the magic for one VM
+sub __handle_vm {
+    my ($vm_hostname, $Z, $option) = @_;
+
+    warn "INFO: handling host $vm_hostname\n"
+	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
+    }
+
+    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);
+    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;
+    }
+
+    # TODO: prepend console=ttyS0.... to the cmdline in order to use kvm's
+    # 'monitor' mode instead of the 'curses' mode (this mode has, let's
+    # say, an "interesting" keymap) ?
+    #
+    # NB: monitor mode is good, but gives only one screen for both the kvm
+    # monitor and the vm serial console. Having a separate screen window
+    # for each of them would really rock! Unfortunately, I don't know
+    # (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},
+    );
+
+    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";
+Usage: $0 [options] [hostregexp|hostlist] ...
+Options:
+    --oneeach (-1)	Ignore any host arg and launch 1 VM of each existing
+			host type.
+			[default: disabled]
+
+    --regex (-e)	Each parameter is a hostname regexp, not a hostname.
+			[default: disabled]
+
+    --detached		Detach the VM screen.
+			[default: disabled]
+
+    --errors		Define the error handling when a VM fails to launch.
+			[default: enabled]
+	When enabled,  terminate immediately;
+	When disabled, proceed with the next one.
+
+    --ram-size		VM RAM size in Mb.
+			[default: $option->{'ram-size'} Mb]
+
+    --disk-size		VM hard disk size in Mb.
+			[default: $option->{'disk-size'} Mb]
+
+    --cvs-update	Start by doing a CVS update (or a checkout).
+			[default: enabled]
+
+    --mode (-m)		Mode of operation.
+			[default: boot, unless there's no disk for this VM]
+
+	start-net: only configure the VM network (create the tun devices and
+	add them to the necessary bridges).
+
+	stop-net: unconfigure the VM network.
+
+	install: configure the VM network, install the VM from scratch with
+	debian-installer, then stop the VM and unconfigure the VM network.
+
+	boot: configure the VM network and boot a previously installed VM
+	(revert to install mode if there's no disk for this VM).
+
+    --verbose (-v)
+    --debug   (-d)
+
+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 $host_dot_vlan = '';
+
+    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;
+
+    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');
+    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 @interfaces = ();
+#    #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,
+	};
+    }
+
+    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
+# truncated to "abv1-ncdn-varni"!
+#
+# It is therefore necessary to discriminate these interfaces... a simple
+# solution is to use a digest function. We use the prefix "m-" (for "mangled")
+# and the hexadecimal representation of the CRC32 digest of the hostname. That
+# 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
+
+    my ($iface_number) = $ifname =~ m{\A \D+ (\d+) \z}xms;
+    my $mangled_hostname = length($host) > $MAX_HOSTNAME_SIZE ? "m-" . crc32_hex($host) : $host;
+
+    my $virtual_ifname = join '.', $mangled_hostname, $iface_number;
+
+    return $virtual_ifname;
+}
+
+sub __install_tap_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'});
+    }
+}
+
+sub __remove_tap_interfaces {
+    my ($option, @interfaces) = @_;
+
+    foreach my $iface (@interfaces) {
+	__brctl_delif($option, $iface->{'vlan'}, $iface->{'ifname'});
+	__delete_tun_device($option, $iface->{'ifname'});
+    }
+}
+
+sub __create_tun_device {
+    my ($option, $ifname) = @_;
+
+    warn "INFO: creating tun device $ifname\n"
+	if $option->{'verbose'};
+
+    __system_or_carp("tunctl -b -t $ifname");
+    __system_or_carp("ifconfig $ifname up");
+}
+
+sub __delete_tun_device {
+    my ($option, $ifname) = @_;
+
+    warn "INFO: deleting tun device $ifname\n"
+	if $option->{'verbose'};
+
+    __system_or_carp("ifconfig $ifname down");
+    __system_or_carp("tunctl -d $ifname");
+}
+
+sub __brctl_addif {
+    my ($option, $vlan_tag, $ifname) = @_;
+
+    my $brname = "br$vlan_tag";
+
+    warn "INFO: adding tun device $ifname to bridge $brname\n"
+	if $option->{'verbose'};
+
+    my $cmd = "brctl addif $brname $ifname";
+    __system_or_carp($cmd);
+}
+
+sub __brctl_delif {
+    my ($option, $vlan_tag, $ifname) = @_;
+
+    my $brname = "br$vlan_tag";
+
+    warn "INFO: removing tun device $ifname from bridge $brname\n"
+	if $option->{'verbose'};
+
+    my $cmd = "brctl delif $brname $ifname";
+    __system_or_carp($cmd);
+}
+
+sub __system_or_croak {
+    my @cmd = @_;
+
+    system(@cmd) == 0
+	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!";
+}
+

Propchange: branches/0.33-stable/tools/kvmlaunch
------------------------------------------------------------------------------
    svn:keywords = Id Revision

Propchange: branches/0.33-stable/tools/kvmlaunch
------------------------------------------------------------------------------
    svn:mergeinfo = 




More information about the pf-tools-commits mailing list