diff options
Diffstat (limited to 'libpamc/test/agents/secret@here')
-rwxr-xr-x | libpamc/test/agents/secret@here | 307 |
1 files changed, 307 insertions, 0 deletions
diff --git a/libpamc/test/agents/secret@here b/libpamc/test/agents/secret@here new file mode 100755 index 0000000..8d82c01 --- /dev/null +++ b/libpamc/test/agents/secret@here @@ -0,0 +1,307 @@ +#!/usr/bin/perl +# +# This is a simple example PAM authentication agent, it implements a +# simple shared secret authentication scheme. The PAM module pam_secret.so +# is its counter part. Both the agent and the remote server are able to +# authenticate one another, but the server is given the opportunity to +# ignore a failed authentication. +# + +$^W = 1; +use strict; +use IPC::Open2; +$| = 1; + +# display extra information to STDERR +my $debug = 0; +if (scalar @ARGV) { + $debug = 1; +} + +# Globals + +my %state; +my $default_key; + +my $next_key = $$; + +# loop over binary prompts +for (;;) { + my ($control, $data) = ReadBinaryPrompt(); + my ($reply_control, $reply_data); + + if ($control == 0) { + if ($debug) { + print STDERR "agent: no packet to read\n"; + } + last; + } elsif ($control == 0x02) { + ($reply_control, $reply_data) = HandleAgentSelection($data); + } elsif ($control == 0x01) { + ($reply_control, $reply_data) = HandleContinuation($data); + } else { + if ($debug) { + print STDERR + "agent: unrecognized packet $control {$data} to read\n"; + } + ($reply_control, $reply_data) = (0x04, ""); + } + + WriteBinaryPrompt($reply_control, $reply_data); +} + +# Only willing to exit well if we've completed our authentication exchange + +if (scalar keys %state) { + if ($debug) { + print STDERR "The following sessions are still active:\n "; + print STDERR join ', ', keys %state; + print STDERR "\n"; + } + exit 1; +} else { + exit 0; +} + +sub HandleAgentSelection ($) { + my ($data) = @_; + + unless ( $data =~ /^([a-zA-Z0-9_]+\@?[a-zA-Z0-9_.]*)\/(.*)$/ ) { + return (0x04, ""); + } + + my ($agent_name, $payload) = ($1, $2); + if ($debug) { + print STDERR "agent: ". "agent=$agent_name, payload=$payload\n"; + } + + # this agent has a defined name + if ($agent_name ne "secret\@here") { + if ($debug) { + print STDERR "bad agent name: [$agent_name]\n"; + } + return (0x04, ""); + } + + # the selection request is acompanied with a hexadecimal cookie + my @tokens = split '\|', $payload; + + unless ((scalar @tokens) == 2) { + if ($debug) { + print STDERR "bad payload\n"; + } + return (0x04, ""); + } + + unless ($tokens[1] =~ /^[a-z0-9]+$/) { + if ($debug) { + print STDERR "bad server cookie\n"; + } + return (0x04, ""); + } + + my $shared_secret = IdentifyLocalSecret($tokens[0]); + + unless (defined $shared_secret) { + # make a secret up + if ($debug) { + print STDERR "agent: cannot authenticate user\n"; + } + $shared_secret = GetRandom(); + } + + my $local_cookie = GetRandom(); + $default_key = $next_key++; + + $state{$default_key} = $local_cookie ."|". $tokens[1] ."|". $shared_secret; + + if ($debug) { + print STDERR "agent: \$state{$default_key} = $state{$default_key}\n"; + } + + return (0x01, $default_key ."|". $local_cookie); +} + +sub HandleContinuation ($) { + my ($data) = @_; + + my ($key, $server_digest) = split '\|', $data; + + unless (defined $state{$key}) { + # retries and out of sequence prompts are not permitted + return (0x04, ""); + } + + my $expected_digest = CreateDigest($state{$key}); + my ($local_cookie, $remote_cookie, $shared_secret) + = split '\|', $state{$key}; + delete $state{$key}; + + unless ($expected_digest eq $server_digest) { + if ($debug) { + print STDERR "agent: don't trust server - faking reply\n"; + print STDERR "agent: got ($server_digest)\n"; + print STDERR "agent: expected ($expected_digest)\n"; + } + + ## FIXME: Agent should exchange a prompt with the client warning + ## that the server is faking us out. + + return (0x03, CreateDigest($expected_digest . $data . GetRandom())); + } + + if ($debug) { + print STDERR "agent: server appears to know the secret\n"; + } + + my $session_authenticated_ticket = + CreateDigest($remote_cookie."|".$shared_secret."|".$local_cookie); + + # FIXME: Agent should set a derived session key environment + # variable (available for the client (and its children) to sign + # future data exchanges. + + if ($debug) { + print STDERR "agent: should putenv(" + ."\"AUTH_SESSION_TICKET=$session_authenticated_ticket\")\n"; + } + + # return agent's authenticating digest + return (0x03, CreateDigest($shared_secret."|".$remote_cookie + ."|".$local_cookie)); +} + +sub ReadBinaryPrompt { + my $buffer = " "; + my $count = read(STDIN, $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(STDIN, $buffer, $length)) { + $data .= $buffer; + if ($count != $length) { + $length -= $count; + next; + } + + if ($debug) { + print STDERR "agent: ". "data is [$data]\n"; + } + + return ($control, $data); + } + + # broken packet data + return (-1, ""); +} + +sub WriteBinaryPrompt ($$) { + my ($control, $data) = @_; + + my $length = 5 + length($data); + if ($debug) { + printf STDERR "agent: ". "{%d|0x%.2x|%s}\n", $length, $control, $data; + } + my $bp = pack("N C a*", $length, $control, $data); + print STDOUT $bp; + if ($debug) { + printf STDERR "agent: ". "agent has replied\n"; + } +} + +## +## Here is where we parse the simple secret file +## The format of this file is a list of lines of the following form: +## +## user@client0.host.name secret_string1 +## user@client1.host.name secret_string2 +## user@client2.host.name secret_string3 +## + +sub IdentifyLocalSecret ($) { + my ($identifier) = @_; + my $secret; + + 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; +} + +## Here is where we generate a message digest + +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; + if ($debug) { + print STDERR "agent: ". "telling md5: <$data>\n"; + } + print MD5in "$data"; + close MD5in; + my $reply = <MD5out>; + ($reply) = split /\s/, $reply; + if ($debug) { + print STDERR "agent: ". "md5 said: <$reply>\n"; + } + close MD5out; + + return $reply; +} + +## get a random number + +sub GetRandom { + + if ( -r "/dev/urandom" ) { + open RANDOM, "< /dev/urandom" or die "crazy"; + + my $i; + my $reply = ""; + + for ($i=0; $i<4; ++$i) { + my $buffer = " "; + while (read(RANDOM, $buffer, 4) != 4) { + ; + } + $reply .= sprintf "%.8x", unpack("N", $buffer); + if ($debug) { + print STDERR "growing reply: [$reply]\n"; + } + } + close RANDOM; + + return $reply; + } else { + print STDERR "agent: ". "[got linux?]\n"; + return "%.8x%.8x%.8x%.8x", time, time, time, time; + } + +} |