keytab.t 30.8 KB
Newer Older
1
#!/usr/bin/perl
2
#
3
# Tests for the keytab object implementation.
4
#
5
# Written by Russ Allbery <eagle@eyrie.org>
6
# Copyright 2007, 2008, 2009, 2010, 2013, 2014
7
#     The Board of Trustees of the Leland Stanford Junior University
8
9
#
# See LICENSE for licensing terms.
10

11
12
13
use strict;
use warnings;

Russ Allbery's avatar
Russ Allbery committed
14
use POSIX qw(strftime);
15
use Test::More tests => 142;
16

17
18
BEGIN { $Wallet::Config::KEYTAB_TMP = '.' }

19
use DBI;
20
use Wallet::Admin;
21
use Wallet::Config;
22
use Wallet::Kadmin;
23
24
use Wallet::Object::Keytab;

25
26
27
use lib 't/lib';
use Util;

28
29
30
31
32
33
34
35
# Mapping of klist -ke output from old MIT Kerberos implementations to to the
# strings that Kerberos uses internally.  It's very annoying to have to
# maintain this, and it probably breaks with Heimdal.
#
# Newer versions of MIT Kerberos just print out the canonical enctype names
# and don't need this logic, but the current test requires that they still
# have entries.  That's why the second set where the key and value are the
# same.
36
37
38
39
my %enctype =
    ('triple des cbc mode with hmac/sha1'      => 'des3-cbc-sha1',
     'des cbc mode with crc-32'                => 'des-cbc-crc',
     'des cbc mode with rsa-md5'               => 'des-cbc-md5',
40
     'aes-128 cts mode with 96-bit sha-1 hmac' => 'aes128-cts-hmac-sha1-96',
41
     'aes-256 cts mode with 96-bit sha-1 hmac' => 'aes256-cts-hmac-sha1-96',
42
43
44
45
46
47
48
49
     'arcfour with hmac/md5'                   => 'rc4-hmac',

     'des3-cbc-sha1'                           => 'des3-cbc-sha1',
     'des-cbc-crc'                             => 'des-cbc-crc',
     'des-cbc-md5'                             => 'des-cbc-md5',
     'aes128-cts-hmac-sha1-96'                 => 'aes128-cts-hmac-sha1-96',
     'aes256-cts-hmac-sha1-96'                 => 'aes256-cts-hmac-sha1-96',
     'rc4-hmac'                                => 'rc4-hmac');
50

51
52
53
# Some global defaults to use.
my $user = 'admin@EXAMPLE.COM';
my $host = 'localhost';
54
my @trace = ($user, $host, time);
55

56
57
58
# Flush all output immediately.
$| = 1;

59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
# Run a command and throw away the output, returning the exit status.
sub system_quiet {
    my ($command, @args) = @_;
    my $pid = fork;
    if (not defined $pid) {
        die "cannot fork: $!\n";
    } elsif ($pid == 0) {
        open (STDIN, '<', '/dev/null') or die "cannot reopen stdin: $!\n";
        open (STDOUT, '>', '/dev/null') or die "cannot reopen stdout: $!\n";
        open (STDERR, '>', '/dev/null') or die "cannot reopen stderr: $!\n";
        exec ($command, @args) or die "cannot exec $command: $!\n";
    } else {
        waitpid ($pid, 0);
        return $?;
    }
}

# Create a principal out of Kerberos.  Only usable once the configuration has
# been set up.
sub create {
    my ($principal) = @_;
80
    my $kadmin = Wallet::Kadmin->new;
81
    return $kadmin->create ($principal);
82
83
84
85
86
87
}

# Destroy a principal out of Kerberos.  Only usable once the configuration has
# been set up.
sub destroy {
    my ($principal) = @_;
88
    my $kadmin = Wallet::Kadmin->new;
89
    return $kadmin->destroy ($principal);
90
91
}

