CVE-2013-4496:s3-samr: Block attempts to crack passwords via repeated password changes
[Samba.git] / selftest / target / Samba.pm
blobd33c1d68672aa78225436af4c1b367867b6e0c4b
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;
12 use Cwd qw(abs_path);
14 sub new($$$$$) {
15 my ($classname, $bindir, $binary_mapping,$ldap, $srcdir, $server_maxtime) = @_;
17 my $self = {
18 samba3 => new Samba3($bindir,$binary_mapping, $srcdir, $server_maxtime),
19 samba4 => new Samba4($bindir,$binary_mapping, $ldap, $srcdir, $server_maxtime),
21 bless $self;
22 return $self;
25 sub setup_env($$$)
27 my ($self, $envname, $path) = @_;
29 $ENV{ENVNAME} = $envname;
31 my $env = $self->{samba4}->setup_env($envname, $path);
32 if (defined($env) and $env ne "UNKNOWN") {
33 if (not defined($env->{target})) {
34 $env->{target} = $self->{samba4};
36 } elsif (defined($env) and $env eq "UNKNOWN") {
37 $env = $self->{samba3}->setup_env($envname, $path);
38 if (defined($env) and $env ne "UNKNOWN") {
39 if (not defined($env->{target})) {
40 $env->{target} = $self->{samba3};
44 if (defined($env) and ($env eq "UNKNOWN")) {
45 warn("Samba can't provide environment '$envname'");
46 return "UNKNOWN";
48 if (not defined $env) {
49 warn("failed to start up environment '$envname'");
50 return undef;
52 return $env;
55 sub bindir_path($$) {
56 my ($object, $path) = @_;
58 if (defined($object->{binary_mapping}->{$path})) {
59 $path = $object->{binary_mapping}->{$path};
62 my $valpath = "$object->{bindir}/$path";
64 return $valpath if (-f $valpath);
65 return $path;
68 sub nss_wrapper_winbind_so_path($) {
69 my ($object) = @_;
70 my $ret = $ENV{NSS_WRAPPER_WINBIND_SO_PATH};
71 if (not defined($ret)) {
72 $ret = bindir_path($object, "default/nsswitch/libnss-winbind.so");
73 $ret = abs_path($ret);
75 return $ret;
78 sub mk_krb5_conf($$)
80 my ($ctx, $other_realms_stanza) = @_;
82 unless (open(KRB5CONF, ">$ctx->{krb5_conf}")) {
83 warn("can't open $ctx->{krb5_conf}$?");
84 return undef;
87 my $our_realms_stanza = mk_realms_stanza($ctx->{realm},
88 $ctx->{dnsname},
89 $ctx->{domain},
90 $ctx->{kdc_ipv4});
91 print KRB5CONF "
92 #Generated krb5.conf for $ctx->{realm}
94 [libdefaults]
95 default_realm = $ctx->{realm}
96 dns_lookup_realm = false
97 dns_lookup_kdc = false
98 ticket_lifetime = 24h
99 forwardable = yes
100 allow_weak_crypto = yes
102 [realms]
103 $our_realms_stanza
104 $other_realms_stanza
108 if (defined($ctx->{tlsdir})) {
109 print KRB5CONF "
111 [appdefaults]
112 pkinit_anchors = FILE:$ctx->{tlsdir}/ca.pem
114 [kdc]
115 enable-pkinit = true
116 pkinit_identity = FILE:$ctx->{tlsdir}/kdc.pem,$ctx->{tlsdir}/key.pem
117 pkinit_anchors = FILE:$ctx->{tlsdir}/ca.pem
121 close(KRB5CONF);
124 sub mk_realms_stanza($$$$)
126 my ($realm, $dnsname, $domain, $kdc_ipv4) = @_;
128 my $realms_stanza = "
129 $realm = {
130 kdc = $kdc_ipv4:88
131 admin_server = $kdc_ipv4:88
132 default_domain = $dnsname
134 $dnsname = {
135 kdc = $kdc_ipv4:88
136 admin_server = $kdc_ipv4:88
137 default_domain = $dnsname
139 $domain = {
140 kdc = $kdc_ipv4:88
141 admin_server = $kdc_ipv4:88
142 default_domain = $dnsname
146 return $realms_stanza;
149 sub get_interface($)
151 my ($netbiosname) = @_;
152 $netbiosname = lc($netbiosname);
154 my %interfaces = ();
155 $interfaces{"locals3dc2"} = 3;
156 $interfaces{"localmember3"} = 4;
157 $interfaces{"localshare4"} = 5;
159 $interfaces{"localktest6"} = 7;
160 $interfaces{"maptoguest"} = 8;
162 # 11-16 used by selftest.pl for client interfaces
164 $interfaces{"localdc"} = 21;
165 $interfaces{"localvampiredc"} = 22;
166 $interfaces{"s4member"} = 23;
167 $interfaces{"localrpcproxy"} = 24;
168 $interfaces{"dc5"} = 25;
169 $interfaces{"dc6"} = 26;
170 $interfaces{"dc7"} = 27;
171 $interfaces{"rodc"} = 28;
172 $interfaces{"localadmember"} = 29;
173 $interfaces{"plugindc"} = 30;
174 $interfaces{"localsubdc"} = 31;
175 $interfaces{"chgdcpass"} = 32;
176 $interfaces{"promotedvdc"} = 33;
177 $interfaces{"rfc2307member"} = 34;
179 # update lib/socket_wrapper/socket_wrapper.c
180 # #define MAX_WRAPPED_INTERFACES 32
181 # if you wish to have more than 32 interfaces
183 if (not defined($interfaces{$netbiosname})) {
184 die();
187 return $interfaces{$netbiosname};
190 sub cleanup_child($$)
192 my ($pid, $name) = @_;
193 my $childpid = waitpid($pid, WNOHANG);
194 if ($childpid == 0) {
195 } elsif ($childpid < 0) {
196 printf STDERR "%s child process %d isn't here any more\n",
197 return $childpid;
199 elsif ($? & 127) {
200 printf STDERR "%s child process %d, died with signal %d, %s coredump\n",
201 $name, $childpid, ($? & 127), ($? & 128) ? 'with' : 'without';
202 } else {
203 printf STDERR "%s child process %d exited with value %d\n", $name, $childpid, $? >> 8;
205 return $childpid;