Adding upstream version 1.4.0.upstream/1.4.0upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

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;
+    }
+
+}