92
93
94
95
# Check whether a principal exists.  MIT uses kvno and Heimdal uses kgetcred.
# Note that the Kerberos type may be different than our local userspace, so
# don't use the Kerberos type to decide here.  Instead, check for which
# program is available on the path.
96
97
98
sub created {
    my ($principal) = @_;
    $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
99
100
101
    local $ENV{KRB5CCNAME} = 'krb5cc_temp';
    getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL);
    if (grep { -x "$_/kvno" } split (':', $ENV{PATH})) {
102
        return (system_quiet ('kvno', $principal) == 0);
103
104
105
106
107
    } elsif (grep { -x "$_/kgetcred" } split (':', $ENV{PATH})) {
        return (system_quiet ('kgetcred', $principal) == 0);
    } else {
        warn "# No kvno or kgetcred found\n";
        return;
108
    }
109
110
}

111
112
113
# Given keytab data, write it to a file and try to determine the enctypes of
# the keys present in that file.  Returns the enctypes as a list, with UNKNOWN
# for encryption types that weren't recognized.  This is an ugly way of doing
114
115
# this for MIT.  Heimdal is much more straightforward, but MIT ktutil doesn't
# have the needed abilities.
116
117
118
119
120
sub enctypes {
    my ($keytab) = @_;
    open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n";
    print KEYTAB $keytab;
    close KEYTAB;
121

122
    my @enctypes;
123
124
125
126
127
128
129
130
    my $pid = open (KLIST, '-|');
    if (not defined $pid) {
        die "cannot fork: $!\n";
    } elsif ($pid == 0) {
        open (STDERR, '>', '/dev/null') or die "cannot reopen stderr: $!\n";
        exec ('klist', '-ke', 'keytab')
            or die "cannot run klist: $!\n";
    }
131
132
133
134
135
    local $_;
    while (<KLIST>) {
        next unless /^ *\d+ /;
        my ($string) = /\((.*)\)\s*$/;
        next unless $string;
136
        my $enctype = $enctype{lc $string} || 'UNKNOWN';
137
138
139
140
141
142
        push (@enctypes, $enctype);
    }
    close KLIST;

    # If that failed, we may have a Heimdal user space instead, so try ktutil.
    # If we try this directly, it will just hang with MIT ktutil.
143
    if ($? != 0 || !@enctypes) {
144
        @enctypes = ();
145
146
147
148
149
150
151
152
153
154
        open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list')
            or die "cannot run ktutil: $!\n";
        local $_;
        while (<KTUTIL>) {
            next unless /^ *\d+ /;
            my ($string) = /^\s*\d+\s+(\S+)/;
            next unless $string;
            push (@enctypes, $string);
        }
        close KTUTIL;
155
156
    }
    unlink 'keytab';
157
    return sort @enctypes;
158
159
}

160
# Use Wallet::Admin to set up the database.
161
162
unlink ('krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid');
db_setup;
163
164
165
my $admin = eval { Wallet::Admin->new };
is ($@, '', 'Database connection succeeded');
is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
166
167
my $schema = $admin->schema;
my $dbh = $admin->dbh;
168

Russ Allbery's avatar
Russ Allbery committed
169
170
171
172
# Use this to accumulate the history traces so that we can check history.
my $history = '';
my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]);

173
# Basic keytab creation and manipulation tests.
174
SKIP: {
175
    skip 'no keytab configuration', 53 unless -f 't/data/test.keytab';
176
177
178
179
180

    # Set up our configuration.
    $Wallet::Config::KEYTAB_FILE      = 't/data/test.keytab';
    $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal');
    $Wallet::Config::KEYTAB_REALM     = contents ('t/data/test.realm');
181
    $Wallet::Config::KEYTAB_KRBTYPE   = contents ('t/data/test.krbtype');
182
183
184
185
186
187
188
189
190
    my $realm = $Wallet::Config::KEYTAB_REALM;

    # Clean up the principals we're going to use.
    destroy ('wallet/one');
    destroy ('wallet/two');

    # Don't destroy the user's Kerberos ticket cache.
    $ENV{KRB5CCNAME} = 'krb5cc_test';

191
192
    # Test that object creation without KEYTAB_TMP fails.
    undef $Wallet::Config::KEYTAB_TMP;
193
    my $object = eval {
194
195
        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
                                        @trace)
196
197
198
199
200
201
      };
    is ($object, undef, 'Creating keytab without KEYTAB_TMP fails');
    is ($@, "KEYTAB_TMP configuration variable not set\n",
        ' with the right error');
    $Wallet::Config::KEYTAB_TMP = '.';

