#!/usr/bin/perl
##
## $Id: generate.pl,v 1.2 1999/09/04 05:26:39 morgan Exp morgan $
##
## Andrew Morgan <morgan@linux.kernel.org>
##
## this is a test script for regressing changes to the
## fp240x240@prototype1 PAM agent. Just run
##
##    ./generate.pl
##
## which will initialize the agent correctly.
##
## It can also be used to save a raw fingerprint to a named file. To do
## that, run this command:
##
##    ./generate.pl <filename>
##

$^W = 1;
use strict;
use IPC::Open2;

$| = 1;

my $whoami = `/usr/bin/whoami`; chomp $whoami;

my $pid = open2(\*Reader, \*Writer, "env - /lib/pamc/fp240x240\@prototype1")
    or die "failed to load fp240x240\@prototype1 agent";

WriteBinaryPrompt(\*Writer, 0x02, "fp240x240\@prototype1/1$whoami");

my ($control, $data);

do {
    ($control, $data) = ReadBinaryPrompt(\*Reader);

    print STDERR "server: got a reply\n";
    print STDERR "server: ". "reply: control=$control, datalen=". 
	length($data) ."\n";
    if (($control != 3) && ($control != 0x41)) {
	die "expected 3 (DONE) or 0x41 (GETENV) for agent reply; got $control";
    }

    if ($control == 0x41) {
	print STDERR "agent asked for env[$data]\n";
	unless (defined $ENV{$data}) {
	    print STDERR "len=" . length($data). "\n";
	    my $key;
	    foreach $key (keys %ENV) {
		print STDERR "env: $key -> $ENV{$key}\n";
		if ($key eq $data) {
		    die "how did we get here?";
		}
	    }
	    print STDERR "agent asked for env[$data]\n";
	    die "agent asked for env<$data>";
	}
	WriteBinaryPrompt(\*Writer, 0x01, $ENV{$data});
    }
} while ($control != 3);

# fp data is a 240x240 bitmap with 256 levels of grey (1 byte per pixel)
if (scalar(@ARGV) && (length($data) > (240*240))) {
    open DUMP, "> $ARGV[0]"
	or die "failed to open $ARGV[0] in order to write fingerprint";
    print DUMP substr($data, 0, 240*240);
    close DUMP;
}

exit 0;

sub ReadBinaryPrompt ($) {
    my ($fd) = @_;

    my $buffer = "     ";
    my $count = read($fd, $buffer, 5);
    if ($count == 0) {
	# no more packets to read
	return (0, "");
    }

    if ($count != 5) {
	print STDERR "broken packet header ($count)\n";
	return (-1, "");
    }
    
    my ($length, $control) = unpack("N C", $buffer);
    if ($length < 5) {
	print STDERR "broken packet header ($length)\n";
	return (-1, "");
    }

    my $data = "";
    $length -= 5;
    while ($length && ($count = read($fd, $buffer, $length))) {
	$data .= $buffer;
	$length -= $count;
    }

    print STDERR "server: ". "data is ". length($data) ." long\n";
    if ($length) {
	# broken packet data
	return (-1, "");
    } else {
	return ($control, $data);
    }
}

sub WriteBinaryPrompt ($$$) {
    my ($fd, $control, $data) = @_;

    my $length = 5 + length($data);
    printf STDERR "server: ". "{%d|0x%.2x|%s}\n", $length, $control, $data;
    my $bp = pack("N C a*", $length, $control, $data);
    print $fd $bp;

    print STDERR "server: ". "control passed to agent\n";
}

