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 use POSIX;
  12 use Cwd qw(abs_path);
  13
  14 sub new($$$$$) {
  15         my ($classname, $bindir, $ldap, $srcdir, $server_maxtime) = @_;
  16
  17         my $self = {
  18             samba3 => new Samba3($bindir, $srcdir, $server_maxtime),
  19             samba4 => new Samba4($bindir, $ldap, $srcdir, $server_maxtime),
  20         };
  21         bless $self;
  22         return $self;
  23 }
  24
  25 %Samba::ENV_DEPS = (%Samba3::ENV_DEPS, %Samba4::ENV_DEPS);
  26 our %ENV_DEPS;
  27
  28 %Samba::ENV_TARGETS = (
  29         (map { $_ => "Samba3" } keys %Samba3::ENV_DEPS),
  30         (map { $_ => "Samba4" } keys %Samba4::ENV_DEPS),
  31 );
  32 our %ENV_TARGETS;
  33
  34 %Samba::ENV_NEEDS_AD_DC = (
  35         (map { $_ => 1 } keys %Samba4::ENV_DEPS)
  36 );
  37 our %ENV_NEEDS_AD_DC;
  38 foreach my $env (keys %Samba3::ENV_DEPS) {
  39     $ENV_NEEDS_AD_DC{$env} = ($env =~ /^ad_/);
  40 }
  41
  42 sub setup_env($$$)
  43 {
  44         my ($self, $envname, $path) = @_;
  45
  46         my $targetname = $ENV_TARGETS{$envname};
  47         if (not defined($targetname)) {
  48                 warn("Samba can't provide environment '$envname'");
  49                 return "UNKNOWN";
  50         }
  51
  52         my %targetlookup = (
  53                 "Samba3" => $self->{samba3},
  54                 "Samba4" => $self->{samba4}
  55         );
  56         my $target = $targetlookup{$targetname};
  57
  58         if (defined($target->{vars}->{$envname})) {
  59                 return $target->{vars}->{$envname};
  60         }
  61
  62         my @dep_vars;
  63         foreach(@{$ENV_DEPS{$envname}}) {
  64                 my $vars = $self->setup_env($_, $path);
  65                 if (defined($vars)) {
  66                         push(@dep_vars, $vars);
  67                 } else {
  68                         warn("Failed setting up $_ as a dependency of $envname");
  69                         return undef;
  70                 }
  71         }
  72
  73         $ENV{ENVNAME} = $envname;
  74         # Avoid hitting system krb5.conf -
  75         # An env that needs Kerberos will reset this to the real value.
  76         $ENV{KRB5_CONFIG} = "$path/no_krb5.conf";
  77
  78         my $setup_name = $ENV_TARGETS{$envname}."::setup_".$envname;
  79         my $setup_sub = \&$setup_name;
  80         my $env = &$setup_sub($target, "$path/$envname", @dep_vars);
  81
  82         if (not defined($env)) {
  83                 warn("failed to start up environment '$envname'");
  84                 return undef;
  85         }
  86
  87         $target->{vars}->{$envname} = $env;
  88         $target->{vars}->{$envname}->{target} = $target;
  89
  90         return $env;
  91 }
  92
  93 sub bindir_path($$) {
  94         my ($object, $path) = @_;
  95
  96         my $valpath = "$object->{bindir}/$path";
  97
  98         return $valpath if (-f $valpath or -d $valpath);
  99         return $path;
 100 }
 101
 102 sub nss_wrapper_winbind_so_path($) {
 103         my ($object) = @_;
 104         my $ret = $ENV{NSS_WRAPPER_WINBIND_SO_PATH};
 105         if (not defined($ret)) {
 106             $ret = bindir_path($object, "shared/libnss_wrapper_winbind.so.2");
 107             $ret = abs_path($ret);
 108         }
 109         return $ret;
 110 }
 111
 112 sub copy_file_content($$)
 113 {
 114         my ($in, $out) = @_;
 115         open(IN, "${in}") or die("failed to open in[${in}] for reading: $!");
 116         open(OUT, ">${out}") or die("failed to open out[${out}] for writing: $!");
 117         while(<IN>) {
 118                 print OUT $_;
 119         }
 120         close(OUT);
 121         close(IN);
 122 }
 123
 124 sub prepare_keyblobs($)
 125 {
 126         my ($ctx) = @_;
 127
 128         my $cadir = "$ENV{SRCDIR_ABS}/selftest/manage-ca/CA-samba.example.com";
 129         my $cacert = "$cadir/Public/CA-samba.example.com-cert.pem";
 130         my $cacrl_pem = "$cadir/Public/CA-samba.example.com-crl.pem";
 131         my $dcdnsname = "$ctx->{hostname}.$ctx->{dnsname}";
 132         my $dcdir = "$cadir/DCs/$dcdnsname";
 133         my $dccert = "$dcdir/DC-$dcdnsname-cert.pem";
 134         my $dckey_private = "$dcdir/DC-$dcdnsname-private-key.pem";
 135         my $adminprincipalname = "administrator\@$ctx->{dnsname}";
 136         my $admindir = "$cadir/Users/$adminprincipalname";
 137         my $admincert = "$admindir/USER-$adminprincipalname-cert.pem";
 138         my $adminkey_private = "$admindir/USER-$adminprincipalname-private-key.pem";
 139         my $pkinitprincipalname = "pkinit\@$ctx->{dnsname}";
 140         my $pkinitdir = "$cadir/Users/$pkinitprincipalname";
 141         my $pkinitcert = "$pkinitdir/USER-$pkinitprincipalname-cert.pem";
 142         my $pkinitkey_private = "$pkinitdir/USER-$pkinitprincipalname-private-key.pem";
 143
 144         my $tlsdir = "$ctx->{tlsdir}";
 145         my $pkinitdir = "$ctx->{prefix_abs}/pkinit";
 146         #TLS and PKINIT crypto blobs
 147         my $dhfile = "$tlsdir/dhparms.pem";
 148         my $cafile = "$tlsdir/ca.pem";
 149         my $crlfile = "$tlsdir/crl.pem";
 150         my $certfile = "$tlsdir/cert.pem";
 151         my $keyfile = "$tlsdir/key.pem";
 152         my $admincertfile = "$pkinitdir/USER-$adminprincipalname-cert.pem";
 153         my $adminkeyfile = "$pkinitdir/USER-$adminprincipalname-private-key.pem";
 154         my $pkinitcertfile = "$pkinitdir/USER-$pkinitprincipalname-cert.pem";
 155         my $pkinitkeyfile = "$pkinitdir/USER-$pkinitprincipalname-private-key.pem";
 156
 157         mkdir($tlsdir, 0700);
 158         mkdir($pkinitdir, 0700);
 159         my $oldumask = umask;
 160         umask 0077;
 161
 162         # This is specified here to avoid draining entropy on every run
 163         # generate by
 164         # openssl dhparam -out dhparms.pem -text -2 8192
 165         open(DHFILE, ">$dhfile");
 166         print DHFILE <<EOF;
 167 -----BEGIN DH PARAMETERS-----
 168 MIIECAKCBAEAlcpjuJptCzC2bIIApLuyFLw2nODQUztqs/peysY9e3LgWh/xrc87
 169 SWJNSUrqFJFh2m357WH0XGcTdTk0b/8aIYIWjbwEhWR/5hZ+1x2TDrX1awkYayAe
 170 pr0arycmWHaAmhw+m+dBdj2O2jRMe7gn0ha85JALNl+Z3wv2q2eys8TIiQ2dbHPx
 171 XvpMmlAv7QHZnpSpX/XgueQr6T3EYggljppZwk1fe4W2cxBjCv9w/Q83pJXMEVVB
 172 WESEQPZC38v6hVIXIlF4J7jXjV3+NtCLL4nvsy0jrLEntyKz5OB8sNPRzJr0Ju2Y
 173 yXORCSMMXMygP+dxJtQ6txzQYWyaCYN1HqHDZy3cFL9Qy8kTFqIcW56Lti2GsW/p
 174 jSMzEOa1NevhKNFL3dSZJx5m+5ZeMvWXlCqXSptmVdbs5wz5jkMUm/E6pVfM5lyb
 175 Ttlcq2iYPqnJz1jcL5xwhoufID8zSJCPJ7C0jb0Ngy5wLIUZfjXJUXxUyxTnNR9i
 176 N9Sc+UkDvLxnCW+qzjyPXGlQU1SsJwMLWa2ZecL/uYE4bOdcN3g+5WHkevyDnXqR
 177 +yy9x7sGXjBT3bRWK5tVHJWOi6eBu1hp39U6aK8oOJWiUt3vmC2qEdIsT6JaLNNi
 178 YKrSfRGBf19IJBaagen1S19bb3dnmwoU1RaWM0EeJQW1oXOBg7zLisB2yuu5azBn
 179 tse00+0nc+GbH2y+jP0sE7xil1QeilZl+aQ3tX9vL0cnCa+8602kXxU7P5HaX2+d
 180 05pvoHmeZbDV85io36oF976gBYeYN+qAkTUMsIZhuLQDuyn0963XOLyn1Pm6SBrU
 181 OkIZXW7WoKEuO/YSfizUIqXwmAMJjnEMJCWG51MZZKx//9Hsdp1RXSm/bRSbvXB7
 182 MscjvQYWmfCFnIk8LYnEt3Yey40srEiS9xyZqdrvobxz+sU1XcqR38kpVf4gKASL
 183 xURia64s4emuJF+YHIObyydazQ+6/wX/C+m+nyfhuxSO6j1janPwtYbU+Uj3TzeM
 184 04K1mpPQpZcaMdZZiNiu7i8VJlOPKAz7aJT8TnMMF5GMyzyLpSMpc+NF9L/BSocV
 185 /cUM4wQT2PTHrcyYzmTVH7c9bzBkuxqrwVB1BY1jitDV9LIYIVBglKcX88qrfHIM
 186 XiXPAIwGclD59qm2cG8OdM9NA5pNMI119KuUAIJsUdgPbR1LkT2XTT15YVoHmFSQ
 187 DlaWOXn4td031jr0EisX8QtFR7+/0Nfoni6ydFGs5fNH/L1ckq6FEO4OhgucJw9H
 188 YRmiFlsQBQNny78vNchwZne3ZixkShtGW0hWDdi2n+h7St1peNJCNJjMbEhRsPRx
 189 RmNGWh4AL8rho4RO9OBao0MnUdjbbffD+wIBAg==
 190 -----END DH PARAMETERS-----
 191 EOF
 192         close(DHFILE);
 193
 194         if (! -e ${dckey_private}) {
 195                 umask $oldumask;
 196                 return;
 197         }
 198
 199         copy_file_content(${cacert}, ${cafile});
 200         copy_file_content(${cacrl_pem}, ${crlfile});
 201         copy_file_content(${dccert}, ${certfile});
 202         copy_file_content(${dckey_private}, ${keyfile});
 203         if (-e ${adminkey_private}) {
 204                 copy_file_content(${admincert}, ${admincertfile});
 205                 copy_file_content(${adminkey_private}, ${adminkeyfile});
 206         }
 207         if (-e ${pkinitkey_private}) {
 208                 copy_file_content(${pkinitcert}, ${pkinitcertfile});
 209                 copy_file_content(${pkinitkey_private}, ${pkinitkeyfile});
 210         }
 211
 212         # COMPAT stuff to be removed in a later commit
 213         my $kdccertfile = "$tlsdir/kdc.pem";
 214         copy_file_content(${dccert}, ${kdccertfile});
 215
 216         umask $oldumask;
 217 }
 218
 219 sub mk_krb5_conf($$)
 220 {
 221         my ($ctx) = @_;
 222
 223         unless (open(KRB5CONF, ">$ctx->{krb5_conf}")) {
 224                 warn("can't open $ctx->{krb5_conf}$?");
 225                 return undef;
 226         }
 227
 228         my $our_realms_stanza = mk_realms_stanza($ctx->{realm},
 229                                                  $ctx->{dnsname},
 230                                                  $ctx->{domain},
 231                                                  $ctx->{kdc_ipv4});
 232         print KRB5CONF "
 233 #Generated krb5.conf for $ctx->{realm}
 234
 235 [libdefaults]
 236  default_realm = $ctx->{realm}
 237  dns_lookup_realm = false
 238  dns_lookup_kdc = true
 239  ticket_lifetime = 24h
 240  forwardable = yes
 241  allow_weak_crypto = yes
 242  # Set the grace clocskew to 5 seconds
 243  # This is especially required by samba3.raw.session krb5 and
 244  # reauth tests
 245  clockskew = 5
 246  # We are running on the same machine, do not correct
 247  # system clock differences
 248  kdc_timesync = 0
 249
 250 ";
 251
 252         if (defined($ctx->{krb5_ccname})) {
 253                 print KRB5CONF "
 254  default_ccache_name = $ctx->{krb5_ccname}
 255 ";
 256         }
 257
 258
 259         if (defined($ctx->{supported_enctypes})) {
 260                 print KRB5CONF "
 261  default_etypes = $ctx->{supported_enctypes}
 262  default_as_etypes = $ctx->{supported_enctypes}
 263  default_tgs_enctypes = $ctx->{supported_enctypes}
 264  default_tkt_enctypes = $ctx->{supported_enctypes}
 265  permitted_enctypes = $ctx->{supported_enctypes}
 266 ";
 267         }
 268
 269         print KRB5CONF "
 270 [realms]
 271  $our_realms_stanza
 272 ";
 273
 274
 275         if (defined($ctx->{tlsdir})) {
 276                print KRB5CONF "
 277
 278 [appdefaults]
 279         pkinit_anchors = FILE:$ctx->{tlsdir}/ca.pem
 280
 281 [kdc]
 282         enable-pkinit = true
 283         pkinit_identity = FILE:$ctx->{tlsdir}/kdc.pem,$ctx->{tlsdir}/key.pem
 284         pkinit_anchors = FILE:$ctx->{tlsdir}/ca.pem
 285
 286 ";
 287         }
 288         close(KRB5CONF);
 289 }
 290
 291 sub mk_realms_stanza($$$$)
 292 {
 293         my ($realm, $dnsname, $domain, $kdc_ipv4) = @_;
 294         my $lc_domain = lc($domain);
 295
 296         my $realms_stanza = "
 297  $realm = {
 298   kdc = $kdc_ipv4:88
 299   admin_server = $kdc_ipv4:88
 300   default_domain = $dnsname
 301  }
 302  $dnsname = {
 303   kdc = $kdc_ipv4:88
 304   admin_server = $kdc_ipv4:88
 305   default_domain = $dnsname
 306  }
 307  $domain = {
 308   kdc = $kdc_ipv4:88
 309   admin_server = $kdc_ipv4:88
 310   default_domain = $dnsname
 311  }
 312  $lc_domain = {
 313   kdc = $kdc_ipv4:88
 314   admin_server = $kdc_ipv4:88
 315   default_domain = $dnsname
 316  }
 317
 318 ";
 319         return $realms_stanza;
 320 }
 321
 322 sub mk_mitkdc_conf($$)
 323 {
 324         # samba_kdb_dir is the path to mit_samba.so
 325         my ($ctx, $samba_kdb_dir) = @_;
 326
 327         unless (open(KDCCONF, ">$ctx->{mitkdc_conf}")) {
 328                 warn("can't open $ctx->{mitkdc_conf}$?");
 329                 return undef;
 330         }
 331
 332         print KDCCONF "
 333 # Generated kdc.conf for $ctx->{realm}
 334
 335 [kdcdefaults]
 336         kdc_ports = 88
 337         kdc_tcp_ports = 88
 338
 339 [realms]
 340         $ctx->{realm} = {
 341         }
 342
 343         $ctx->{dnsname} = {
 344         }
 345
 346         $ctx->{domain} = {
 347         }
 348
 349 [dbmodules]
 350         db_module_dir = $samba_kdb_dir
 351
 352         $ctx->{realm} = {
 353                 db_library = samba
 354         }
 355
 356         $ctx->{dnsname} = {
 357                 db_library = samba
 358         }
 359
 360         $ctx->{domain} = {
 361                 db_library = samba
 362         }
 363
 364 [logging]
 365         kdc = FILE:$ctx->{logdir}/mit_kdc.log
 366 ";
 367
 368         close(KDCCONF);
 369 }
 370
 371 sub get_interface($)
 372 {
 373     my ($netbiosname) = @_;
 374     $netbiosname = lc($netbiosname);
 375
 376     my %interfaces = ();
 377     $interfaces{"localnt4dc2"} = 3;
 378     $interfaces{"localnt4member3"} = 4;
 379     $interfaces{"localshare4"} = 5;
 380
 381     $interfaces{"localktest6"} = 7;
 382     $interfaces{"maptoguest"} = 8;
 383     $interfaces{"localnt4dc9"} = 9;
 384
 385     # 11-16 used by selftest.pl for client interfaces
 386
 387     $interfaces{"addc_no_nss"} = 17;
 388     $interfaces{"addc_no_ntlm"} = 18;
 389     $interfaces{"idmapadmember"} = 19;
 390     $interfaces{"idmapridmember"} = 20;
 391     $interfaces{"localdc"} = 21;
 392     $interfaces{"localvampiredc"} = 22;
 393     $interfaces{"s4member"} = 23;
 394     $interfaces{"localrpcproxy"} = 24;
 395     $interfaces{"dc5"} = 25;
 396     $interfaces{"dc6"} = 26;
 397     $interfaces{"dc7"} = 27;
 398     $interfaces{"rodc"} = 28;
 399     $interfaces{"localadmember"} = 29;
 400     $interfaces{"addc"} = 30;
 401     $interfaces{"localsubdc"} = 31;
 402     $interfaces{"chgdcpass"} = 32;
 403     $interfaces{"promotedvdc"} = 33;
 404     $interfaces{"rfc2307member"} = 34;
 405     $interfaces{"fileserver"} = 35;
 406     $interfaces{"fakednsforwarder1"} = 36;
 407     $interfaces{"fakednsforwarder2"} = 37;
 408     $interfaces{"s4member_dflt"} = 38;
 409     $interfaces{"vampire2000dc"} = 39;
 410
 411     # update lib/socket_wrapper/socket_wrapper.c
 412     #  #define MAX_WRAPPED_INTERFACES 40
 413     # if you wish to have more than 40 interfaces
 414
 415     if (not defined($interfaces{$netbiosname})) {
 416         die();
 417     }
 418
 419     return $interfaces{$netbiosname};
 420 }
 421
 422 sub cleanup_child($$)
 423 {
 424     my ($pid, $name) = @_;
 425
 426     if (!defined($pid)) {
 427         print STDERR "cleanup_child: pid not defined ... not calling waitpid\n";
 428         return -1;
 429     }
 430
 431     my $childpid = waitpid($pid, WNOHANG);
 432
 433     if ($childpid == 0) {
 434     } elsif ($childpid < 0) {
 435         printf STDERR "%s child process %d isn't here any more\n", $name, $pid;
 436         return $childpid;
 437     } elsif ($? & 127) {
 438         printf STDERR "%s child process %d, died with signal %d, %s coredump\n",
 439                 $name, $childpid, ($? & 127),  ($? & 128) ? 'with' : 'without';
 440     } else {
 441         printf STDERR "%s child process %d exited with value %d\n", $name, $childpid, $? >> 8;
 442     }
 443     return $childpid;
 444 }
 445
 446 1;