202
203
    # Okay, now we can test.  First, create.
    $object = eval {
204
205
        Wallet::Object::Keytab->create ('keytab', "wallet\nf", $schema,
                                        @trace)
206
207
      };
    is ($object, undef, 'Creating malformed principal fails');
208
209
210
    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
        is ($@, "invalid principal name wallet\nf\n", ' with the right error');
    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
211
        like ($@, qr/^error adding principal wallet\nf/,
212
213
              ' with the right error');
    }
214
    $object = eval {
215
        Wallet::Object::Keytab->create ('keytab', '', $schema, @trace)
216
217
      };
    is ($object, undef, 'Creating empty principal fails');
218
219
220
221
222
    if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') {
        is ($@, "invalid principal name \n", ' with the right error');
    } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') {
        like ($@, qr/^error adding principal \@/, ' with the right error');
    }
223
    $object = eval {
224
225
        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
                                        @trace)
226
      };
227
228
229
230
231
    if (defined ($object)) {
        ok (defined ($object), 'Creating good principal succeeds');
    } else {
        is ($@, '', 'Creating good principal succeeds');
    }
232
233
234
235
    ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right class');
    ok (created ('wallet/one'), ' and the principal was created');
    create ('wallet/two');
    $object = eval {
236
237
        Wallet::Object::Keytab->create ('keytab', 'wallet/two', $schema,
                                        @trace)
238
      };
239
240
241
242
243
    if (defined ($object)) {
        ok (defined ($object), 'Creating an existing principal succeeds');
    } else {
        is ($@, '', 'Creating an existing principal succeeds');
    }
244
245
    ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right class');
    is ($object->destroy (@trace), 1, ' and destroying it succeeds');
246
    is ($object->error, undef, ' with no error message');
247
248
    ok (! created ('wallet/two'), ' and now it does not exist');
    my @name = qw(keytab wallet-test/one);
249
    $object = eval { Wallet::Object::Keytab->create (@name, $schema, @trace) };
250
251
252
    is ($object, undef, 'Creation without permissions fails');
    like ($@, qr{^error adding principal wallet-test/one\@\Q$realm: },
          ' with the right error');
253
254

    # Now, try retrieving the keytab.
255
    $object = Wallet::Object::Keytab->new ('keytab', 'wallet/one', $schema);
256
257
    ok (defined ($object), 'Retrieving the object works');
    ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right type');
Russ Allbery's avatar
Russ Allbery committed
258
259
260
261
262
263
    is ($object->flag_set ('locked', @trace), 1, ' and setting locked works');
    is ($object->get (@trace), undef, ' and get fails');
    is ($object->error, "cannot get keytab:wallet/one: object is locked",
        ' because it is locked');
    is ($object->flag_clear ('locked', @trace), 1,
        ' and clearing locked works');
264
265
266
267
268
269
270
    my $data = $object->get (@trace);
    if (defined ($data)) {
        ok (defined ($data), ' and getting the keytab works');
    } else {
        is ($object->error, '', ' and getting the keytab works');
    }
    ok (! -f "./keytab.$$", ' and the temporary file was cleaned up');
271
    ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid');
272

273
274
275
276
277
278
279
    # For right now, this is the only backend type that we have for which we
    # can do a get, so test display of the last download information.
    my $expected = <<"EOO";
           Type: keytab
           Name: wallet/one
     Created by: $user
   Created from: $host
280
     Created on: $date
281
282
  Downloaded by: $user
Downloaded from: $host
283
  Downloaded on: $date
284
EOO
285
    is ($object->show, $expected, 'Show output is correct');
286

287
    # Test error handling on keytab retrieval.
288
289
290
291
292
293
294
295
296
  SKIP: {
        skip 'no kadmin program test for Heimdal', 2
            if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal';
        $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file';
        $data = $object->get (@trace);
        is ($data, undef, 'Cope with a failure to run kadmin');
        like ($object->error, qr{^cannot run /some/nonexistent/file: },
              ' with the right error');
        $Wallet::Config::KEYTAB_KADMIN = 'kadmin';
297
    }
298
299
300
301
302
303
304
305
    destroy ('wallet/one');
    $data = $object->get (@trace);
    is ($data, undef, 'Getting a keytab for a nonexistent principal fails');
    like ($object->error,
          qr{^error creating keytab for wallet/one\@\Q$realm\E: },
          ' with the right error');
    is ($object->destroy (@trace), 1, ' but we can still destroy it');

