selftest: bug #8373 is fixed and we should always test this now.
[Samba/vl.git] / selftest / target / Samba.pm
blob72f26a5edd68f46c524d4ebcab549a3b96960680
1 #!/usr/bin/perl
2 # Bootstrap Samba and run a number of tests against it.
3 # Copyright (C) 2005-2007 Jelmer Vernooij <jelmer@samba.org>
4 # Published under the GNU GPL, v3 or later.
6 package Samba;
8 use strict;
9 use target::Samba3;
10 use target::Samba4;
11 use POSIX;
13 sub new($$$$$) {
14 my ($classname, $bindir, $binary_mapping,$ldap, $srcdir, $server_maxtime) = @_;
16 my $self = {
17 samba3 => new Samba3($bindir,$binary_mapping, $srcdir, $server_maxtime),
18 samba4 => new Samba4($bindir,$binary_mapping, $ldap, $srcdir, $server_maxtime),
20 bless $self;
21 return $self;
24 sub setup_env($$$)
26 my ($self, $envname, $path) = @_;
28 $ENV{ENVNAME} = $envname;
30 my $env = $self->{samba4}->setup_env($envname, $path);
31 if (defined($env) and $env ne "UNKNOWN") {
32 if (not defined($env->{target})) {
33 $env->{target} = $self->{samba4};
35 } elsif (defined($env) and $env eq "UNKNOWN") {
36 $env = $self->{samba3}->setup_env($envname, $path);
37 if (defined($env) and $env ne "UNKNOWN") {
38 if (not defined($env->{target})) {
39 $env->{target} = $self->{samba3};
43 if (defined($env) and ($env eq "UNKNOWN")) {
44 warn("Samba can't provide environment '$envname'");
45 return "UNKNOWN";
47 if (not defined $env) {
48 warn("failed to start up environment '$envname'");
49 return undef;
51 return $env;
54 sub bindir_path($$) {
55 my ($object, $path) = @_;
57 if (defined($object->{binary_mapping}->{$path})) {
58 $path = $object->{binary_mapping}->{$path};
61 my $valpath = "$object->{bindir}/$path";
63 return $valpath if (-f $valpath);
64 return $path;
67 sub mk_krb5_conf($$)
69 my ($ctx, $other_realms_stanza) = @_;
71 unless (open(KRB5CONF, ">$ctx->{krb5_conf}")) {
72 warn("can't open $ctx->{krb5_conf}$?");
73 return undef;
76 my $our_realms_stanza = mk_realms_stanza($ctx->{realm},
77 $ctx->{dnsname},
78 $ctx->{domain},
79 $ctx->{kdc_ipv4});
80 print KRB5CONF "
81 #Generated krb5.conf for $ctx->{realm}
83 [libdefaults]
84 default_realm = $ctx->{realm}
85 dns_lookup_realm = false
86 dns_lookup_kdc = false
87 ticket_lifetime = 24h
88 forwardable = yes
89 allow_weak_crypto = yes
91 [realms]
92 $our_realms_stanza
93 $other_realms_stanza
97 if (defined($ctx->{tlsdir})) {
98 print KRB5CONF "
100 [appdefaults]
101 pkinit_anchors = FILE:$ctx->{tlsdir}/ca.pem
103 [kdc]
104 enable-pkinit = true
105 pkinit_identity = FILE:$ctx->{tlsdir}/kdc.pem,$ctx->{tlsdir}/key.pem
106 pkinit_anchors = FILE:$ctx->{tlsdir}/ca.pem
110 close(KRB5CONF);
113 sub mk_realms_stanza($$$$)
115 my ($realm, $dnsname, $domain, $kdc_ipv4) = @_;
117 my $realms_stanza = "
118 $realm = {
119 kdc = $kdc_ipv4:88
120 admin_server = $kdc_ipv4:88
121 default_domain = $dnsname
123 $dnsname = {
124 kdc = $kdc_ipv4:88
125 admin_server = $kdc_ipv4:88
126 default_domain = $dnsname
128 $domain = {
129 kdc = $kdc_ipv4:88
130 admin_server = $kdc_ipv4:88
131 default_domain = $dnsname
135 return $realms_stanza;
138 sub get_interface($)
140 my ($netbiosname) = @_;
141 $netbiosname = lc($netbiosname);
143 my %interfaces = ();
144 $interfaces{"locals3dc2"} = 2;
145 $interfaces{"localmember3"} = 3;
146 $interfaces{"localshare4"} = 4;
147 $interfaces{"localktest6"} = 6;
148 $interfaces{"maptoguest"} = 7;
150 # 11-16 used by selftest.pl for client interfaces
152 $interfaces{"localdc"} = 21;
153 $interfaces{"localvampiredc"} = 22;
154 $interfaces{"s4member"} = 23;
155 $interfaces{"localrpcproxy"} = 24;
156 $interfaces{"dc5"} = 25;
157 $interfaces{"dc6"} = 26;
158 $interfaces{"dc7"} = 27;
159 $interfaces{"rodc"} = 28;
160 $interfaces{"localadmember"} = 29;
161 $interfaces{"plugindc"} = 30;
162 $interfaces{"localsubdc"} = 31;
163 $interfaces{"chgdcpass"} = 32;
165 # update lib/socket_wrapper/socket_wrapper.c
166 # #define MAX_WRAPPED_INTERFACES 32
167 # if you wish to have more than 32 interfaces
169 if (not defined($interfaces{$netbiosname})) {
170 die();
173 return $interfaces{$netbiosname};
176 sub cleanup_child($$)
178 my ($pid, $name) = @_;
179 my $childpid = waitpid($pid, WNOHANG);
180 if ($childpid == 0) {
181 } elsif ($childpid < 0) {
182 printf STDERR "%s child process %d isn't here any more\n",
183 return $childpid;
185 elsif ($? & 127) {
186 printf STDERR "%s child process %d, died with signal %d, %s coredump\n",
187 $name, $childpid, ($? & 127), ($? & 128) ? 'with' : 'without';
188 } else {
189 printf STDERR "%s child process %d exited with value %d\n", $name, $childpid, $? >> 8;
191 return $childpid;