summaryrefslogtreecommitdiffstats
path: root/libpamc/test/agents
diff options
context:
space:
mode:
Diffstat (limited to 'libpamc/test/agents')
-rwxr-xr-xlibpamc/test/agents/secret@here307
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;
+ }
+
+}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-20 00:59:44 +0000