306
    # Test principal deletion on object destruction.
307
    $object = eval {
308
309
        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
                                        @trace)
310
311
      };
    ok (defined ($object), 'Creating good principal succeeds');
312
    is ($@, '', ' with no error');
313
    ok (created ('wallet/one'), ' and the principal was created');
314
315
316
317
318
319
320
321
322
  SKIP: {
        skip 'no kadmin program test for Heimdal', 2
            if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal';
        $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file';
        is ($object->destroy (@trace), undef,
            ' and destroying it with bad kadmin fails');
        like ($object->error, qr{^cannot run /some/nonexistent/file: },
              ' with the right error');
        $Wallet::Config::KEYTAB_KADMIN = 'kadmin';
323
    }
Russ Allbery's avatar
Russ Allbery committed
324
325
326
327
328
329
    is ($object->flag_set ('locked', @trace), 1, ' and setting locked works');
    is ($object->destroy (@trace), undef, ' and destroying it fails');
    is ($object->error, "cannot destroy keytab:wallet/one: object is locked",
        ' because it is locked');
    is ($object->flag_clear ('locked', @trace), 1,
        ' and clearing locked works');
330
331
332
    is ($object->destroy (@trace), 1, ' and destroying it succeeds');
    ok (! created ('wallet/one'), ' and now it does not exist');

Russ Allbery's avatar
Russ Allbery committed
333
334
335
    # Test history (which should still work after the object is deleted).
    $history .= <<"EOO";
$date  create
336
    by $user from $host
Russ Allbery's avatar
Russ Allbery committed
337
$date  set flag locked
338
    by $user from $host
Russ Allbery's avatar
Russ Allbery committed
339
$date  clear flag locked
340
    by $user from $host
Russ Allbery's avatar
Russ Allbery committed
341
$date  get
342
    by $user from $host
Russ Allbery's avatar
Russ Allbery committed
343
$date  destroy
344
    by $user from $host
Russ Allbery's avatar
Russ Allbery committed
345
$date  create
346
    by $user from $host
Russ Allbery's avatar
Russ Allbery committed
347
$date  set flag locked
348
    by $user from $host
Russ Allbery's avatar
Russ Allbery committed
349
$date  clear flag locked
350
    by $user from $host
Russ Allbery's avatar
Russ Allbery committed
351
$date  destroy
352
    by $user from $host
Russ Allbery's avatar
Russ Allbery committed
353
354
355
EOO
    is ($object->history, $history, 'History is correct to this point');

356
357
358
    # Test configuration errors.
    undef $Wallet::Config::KEYTAB_FILE;
    $object = eval {
359
360
        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
                                        @trace)
361
362
363
364
365
366
367
      };
    is ($object, undef, 'Creating with bad configuration fails');
    is ($@, "keytab object implementation not configured\n",
        ' with the right error');
    $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab';
    undef $Wallet::Config::KEYTAB_PRINCIPAL;
    $object = eval {
368
369
        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
                                        @trace)
370
371
372
373
374
375
376
      };
    is ($object, undef, ' likewise with another missing variable');
    is ($@, "keytab object implementation not configured\n",
        ' with the right error');
    $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal');
    undef $Wallet::Config::KEYTAB_REALM;
    $object = eval {
377
378
        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
                                        @trace)
379
380
381
382
383
      };
    is ($object, undef, ' and another');
    is ($@, "keytab object implementation not configured\n",
        ' with the right error');
    $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm');
384
385
    undef $Wallet::Config::KEYTAB_KRBTYPE;
    $object = eval {
386
387
        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
                                        @trace)
388
389
390
391
392
393
      };
    is ($object, undef, ' and another');
    is ($@, "keytab object implementation not configured\n",
        ' with the right error');
    $Wallet::Config::KEYTAB_KRBTYPE = 'Active Directory';
    $object = eval {
394
395
        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
                                        @trace)
396
397
      };
    is ($object, undef, ' and one set to an invalid value');
398
    is ($@, "unknown KEYTAB_KRBTYPE setting: Active Directory\n",
399
400
        ' with the right error');
    $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype');
401
402
403
404
405
}

