selftest: Do not skip environments that fail to start up
[mdw/samba.git] / selftest / target / Samba.pm
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.
5
6 package Samba;
7
8 use strict;
9 use target::Samba3;
10 use target::Samba4;
11
12 sub new($$$$$) {
13         my ($classname, $bindir, $binary_mapping,$ldap, $srcdir, $server_maxtime) = @_;
14
15         my $self = {
16             samba3 => new Samba3($bindir,$binary_mapping, $srcdir, $server_maxtime),
17             samba4 => new Samba4($bindir,$binary_mapping, $ldap, $srcdir, $server_maxtime),
18         };
19         bless $self;
20         return $self;
21 }
22
23 sub setup_env($$$)
24 {
25         my ($self, $envname, $path) = @_;
26
27         $ENV{ENVNAME} = $envname;
28
29         my $env = $self->{samba4}->setup_env($envname, $path);
30         if (defined($env) and $env ne "UNKNOWN") {
31             if (not defined($env->{target})) {
32                 $env->{target} = $self->{samba4};
33             }
34         } elsif (defined($env) and $env eq "UNKNOWN") {
35                 $env = $self->{samba3}->setup_env($envname, $path);
36                 if (defined($env) and $env ne "UNKNOWN") {
37                     if (not defined($env->{target})) {
38                         $env->{target} = $self->{samba3};
39                     }
40                 }
41         }
42         if (defined($env) and ($env eq "UNKNOWN")) {
43                 warn("Samba can't provide environment '$envname'");
44                 return "UNKNOWN";
45         }
46         if (not defined $env) {
47                 warn("failed to start up environment '$envname'");
48                 return undef;
49         }
50         return $env;
51 }
52
53 sub bindir_path($$) {
54         my ($object, $path) = @_;
55
56         if (defined($object->{binary_mapping}->{$path})) {
57             $path = $object->{binary_mapping}->{$path};
58         }
59
60         my $valpath = "$object->{bindir}/$path";
61
62         return $valpath if (-f $valpath);
63         return $path;
64 }
65
66 sub mk_krb5_conf($$)
67 {
68         my ($ctx, $other_realms_stanza) = @_;
69
70         unless (open(KRB5CONF, ">$ctx->{krb5_conf}")) {
71                 warn("can't open $ctx->{krb5_conf}$?");
72                 return undef;
73         }
74
75         my $our_realms_stanza = mk_realms_stanza($ctx->{realm},
76                                                  $ctx->{dnsname},
77                                                  $ctx->{domain},
78                                                  $ctx->{kdc_ipv4});
79         print KRB5CONF "
80 #Generated krb5.conf for $ctx->{realm}
81
82 [libdefaults]
83  default_realm = $ctx->{realm}
84  dns_lookup_realm = false
85  dns_lookup_kdc = false
86  ticket_lifetime = 24h
87  forwardable = yes
88  allow_weak_crypto = yes
89
90 [realms]
91  $our_realms_stanza
92  $other_realms_stanza
93 ";
94
95
96         if (defined($ctx->{tlsdir})) {
97                print KRB5CONF "
98
99 [appdefaults]
100         pkinit_anchors = FILE:$ctx->{tlsdir}/ca.pem
101
102 [kdc]
103         enable-pkinit = true
104         pkinit_identity = FILE:$ctx->{tlsdir}/kdc.pem,$ctx->{tlsdir}/key.pem
105         pkinit_anchors = FILE:$ctx->{tlsdir}/ca.pem
106
107 ";
108         }
109         close(KRB5CONF);
110 }
111
112 sub mk_realms_stanza($$$$)
113 {
114         my ($realm, $dnsname, $domain, $kdc_ipv4) = @_;
115
116         my $realms_stanza = "
117  $realm = {
118   kdc = $kdc_ipv4:88
119   admin_server = $kdc_ipv4:88
120   default_domain = $dnsname
121  }
122  $dnsname = {
123   kdc = $kdc_ipv4:88
124   admin_server = $kdc_ipv4:88
125   default_domain = $dnsname
126  }
127  $domain = {
128   kdc = $kdc_ipv4:88
129   admin_server = $kdc_ipv4:88
130   default_domain = $dnsname
131  }
132
133 ";
134         return $realms_stanza;
135 }
136
137 1;