contrib/libpam/libpamc/test/agents/secret@here

   1 #!/usr/bin/perl
   2 #
   3 # This is a simple example PAM authentication agent, it implements a
   4 # simple shared secret authentication scheme. The PAM module pam_secret.so
   5 # is its counter part. Both the agent and the remote server are able to
   6 # authenticate one another, but the server is given the opportunity to
   7 # ignore a failed authentication.
   8 #
   9
  10 $^W = 1;
  11 use strict;
  12 use IPC::Open2;
  13 $| = 1;
  14
  15 # display extra information to STDERR
  16 my $debug = 0;
  17 if (scalar @ARGV) {
  18     $debug = 1;
  19 }
  20
  21 # Globals
  22
  23 my %state;
  24 my $default_key;
  25
  26 my $next_key = $$;
  27
  28 # loop over binary prompts
  29 for (;;) {
  30     my ($control, $data) = ReadBinaryPrompt();
  31     my ($reply_control, $reply_data);
  32
  33     if ($control == 0) {
  34         if ($debug) {
  35             print STDERR "agent: no packet to read\n";
  36         }
  37         last;
  38     } elsif ($control == 0x02) {
  39         ($reply_control, $reply_data) = HandleAgentSelection($data);
  40     } elsif ($control == 0x01) {
  41         ($reply_control, $reply_data) = HandleContinuation($data);
  42     } else {
  43         if ($debug) {
  44             print STDERR
  45                 "agent: unrecognized packet $control {$data} to read\n";
  46         }
  47         ($reply_control, $reply_data) = (0x04, "");
  48     }
  49
  50     WriteBinaryPrompt($reply_control, $reply_data);
  51 }
  52
  53 # Only willing to exit well if we've completed our authentication exchange
  54
  55 if (scalar keys %state) {
  56     if ($debug) {
  57         print STDERR "The following sessions are still active:\n  ";
  58         print STDERR join ', ', keys %state;
  59         print STDERR "\n";
  60     }
  61     exit 1;
  62 } else {
  63     exit 0;
  64 }
  65
  66 sub HandleAgentSelection ($) {
  67     my ($data) = @_;
  68
  69     unless ( $data =~ /^([a-zA-Z0-9_]+\@?[a-zA-Z0-9_.]*)\/(.*)$/ ) {
  70         return (0x04, "");
  71     }
  72
  73     my ($agent_name, $payload) = ($1, $2);
  74     if ($debug) {
  75         print STDERR "agent: ". "agent=$agent_name, payload=$payload\n";
  76     }
  77
  78     # this agent has a defined name
  79     if ($agent_name ne "secret\@here") {
  80         if ($debug) {
  81             print STDERR "bad agent name: [$agent_name]\n";
  82         }
  83         return (0x04, "");
  84     }
  85
  86     # the selection request is acompanied with a hexadecimal cookie
  87     my @tokens = split '\|', $payload;
  88
  89     unless ((scalar @tokens) == 2) {
  90         if ($debug) {
  91             print STDERR "bad payload\n";
  92         }
  93         return (0x04, "");
  94     }
  95
  96     unless ($tokens[1] =~ /^[a-z0-9]+$/) {
  97         if ($debug) {
  98             print STDERR "bad server cookie\n";
  99         }
 100         return (0x04, "");
 101     }
 102
 103     my $shared_secret = IdentifyLocalSecret($tokens[0]);
 104
 105     unless (defined $shared_secret) {
 106         # make a secret up
 107         if ($debug) {
 108             print STDERR "agent: cannot authenticate user\n";
 109         }
 110         $shared_secret = GetRandom();
 111     }
 112
 113     my $local_cookie = GetRandom();
 114     $default_key = $next_key++;
 115
 116     $state{$default_key} = $local_cookie ."|". $tokens[1] ."|". $shared_secret;
 117
 118     if ($debug) {
 119         print STDERR "agent: \$state{$default_key} = $state{$default_key}\n";
 120     }
 121
 122     return (0x01, $default_key ."|". $local_cookie);
 123 }
 124
 125 sub HandleContinuation ($) {
 126     my ($data) = @_;
 127
 128     my ($key, $server_digest) = split '\|', $data;
 129
 130     unless (defined $state{$key}) {
 131         # retries and out of sequence prompts are not permitted
 132         return (0x04, "");
 133     }
 134
 135     my $expected_digest = CreateDigest($state{$key});
 136     my ($local_cookie, $remote_cookie, $shared_secret)
 137         = split '\|', $state{$key};
 138     delete $state{$key};
 139
 140     unless ($expected_digest eq $server_digest) {
 141         if ($debug) {
 142             print STDERR "agent: don't trust server - faking reply\n";
 143             print STDERR "agent: got      ($server_digest)\n";
 144             print STDERR "agent: expected ($expected_digest)\n";
 145         }
 146
 147         ## FIXME: Agent should exchange a prompt with the client warning
 148         ## that the server is faking us out.
 149
 150         return (0x03, CreateDigest($expected_digest . $data . GetRandom()));
 151     }
 152
 153     if ($debug) {
 154         print STDERR "agent: server appears to know the secret\n";
 155     }
 156
 157     my $session_authenticated_ticket =
 158         CreateDigest($remote_cookie."|".$shared_secret."|".$local_cookie);
 159
 160     # FIXME: Agent should set a derived session key environment
 161     # variable (available for the client (and its children) to sign
 162     # future data exchanges.
 163
 164     if ($debug) {
 165         print STDERR "agent: should putenv("
 166             ."\"AUTH_SESSION_TICKET=$session_authenticated_ticket\")\n";
 167     }
 168
 169     # return agent's authenticating digest
 170     return (0x03, CreateDigest($shared_secret."|".$remote_cookie
 171                                ."|".$local_cookie));
 172 }
 173
 174 sub ReadBinaryPrompt {
 175     my $buffer = "     ";
 176     my $count = read(STDIN, $buffer, 5);
 177     if ($count == 0) {
 178         # no more packets to read
 179         return (0, "");
 180     }
 181
 182     if ($count != 5) {
 183         # broken packet header
 184         return (-1, "");
 185     }
 186
 187     my ($length, $control) = unpack("N C", $buffer);
 188     if ($length < 5) {
 189         # broken packet length
 190         return (-1, "");
 191     }
 192
 193     my $data = "";
 194     $length -= 5;
 195     while ($count = read(STDIN, $buffer, $length)) {
 196         $data .= $buffer;
 197         if ($count != $length) {
 198             $length -= $count;
 199             next;
 200         }
 201
 202         if ($debug) {
 203             print STDERR "agent: ". "data is [$data]\n";
 204         }
 205
 206         return ($control, $data);
 207     }
 208
 209     # broken packet data
 210     return (-1, "");
 211 }
 212
 213 sub WriteBinaryPrompt ($$) {
 214     my ($control, $data) = @_;
 215
 216     my $length = 5 + length($data);
 217     if ($debug) {
 218         printf STDERR "agent: ". "{%d|0x%.2x|%s}\n", $length, $control, $data;
 219     }
 220     my $bp = pack("N C a*", $length, $control, $data);
 221     print STDOUT $bp;
 222     if ($debug) {
 223         printf STDERR "agent: ". "agent has replied\n";
 224     }
 225 }
 226
 227 ##
 228 ## Here is where we parse the simple secret file
 229 ## The format of this file is a list of lines of the following form:
 230 ##
 231 ## user@client0.host.name  secret_string1
 232 ## user@client1.host.name  secret_string2
 233 ## user@client2.host.name  secret_string3
 234 ##
 235
 236 sub IdentifyLocalSecret ($) {
 237     my ($identifier) = @_;
 238     my $secret;
 239
 240     if (open SECRETS, "< ". (getpwuid($<))[7] ."/.secret\@here") {
 241         my $line;
 242         while (defined ($line = <SECRETS>)) {
 243             my ($id, $sec) = split /[\s]+/, $line;
 244             if ((defined $id) && ($id eq $identifier)) {
 245                 $secret = $sec;
 246                 last;
 247             }
 248         }
 249         close SECRETS;
 250     }
 251
 252     return $secret;
 253 }
 254
 255 ## Here is where we generate a message digest
 256
 257 sub CreateDigest ($) {
 258     my ($data) = @_;
 259
 260     my $pid = open2(\*MD5out, \*MD5in, "/usr/bin/md5sum -")
 261         or die "you'll need /usr/bin/md5sum installed";
 262
 263     my $oldfd = select MD5in; $|=1; select $oldfd;
 264     if ($debug) {
 265         print STDERR "agent: ". "telling md5: <$data>\n";
 266     }
 267     print MD5in "$data";
 268     close MD5in;
 269     my $reply = <MD5out>;
 270     ($reply) = split /\s/, $reply;
 271     if ($debug) {
 272         print STDERR "agent: ". "md5 said: <$reply>\n";
 273     }
 274     close MD5out;
 275
 276     return $reply;
 277 }
 278
 279 ## get a random number
 280
 281 sub GetRandom {
 282
 283     if ( -r "/dev/urandom" ) {
 284         open RANDOM, "< /dev/urandom" or die "crazy";
 285
 286         my $i;
 287         my $reply = "";
 288
 289         for ($i=0; $i<4; ++$i) {
 290             my $buffer = "    ";
 291             while (read(RANDOM, $buffer, 4) != 4) {
 292                 ;
 293             }
 294             $reply .= sprintf "%.8x", unpack("N", $buffer);
 295             if ($debug) {
 296                 print STDERR "growing reply: [$reply]\n";
 297             }
 298         }
 299         close RANDOM;
 300
 301         return $reply;
 302     } else {
 303         print STDERR "agent: ". "[got linux?]\n";
 304         return "%.8x%.8x%.8x%.8x", time, time, time, time;
 305     }
 306
 307 }
 308