# $File: //depot/OurNet-BBS/BBS/Client.pm $ $Author: autrijus $
# $Revision: #21 $ $Change: 1581 $ $DateTime: 2001/08/28 07:27:35 $

package OurNet::BBS::Client;

use strict;
use OurNet::BBS::Base;

our $Ego;

use overload (
    '""'   => sub { overload::AddrRef($_[0]) },
    '<=>'  => sub { "$_[0]" cmp "$_[1]" },
    'cmp'  => sub { "$_[0]" cmp "$_[1]" },
    'bool' => sub { 1 },
    '0+'   => sub { 0 },
    map {
	my $type = $_; 
	( SIGILS->[$type].'{}' => sub {
	    my $self = ${$_[0]};
	    $Ego = $self->[0];
	    return $self->[$type];
	} );
    } ( HASH .. GLOB ) 
);

use RPC::PlClient;
use Digest::MD5 qw/md5/;
use OurNet::BBS::Authen;

use enum qw/id remote_ref optree/;
use enum qw/BITMASK:CIPHER_ NONE BASIC PGP/;
use enum qw/BITMASK:AUTH_   NONE CRYPT PGP/;

our ($AUTOLOAD, $Port);

$Port = 7979;

my $OP = $OurNet::BBS::Authen::OP;
my (%Cache, @delegators);

tie my %obj  => __PACKAGE__, 'HASH_';
tie my @obj  => __PACKAGE__, 'ARRAY_';
tie my $code => __PACKAGE__, 'CODE_'; # XXX: not working
tie my $glob => __PACKAGE__, 'GLOB_'; # XXX: not working

sub TIEHASH   { bless(\[$_[1]], $_[0]) }
sub TIEARRAY  { bless(\[$_[1]], $_[0]) }
sub TIESCALAR { bless(\[$_[1]], $_[0]) }

# spawn (optree_id)
sub _spawn {
    my $self = [ $Ego->[id], @_ ];

    show("SPAWN: @_\n");

    # warning: one-arg bless!
    return bless(\[$self, \%obj, \@obj, \$code, \$glob, 'OBJECT_']);
}

sub new {
    my ($class, $peeraddr, $peerport, 
	$keyid, $user, $pass, $cipher_level, $auth_level) = @_; 

    my $self = [];

    $self->[id] = scalar @delegators; # 1 more than max

    $delegators[$self->[id]] = RPC::PlClient->new(
	peeraddr    => $peeraddr,
	peerport    => $peerport || $Port,
	application => 'OurNet::BBS::Server',
	version     => $OurNet::BBS::Authen::VERSION,
    )->ClientObject('__', 'spawn');

    my $client = $delegators[$self->[id]];

## Initialization #####################################################
# spawn a handle and get server's accepted modes.

    unless ($OurNet::BBS::BYPASS_NEGOTIATION) {
	($cipher_level, $auth_level) = $client->handshake(
	    OurNet::BBS::Authen->adjust(
		$cipher_level, $auth_level, $keyid, 1
	    )
	) or print "[Client] initialization failed.\n" and die;

	my ($status, $auth) = negotiate_cipher($client, $cipher_level)
	    or print "[Client] cipher negotiation failed.\n" and die;

	negotiate_auth($client, $auth_level, $auth, $keyid, $user, $pass)
	    or print "[Client] authentication failed.\n" and die;

	$self->[remote_ref] = negotiate_locate($client)
	    or print "[Client] object location failed.\n" and die;
    }

    show("done!\n");
    
    return bless(\[$self, \%obj, \@obj, \$code, \$glob, 'OBJECT_'], $class);
}

sub negotiate_locate {
    my $client = shift;

    return $client->locate(@_);
}

sub make_auth {
    my ($keyid, $pubkey) = @_;

    my $auth = OurNet::BBS::Authen->new($keyid) or return;
    $auth->import_key($pubkey);

    return $auth;
}

sub negotiate_cipher {
    my ($client, $mode, $auth) = @_;

## Seed Phase #########################################################
# gets supported cipher suites and (optionally) server's public key

    my $cipher = OurNet::BBS::Authen->suites($client->get_suites)
	if $mode & (CIPHER_BASIC | CIPHER_PGP);

    show("[Client] agreed on cipher: $cipher ") if $cipher;

    if ($cipher and $mode & CIPHER_PGP) {
	$auth = make_auth($client->get_pubkey);

## Cipher Phase #######################################################
# try each mutually acceptable cipher schemes in turn to set cipher

	if ($auth and cipher_pgp($client, $cipher, $auth)) {
	    show("in secure mode.\n");
	    return(CIPHER_PGP, $auth);
	}
    }

    if ($cipher and $mode & CIPHER_BASIC) {
	if (cipher_basic($client, $cipher)) {
	    show("in insecure mode.\n");
	    return(CIPHER_BASIC, $auth);
	}
    }

    if ($mode & CIPHER_NONE and cipher_none($client)) {
	show("[Client] warning: using plaintext communication.\n");
	return(CIPHER_NONE, $auth);
    }

    show("failed!\n");
    return;
}

