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         my $python_cmd = "";
  98         my $result = $path;
  99         if (defined $ENV{'PYTHON'}) {
 100                 $python_cmd = $ENV{'PYTHON'} . " ";
 101         }
 102
 103         if (-f $valpath or -d $valpath) {
 104                 $result = $valpath;
 105         }
 106         # make sure we prepend samba-tool with calling $PYTHON python version
 107         if ($path eq "samba-tool") {
 108                 $result = $python_cmd . $result;
 109         }
 110         return $result;
 111 }
 112
 113 sub nss_wrapper_winbind_so_path($) {
 114         my ($object) = @_;
 115         my $ret = $ENV{NSS_WRAPPER_WINBIND_SO_PATH};
 116         if (not defined($ret)) {
 117             $ret = bindir_path($object, "shared/libnss_wrapper_winbind.so.2");
 118             $ret = abs_path($ret);
 119         }
 120         return $ret;
 121 }
 122
 123 sub copy_file_content($$)
 124 {
 125         my ($in, $out) = @_;
 126         open(IN, "${in}") or die("failed to open in[${in}] for reading: $!");
 127         open(OUT, ">${out}") or die("failed to open out[${out}] for writing: $!");
 128         while(<IN>) {
 129                 print OUT $_;
 130         }
 131         close(OUT);
 132         close(IN);
 133 }
 134
 135 sub prepare_keyblobs($)
 136 {
 137         my ($ctx) = @_;
 138
 139         my $cadir = "$ENV{SRCDIR_ABS}/selftest/manage-ca/CA-samba.example.com";
 140         my $cacert = "$cadir/Public/CA-samba.example.com-cert.pem";
 141         my $cacrl_pem = "$cadir/Public/CA-samba.example.com-crl.pem";
 142         my $dcdnsname = "$ctx->{hostname}.$ctx->{dnsname}";
 143         my $dcdir = "$cadir/DCs/$dcdnsname";
 144         my $dccert = "$dcdir/DC-$dcdnsname-cert.pem";
 145         my $dckey_private = "$dcdir/DC-$dcdnsname-private-key.pem";
 146         my $adminprincipalname = "administrator\@$ctx->{dnsname}";
 147         my $admindir = "$cadir/Users/$adminprincipalname";
 148         my $admincert = "$admindir/USER-$adminprincipalname-cert.pem";
 149         my $adminkey_private = "$admindir/USER-$adminprincipalname-private-key.pem";
 150         my $pkinitprincipalname = "pkinit\@$ctx->{dnsname}";
 151         my $pkinitdir = "$cadir/Users/$pkinitprincipalname";
 152         my $pkinitcert = "$pkinitdir/USER-$pkinitprincipalname-cert.pem";
 153         my $pkinitkey_private = "$pkinitdir/USER-$pkinitprincipalname-private-key.pem";
 154
 155         my $tlsdir = "$ctx->{tlsdir}";
 156         my $pkinitdir = "$ctx->{prefix_abs}/pkinit";
 157         #TLS and PKINIT crypto blobs
 158         my $dhfile = "$tlsdir/dhparms.pem";
 159         my $cafile = "$tlsdir/ca.pem";
 160         my $crlfile = "$tlsdir/crl.pem";
 161         my $certfile = "$tlsdir/cert.pem";
 162         my $keyfile = "$tlsdir/key.pem";
 163         my $admincertfile = "$pkinitdir/USER-$adminprincipalname-cert.pem";
 164         my $adminkeyfile = "$pkinitdir/USER-$adminprincipalname-private-key.pem";
 165         my $pkinitcertfile = "$pkinitdir/USER-$pkinitprincipalname-cert.pem";
 166         my $pkinitkeyfile = "$pkinitdir/USER-$pkinitprincipalname-private-key.pem";
 167
 168         mkdir($tlsdir, 0700);
 169         mkdir($pkinitdir, 0700);
 170         my $oldumask = umask;
 171         umask 0077;
 172
 173         # This is specified here to avoid draining entropy on every run
 174         # generate by
 175         # openssl dhparam -out dhparms.pem -text -2 8192
 176         open(DHFILE, ">$dhfile");
 177         print DHFILE <<EOF;
 178 -----BEGIN DH PARAMETERS-----
 179 MIIECAKCBAEAlcpjuJptCzC2bIIApLuyFLw2nODQUztqs/peysY9e3LgWh/xrc87
 180 SWJNSUrqFJFh2m357WH0XGcTdTk0b/8aIYIWjbwEhWR/5hZ+1x2TDrX1awkYayAe
 181 pr0arycmWHaAmhw+m+dBdj2O2jRMe7gn0ha85JALNl+Z3wv2q2eys8TIiQ2dbHPx
 182 XvpMmlAv7QHZnpSpX/XgueQr6T3EYggljppZwk1fe4W2cxBjCv9w/Q83pJXMEVVB
 183 WESEQPZC38v6hVIXIlF4J7jXjV3+NtCLL4nvsy0jrLEntyKz5OB8sNPRzJr0Ju2Y
 184 yXORCSMMXMygP+dxJtQ6txzQYWyaCYN1HqHDZy3cFL9Qy8kTFqIcW56Lti2GsW/p
 185 jSMzEOa1NevhKNFL3dSZJx5m+5ZeMvWXlCqXSptmVdbs5wz5jkMUm/E6pVfM5lyb
 186 Ttlcq2iYPqnJz1jcL5xwhoufID8zSJCPJ7C0jb0Ngy5wLIUZfjXJUXxUyxTnNR9i
 187 N9Sc+UkDvLxnCW+qzjyPXGlQU1SsJwMLWa2ZecL/uYE4bOdcN3g+5WHkevyDnXqR
 188 +yy9x7sGXjBT3bRWK5tVHJWOi6eBu1hp39U6aK8oOJWiUt3vmC2qEdIsT6JaLNNi
 189 YKrSfRGBf19IJBaagen1S19bb3dnmwoU1RaWM0EeJQW1oXOBg7zLisB2yuu5azBn
 190 tse00+0nc+GbH2y+jP0sE7xil1QeilZl+aQ3tX9vL0cnCa+8602kXxU7P5HaX2+d
 191 05pvoHmeZbDV85io36oF976gBYeYN+qAkTUMsIZhuLQDuyn0963XOLyn1Pm6SBrU
 192 OkIZXW7WoKEuO/YSfizUIqXwmAMJjnEMJCWG51MZZKx//9Hsdp1RXSm/bRSbvXB7
 193 MscjvQYWmfCFnIk8LYnEt3Yey40srEiS9xyZqdrvobxz+sU1XcqR38kpVf4gKASL
 194 xURia64s4emuJF+YHIObyydazQ+6/wX/C+m+nyfhuxSO6j1janPwtYbU+Uj3TzeM
 195 04K1mpPQpZcaMdZZiNiu7i8VJlOPKAz7aJT8TnMMF5GMyzyLpSMpc+NF9L/BSocV
 196 /cUM4wQT2PTHrcyYzmTVH7c9bzBkuxqrwVB1BY1jitDV9LIYIVBglKcX88qrfHIM
 197 XiXPAIwGclD59qm2cG8OdM9NA5pNMI119KuUAIJsUdgPbR1LkT2XTT15YVoHmFSQ
 198 DlaWOXn4td031jr0EisX8QtFR7+/0Nfoni6ydFGs5fNH/L1ckq6FEO4OhgucJw9H
 199 YRmiFlsQBQNny78vNchwZne3ZixkShtGW0hWDdi2n+h7St1peNJCNJjMbEhRsPRx
 200 RmNGWh4AL8rho4RO9OBao0MnUdjbbffD+wIBAg==
 201 -----END DH PARAMETERS-----
 202 EOF
 203         close(DHFILE);
 204
 205         if (! -e ${dckey_private}) {
 206                 umask $oldumask;
 207                 return;
 208         }
 209
 210         copy_file_content(${cacert}, ${cafile});
 211         copy_file_content(${cacrl_pem}, ${crlfile});
 212         copy_file_content(${dccert}, ${certfile});
 213         copy_file_content(${dckey_private}, ${keyfile});
 214         if (-e ${adminkey_private}) {
 215                 copy_file_content(${admincert}, ${admincertfile});
 216                 copy_file_content(${adminkey_private}, ${adminkeyfile});
 217         }
 218         if (-e ${pkinitkey_private}) {
 219                 copy_file_content(${pkinitcert}, ${pkinitcertfile});
 220                 copy_file_content(${pkinitkey_private}, ${pkinitkeyfile});
 221         }
 222
 223         # COMPAT stuff to be removed in a later commit
 224         my $kdccertfile = "$tlsdir/kdc.pem";
 225         copy_file_content(${dccert}, ${kdccertfile});
 226
 227         umask $oldumask;
 228 }
 229
 230 sub mk_krb5_conf($$)
 231 {
 232         my ($ctx) = @_;
 233
 234         unless (open(KRB5CONF, ">$ctx->{krb5_conf}")) {
 235                 warn("can't open $ctx->{krb5_conf}$?");
 236                 return undef;
 237         }
 238
 239         my $our_realms_stanza = mk_realms_stanza($ctx->{realm},
 240                                                  $ctx->{dnsname},
 241                                                  $ctx->{domain},
 242                                                  $ctx->{kdc_ipv4});
 243         print KRB5CONF "
 244 #Generated krb5.conf for $ctx->{realm}
 245
 246 [libdefaults]
 247  default_realm = $ctx->{realm}
 248  dns_lookup_realm = false
 249  dns_lookup_kdc = true
 250  ticket_lifetime = 24h
 251  forwardable = yes
 252  allow_weak_crypto = yes
 253
 254  # We are running on the same machine, do not correct
 255  # system clock differences
 256  kdc_timesync = 0
 257
 258 ";
 259
 260         if (defined($ENV{MITKRB5})) {
 261                 print KRB5CONF "
 262  # Set the grace clocskew to 5 seconds
 263  # This is especially required by samba3.raw.session krb5 and
 264  # reauth tests when not using Heimdal
 265  clockskew = 5
 266     ";
 267         }
 268
 269         if (defined($ctx->{krb5_ccname})) {
 270                 print KRB5CONF "
 271  default_ccache_name = $ctx->{krb5_ccname}
 272 ";
 273         }
 274
 275
 276         if (defined($ctx->{supported_enctypes})) {
 277                 print KRB5CONF "
 278  default_etypes = $ctx->{supported_enctypes}
 279  default_as_etypes = $ctx->{supported_enctypes}
 280  default_tgs_enctypes = $ctx->{supported_enctypes}
 281  default_tkt_enctypes = $ctx->{supported_enctypes}
 282  permitted_enctypes = $ctx->{supported_enctypes}
 283 ";
 284         }
 285
 286         print KRB5CONF "
 287 [realms]
 288  $our_realms_stanza
 289 ";
 290
 291
 292         if (defined($ctx->{tlsdir})) {
 293                print KRB5CONF "
 294
 295 [appdefaults]
 296         pkinit_anchors = FILE:$ctx->{tlsdir}/ca.pem
 297
 298 [kdc]
 299         enable-pkinit = true
 300         pkinit_identity = FILE:$ctx->{tlsdir}/kdc.pem,$ctx->{tlsdir}/key.pem
 301         pkinit_anchors = FILE:$ctx->{tlsdir}/ca.pem
 302
 303 ";
 304         }
 305         close(KRB5CONF);
 306 }
 307
 308 sub mk_realms_stanza($$$$)
 309 {
 310         my ($realm, $dnsname, $domain, $kdc_ipv4) = @_;
 311         my $lc_domain = lc($domain);
 312
 313         my $realms_stanza = "
 314  $realm = {
 315   kdc = $kdc_ipv4:88
 316   admin_server = $kdc_ipv4:88
 317   default_domain = $dnsname
 318  }
 319  $dnsname = {
 320   kdc = $kdc_ipv4:88
 321   admin_server = $kdc_ipv4:88
 322   default_domain = $dnsname
 323  }
 324  $domain = {
 325   kdc = $kdc_ipv4:88
 326   admin_server = $kdc_ipv4:88
 327   default_domain = $dnsname
 328  }
 329  $lc_domain = {
 330   kdc = $kdc_ipv4:88
 331   admin_server = $kdc_ipv4:88
 332   default_domain = $dnsname
 333  }
 334
 335 ";
 336         return $realms_stanza;
 337 }
 338
 339 sub mk_mitkdc_conf($$)
 340 {
 341         # samba_kdb_dir is the path to mit_samba.so
 342         my ($ctx, $samba_kdb_dir) = @_;
 343
 344         unless (open(KDCCONF, ">$ctx->{mitkdc_conf}")) {
 345                 warn("can't open $ctx->{mitkdc_conf}$?");
 346                 return undef;
 347         }
 348
 349         print KDCCONF "
 350 # Generated kdc.conf for $ctx->{realm}
 351
 352 [kdcdefaults]
 353         kdc_ports = 88
 354         kdc_tcp_ports = 88
 355
 356 [realms]
 357         $ctx->{realm} = {
 358         }
 359
 360         $ctx->{dnsname} = {
 361         }
 362
 363         $ctx->{domain} = {
 364         }
 365
 366 [dbmodules]
 367         db_module_dir = $samba_kdb_dir
 368
 369         $ctx->{realm} = {
 370                 db_library = samba
 371         }
 372
 373         $ctx->{dnsname} = {
 374                 db_library = samba
 375         }
 376
 377         $ctx->{domain} = {
 378                 db_library = samba
 379         }
 380
 381 [logging]
 382         kdc = FILE:$ctx->{logdir}/mit_kdc.log
 383 ";
 384
 385         close(KDCCONF);
 386 }
 387
 388 sub realm_to_ip_mappings
 389 {
 390         # this maps the DNS realms for the various testenvs to the corresponding
 391         # PDC (i.e. the first DC created for that realm).
 392         my %realm_to_pdc_mapping = (
 393                 'adnonssdom.samba.example.com'    => 'addc_no_nss',
 394                 'adnontlmdom.samba.example.com'   => 'addc_no_ntlm',
 395                 'samba2000.example.com'           => 'dc5',
 396                 'samba2003.example.com'           => 'dc6',
 397                 'samba2008r2.example.com'         => 'dc7',
 398                 'addom.samba.example.com'         => 'addc',
 399                 'sub.samba.example.com'           => 'localsubdc',
 400                 'chgdcpassword.samba.example.com' => 'chgdcpass',
 401                 'backupdom.samba.example.com'     => 'backupfromdc',
 402                 'renamedom.samba.example.com'     => 'renamedc',
 403                 'labdom.samba.example.com'        => 'labdc',
 404                 'samba.example.com'               => 'localdc',
 405         );
 406
 407         my @mapping = ();
 408
 409         # convert the hashmap to a list of key=value strings, where key is the
 410         # realm and value is the IP address
 411         while (my ($realm, $pdc) = each(%realm_to_pdc_mapping)) {
 412                 my $ipaddr = get_ipv4_addr($pdc);
 413                 push(@mapping, "$realm=$ipaddr");
 414         }
 415         # return the mapping as a single comma-separated string
 416         return join(',', @mapping);
 417 }
 418
 419 sub get_interface($)
 420 {
 421         my ($netbiosname) = @_;
 422         $netbiosname = lc($netbiosname);
 423
 424         # this maps the SOCKET_WRAPPER_DEFAULT_IFACE value for each possible
 425         # testenv to the DC's NETBIOS name. This value also corresponds to last
 426         # digit of the DC's IP address. Note that the NETBIOS name may differ from
 427         # the testenv name.
 428         # Note that when adding a DC with a new realm, also update
 429         # get_realm_ip_mappings() above.
 430         my %testenv_iface_mapping = (
 431                 localnt4dc2       => 3,
 432                 localnt4member3   => 4,
 433                 localshare4       => 5,
 434                 # 6 is spare
 435                 localktest6       => 7,
 436                 maptoguest        => 8,
 437                 localnt4dc9       => 9,
 438                 # 10 is spare
 439
 440                 # 11 is used by selftest.pl for the client interface
 441                 client            => 11,
 442
 443                 # 12-16 have been historically reserved for the client, although
 444                 # aren't actually used
 445
 446                 addc_no_nss       => 17,
 447                 addc_no_ntlm      => 18,
 448                 idmapadmember     => 19,
 449                 idmapridmember    => 20,
 450                 localdc           => 21,
 451                 localvampiredc    => 22,
 452                 s4member          => 23,
 453                 localrpcproxy     => 24,
 454                 dc5               => 25,
 455                 dc6               => 26,
 456                 dc7               => 27,
 457                 rodc              => 28,
 458                 localadmember     => 29,
 459                 addc              => 30,
 460                 localsubdc        => 31,
 461                 chgdcpass         => 32,
 462                 promotedvdc       => 33,
 463                 rfc2307member     => 34,
 464                 fileserver        => 35,
 465                 fakednsforwarder1 => 36,
 466                 fakednsforwarder2 => 37,
 467                 s4member_dflt     => 38,
 468                 vampire2000dc     => 39,
 469                 backupfromdc      => 40,
 470                 restoredc         => 41,
 471                 renamedc          => 42,
 472                 labdc             => 43,
 473                 offlinebackupdc   => 44,
 474                 customdc          => 45,
 475                 prockilldc        => 46,
 476                 proclimitdc       => 47,
 477
 478                 rootdnsforwarder  => 64,
 479
 480                 # update lib/socket_wrapper/socket_wrapper.c
 481                 #  #define MAX_WRAPPED_INTERFACES 64
 482                 # if you wish to have more than 64 interfaces
 483         );
 484
 485         if (not defined($testenv_iface_mapping{$netbiosname})) {
 486                 die();
 487         }
 488
 489         return $testenv_iface_mapping{$netbiosname};
 490 }
 491
 492 sub get_ipv4_addr
 493 {
 494         (my $hostname) = @_;
 495         my $swiface = Samba::get_interface($hostname);
 496
 497         return "127.0.0.$swiface";
 498 }
 499
 500 sub get_ipv6_addr
 501 {
 502         (my $hostname) = @_;
 503         my $swiface = Samba::get_interface($hostname);
 504
 505         return sprintf("fd00:0000:0000:0000:0000:0000:5357:5f%02x", $swiface);
 506 }
 507
 508 sub cleanup_child($$)
 509 {
 510     my ($pid, $name) = @_;
 511
 512     if (!defined($pid)) {
 513         print STDERR "cleanup_child: pid not defined ... not calling waitpid\n";
 514         return -1;
 515     }
 516
 517     my $childpid = waitpid($pid, WNOHANG);
 518
 519     if ($childpid == 0) {
 520     } elsif ($childpid < 0) {
 521         printf STDERR "%s child process %d isn't here any more\n", $name, $pid;
 522         return $childpid;
 523     } elsif ($? & 127) {
 524         printf STDERR "%s child process %d, died with signal %d, %s coredump\n",
 525                 $name, $childpid, ($? & 127),  ($? & 128) ? 'with' : 'without';
 526     } else {
 527         printf STDERR "%s child process %d exited with value %d\n", $name, $childpid, $? >> 8;
 528     }
 529     return $childpid;
 530 }
 531
 532 sub random_domain_sid()
 533 {
 534         my $domain_sid = "S-1-5-21-". int(rand(4294967295)) . "-" . int(rand(4294967295)) . "-" . int(rand(4294967295));
 535         return $domain_sid;
 536 }
 537
 538 my @exported_envvars = (
 539         # domain stuff
 540         "DOMAIN",
 541         "DNSNAME",
 542         "REALM",
 543         "DOMSID",
 544
 545         # stuff related to a trusted domain
 546         "TRUST_SERVER",
 547         "TRUST_USERNAME",
 548         "TRUST_PASSWORD",
 549         "TRUST_DOMAIN",
 550         "TRUST_REALM",
 551         "TRUST_DOMSID",
 552
 553         # domain controller stuff
 554         "DC_SERVER",
 555         "DC_SERVER_IP",
 556         "DC_SERVER_IPV6",
 557         "DC_NETBIOSNAME",
 558         "DC_NETBIOSALIAS",
 559
 560         # server stuff
 561         "SERVER",
 562         "SERVER_IP",
 563         "SERVER_IPV6",
 564         "NETBIOSNAME",
 565         "NETBIOSALIAS",
 566         "SAMSID",
 567
 568         # only use these 2 as a last resort. Some tests need to test both client-
 569         # side and server-side. In this case, run as default client, ans access
 570         # server's smb.conf as needed, typically using:
 571         #  param.LoadParm(filename_for_non_global_lp=os.environ['SERVERCONFFILE'])
 572         "SERVERCONFFILE",
 573         "DC_SERVERCONFFILE",
 574
 575         # user stuff
 576         "USERNAME",
 577         "USERID",
 578         "PASSWORD",
 579         "DC_USERNAME",
 580         "DC_PASSWORD",
 581
 582         # UID/GID for rfc2307 mapping tests
 583         "UID_RFC2307TEST",
 584         "GID_RFC2307TEST",
 585
 586         # misc stuff
 587         "KRB5_CONFIG",
 588         "KRB5CCNAME",
 589         "SELFTEST_WINBINDD_SOCKET_DIR",
 590         "NMBD_SOCKET_DIR",
 591         "LOCAL_PATH",
 592         "DNS_FORWARDER1",
 593         "DNS_FORWARDER2",
 594         "RESOLV_CONF",
 595         "UNACCEPTABLE_PASSWORD",
 596         "LOCK_DIR",
 597         "SMBD_TEST_LOG",
 598
 599         # nss_wrapper
 600         "NSS_WRAPPER_PASSWD",
 601         "NSS_WRAPPER_GROUP",
 602         "NSS_WRAPPER_HOSTS",
 603         "NSS_WRAPPER_HOSTNAME",
 604         "NSS_WRAPPER_MODULE_SO_PATH",
 605         "NSS_WRAPPER_MODULE_FN_PREFIX",
 606
 607         # resolv_wrapper
 608         "RESOLV_WRAPPER_CONF",
 609         "RESOLV_WRAPPER_HOSTS",
 610 );
 611
 612 sub exported_envvars_str
 613 {
 614         my ($testenv_vars) = @_;
 615         my $out = "";
 616
 617         foreach (@exported_envvars) {
 618                 next unless defined($testenv_vars->{$_});
 619                 $out .= $_."=".$testenv_vars->{$_}."\n";
 620         }
 621
 622         return $out;
 623 }
 624
 625 sub clear_exported_envvars
 626 {
 627         foreach (@exported_envvars) {
 628                 delete $ENV{$_};
 629         }
 630 }
 631
 632 sub export_envvars
 633 {
 634         my ($testenv_vars) = @_;
 635
 636         foreach (@exported_envvars) {
 637                 if (defined($testenv_vars->{$_})) {
 638                         $ENV{$_} = $testenv_vars->{$_};
 639                 } else {
 640                         delete $ENV{$_};
 641                 }
 642         }
 643 }
 644
 645 sub export_envvars_to_file
 646 {
 647         my ($filepath, $testenv_vars) = @_;
 648         my $env_str = exported_envvars_str($testenv_vars);
 649
 650         open(FILE, "> $filepath");
 651         print FILE "$env_str";
 652         close(FILE);
 653 }
 654
 655 1;