[745] | 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 | 1;
|
---|