# Tests for unchanging support.  Skip these if we don't have a keytab or if we
# can't find remctld.
SKIP: {
406
    skip 'no keytab configuration', 32 unless -f 't/data/test.keytab';
407

408
409
410
411
    # Set up our configuration.
    $Wallet::Config::KEYTAB_FILE      = 't/data/test.keytab';
    $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal');
    $Wallet::Config::KEYTAB_REALM     = contents ('t/data/test.realm');
412
    $Wallet::Config::KEYTAB_KRBTYPE   = contents ('t/data/test.krbtype');
413
414
415
416
417
418
    $Wallet::Config::KEYTAB_TMP       = '.';
    my $realm = $Wallet::Config::KEYTAB_REALM;
    my $principal = $Wallet::Config::KEYTAB_PRINCIPAL;

    # Create the objects for testing and set the unchanging flag.
    my $one = eval {
419
420
        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
                                        @trace)
421
422
423
424
      };
    ok (defined ($one), 'Creating wallet/one succeeds');
    is ($one->flag_set ('unchanging', @trace), 1, ' and setting unchanging');
    my $two = eval {
425
426
        Wallet::Object::Keytab->create ('keytab', 'wallet/two', $schema,
                                        @trace);
427
428
429
430
      };
    ok (defined ($two), 'Creating wallet/two succeeds');
    is ($two->flag_set ('unchanging', @trace), 1, ' and setting unchanging');

431
432
    # Finally we can test.  First the MIT Kerberos tests.
  SKIP: {
433
        skip 'skipping MIT unchanging tests for Heimdal', 16
434
435
436
437
438
            if (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'heimdal');

        # We need remctld and Net::Remctl.
        my @path = (split (':', $ENV{PATH}), '/usr/local/sbin', '/usr/sbin');
        my ($remctld) = grep { -x $_ } map { "$_/remctld" } @path;
439
        skip 'remctld not found', 16 unless $remctld;
440
        eval { require Net::Remctl };
441
        skip 'Net::Remctl not available', 16 if $@;
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474

        # Now spawn our remctld server and get a ticket cache.
        remctld_spawn ($remctld, $principal, 't/data/test.keytab',
                       't/data/keytab.conf');
        $ENV{KRB5CCNAME} = 'krb5cc_test';
        getcreds ('t/data/test.keytab', $principal);
        $ENV{KRB5CCNAME} = 'krb5cc_good';

        # Do the unchanging tests for MIT Kerberos.
        is ($one->get (@trace), undef, 'Get without configuration fails');
        is ($one->error, 'keytab unchanging support not configured',
            ' with the right error');
        $Wallet::Config::KEYTAB_REMCTL_CACHE = 'krb5cc_test';
        is ($one->get (@trace), undef, ' and still fails without host');
        is ($one->error, 'keytab unchanging support not configured',
            ' with the right error');
        $Wallet::Config::KEYTAB_REMCTL_HOST = 'localhost';
        $Wallet::Config::KEYTAB_REMCTL_PRINCIPAL = $principal;
        $Wallet::Config::KEYTAB_REMCTL_PORT = 14373;
        is ($one->get (@trace), undef, ' and still fails without ACL');
        is ($one->error,
            "cannot retrieve keytab for wallet/one\@$realm: Access denied",
            ' with the right error');
        open (ACL, '>', 'test-acl') or die "cannot create test-acl: $!\n";
        print ACL "$principal\n";
        close ACL;
        is ($one->get (@trace), 'Keytab for wallet/one', 'Now get works');
        is ($ENV{KRB5CCNAME}, 'krb5cc_good',
            ' and we did not nuke the cache name');
        is ($one->get (@trace), 'Keytab for wallet/one',
            ' and we get the same thing the second time');
        is ($one->flag_clear ('unchanging', @trace), 1,
            'Clearing the unchanging flag works');
475
        my $data = $one->get (@trace);
476
        ok (defined ($data), ' and getting the keytab works');
477
        ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid');
478
479
480
481
482
483
484
        is ($two->get (@trace), undef, 'Get for wallet/two does not work');
        is ($two->error,
            "cannot retrieve keytab for wallet/two\@$realm: bite me",
            ' with the right error');
        is ($one->destroy (@trace), 1, 'Destroying wallet/one works');
        is ($two->destroy (@trace), 1, ' as does destroying wallet/two');
        remctld_stop;
485
        unlink 'krb5cc_good';
486
    }
