#!/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: expn,v 1.7 1999/01/28 20:35:33 ejb Exp $
# $Source: /home/ejb/scripts/RCS/expn,v $
# $Author: ejb $
#

require 5.002;
use strict;

my $whoami = ($0 =~ m,([^/\\]*)$,) ? $1 : $0;
#my $dirname = ($0 =~ m,(.*)[/\\][^/\\]+$,) ? $1 : ".";

# -*- perl -*-
#
# $Id: expn,v 1.7 1999/01/28 20:35:33 ejb Exp $
# $Source: /home/ejb/scripts/RCS/expn,v $
# $Author: ejb $
#

package TCPConnection;
my $package = "TCPConnection";

use Socket;

# Field names
my $f_socket = "socket";

# Static Variables
my $x;
my $proto;
($x, $x, $proto) = getprotobyname('tcp');
my $sockaddr = 'S n a4 x8';
my $have_sig_pipe = 1;
eval
{
    my $w = $SIG{'__WARN__'} || 'DEFAULT';
    $SIG{'__WARN__'} = sub { $have_sig_pipe = 0; };
    eval { $SIG{'PIPE'} = sub { die "--pipe--\n"; }; };
    $SIG{'__WARN__'} = $w;
};

# Routines

sub new
{
    my $class = shift;
    my $rep = +{$package => {} };
    local(*S);

    if (@_ != 2)
    {
	die "$package: Usage: new $package(port, host)\n";
    }
    my ($remotehost, $portname) = @_;

    my ($port, $thataddr, $that);

    eval
    {
	if ($portname =~ m/^\d+$/)
	{
	    $port = $portname;
	}
	else
	{
	    (($x, $x, $port) = getservbyname($portname, 'tcp')) ||
		die "unknown service $portname\n";
	}

	if ($remotehost =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)
	{
	    $thataddr = pack('C4', $1, $2, $3, $4);
	}
	else
	{
	    (undef, undef, undef, undef, $thataddr) =
		gethostbyname($remotehost) or
		    die "unknown host $remotehost\n";
	}

	$that = pack($sockaddr, &AF_INET(), $port, $thataddr);
	socket(S, &PF_INET(), &SOCK_STREAM(), $proto) ||
	    die "socket (in new): $!\n";
	connect(S, $that) || die "connect: $!\n";
    };
    die "$package: connection to $remotehost on port $port: $@" if $@;

    &p_unbuffer(*S);

    $rep->{$package}{$f_socket} = *S;

    bless $rep, $class;
}

sub new_accept
{
    my $class = shift;
    my $rep = +{$package => {} };
    local(*S);
    local(*L);

    if (@_ != 1)
    {
	die "$package: Usage: accept $package(listener)\n";
    }
    my $l = shift;
    local(*L) = $l->socket();
    accept(S, L) || die "$package: accept: $!\n";

    &p_unbuffer(*S);

    $rep->{$package}{$f_socket} = *S;

    bless $rep, $class;
}

sub new_listen
{
    my $class = shift;
    my $rep = +{$package => {} };
    local(*S);

    if (@_ != 1)
    {
	die "$package: Usage: accept $package(port)\n";
    }
    my $port;
    my $portname = shift;
    if ($portname =~ m/^\d+$/)
    {
	$port = $portname;
    }
    else
    {
	(($x, $x, $port) = getservbyname($portname, 'tcp')) ||
	    die "unknown service $portname\n";
    }

    my $this = pack($sockaddr, AF_INET, $port, "\0\0\0\0");
    socket(S, PF_INET, SOCK_STREAM, $proto) ||
	die "socket (in new_listen): $!\n";
    bind(S, $this) || die "bind: $!\n";
    listen(S, 5) || die "listen: $!\n";

    &p_unbuffer(*S);

    $rep->{$package}{$f_socket} = *S;

    bless $rep, $class;
}

sub new_from_stdin
{
    my $class = shift;
    my $fh = shift;
    my $rep = +{$package => {} };

    local(*S);
    open(S, "+<&STDIN");
    &p_unbuffer(*S);

    $rep->{$package}{$f_socket} = *S;

    bless $rep, $class;
}

sub p_unbuffer
{
    local(*S) = shift;
    $x = select(S);
    $| = 1;
    no strict 'refs';
    select($x);
    use strict 'refs';
}

sub sockname
{
    my $rep = shift;
    local(*S) = $rep->socket();
    (undef, my $port, my $addr) = unpack($sockaddr, getsockname(S));
    ($port, $addr);
}

sub socket
{
    my $rep = shift;
    $rep->{$package}{$f_socket} = $_[0] if @_;
    $rep->{$package}{$f_socket};
}

sub p_print_or_printf
{
    my $rep = shift;
    my $printf = shift;
    local(*S) = $rep->socket();
    my $pipe;
    if ($have_sig_pipe)
    {
	$pipe = $SIG{'PIPE'};
	$SIG{'PIPE'} = sub { die "--pipe--\n"; };
    }
    eval
    {
	if ($printf)
	{
	    printf S @_;
	}
	else
	{
	    print S @_;
	}
    };
    my $t = $@;
    if ($have_sig_pipe)
    {
	local($^W) = 0;
	$SIG{'PIPE'} = $pipe;
    }
    ($t ? undef : 1);
}

sub print
{
    my $rep = shift;
    $rep->p_print_or_printf(0, @_);
}

sub printf
{
    my $rep = shift;
    $rep->p_print_or_printf(1, @_);
}

sub get
{
    my $rep = shift;
    local(*S) = $rep->socket();
    scalar(<S>);
}

sub read
{
    my $rep = shift;
    local(*S) = $rep->socket();
    read S, $_[0], $_[1], ($_[2] || 0);
}

sub DESTROY
{
    my $rep = shift;
    my $s = $rep->socket();
    if (defined $s)
    {
	local(*S) = $rep->socket();
	shutdown S, 2;
	close(S);
	$rep->socket(undef);
    }
}

sub test
{
    $DB::single = 1 if defined $DB::single;
    shift;
    my $t = shift;
    $t =~ m/^(.*)\@(.*)$/ || die "$package: test arg must be x\@y\n";
    my ($u, $h) = ($1, $2);
    my $s = new TCPConnection($h, "smtp");
    $s->print("EXPN $u\n");
    $s->print("quit\n");
    while (1)
    {
	my $l = $s->get();
	last if ! defined($l);
	print $l;
    }
}

1;

#
# END OF TCPConnection
#

package main;

for (@ARGV)
{
    &expn($_);
}

sub expn
{
    my $addr = shift;
    my $host = "mail";		# default
    if ($addr =~ m/^(.*)\@([^\@]*)$/)
    {
	$host = $2;
	$addr = $1;
    }
    my $s = new TCPConnection($host, "smtp");
    chop(my $thishost = `hostname`);
    $s->print("HELO $thishost\n");
    $s->print("EXPN $addr\n");
    $s->print("quit\n");
    my $l;
    while (1)
    {
	$l = $s->get();
	last if ! defined($l);
	print $l;
    }
}