summaryrefslogtreecommitdiffstats
path: root/libpamc/test/regress/test.secret@here
blob: 67fe22ece6750350121d0ccf395346713bd7ddb6 (plain)
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
#!/usr/bin/perl

##
## this is a test script for regressing changes to the secret@here PAM
## agent
##

$^W = 1;
use strict;
use IPC::Open2;

$| = 1;

my $whoami = `/usr/bin/whoami`; chomp $whoami;
my $cookie = "12345";
my $user_domain = "$whoami\@local.host";

my $pid = open2(\*Reader, \*Writer, "../agents/secret\@here blah")
    or die "failed to load secret\@here agent";

unless (-f (getpwuid($<))[7]."/.secret\@here") {
    print STDERR "server: ". "no " .(getpwuid($<))[7]. "/.secret\@here file\n";
    die "no config file";
}

WriteBinaryPrompt(\*Writer, 0x02, "secret\@here/$user_domain|$cookie");

my ($control, $data) = ReadBinaryPrompt(\*Reader);

print STDERR "server: ". "reply: control=$control, data=$data\n";
if ($control != 1) {
    die "expected 1 (OK) for the first agent reply; got $control";
}
my ($seqid, $a_cookie) = split '\|', $data;

# server needs to convince agent that it knows the secret before
# agent will give a valid response
my $secret = IdentifyLocalSecret($user_domain);
my $digest = CreateDigest($a_cookie."|".$cookie."|".$secret);

print STDERR "server: ". "digest = $digest\n";
WriteBinaryPrompt(\*Writer, 0x01, "$seqid|$digest");

# The agent will authenticate us and then reply with its
# authenticating digest. we check that before we're done.

($control, $data) = ReadBinaryPrompt(\*Reader);
if ($control != 0x03) {
    die "server: agent did not reply with a 'done' prompt ($control)\n";
}

unless ($data eq CreateDigest($secret."|".$cookie."|".$a_cookie)) {
    die "server: agent is not authenticated\n";
}

print STDERR "server: agent appears to know secret\n";

my $session_authenticated_ticket
    = CreateDigest($cookie."|".$secret."|".$a_cookie);

print STDERR "server: should putenv("
	    ."\"AUTH_SESSION_TICKET=$session_authenticated_ticket\")\n";

exit 0;

sub CreateDigest ($) {
    my ($data) = @_;

    my $pid = open2(\*MD5out, \*MD5in, "/usr/bin/md5sum -")
	or die "you'll need /usr/bin/md5sum installed";

    my $oldfd = select MD5in; $|=1; select $oldfd;
    print MD5in "$data";
    close MD5in;
    my $reply = <MD5out>;
    ($reply) = split /\s/, $reply;
    print STDERR "server: ". "md5 said: <$reply>\n";
    close MD5out;

    return $reply;
}

sub ReadBinaryPrompt ($) {
    my ($fd) = @_;

    my $buffer = "     ";
    my $count = read($fd, $buffer, 5);
    if ($count == 0) {
	# no more packets to read
	return (0, "");
    }

    if ($count != 5) {
	# broken packet header
	return (-1, "");
    }

    my ($length, $control) = unpack("N C", $buffer);
    if ($length < 5) {
	# broken packet length
	return (-1, "");
    }

    my $data = "";
    $length -= 5;
    while ($count = read($fd, $buffer, $length)) {
	$data .= $buffer;
	if ($count != $length) {
	    $length -= $count;
	    next;
	}

	print STDERR "server: ". "data is [$data]\n";

	return ($control, $data);
    }

    # broken packet data
    return (-1, "");
}

sub WriteBinaryPrompt ($$$) {
    my ($fd, $control, $data) = @_;

    my $length = 5 + length($data);
    printf STDERR "server: ". "{%d|0x%.2x|%s}\n", $length, $control, $data;
    my $bp = pack("N C a*", $length, $control, $data);
    print $fd $bp;

    print STDERR "server: ". "control passed to agent\@here\n";
}

sub IdentifyLocalSecret ($) {
    my ($identifier) = @_;
    my $secret;

    my $whoami = `/usr/bin/whoami` ; chomp $whoami;
    if (open SECRETS, "< " .(getpwuid($<))[7]. "/.secret\@here") {
	my $line;
	while (defined ($line = <SECRETS>)) {
	    my ($id, $sec) = split /[\s]/, $line;
	    if ((defined $id) && ($id eq $identifier)) {
		$secret = $sec;
		last;
	    }
	}
	close SECRETS;
    }

    return $secret;
}