contrib/libpam/libpamc/test/regress/test.secret@here

   1 #!/usr/bin/perl
   2
   3 ##
   4 ## this is a test script for regressing changes to the secret@here PAM
   5 ## agent
   6 ##
   7
   8 $^W = 1;
   9 use strict;
  10 use IPC::Open2;
  11
  12 $| = 1;
  13
  14 my $whoami = `/usr/bin/whoami`; chomp $whoami;
  15 my $cookie = "12345";
  16 my $user_domain = "$whoami\@local.host";
  17
  18 my $pid = open2(\*Reader, \*Writer, "../agents/secret\@here blah")
  19     or die "failed to load secret\@here agent";
  20
  21 unless (-f (getpwuid($<))[7]."/.secret\@here") {
  22     print STDERR "server: ". "no " .(getpwuid($<))[7]. "/.secret\@here file\n";
  23     die "no config file";
  24 }
  25
  26 WriteBinaryPrompt(\*Writer, 0x02, "secret\@here/$user_domain|$cookie");
  27
  28 my ($control, $data) = ReadBinaryPrompt(\*Reader);
  29
  30 print STDERR "server: ". "reply: control=$control, data=$data\n";
  31 if ($control != 1) {
  32     die "expected 1 (OK) for the first agent reply; got $control";
  33 }
  34 my ($seqid, $a_cookie) = split '\|', $data;
  35
  36 # server needs to convince agent that it knows the secret before
  37 # agent will give a valid response
  38 my $secret = IdentifyLocalSecret($user_domain);
  39 my $digest = CreateDigest($a_cookie."|".$cookie."|".$secret);
  40
  41 print STDERR "server: ". "digest = $digest\n";
  42 WriteBinaryPrompt(\*Writer, 0x01, "$seqid|$digest");
  43
  44 # The agent will authenticate us and then reply with its
  45 # authenticating digest. we check that before we're done.
  46
  47 ($control, $data) = ReadBinaryPrompt(\*Reader);
  48 if ($control != 0x03) {
  49     die "server: agent did not reply with a 'done' prompt ($control)\n";
  50 }
  51
  52 unless ($data eq CreateDigest($secret."|".$cookie."|".$a_cookie)) {
  53     die "server: agent is not authenticated\n";
  54 }
  55
  56 print STDERR "server: agent appears to know secret\n";
  57
  58 my $session_authenticated_ticket
  59     = CreateDigest($cookie."|".$secret."|".$a_cookie);
  60
  61 print STDERR "server: should putenv("
  62             ."\"AUTH_SESSION_TICKET=$session_authenticated_ticket\")\n";
  63
  64 exit 0;
  65
  66 sub CreateDigest ($) {
  67     my ($data) = @_;
  68
  69     my $pid = open2(\*MD5out, \*MD5in, "/usr/bin/md5sum -")
  70         or die "you'll need /usr/bin/md5sum installed";
  71
  72     my $oldfd = select MD5in; $|=1; select $oldfd;
  73     print MD5in "$data";
  74     close MD5in;
  75     my $reply = <MD5out>;
  76     ($reply) = split /\s/, $reply;
  77     print STDERR "server: ". "md5 said: <$reply>\n";
  78     close MD5out;
  79
  80     return $reply;
  81 }
  82
  83 sub ReadBinaryPrompt ($) {
  84     my ($fd) = @_;
  85
  86     my $buffer = "     ";
  87     my $count = read($fd, $buffer, 5);
  88     if ($count == 0) {
  89         # no more packets to read
  90         return (0, "");
  91     }
  92
  93     if ($count != 5) {
  94         # broken packet header
  95         return (-1, "");
  96     }
  97
  98     my ($length, $control) = unpack("N C", $buffer);
  99     if ($length < 5) {
 100         # broken packet length
 101         return (-1, "");
 102     }
 103
 104     my $data = "";
 105     $length -= 5;
 106     while ($count = read($fd, $buffer, $length)) {
 107         $data .= $buffer;
 108         if ($count != $length) {
 109             $length -= $count;
 110             next;
 111         }
 112
 113         print STDERR "server: ". "data is [$data]\n";
 114
 115         return ($control, $data);
 116     }
 117
 118     # broken packet data
 119     return (-1, "");
 120 }
 121
 122 sub WriteBinaryPrompt ($$$) {
 123     my ($fd, $control, $data) = @_;
 124
 125     my $length = 5 + length($data);
 126     printf STDERR "server: ". "{%d|0x%.2x|%s}\n", $length, $control, $data;
 127     my $bp = pack("N C a*", $length, $control, $data);
 128     print $fd $bp;
 129
 130     print STDERR "server: ". "control passed to agent\@here\n";
 131 }
 132
 133 sub IdentifyLocalSecret ($) {
 134     my ($identifier) = @_;
 135     my $secret;
 136
 137     my $whoami = `/usr/bin/whoami` ; chomp $whoami;
 138     if (open SECRETS, "< " .(getpwuid($<))[7]. "/.secret\@here") {
 139         my $line;
 140         while (defined ($line = <SECRETS>)) {
 141             my ($id, $sec) = split /[\s]/, $line;
 142             if ((defined $id) && ($id eq $identifier)) {
 143                 $secret = $sec;
 144                 last;
 145             }
 146         }
 147         close SECRETS;
 148     }
 149
 150     return $secret;
 151 }
 152