selftest/target/Kvm.pm

   1 #!/usr/bin/perl
   2 # Start a KVM machine and run a number of tests against it.
   3 # Copyright (C) 2005-2008 Jelmer Vernooij <jelmer@samba.org>
   4 # Published under the GNU GPL, v3 or later.
   5
   6 package Kvm;
   7
   8 use strict;
   9 use Cwd qw(abs_path);
  10 use FindBin qw($RealBin);
  11 use POSIX;
  12
  13 sub new($$$$) {
  14         my ($classname, $dc_image, $vdesocket) = @_;
  15         my $self = {
  16                 dc_image => $dc_image,
  17                 vdesocket => $vdesocket,
  18         };
  19         bless $self;
  20         return $self;
  21 }
  22
  23 sub write_kvm_ifup($$$)
  24 {
  25         my ($self, $path, $ip_prefix) = @_;
  26         open(SCRIPT, ">$path/kvm-ifup");
  27
  28         print SCRIPT <<__EOF__;
  29 #!/bin/sh
  30
  31 PREFIX=$ip_prefix
  32
  33 /sbin/ifconfig \$1 \$PREFIX.1 up
  34
  35 cat <<EOF>$path/udhcpd.conf
  36 interface \$1
  37 start           \$PREFIX.20
  38 end             \$PREFIX.20
  39 max_leases 1
  40 lease_file      $path/udhcpd.leases
  41 pidfile $path/udhcpd.pid
  42 EOF
  43
  44 touch $path/udhcpd.leases
  45
  46 /usr/sbin/udhcpd $path/udhcpd.conf
  47
  48 exit 0
  49 __EOF__
  50         close(SCRIPT);
  51         chmod(0755, "$path/kvm-ifup");
  52
  53         return ("$path/kvm-ifup", "$path/udhcpd.pid", "$ip_prefix.20");
  54 }
  55
  56 sub teardown_env($$)
  57 {
  58         my ($self, $envvars) = @_;
  59
  60         print "Killing kvm instance $envvars->{KVM_PID}\n";
  61
  62         kill 9, $envvars->{KVM_PID};
  63
  64         if (defined($envvars->{DHCPD_PID})) {
  65                 print "Killing dhcpd instance $envvars->{DHCPD_PID}\n";
  66                 kill 9, $envvars->{DHCPD_PID};
  67         }
  68
  69         return 0;
  70 }
  71
  72 sub getlog_env($$)
  73 {
  74         my ($self, $envvars) = @_;
  75
  76         return "";
  77 }
  78
  79 sub check_env($$)
  80 {
  81         my ($self, $envvars) = @_;
  82
  83         # FIXME: Check whether $self->{pid} is still running
  84
  85         return 1;
  86 }
  87
  88 sub read_pidfile($)
  89 {
  90         my ($path) = @_;
  91
  92         open(PID, $path);
  93         <PID> =~ /([0-9]+)/;
  94         my ($pid) = $1;
  95         close(PID);
  96         return $pid;
  97 }
  98
  99 sub start($$$)
 100 {
 101         my ($self, $path, $image) = @_;
 102
 103         my $pidfile = "$path/kvm.pid";
 104
 105         my $opts = (defined($ENV{KVM_OPTIONS})?$ENV{KVM_OPTIONS}:"-nographic");
 106
 107         if (defined($ENV{KVM_SNAPSHOT})) {
 108                 $opts .= " -loadvm $ENV{KVM_SNAPSHOT}";
 109         }
 110
 111         my $netopts;
 112         my $dhcp_pid;
 113         my $ip_address;
 114
 115         if ($self->{vdesocket}) {
 116                 $netopts = "vde,socket=$self->{vdesocket}";
 117         } else {
 118                 my $ifup_script, $dhcpd_pidfile;
 119                 ($ifup_script, $dhcpd_pidfile, $ip_address) = $self->write_kvm_ifup($path, "192.168.9");
 120                 $netopts = "tap,script=$ifup_script";
 121                 $dhcp_pid = read_pidfile($dhcpd_pidfile);
 122         }
 123
 124         system("kvm -name \"Samba 4 Test Subject\" $opts -monitor unix:$path/kvm.monitor,server,nowait -daemonize -pidfile $pidfile -snapshot $image -net nic -net $netopts");
 125
 126         return (read_pidfile($pidfile), $dhcp_pid, $ip_address);
 127 }
 128
 129 sub setup_env($$$)
 130 {
 131         my ($self, $envname, $path) = @_;
 132
 133         if ($envname eq "dc") {
 134                 ($self->{dc_pid}, $self->{dc_dhcpd_pid}, $self->{dc_ip}) = $self->start($path, $self->{dc_image});
 135
 136                 sub choose_var($$) {
 137                         my ($name, $default) = @_;
 138                         return defined($ENV{"KVM_DC_$name"})?$ENV{"KVM_DC_$name"}:$default;
 139                 }
 140
 141                 if ($envname eq "dc") {
 142                         return {
 143                                 KVM_PID => $self->{dc_pid},
 144                                 DHCPD_PID => $self->{dc_dhcpd_pid},
 145                                 USERNAME => choose_var("USERNAME", "Administrator"),
 146                                 PASSWORD => choose_var("PASSWORD", "penguin"),
 147                                 DOMAIN => choose_var("DOMAIN", "SAMBA"),
 148                                 REALM => choose_var("REALM", "SAMBA"),
 149                                 SERVER => choose_var("SERVER", "DC"),
 150                                 SERVER_IP => $self->{dc_ip},
 151                                 NETBIOSNAME => choose_var("NETBIOSNAME", "DC"),
 152                                 NETBIOSALIAS => choose_var("NETBIOSALIAS", "DC"),
 153                         };
 154                 } else {
 155                         return undef;
 156                 }
 157         } else {
 158                 return undef;
 159         }
 160 }
 161
 162 sub stop($)
 163 {
 164         my ($self) = @_;
 165 }
 166
 167 1;