path: root/qemu-run

#!/usr/bin/perl
use warnings;
use strict;
use XML::Parser;
use Getopt::Std;

# args
my %opts;
getopts('dm', \%opts);
my $name    = shift;
my $debug   = defined($opts{'d'}) ? 1 : 0;
my $showmon = defined($opts{'m'}) ? 1 : 0;

# config
my $tapup   = "/etc/qemu-virbr0-ifup";
my $tapdown = "/etc/qemu-virbr0-ifdown";
my $mondir  = $ENV{HOME} . "/.qemu-gtk";
my $monitor = $mondir . "/" . $name;

# vars
my ($xml, $help, $parser, @cmdline, $pid);
my $level = 0;
my $indent = 3;
my $skip_qemu = 0;
my @xml_path;
my $xml_string;

# domain config
my %xml_elems;

my (@disks,@nics);
my $ndisk = 0;
my $nnic = 0;

my $usb = 0;
my $usbtablet = 0;
my $graphics = 0;
my $soundhw;

########################################################################
# map tables

my %ide_table = (
	'hda' => 'if=ide,bus=0,unit=0',
	'hdb' => 'if=ide,bus=0,unit=1',
	'hdc' => 'if=ide,bus=1,unit=0',
	'hdd' => 'if=ide,bus=1,unit=1'
);

########################################################################
# helper functions

sub xml_start {
	my $expat   = shift;
	my $element = shift;
	my $path;
	my %attrs;

	while (defined($_[0])) { $attrs{$_[0]} = $_[1]; shift; shift; }
	push @xml_path, $element;

	printf("start: %*s%-*s | %s\n",
	       $level * $indent, "",
	       20 - $level * $indent, $element,
	       join(", ", map { "$_=$attrs{$_}" } sort keys %attrs))
	  if $debug;

	$path = join("-", @xml_path);

	# disks
	if ($path eq "domain-devices-disk" ||
	    $path eq "domain-devices-disk-source" ||
	    $path eq "domain-devices-disk-target") {
		for my $elem ('device', 'bus', 'dev', 'file') {
			next unless defined($attrs{$elem});
			$disks[$ndisk]{"$element-$elem"} = $attrs{$elem};
		}
	}

	# nics
	if ($path eq "domain-devices-interface-mac" ||
	    $path eq "domain-devices-interface-model") {
		for my $elem ('address', 'type') {
			next unless defined($attrs{$elem});
			$nics[$nnic]{"$element-$elem"} = $attrs{$elem};
		}
	}

	# input
	if ($element eq "input" && $attrs{'type'} eq "tablet") {
		$usb = 1;
		$usbtablet = 1;
	}

	# sound
	if ($element eq "sound" && defined($attrs{'model'})) {
		$soundhw = $attrs{'model'};
	}

	# graphics
	if ($element eq "graphics") {
		$graphics = 1;
	}

	undef $xml_string;
	$level++;
}

sub xml_char {
	my $expat  = shift;
	my $string = shift;

	return unless $string =~ m/\S/;
	$xml_string = $string;
}

sub xml_end {
	my $expat   = shift;
	my $element = shift;
	my $path;

	$level--;

	if (defined($xml_string)) {
		printf("/end : %*s%-*s | %s\n",
		       $level * $indent, "",
		       20 - $level * $indent, $element,
		       $xml_string)
		  if $debug;
		$xml_elems{$element} = $xml_string;
	}

	$path = join("-", @xml_path);
	if ($path eq "domain-devices-disk") {
		$ndisk++;
	}
	if ($path eq "domain-devices-interface") {
		$nics[$nnic]{'vlan'} = $nnic;
		$nnic++;
	}

	pop @xml_path;
}


########################################################################
# main

# read config
open XML, "-|", "virsh dumpxml $name";
{ local $/; undef $/; $xml = <XML>; };
close XML;

# set defaults
$xml_elems{'emulator'} = "qemu";

# parse config
$parser = new XML::Parser();
$parser->setHandlers(Start   => \&xml_start,
		     Char    => \&xml_char,
		     End     => \&xml_end);
$parser->parse($xml) or die "domain config parse error";

# get help text
open HELP, "-|", "$xml_elems{'emulator'} --help";
{ local $/; undef $/; $help = <HELP>; };
close HELP;

