1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
# Utility class for wallet tests.
#
# Written by Russ Allbery <eagle@eyrie.org>
# Copyright 2020 Russ Allbery <eagle@eyrie.org>
# Copyright 2007-2008, 2014
# The Board of Trustees of the Leland Stanford Junior University
#
# SPDX-License-Identifier: MIT
package Util;
require 5.006;
use strict;
use warnings;
use vars qw(@ISA @EXPORT $VERSION);
use Wallet::Config;
# This version should be increased on any code change to this module. Always
# use two digits for the minor version with a leading zero if necessary so
# that it will sort properly.
$VERSION = '0.04';
use Exporter ();
@ISA = qw(Exporter);
@EXPORT = qw(contents db_setup getcreds keytab_valid remctld_spawn
remctld_stop);
##############################################################################
# General utility functions
##############################################################################
# Returns the one-line contents of a file as a string, removing the newline.
sub contents {
my ($file) = @_;
open (FILE, '<', $file) or die "cannot open $file: $!\n";
my $data = <FILE>;
close FILE;
chomp $data;
return $data;
}
##############################################################################
# User test configuration
##############################################################################
# Set up the database configuration parameters. Use a local SQLite database
# for testing by default, but support t/data/test.database as a configuration
# file to use another database backend.
sub db_setup {
$Wallet::Config::DB_DDL_DIRECTORY = 'sql/';
if (-f 't/data/test.database') {
open (DB, '<', 't/data/test.database')
or die "cannot open t/data/test.database: $!";
my $driver = <DB>;
my $info = <DB>;
my $user = <DB>;
my $password = <DB>;
chomp ($driver, $info);
chomp $user if $user;
chomp $password if $password;
$Wallet::Config::DB_DRIVER = $driver;
$Wallet::Config::DB_INFO = $info;
$Wallet::Config::DB_USER = $user if $user;
$Wallet::Config::DB_PASSWORD = $password if $password;
} else {
# If we have a new SQLite db by default, disable version checking.
$ENV{DBIC_NO_VERSION_CHECK} = 1;
$Wallet::Config::DB_DRIVER = 'SQLite';
$Wallet::Config::DB_INFO = 'wallet-db';
unlink 'wallet-db';
}
}
##############################################################################
# Kerberos utility functions
##############################################################################
# Given a keytab file and a principal, try authenticating with kinit.
sub getcreds {
my ($file, $principal) = @_;
my @commands = (
"kinit --no-afslog -k -t $file $principal >/dev/null 2>&1 </dev/null",
"kinit -k -t $file $principal >/dev/null 2>&1 </dev/null",
"kinit -t $file $principal >/dev/null 2>&1 </dev/null",
"kinit -T /bin/true -k -K $file $principal >/dev/null 2>&1 </dev/null",
);
for my $command (@commands) {
if (system ($command) == 0) {
return 1;
}
}
return 0;
}
# Given keytab data and the principal, write it to a file and try
# authenticating using kinit.
sub keytab_valid {
my ($keytab, $principal) = @_;
open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n";
print KEYTAB $keytab;
close KEYTAB;
$principal .= '@' . $Wallet::Config::KEYTAB_REALM
unless $principal =~ /\@/;
my $result = getcreds ('keytab', $principal);
if ($result) {
unlink 'keytab';
}
return $result;
}
##############################################################################
# remctld handling
##############################################################################
# Start remctld with the appropriate options to run our fake keytab backend.
# Takes the path to remctld, the principal it uses as its server principal,
# the keytab it uses for authentication, and the configuration file it should
# load.
sub remctld_spawn {
my ($path, $principal, $keytab, $config, $silent) = @_;
unlink 'test-pid';
my @command = ($path, '-m', '-p', 14373, '-s', $principal, '-P',
'test-pid', '-f', $config, '-S', '-F', '-k', $keytab);
print "# Starting remctld: @command\n";
my $pid = fork;
if (not defined $pid) {
die "cannot fork: $!\n";
} elsif ($pid == 0) {
if ($silent) {
open (STDOUT, '>', '/dev/null')
or die "cannot redirect stdout: $!\n";
open (STDERR, '>', '/dev/null')
or die "cannot redirect stdout: $!\n";
} else {
open (STDOUT, '>&STDERR') or die "cannot redirect stdout: $!\n";
}
exec (@command) or die "cannot exec $path: $!\n";
} else {
my $tries = 0;
while ($tries < 10 && ! -f 'test-pid') {
select (undef, undef, undef, 0.25);
}
}
}
# Stop the running remctld process.
sub remctld_stop {
open (PID, '<', 'test-pid') or return;
my $pid = <PID>;
close PID;
chomp $pid;
kill 15, $pid;
}
|
