InfoMagic Source Code 1993 July/THE_SOURCE_CODE_CD_ROM.iso/languages/perl/tutorial/eg/uupath

Text File | 1990-02-06 | 1.4 KB | 66 lines

#!/usr/bin/perl

($program = $0) =~ s%.*/%%;

die "i'd rather be called uupath or uuhost"
    unless $program eq 'uupath' || $program eq 'uuhost';

die "usage: $program args\n" if $#ARGV < $[;

do 'sys/socket.pl' || die "can't do sys/socket.pl: $@";

$sockaddr = 'S n a4 x8';

chop ($hostname = `hostname`);


($USER = getlogin) || ($USER = $ENV{'USER'}) || (($USER) = getpwuid($<));;

(($name, $aliases, $port, $proto) = getservbyname('uupath', 'tcp'))
    || die "no tcp service for \"uupath\"";
#printf "port is %d\n", $port;

(($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname))
    || die "no localhost \"$hostname\"\n";
(($name, $aliases, $type, $len, $thataddr) = gethostbyname('mailhost'))
    || die "no server host \"mailhost\"\n";
#printf "server is %s\n", $name;

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



$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
$that = pack($sockaddr, $AF_INET, $port, $thataddr);

socket(SERVER, $PF_INET, $SOCK_STREAM, $proto ) || die "socket: $!";

bind(SERVER, $this) || die "bind: $!";

connect(SERVER, $that) || die "connect: $!";

select(SERVER); $| = 1; select(STDOUT);

printf SERVER "helo %s\@%s\n", $USER, $hostname;

$program =~ s/^uu//;

print SERVER "$program @ARGV\n";

while (<SERVER>) {
    last if /^uuhostd> \//;
}

while (<SERVER>) {
    last if /^\.$/;
    next unless $_ || $ok;
    $ok++;
    print;
}

print SERVER "quit\n";

close SERVER;

exit !$ok;