#! /usr/local/bin/perl -wc
#
#V  WireRFC931.pm V3.0  2 Mar 1998 with init, allowing asynchronous call
#   WireRFC931.pm V2.1 25 Mar 1996 with "use Wire"
#   WireRFC931.pm V2.0 22 Nov 1995 with remote_user_raw
#   WireRFC931.pm V1.1 17 Feb 1995
#   Jim Richardson, University of Sydney
#   jimr@maths.usyd.edu.au or http://www.maths.usyd.edu.au:8000/jimr.html

package WireRFC931;

#   Use RFC931 to try to find the name of the user at the other end of a socket.
#   Call via
#
#	$result = remote_user( SOCKHDL [, $timeout ] );
#
#   where SOCKHDL is the file handle for the socket, and $timeout is an optional
#   timeouit in seconds, defaulting to 15.  The result will be in the form
#
#	user@host
#
#   where user is either a username or an error message in parentheses (most
#   commonly '( REFUSED )'), and host is a fully qualified domain name, or if
#   that is unavailable an IP address in dotted-decimal form.
#
#   There is an alternative call
#
#	$result = remote_user_raw( $rawsock, $rawpeer [, $timeout ] );
#
#   where $rawsock and $rawpeer are the addresses of the local and remote end of
#   the socket in sockaddr form.
#
#   To allow use of time spent waiting for the remote server to reply, there is a
#   third calling sequence making use of a WireRFC931 object:
#
#	$wr = WireRFC931->init( $rawsock, $rawpeer [, $timeout ] );
#	...
#	$result = $wr->get_remote_user();
#
#   It is not necessary to close $wr afterwards; its internal storage is deleted
#   by get_remote_user.

    require Exporter;
    @ISA = qw( Exporter Wire );
    @EXPORT = qw( remote_user remote_user_raw );

    use Wire;

BEGIN
{
    $rfc931_port = 113;		# semi-well-known RFC931 authd port

    $AF_INET = 2;
}

sub init
{
    my $class = shift;
    my ( $rawsock, $rawpeer, $timeout ) = @_;
    
    my ( $ourport, $ouraddr, $cliport, $cliaddr, $wr, $errmsg );

    ( $ourport, $ouraddr ) = unpack( 'x2 n a4', $rawsock );
    ( $cliport, $cliaddr ) = unpack( 'x2 n a4', $rawpeer );

    #  Open wire to remote RFC931 daemon, and send request

    if( not ( $wr = Wire->open( ADDR => $cliaddr,  PORT => $rfc931_port,
	    LOCALADDR => $ouraddr, TIMEOUT => $timeout || 15,
	    CALLBACK => sub { $errmsg = $_[0] } ) )
	or not $wr->print( sprintf "%u,%u\r\n", $cliport, $ourport ) )
    {
	#  Something failed: remember this

	$wr = {}, $wr->{ OPENFAIL } = 1 unless $wr;
	$wr->{ INITFAIL } = $errmsg;
    }

    @$wr{ CLIADDR, CLIPORT, OURPORT } = ( $cliaddr, $cliport, $ourport );

    return bless $wr, $class;
}

sub get_remote_user
{
    my ( $wr ) = @_;

    my( $line, $user, $host );

    if( not( $line = $wr->{ INITFAIL } )
	and ( $line = $wr->readline ) =~
		m!^(\d+)\s*,\s*(\d+)\s*:\s*USERID\s*:[^:]*:\s*([^\r\n]*)!
	and $1 == $wr->{ CLIPORT } and $2 == $wr->{ OURPORT } )
    {
	#  Success ...

	$user = $3;
    }
    else
    {
	#  Tidy up error message and return, parenthesized, as $user

	( $user = $line ) =~ s![\r\n]! !g;
	$user =~ s! +$!!;
	$user =~ s!failed to open \S+ \(connection refused\)!REFUSED!;
	$user = "( $user )";
    }

    #  Use host name if possible, otherwise dotted-decimal IP address

    $host = ( gethostbyaddr( $wr->{ CLIADDR }, $AF_INET ) )[0] ||
	join( '.', unpack( C4, $wr->{ CLIADDR } ) );

    $wr->close unless $wr->{ OPENFAIL };
    undef %$wr;

    "$user\@$host";
}

sub remote_user_raw
{
    my $wr = WireRFC931->init( @_ );
    $wr->get_remote_user();
}

sub remote_user
{
    my ( $sock, $timeout ) = @_;

    remote_user_raw( getsockname( $sock ), getpeername( $sock ), $timeout );
}

1;

#!#