#!/bin/sh
# -*- perl -*-
# This code allows us to start perl from our path or an environment variable
# rather than hardcoding a path into the #! line.  It works from sh or csh.
(exit $?0) && eval 'exec ${QPERLQ-perl} -x $0 ${1+"$@"}'
if (! $?QPERLQ) setenv QPERLQ perl
exec $QPERLQ -x $0 $argv:q

#!/usr/local/bin/perl -w
#
# $Id: user_daemon,v 1.7 1999/04/12 17:01:02 ejb Exp $
# $Source: /home/ejb/scripts/RCS/user_daemon,v $
# $Author: ejb $
#

require 5.001;
use strict;

my $whoami = ($0 =~ m,([^/]*)$,) ? $1 : $0;
my $search = $ENV{"SEARCH"} || $ENV{"HOME"} || undef;
if (! defined($search))
{
    $search = (-d "/home/qjb/.") ? "/home/qjb" : "/home/ejb";
}

use IO::Socket;

&usage unless (@ARGV) == 1;
my $s_port = shift(@ARGV);
my $s_addr;
my $listensock =     IO::Socket::INET->new(Listen => 5,
					   Proto => 'tcp',
					   Port => $s_port);
($s_port, $s_addr) = unpack_sockaddr_in($listensock->sockname());
my @port_args = unpack('C4', $s_addr);
push(@port_args, $s_port >> 8, $s_port & 0xff);
print "Port number $s_port\n";
print "FTP PORT args: ", join(",", @port_args), "\n";

my $done = 0;
do
{
    print "==> waiting for connection...\n";
    my $s = $listensock->accept() or die $!;
    print "==> connection established\n";

    my $oread_fds = '';
    vec($oread_fds, fileno(STDIN), 1) = 1;
    vec($oread_fds, fileno($s), 1) = 1;
    while (1)
    {
	my $read_fds = $oread_fds;
	select($read_fds, undef, undef, undef);
	my $line = undef;
	if (vec($read_fds, fileno(STDIN), 1))
	{
	    $line = <STDIN>;
	    last if ! defined($line);
	    print $s $line;
	}
	if (vec($read_fds, fileno($s), 1))
	{
	    $line = $s->getline();
	    last if ! defined($line);
	    print $line;
	}
    }
} until ($done);

sub usage
{
    warn "Usage: $whoami server_port\n";
    die "  Copy server_port to stdout and stdin to server_port in " .
	"line mode.\n";
}