2008-02-19 04:44:31 +03:00
#!/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 ($$$$) {
2008-02-19 23:51:09 +03:00
my ( $ classname , $ dc_image , $ vdesocket ) = @ _ ;
2008-02-19 04:44:31 +03:00
my $ self = {
2008-02-19 17:12:57 +03:00
dc_image = > $ dc_image ,
2008-02-19 23:51:09 +03:00
vdesocket = > $ vdesocket ,
2008-02-19 04:44:31 +03:00
} ;
bless $ self ;
return $ self ;
}
2008-02-19 18:28:32 +03:00
sub write_kvm_ifup ($$$)
{
my ( $ self , $ path , $ ip_prefix ) = @ _ ;
open ( SCRIPT , ">$path/kvm-ifup" ) ;
print SCRIPT << __EOF__ ;
#!/bin/sh
PREFIX = $ ip_prefix
/sbin/i fconfig \ $ 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/s bin /udhcpd $path/ udhcpd . conf
exit 0
__EOF__
close ( SCRIPT ) ;
chmod ( 0755 , "$path/kvm-ifup" ) ;
return ( "$path/kvm-ifup" , "$path/udhcpd.pid" , "$ip_prefix.20" ) ;
}
2008-02-19 04:44:31 +03:00
sub teardown_env ($$)
{
my ( $ self , $ envvars ) = @ _ ;
2008-02-19 17:12:57 +03:00
print "Killing kvm instance $envvars->{KVM_PID}\n" ;
kill 9 , $ envvars - > { KVM_PID } ;
2008-02-19 23:51:09 +03:00
if ( defined ( $ envvars - > { DHCPD_PID } ) ) {
print "Killing dhcpd instance $envvars->{DHCPD_PID}\n" ;
kill 9 , $ envvars - > { DHCPD_PID } ;
}
2008-02-19 18:28:32 +03:00
2008-02-19 04:44:31 +03:00
return 0 ;
}
sub getlog_env ($$)
{
my ( $ self , $ envvars ) = @ _ ;
return "" ;
}
sub check_env ($$)
{
my ( $ self , $ envvars ) = @ _ ;
2008-02-19 17:12:57 +03:00
# FIXME: Check whether $self->{pid} is still running
2008-02-19 04:44:31 +03:00
return 1 ;
}
2008-02-19 18:28:32 +03:00
sub read_pidfile ($)
{
my ( $ path ) = @ _ ;
open ( PID , $ path ) ;
<PID> =~ /([0-9]+)/ ;
my ( $ pid ) = $ 1 ;
close ( PID ) ;
return $ pid ;
}
2008-02-19 17:12:57 +03:00
sub start ($$$)
2008-02-19 05:29:03 +03:00
{
2008-02-19 17:12:57 +03:00
my ( $ self , $ path , $ image ) = @ _ ;
2008-02-19 05:29:03 +03:00
2008-02-19 17:12:57 +03:00
my $ pidfile = "$path/kvm.pid" ;
2008-02-19 05:29:03 +03:00
2008-02-19 18:49:29 +03:00
my $ opts = ( defined ( $ ENV { KVM_OPTIONS } ) ? $ ENV { KVM_OPTIONS } : "-nographic" ) ;
2008-02-19 06:44:30 +03:00
2008-02-19 19:23:38 +03:00
if ( defined ( $ ENV { KVM_SNAPSHOT } ) ) {
$ opts . = " -loadvm $ENV{KVM_SNAPSHOT}" ;
}
2008-02-19 23:51:09 +03:00
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 ) ;
}
2008-02-19 05:29:03 +03:00
2008-02-19 23:51:09 +03:00
system ( "kvm -name \"Samba 4 Test Subject\" $opts -monitor unix:$path/kvm.monitor,server,nowait -daemonize -pidfile $pidfile -snapshot $image -net nic -net $netopts" ) ;
2008-02-19 18:28:32 +03:00
2008-02-19 23:51:09 +03:00
return ( read_pidfile ( $ pidfile ) , $ dhcp_pid , $ ip_address ) ;
2008-02-19 05:29:03 +03:00
}
2008-02-19 04:44:31 +03:00
sub setup_env ($$$)
{
my ( $ self , $ envname , $ path ) = @ _ ;
2008-02-19 05:29:03 +03:00
if ( $ envname eq "dc" ) {
2008-02-19 18:28:32 +03:00
( $ 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 ;
}
2008-02-19 17:12:57 +03:00
if ( $ envname eq "dc" ) {
return {
KVM_PID = > $ self - > { dc_pid } ,
2008-02-19 18:28:32 +03:00
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" ) ,
2008-02-19 17:12:57 +03:00
} ;
} else {
return undef ;
2008-02-19 05:29:03 +03:00
}
2008-02-19 17:12:57 +03:00
} else {
2008-02-19 05:29:03 +03:00
return undef ;
}
2008-02-19 04:44:31 +03:00
}
sub stop ($)
{
my ( $ self ) = @ _ ;
}
1 ;