487

488
489
490
    # Now Heimdal.  Since the keytab contains timestamps, before testing for
    # equality we have to substitute out the timestamps.
  SKIP: {
491
        skip 'skipping Heimdal unchanging tests for MIT', 11
492
493
494
            if (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'mit');
        my $data = $one->get (@trace);
        ok (defined $data, 'Get of unchanging keytab works');
495
        ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid');
496
497
498
499
        my $second = $one->get (@trace);
        ok (defined $second, ' and second retrieval also works');
        $data =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g;
        $second =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g;
500
501
        ok (keytab_valid ($second, 'wallet/one'), ' and the keytab is valid');
        ok (keytab_valid ($data, 'wallet/one'), ' as is the first keytab');
502
503
504
505
        is ($one->flag_clear ('unchanging', @trace), 1,
            'Clearing the unchanging flag works');
        $data = $one->get (@trace);
        ok (defined ($data), ' and getting the keytab works');
506
        ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid');
507
508
509
510
511
        $data =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g;
        ok ($data ne $second, ' and the new keytab is different');
        is ($one->destroy (@trace), 1, 'Destroying wallet/one works');
        is ($two->destroy (@trace), 1, ' as does destroying wallet/two');
    }
512
513
514
515

    # Check that history has been updated correctly.
    $history .= <<"EOO";
$date  create
516
    by $user from $host
517
$date  set flag unchanging
518
519
520
521
522
523
    by $user from $host
$date  get
    by $user from $host
$date  get
    by $user from $host
$date  clear flag unchanging
524
    by $user from $host
525
$date  get
526
    by $user from $host
527
$date  destroy
528
    by $user from $host
529
530
EOO
    is ($one->history, $history, 'History is correct to this point');
531
}
532

533
534
535
# Tests for synchronization support.  This code is deactivated at present
# since no synchronization targets are supported, but we want to still test
# the basic stub code.
536
SKIP: {
537
    skip 'no keytab configuration', 18 unless -f 't/data/test.keytab';
538

539
540
    # Test setting synchronization attributes, which can also be done without
    # configuration.
541
    my $one = eval {
542
543
        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
                                        @trace)
544
545
      };
    ok (defined ($one), 'Creating wallet/one succeeds');
546
547
548
549
550
    my $expected = <<"EOO";
           Type: keytab
           Name: wallet/one
     Created by: $user
   Created from: $host
551
     Created on: $date
552
EOO
553
    is ($one->show, $expected, 'Show output displays no attributes');
554
555
556
557
558
559
    is ($one->attr ('foo', [ 'bar' ], @trace), undef,
        'Setting unknown attribute fails');
    is ($one->error, 'unknown attribute foo', ' with the right error');
    my @targets = $one->attr ('foo');
    is (scalar (@targets), 0, ' and getting an unknown attribute fails');
    is ($one->error, 'unknown attribute foo', ' with the right error');
560
    is ($one->attr ('sync', [ 'kaserver' ], @trace), undef,
561
        ' and setting an unknown sync target fails');
562
    is ($one->error, 'unsupported synchronization target kaserver',
563
564
565
566
567
        ' with the right error');
    is ($one->attr ('sync', [ 'kaserver', 'bar' ], @trace), undef,
        ' and setting two targets fails');
    is ($one->error, 'only one synchronization target supported',
        ' with the right error');
568
569
570
571
572
573

    # Create a synchronization manually so that we can test the display and
    # removal code.
    my $sql = "insert into keytab_sync (ks_name, ks_target) values
        ('wallet/one', 'kaserver')";
    $dbh->do ($sql);
574
575
576
577
    @targets = $one->attr ('sync');
    is (scalar (@targets), 1, ' and now one target is set');
    is ($targets[0], 'kaserver', ' and it is correct');
    is ($one->error, undef, ' and there is no error');
578
579
580
581
582
583
    $expected = <<"EOO";
           Type: keytab
           Name: wallet/one
    Synced with: kaserver
     Created by: $user
   Created from: $host
584
     Created on: $date
585
EOO
586
    is ($one->show, $expected, ' and show now displays the attribute');
587
588
    $history .= <<"EOO";
$date  create
589
    by $user from $host
