Article 4267 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:4267
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!wupost!usc!elroy.jpl.nasa.gov!ames!koriel!sh.wide!wnoc-tyo-news!sranha!sranhd!sran230!utashiro
From: utashiro@sran230.sra.co.jp (Kazumasa Utashiro)
Subject: Re: How to get the ip-address of socket 0
References: <PFEIFER.93Jul15150816@linus.ls6.informatik.uni-dortmund.de>
Organization: Software Research Associates, Inc., Japan
Date: Fri, 16 Jul 1993 01:41:45 GMT
Message-ID: <CA8I1M.ADs@sran230.sra.co.jp>
Lines: 191

In article <PFEIFER.93Jul15150816@linus.ls6.informatik.uni-dortmund.de>
	Ulrich Pfeifer <pfeifer@ls6.informatik.uni-dortmund.de> writes:
> I've a little (hopefully) problem setting up an tcp/ip server. The server ist
> started by inetd an i want to find the ip-address of the machine the client
> runs on for logging purposes. Reading the manual i found no way to investigate
> socket 0.
> 
>         $sockaddr = 'S n a4 x8';
>         $mysockaddr = getpeername(0);
>         ($family, $port, $myaddr, $mist) =
>            unpack($sockaddr,$mysockaddr);
> 
> Does't work. Preciselly getpeername(0) returns nothing.

Use getpeername(STDIN).  I'm enclosing sample program which
you can use from inetd.  Some more tcp related program can
be get from srawgw.sra.co.jp:pub/lang/perl/sra-scripts via
anonymous ftp.

---
K. Utashiro
utashiro@sra.co.jp

#!/usr/local/bin/perl
;#
;# tcpconnect: make a connection to remote port by tcp
;#
;# Copyright (c) 1991,1992 Kazumasa Utashiro <utashiro@sra.co.jp>
;# Software Research Associates, Inc., Japan
;#
;; $rcsid = q$Id: tcpconnect,v 0.4 1992/12/17 07:58:30 utashiro Exp $;
;#
;# With this command, you can forward some specific protocol
;# on gateway machine which doesn't forward IP packet.
;#
;# Syntax:
;#	tcpconnect server[:service]
;#	tcpconnect server[:service] client
;#	tcpconnect server[:service] client server[:service] client ...
;#	tcpconnect -f config-file
;#
;# + If client is not specified or is '*', any client is allowed
;#   to connect.
;#
;# + Server is choosed on first-hit policy.  So, if there is '*'
;#   client at the first, remained servers will not be checked.
;#
;# + Same port number will be used when no server services is
;#   specified.
;#
;# + Client and server name can be symbolic hostname or IP
;#   address in dotted decimal notation.
;#
;# + Service name can be specified by symbolic name or port-number
;#
;# + Configuration file contains client and server pair on each line.
;#
;# EXAMPLES:
;#
;# All SMTP connection is to be forwarded to mail-server:
;#
;#	smtp stream tcp nowait root /etc/tcpconnect tcpconnect mail-server
;#
;# NNTP connectioned is exchanged between A and B:
;#
;#	nntp stream tcp nowait root /etc/tcpconnect tcpconnect A B B A
;#
;# Simply connect a terminal to nntp server:
;#
;#	% tcpconnect nntp-server:nntp
;#

;# require 'sys/socket.ph';
unless (do 'sys/socket.ph') {
    #print "File sys/socket.ph is not found. Using default...\n";
    eval 'sub SOCK_STREAM {1;} sub AF_INET {2;} sub PF_INET {2;}';
}

while ($_ = $ARGV[0], /^-/) {
    shift;
    if (/-f$/)		{$configfile = shift || &usage;	next;}
    if (/-d(\d*)$/)	{$debug = $1||1;		next;}
    if (/-h/)		{&usage;			next;}
    &usage;
}

sub usage {
    $0 =~ s|.*/||;
    $* = 1;
    ($usage = <<"    EOF") =~ s/^    //g;
    Usage: $0 server[:service] [client] [server[:service] client ...]
           $0 -f config-file

    ($rcsid)
    EOF
    for (@_) { print "ERROR: $_", /\n$/ ? "" : "\n"; }
    print $usage;
    exit(1);
}

unless ($configfile) {
    @forwardlist = @ARGV;
} else {
    open(CONF, $configfile) || die("$configfile: $!\n");
    while(<CONF>) {
	chop;
	s/#.*$//;
	s/^\s*//;
	next if /^$/;
	push(@forwardlist, (split($_))[0,1]);
    }
    close(CONF);
}

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

chop($localname = `hostname`);

unless ($hersockaddr = getpeername(STDIN)) {
    $server = shift || &usage;
} else {
    open(STDERR, ">/dev/console");
    select(STDERR); $| = 1; select(STDOUT);

    ($family, $herport, $heraddr) = unpack($sockaddr, $hersockaddr);

    $mysockaddr = getsockname(STDIN);
    ($family, $myport, $myaddr) = unpack($sockaddr, $mysockaddr);

    if ($debug) {
	printf STDERR ("$0: Connection from %s(%d)\n",
		       &dotted($heraddr), $herport);
    }
    CHECKADDR: {
	while (($server, $client) = splice(@forwardlist, 0, 2)) {
	    if (!defined($client) || $client eq '*') {
		$clientaddr = "\0\0\0\0";
	    } else {
		($clientaddr = &getaddr($client)) || next;
	    }
	    if ($clientaddr eq "\0\0\0\0" || $clientaddr eq $heraddr) {
		$server = "$server:$myport" unless ($server =~ /:/);
		last CHECKADDR;
	    }
	}
	printf STDERR ("Connection from %s is not allowed!\n",
			&dotted($heraddr));
	exit(1);
    }
}

($servername, $serverport) = split(/:/, $server);
$serverport || &usage("No server port");

($serveraddr = &getaddr($servername)) || die "Unknown server $servername.\n";
$serverport = (getservbyname($serverport, 'tcp'))[2]
    unless $serverport =~ /^\d+$/;

$that = pack($sockaddr, &AF_INET, $serverport, $serveraddr);
socket(S, &PF_INET, &SOCK_STREAM, $TCP) || die "socket: $!";
connect(S, $that) || die "connect: $!";
select(S); $| = 1; select(stdout);

if ($child = fork) {
    &forward(S, STDOUT);
} else {
    &forward(STDIN, S);
}

print STDERR "$0($$): exiting\n" if $debug;
exit(0);

sub forward {
    local($from, $to) = @_;
    select($from); $| = 1;
    select($to); $| = 1;
    if (-t $from) {
	eval "print $to \$_ while(<$from>);";
    } else {
	eval "print $to \$_ while(read($from, \$_, 4096));";
    }
    shutdown($from, 1); shutdown($to, 0);
}

sub getaddr {
    local($_) = @_;
    /^[0-9\.]+$/ ? pack("C4", split(/\./)) : (gethostbyname($_))[4];
}

sub dotted { join('.', unpack('C4', shift)); }