# build cmdline -- basic setup
print "-- \n" if $debug;
push @cmdline, $xml_elems{'emulator'};
if (defined($xml_elems{'name'})  &&  $help =~ m/-name/) {
	push @cmdline, "-name";
	push @cmdline, $xml_elems{'name'};
}
if (defined($xml_elems{'uuid'})  &&  $help =~ m/-uuid/) {
	push @cmdline, "-uuid";
	push @cmdline, $xml_elems{'uuid'};
}
if (defined($xml_elems{'memory'})) {
	push @cmdline, "-m";
	push @cmdline, $xml_elems{'memory'} / 1024;
}
if (defined($xml_elems{'vcpu'})) {
	push @cmdline, "-smp";
	push @cmdline, $xml_elems{'vcpu'};
}
if ($usb) {
	push @cmdline, "-usb";
}
if ($usbtablet) {
	push @cmdline, "-usbdevice";
	push @cmdline, "tablet";
}
if (defined($soundhw)) {
	push @cmdline, "-soundhw";
	push @cmdline, $soundhw;
}

# build cmdline -- disks
foreach my $disk (@disks) {
	print "disk: " . join (", ", map {
		$_ . "=" . $disk->{$_};
	} keys %{$disk}) . "\n"
	  if $debug;

	$disk->{'config'} = "media=" . $disk->{'disk-device'};
	$disk->{'config'} .= ",file=" . $disk->{'source-dev'}
	  if defined($disk->{'source-dev'});
	$disk->{'config'} .= ",file=" . $disk->{'source-file'}
	  if defined($disk->{'source-file'});

	if ($disk->{'target-bus'} eq "ide") {
		# handle ide
		$disk->{'config'} .= "," . $ide_table{$disk->{'target-dev'}};
	} else {
		# default
		$disk->{'config'} .= ",if=" . $disk->{'target-bus'};
	}

	push @cmdline, "-drive";
	push @cmdline, $disk->{'config'};
}

# build cmdline -- nics
foreach my $nic (@nics) {
	print "nic: " . join (", ", map {
		$_ . "=" . $nic->{$_};
	} keys %{$nic}) . "\n"
	  if $debug;
	$nic->{'netconfig'} = "tap,vlan=" . $nic->{'vlan'};
	$nic->{'nicconfig'} = "nic,vlan=" . $nic->{'vlan'};

	$nic->{'netconfig'} .= ",script=" . $tapup;
	$nic->{'netconfig'} .= ",downscript=" . $tapdown;

	$nic->{'nicconfig'} .= ",macaddr=" . $nic->{'mac-address'}
	  if defined($nic->{'mac-address'});
	$nic->{'nicconfig'} .= ",model=" . $nic->{'model-type'}
	  if defined($nic->{'model-type'});

	push @cmdline, "-net";
	push @cmdline, $nic->{'nicconfig'};
	push @cmdline, "-net";
	push @cmdline, $nic->{'netconfig'};
}

# build cmdline -- hardwired stuff
push @cmdline, "-monitor";
push @cmdline, "unix:" . $monitor . ",server,nowait";
push @cmdline, "-serial";
push @cmdline, "unix:,server,nowait";
if ($graphics) {
	push @cmdline, "-vnc";
	push @cmdline, "127.0.0.1:0,to=128,password";
}

# prepare
print "-- \n" if $debug;
mkdir $mondir unless -d $mondir;

# run qemu emulator
if (-S $monitor and !system("fuser", "-s", $monitor)) {
	# still running
	printf "VM %s still running, reconnecting\n", $name;
} else {
	$pid = fork();
	die "fork: $!" unless defined($pid);
	if (0 == $pid) {
		# child
		print join(", ", map { "\"$_\"" } @cmdline) . "\n"
		  if $debug;
		exec(@cmdline);
		exit(1);
	}
}

# run qemu-gtk
@cmdline = ();
push @cmdline, "qemu-gtk";
push @cmdline, "-m" if $showmon;
push @cmdline, "unix:" . $monitor . ",server,nowait";
foreach my $i (0 ... 100) {
	last if -S $monitor;
	sleep(0.1);
}
print join(", ", map { "\"$_\"" } @cmdline) . "\n"
  if $debug;
exec(@cmdline);