590
591
EOO
    is ($one->history, $history, ' and history is correct for attributes');
592
    is ($one->attr ('sync', [], @trace), 1,
593
        'Removing the kaserver sync attribute works');
594
595
596
597
598
599
600
    is ($one->destroy (@trace),1, ' and then destroying wallet/one works');
    $history .= <<"EOO";
$date  remove kaserver from attribute sync
    by $user from $host
$date  destroy
    by $user from $host
EOO
601
    is ($one->history, $history, ' and history is correct for removal');
602
603
604
605
}

# Tests for enctype restriction.
SKIP: {
606
    skip 'no keytab configuration', 37 unless -f 't/data/test.keytab';
607
608
609
610
611

    # Set up our configuration.
    $Wallet::Config::KEYTAB_FILE      = 't/data/test.keytab';
    $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal');
    $Wallet::Config::KEYTAB_REALM     = contents ('t/data/test.realm');
612
    $Wallet::Config::KEYTAB_KRBTYPE   = contents ('t/data/test.krbtype');
613
614
615
616
617
618
619
    $Wallet::Config::KEYTAB_TMP       = '.';
    my $realm = $Wallet::Config::KEYTAB_REALM;
    my $principal = $Wallet::Config::KEYTAB_PRINCIPAL;

    # Create an object for testing and determine the enctypes we have to work
    # with.
    my $one = eval {
620
621
        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
                                        @trace)
622
      };
623
624
625
626
627
    if (defined ($one)) {
        ok (1, 'Creating wallet/one succeeds');
    } else {
        is ($@, '', 'Creating wallet/one succeeds');
    }
628
629
    my $keytab = $one->get (@trace);
    ok (defined ($keytab), ' and retrieving the keytab works');
630
    my @enctypes = grep { $_ ne 'UNKNOWN' } enctypes ($keytab);
631
632
    $history .= <<"EOO";
$date  create
633
    by $user from $host
634
$date  get
635
    by $user from $host
636
637
EOO
    is ($one->history, $history, ' and history is still correct');
638
639

    # No enctypes we recognize?
640
    skip 'no recognized enctypes', 34 unless @enctypes;
641
642
643
644

    # Set those encryption types and make sure we get back a limited keytab.
    is ($one->attr ('enctypes', [ @enctypes ], @trace), 1,
        'Setting enctypes works');
645
    is ($one->error, undef, ' with no error');
646
647
    for my $enctype (@enctypes) {
        $history .= "$date  add $enctype to attribute enctypes\n";
648
        $history .= "    by $user from $host\n";
649
    }
650
651
652
653
    my @values = $one->attr ('enctypes');
    is ("@values", "@enctypes", ' and we get back the right enctype list');
    my $eshow = join ("\n" . (' ' x 17), @enctypes);
    $eshow =~ s/\s+\z/\n/;
654
    my $expected = <<"EOO";
655
656
657
658
659
           Type: keytab
           Name: wallet/one
       Enctypes: $eshow
     Created by: $user
   Created from: $host
660
     Created on: $date
661
662
  Downloaded by: $user
Downloaded from: $host
663
  Downloaded on: $date
664
EOO
665
    is ($one->show, $expected, ' and show now displays the enctype list');
666
667
668
669
    $keytab = $one->get (@trace);
    ok (defined ($keytab), ' and retrieving the keytab still works');
    @values = enctypes ($keytab);
    is ("@values", "@enctypes", ' and the keytab has the right keys');
670
671
672
673
    is ($one->attr ('enctypes', [ 'foo-bar' ], @trace), undef,
        'Setting an unrecognized enctype fails');
    is ($one->error, 'unknown encryption type foo-bar',
        ' with the right error message');
674
    is ($one->show, $expected, ' and we did rollback properly');
675
676
    $history .= <<"EOO";
$date  get
677
    by $user from $host
678
679
EOO
    is ($one->history, $history, 'History is correct to this point');
