#!/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;
}