File: krb5.t

package info (click to toggle)
webauth 4.7.0-8
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 7,932 kB
  • sloc: ansic: 28,341; sh: 12,031; perl: 8,361; xml: 6,856; makefile: 459; php: 7
file content (105 lines) | stat: -rwxr-xr-x 3,191 bytes parent folder | download | duplicates (5)
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
#!/usr/bin/perl -w
#
# Test suite for WebAuth Perl bindings for krb5 functions.
#
# Written by Roland Schemers
# Updated by Jon Robertson <jonrober@stanford.edu>
# Copyright 2002, 2003, 2005, 2009, 2010, 2012, 2013
#     The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.

use strict;

use Test::More;

use lib ('t/lib', 'lib', 'blib/arch');
use Util qw(contents get_userinfo);

# Check for kerberos config all good.  Default is yes.
my $kerberos_config = 1;

my ($keytab, $principal, $wa_principal, $princ_type, $princ_host);
if (-f 't/data/test.keytab' && -f 't/data/test.principal'
    && -f 't/data/test.principal-webauth') {

    $keytab = 't/data/test.keytab';
    $principal = contents ('t/data/test.principal');
    $wa_principal = contents ('t/data/test.principal-webauth');
    ($princ_type, $princ_host) = split (/\//, $principal);
} else {
    $kerberos_config = 0;
}

# Get the username we need to change, and its current password.
my $fname_passwd = 't/data/test.password';
my ($username, $password) = get_userinfo ($fname_passwd) if -f $fname_passwd;
unless ($username && $password && $principal && $wa_principal) {
    $kerberos_config = 0;
}

# Skip all tests without a valid kerberos configuration.
if ($kerberos_config) {
    plan tests => 13;
} else {
    plan skip_all => 'Kerberos tests not configured';
}

# Test actually loading WebAuth module.
use WebAuth qw(:const);
ok (1, 'loading WebAuth works');
my $wa = WebAuth->new;

my ($context, $sp, $ctx_princ, $tgt, $expiration, $princ, $ticket, $rprinc,
    $request, $client_princ);

eval { $context = $wa->krb5_new };
isa_ok ($context, 'WebAuth::Krb5');

# We should now be able to drop the WebAuth context without destroying our
# Kerberos context, since the WebAuth::Krb5 object should hold a reference.
undef $wa;

eval {
    $sp = $context->init_via_password($username, $password, '', $keytab);
};
is ($@, '', "init_via_password didn't thrown an exception");
ok ($sp, 'init_via_password works');

eval { $ctx_princ = $context->get_principal (1) };
ok ($ctx_princ, 'get_principal works');

eval { ($tgt, $expiration) = $context->export_cred };
is ($@, '', 'export_cred works');
ok ($expiration, '... and returns an expiration time');

# If our user is in a realm other than our default realm, we can't use the
# results of service_principal by itself, since it's qualified with the wrong
# realm.
eval {
    ($ticket, $expiration)
        = $context->export_cred ($wa_principal);
};
is ($@, '', 'krb5_export_cred works');
ok ($ticket, '... and returns a ticket');
ok ($expiration, '... and an expiration time');

# Nuke current context and import from tgt we created.
eval {
    my $wa = WebAuth->new;
    $context = $wa->krb5_new;
    $context->import_cred ($tgt);
};
is ($@, '', 'import_cred from a tgt works');

# Import ticket we exported
eval { $context->import_cred ($ticket) };
is ($@, '', 'krb5_import_cred to import an exported ticket works');

# Nuke current context and get from keytab
$wa = WebAuth->new;
eval {
    $context = $wa->krb5_new;
    $context->init_via_keytab ($keytab);
};
is ($@, '', 'init_via_keytab to get context from a keytab works');