;#
;# ident.pl: identify remote user using ident protocol (RFC-1413)
;#
;# Copyright (c) 1991-1994 Kazumasa Utashiro <utashiro@sra.co.jp>
;# Software Research Associates, Inc.
;# 1-1-1 Hirakawa-cho, Chiyoda-ku, Tokyo 102, Japan
;#
;# Original: Apr 27 1994
;; $rcsid = q$Id: ident.pl,v 1.3 1994/05/06 16:41:42 utashiro Exp $;
;#
;# DESCRIPTION
;#
;# $userid = &ident(FILEHANDLE);
;# $userid = &ident(FILEHANDLE, TIMEOUT);
;#
;#	&ident returns remote user name in scalar context.  If the
;#	ident server returns error or connection to the ident server
;#	failed, 'undef' is returned.
;#
;# ($fport, $lport, $restype, $os, $userid) = &ident(FILEHANDLE);
;# ($fport, $lport, $restype, $os, $userid) = &ident(FILEHANDLE, TIMEOUT);
;#
;#	In array context, it returs a list of foreign port, local
;#	port, type of response, operating system type and userid.  If
;#	$restype is not 'USERID', later values have different
;#	meanings.  See RFC-1413 for detail.  &ident retuns 'undef' if
;#	it couldn't connect to the ident server.
;#
;# If the second argument given, it specifies timeout in second.
;# Default timeout is five second.  You can also spcify the ident port
;# number (113 by default) of remote host in the third argument but
;# probably nobody want to use this.
;#
;#
;# Redistribution of this software for non-commercial purpose, without
;# modification, is granted as long as all copyright notices are
;# retained.  Contact the author if you want to distribute in modified
;# form.
;#
;# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
;# OR IMPLIED WARRANTIES ARE DISCLAIMED.
;#

package main;

require 'sys/socket.ph';


package ident;

sub main'ident {

    local($[) = 0;
    local($_);

    local($FH) = sprintf("%s'%s", (caller)[0], shift);
    local($timeout) = shift || 5;			# timeout (5 sec.)
    local($identport) = shift || 113;			# port number (113)

    local($lsockaddr, $lfamily, $lport, $laddr);	# local
    local($fsockaddr, $ffamily, $fport, $faddr);	# foreign
    local($userid, @ident);

    $sockaddr = 'S n a4 x8';
    ($name, $aliases, $TCP) = getprotobyname('tcp');

    unless ($lsockaddr = getsockname($FH)) {
	&debug("getsockname: %s\n", $!);
	return undef;
    }

    unless ($fsockaddr = getpeername($FH)) {
	&debug("getpeername: %s\n", $!);
	return undef;
    }

    ($lfamily, $lport, $laddr) = unpack($sockaddr, $lsockaddr);
    ($ffamily, $fport, $faddr) = unpack($sockaddr, $fsockaddr);

    $identaddr = pack($sockaddr, &'AF_INET, $identport, $faddr);

    ($name, $aliases, $TCP) = getprotobyname('tcp');

    unless (socket(S, &'PF_INET, &'SOCK_STREAM, $TCP)) {
	&debug("socket: %s\n", $!);
	close(S);
	return undef;
    }

    unless (connect(S, $identaddr)) {
	&debug("connect: %s\n", $!);
	close(S);
	return undef;
    }

    select((select(S), $| = 1)[0]);
    printf S "%d, %d\r\n", $fport, $lport;

    local($rin, $rout) = ('', '');
    vec($rin, fileno(S), 1) = 1;
    local($nfound, $timeleft) = select($rout = $rin, undef, undef, $timeout);

    if ($nfound) {
	$_ = <S>;
	&debug("%s", $_);
	s/[\r\n][\000-\377]*//;
	if (s/^\s*(\d+)\s*,\s*(\d+)\s*:\s*//) {		# fport , lport :
	    @ident = ($1, $2, split(/\s*:\s*/, $_, 3));
	    $userid = $ident[4] if $ident[2] eq 'USERID';
	}
    }

    close(S);

    wantarray ? @ident : $userid;
}

sub debug {
    return unless $debug;
    if (@_ == 1) {
	print STDERR @_;
    } else {
	printf STDERR @_;
    }
}

1;