Merge branch 'master' of ssh://git.samba.org/data/git/samba into selftest
[kai/samba-autobuild/.git] / 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;