source: branches/samba-3.5.x/selftest/target/Kvm.pm@ 1010

#!/usr/bin/perl
# Start a KVM machine and run a number of tests against it.
# Copyright (C) 2005-2008 Jelmer Vernooij <jelmer@samba.org>
# Published under the GNU GPL, v3 or later.

package Kvm;

use strict;
use Cwd qw(abs_path);
use FindBin qw($RealBin);
use POSIX;

sub new($$$$) {
        my ($classname, $dc_image, $vdesocket) = @_;
        my $self = { 
                dc_image => $dc_image,
                vdesocket => $vdesocket,
        };
        bless $self;
        return $self;
}

sub write_kvm_ifup($$$)
{
        my ($self, $path, $ip_prefix) = @_;
        open(SCRIPT, ">$path/kvm-ifup");

        print SCRIPT <<__EOF__;
#!/bin/sh

PREFIX=$ip_prefix

/sbin/ifconfig \$1 \$PREFIX.1 up

cat <<EOF>$path/udhcpd.conf
interface \$1
start           \$PREFIX.20
end             \$PREFIX.20
max_leases 1
lease_file      $path/udhcpd.leases
pidfile $path/udhcpd.pid
EOF

touch $path/udhcpd.leases

/usr/sbin/udhcpd $path/udhcpd.conf

exit 0
__EOF__
        close(SCRIPT);
        chmod(0755, "$path/kvm-ifup");

        return ("$path/kvm-ifup", "$path/udhcpd.pid", "$ip_prefix.20");
}

sub teardown_env($$)
{
        my ($self, $envvars) = @_;

        print "Killing kvm instance $envvars->{KVM_PID}\n";

        kill 9, $envvars->{KVM_PID};

        if (defined($envvars->{DHCPD_PID})) {
                print "Killing dhcpd instance $envvars->{DHCPD_PID}\n";
                kill 9, $envvars->{DHCPD_PID};
        }

        return 0;
}

sub getlog_env($$)
{
        my ($self, $envvars) = @_;

        return "";
}

sub check_env($$)
{
        my ($self, $envvars) = @_;

        # FIXME: Check whether $self->{pid} is still running

        return 1;
}

sub read_pidfile($)
{
        my ($path) = @_;

        open(PID, $path);
        <PID> =~ /([0-9]+)/;
        my ($pid) = $1;
        close(PID);
        return $pid;
}

sub start($$$)
{
        my ($self, $path, $image) = @_;

        my $pidfile = "$path/kvm.pid";

        my $opts = (defined($ENV{KVM_OPTIONS})?$ENV{KVM_OPTIONS}:"-nographic");

        if (defined($ENV{KVM_SNAPSHOT})) {
                $opts .= " -loadvm $ENV{KVM_SNAPSHOT}";
        }

        my $netopts;
        my $dhcp_pid;
        my $ip_address;

        if ($self->{vdesocket}) {
                $netopts = "vde,socket=$self->{vdesocket}";
        } else {
                my $ifup_script, $dhcpd_pidfile;
                ($ifup_script, $dhcpd_pidfile, $ip_address) = $self->write_kvm_ifup($path, "192.168.9");
                $netopts = "tap,script=$ifup_script";
                $dhcp_pid = read_pidfile($dhcpd_pidfile);
        }

        system("kvm -name \"Samba 4 Test Subject\" $opts -monitor unix:$path/kvm.monitor,server,nowait -daemonize -pidfile $pidfile -snapshot $image -net nic -net $netopts");

        return (read_pidfile($pidfile), $dhcp_pid, $ip_address);
}

sub setup_env($$$)
{
        my ($self, $envname, $path) = @_;

        if ($envname eq "dc") {
                ($self->{dc_pid}, $self->{dc_dhcpd_pid}, $self->{dc_ip}) = $self->start($path, $self->{dc_image});

                sub choose_var($$) { 
                        my ($name, $default) = @_; 
                        return defined($ENV{"KVM_DC_$name"})?$ENV{"KVM_DC_$name"}:$default; 
                }

                if ($envname eq "dc") {
                        return {
                                KVM_PID => $self->{dc_pid},
                                DHCPD_PID => $self->{dc_dhcpd_pid},
                                USERNAME => choose_var("USERNAME", "Administrator"),
                                PASSWORD => choose_var("PASSWORD", "penguin"),
                                DOMAIN => choose_var("DOMAIN", "SAMBA"), 
                                REALM => choose_var("REALM", "SAMBA"), 
                                SERVER => choose_var("SERVER", "DC"), 
                                SERVER_IP => $self->{dc_ip},
                                NETBIOSNAME => choose_var("NETBIOSNAME", "DC"), 
                                NETBIOSALIAS => choose_var("NETBIOSALIAS", "DC"), 
                        };
                } else {
                        return undef;
                }
        } else {
                return undef;
        }
}

sub stop($)
{
        my ($self) = @_;
}

1;