summaryrefslogtreecommitdiff
path: root/libpamc/test/agents
diff options
context:
space:
mode:
Diffstat (limited to 'libpamc/test/agents')
-rwxr-xr-xlibpamc/test/agents/secret@here308
1 files changed, 0 insertions, 308 deletions
diff --git a/libpamc/test/agents/secret@here b/libpamc/test/agents/secret@here
deleted file mode 100755
index afdcbaa8..00000000
--- a/libpamc/test/agents/secret@here
+++ /dev/null
@@ -1,308 +0,0 @@
-#!/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;
- }
-
-}
-
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-26 22:43:51 +0000