680
681
682

    # Now, try testing limiting the enctypes to just one.
  SKIP: {
683
        skip 'insufficient recognized enctypes', 14 unless @enctypes > 1;
684

685
686
        is ($one->attr ('enctypes', [ $enctypes[0] ], @trace), 1,
            'Setting a single enctype works');
687
688
689
        for my $enctype (@enctypes) {
            next if $enctype eq $enctypes[0];
            $history .= "$date  remove $enctype from attribute enctypes\n";
690
            $history .= "    by $user from $host\n";
691
        }
692
693
694
695
        @values = $one->attr ('enctypes');
        is ("@values", $enctypes[0], ' and we get back the right value');
        $keytab = $one->get (@trace);
        ok (defined ($keytab), ' and retrieving the keytab still works');
696
697
698
699
700
701
        if (defined ($keytab)) {
            @values = enctypes ($keytab);
            is ("@values", $enctypes[0], ' and it has the right enctype');
        } else {
            ok (0, ' and it has the right keytab');
        }
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
        is ($one->attr ('enctypes', [ $enctypes[1] ], @trace), 1,
            'Setting a different single enctype works');
        @values = $one->attr ('enctypes');
        is ("@values", $enctypes[1], ' and we get back the right value');
        $keytab = $one->get (@trace);
        ok (defined ($keytab), ' and retrieving the keytab still works');
        @values = enctypes ($keytab);
        is ("@values", $enctypes[1], ' and it has the right enctype');
        is ($one->attr ('enctypes', [ @enctypes[0..1] ], @trace), 1,
            'Setting two enctypes works');
        @values = $one->attr ('enctypes');
        is ("@values", "@enctypes[0..1]", ' and we get back the right values');
        $keytab = $one->get (@trace);
        ok (defined ($keytab), ' and retrieving the keytab still works');
        @values = enctypes ($keytab);
        is ("@values", "@enctypes[0..1]", ' and it has the right enctypes');
718
719
720
721
722

        # Check the history trace.  Put back all the enctypes for consistent
        # status whether or not we skipped this section.
        $history .= <<"EOO";
$date  get
723
    by $user from $host
724
$date  remove $enctypes[0] from attribute enctypes
725
    by $user from $host
726
$date  add $enctypes[1] to attribute enctypes
727
    by $user from $host
728
$date  get
729
    by $user from $host
730
$date  add $enctypes[0] to attribute enctypes
731
    by $user from $host
732
$date  get
733
    by $user from $host
734
735
736
737
738
739
740
EOO
        is ($one->attr ('enctypes', [ @enctypes ], @trace), 1,
            'Restoring all enctypes works');
        for my $enctype (@enctypes) {
            next if $enctype eq $enctypes[0];
            next if $enctype eq $enctypes[1];
            $history .= "$date  add $enctype to attribute enctypes\n";
741
            $history .= "    by $user from $host\n";
742
743
        }
        is ($one->history, $history, 'History is correct to this point');
744
745
746
747
    }

    # Test clearing enctypes.
    is ($one->attr ('enctypes', [], @trace), 1, 'Clearing enctypes works');
748
749
    for my $enctype (@enctypes) {
        $history .= "$date  remove $enctype from attribute enctypes\n";
750
        $history .= "    by $user from $host\n";
751
    }
752
753
754
755
756
757
758
759
760
    @values = $one->attr ('enctypes');
    ok (@values == 0, ' and now there are no enctypes');
    is ($one->error, undef, ' and no error');

    # Test deleting enctypes on object destruction.
    is ($one->attr ('enctypes', [ $enctypes[0] ], @trace), 1,
        'Setting a single enctype works');
    is ($one->destroy (@trace), 1, ' and destroying the object works');
    $one = eval {
761
762
        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema,
                                        @trace)
763
764
765
766
767
      };
    ok (defined ($one), ' as does recreating it');
    @values = $one->attr ('enctypes');
    ok (@values == 0, ' and now there are no enctypes');
    is ($one->error, undef, ' and no error');
768

769
    # All done.  Clean up and check history.
770
    is ($one->destroy (@trace), 1, 'Destroying wallet/one works');
771
772
    $history .= <<"EOO";
$date  add $enctypes[0] to attribute enctypes
773
    by $user from $host
774
$date  destroy
775
    by $user from $host
776
$date  create
777
    by $user from $host
778
$date  destroy
779
    by $user from $host
780
781
EOO
    is ($one->history, $history, 'History is correct to this point');
782
783
}

784
# Clean up.
785
$admin->destroy;
786
787
788
END {
    unlink ('wallet-db', 'krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid');
}