sub cipher_pgp {
    my ($client, $cipher, $auth) = @_;

    my $keysize = $cipher->keysize || (
	$cipher eq 'Crypt::Blowfish' ? 56 : 8
    );

    # make session key
    my $session_key = md5(rand);
    $session_key .= md5(rand) until length($session_key) >= $keysize;
    $session_key = substr($session_key, 0, $keysize);

    my $authcrypt = $auth->encrypt($session_key) or return; # encrypt it
    $client->cipher_pgp($cipher, $authcrypt) or return;	    # send it back

    $client->{client}{cipher} = $cipher->new($session_key);

    return $auth;
}

sub cipher_basic {
    my ($client, $cipher) = @_;
    my ($status, $session) = $client->cipher_basic($cipher) or return;

    return ($client->{client}{cipher} = $cipher->new($session));
}

sub cipher_none {
    my ($client) = @_;
    return $client->cipher_none;
}

## Auth Phase #########################################################
# log in by trying each mutually acceptable authentication schemes

sub negotiate_auth {
    my ($client, $mode, $auth, $keyid, $user, $pass) = @_;

    # Authentication Negotiation
    show("[Client] begin authentication...");

    if ($mode & AUTH_PGP and $auth ||= make_auth($client->get_pubkey)) {
	# public key authentication
	show("trying pubkey...");
	return AUTH_PGP if auth_pgp(
	    $client, $auth, $keyid, $user, $pass
	);
    }

    if ($mode & AUTH_CRYPT and $user) {
	# crypt-based authentication
	show("trying crypt...");
	return AUTH_CRYPT if auth_crypt($client, $user, $pass);
    }

    if ($mode & AUTH_NONE and $client->auth_none) {
	# no authentication at all
	show("fallback to none...");
	return AUTH_NONE;
    }

    show("failed!\n");
    return;
}

sub auth_pgp {
    my ($client, $auth, $keyid, $login, $passphrase) = @_;
    return unless $keyid and $login and defined $passphrase;

    $auth->{keyid} = $keyid;
    $auth->setpass($passphrase);

    my $challenge = $client->auth_pgp($login);

    if ($challenge eq $OP->{STATUS_NO_USER}) {
	show('no such user! ');
	return;
    }
    elsif ($challenge eq $OP->{STATUS_NO_PUBKEY}) {
	show('no public key info! ');
	return;
    }
    elsif ($challenge eq $OP->{STATUS_OK}) {
	show("challenge($challenge)");
	$challenge = $client->set_pubkey($auth->export_key);
    }

    if ($challenge eq $OP->{STATUS_BAD_PUBKEY}) {
	show('public key mismatch! ');
	return;
    }

    my $signature = $auth->clearsign($challenge)
	or show('cannot make signature! ') and return;

    if ($client->set_sign($signature) eq $OP->{STATUS_BAD_SIGNATURE}) {
	show('signature rejected! ');
	return;
    }

    return 1;
}

sub auth_crypt {
    my ($client, $user, $pass) = @_;
    my ($status, $salt) = $client->auth_crypt($user) or return;

    if ($status eq $OP->{STATUS_NO_USER}) {
	show('no such user! ');
	return;
    }

    return (
	$client->set_crypted(crypt($pass, $salt)) eq $OP->{STATUS_ACCEPTED}
    );
}

sub auth_none {
    my ($client) = @_;
    return $client->auth_none;
}

sub quit {
    foreach my $client (@delegators) {
	$client->quit if $client;
    }

    undef @delegators;
}

sub show {
    no warnings 'once';
    print $_[0] if $OurNet::BBS::DEBUG;
}

## Connected ##########################################################
# do the real job via AUTOLOAD passing and ArrayHashMonster magic

sub AUTOLOAD {
    my ($ego, $op);

    no strict 'refs';

    my $action = substr($AUTOLOAD, (
	(rindex($AUTOLOAD, ':') + 1) || return
    ));

    # install a closure-based handler for future use instead of AUTOLOAD
*{$AUTOLOAD} = sub {
    no warnings 'uninitialized';

    my ($self, $op) = @{${+shift}}[0, -1];

    local $Ego = $self if ($op eq 'OBJECT_');

    $op .= $action;

    my @result = $delegators[$Ego->[id]]->__(
	$OP->{$op} || $op, $Ego->[optree], map { 
	    ref($_) eq __PACKAGE__ ? bless(\(${$_}->[0][optree]), '__') : $_ 
	} @_
    );

    if (@result == 4 and !$result[0] and my $opcode = $result[1]) {
        return ($Cache{$result[2]} ||= _spawn(@result[2, 3]))
	    if $OP->{$opcode} eq 'OBJECT_SPAWN';

	return @result if $OP->{$opcode} eq 'STATUS_IGNORED';

        die "@result[2, 3] [$OP->{$opcode}]\n";
    }

#   print ("<==:  ".(wantarray ? "@result" : $result[0]), "\n");
    return wantarray ? @result : $result[0];
} unless exists(&{$AUTOLOAD});

    goto &{$AUTOLOAD};
}

# couldn't care less
sub UNTIE() {}
sub DESTROY() {}

1;

