1 #!/usr/local/bin/perl -w
3 # Copyright (c) 1996-2000 by John T. Beck <john@beck.org>
6 # Copyright (c) 2000 by Sun Microsystems, Inc.
9 #ident "@(#)etrn.pl 1.1 00/09/06 SMI"
11 require 5.005; # minimal Perl version required
15 # hardcoded constants, should work fine for BSD-based systems
19 my $sockaddr = 'S n a4 x8';
21 # system requirements:
22 # must have 'hostname' program.
27 chop(my $name = `hostname || uname -n`);
29 (my $hostname, my $aliases, my $type, my $len, undef) = gethostbyname($name);
31 my $usage = "Usage: $PROGRAM_NAME [-v] host [args]";
34 my $server = shift(@ARGV);
36 die $usage unless $server;
38 my $alarm_action = "";
41 push(@hosts, $hostname);
43 open(CF, "</etc/mail/sendmail.cf") ||
44 die "open /etc/mail/sendmail.cf: $ERRNO";
46 # look for a line starting with "Fw"
50 my $optional = /^Fw-o/;
51 # extract the file name
52 $cwfile =~ s,^Fw[^/]*,,;
54 # strip the options after the filename
55 $cwfile =~ s/ [^ ]+$//;
58 push (@cwfiles, $cwfile);
60 die "$cwfile is not readable" unless $optional;
63 # look for a line starting with "Cw"
65 my @cws = split (' ', $1);
67 my $thishost = shift(@cws);
68 push(@hosts, $thishost)
69 unless $thishost =~ "$hostname|localhost";
75 for my $cwfile (@cwfiles) {
76 if (open(CW, "<$cwfile")) {
81 push(@hosts, $thishost)
82 unless $thishost =~ $hostname;
86 die "open $cwfile: $ERRNO";
91 ($name, $aliases, my $proto) = getprotobyname('tcp');
92 ($name, $aliases, $port) = getservbyname($port, 'tcp')
93 unless $port =~ /^\d+/;
97 ($name, $aliases, $type, $len, my $thataddr) = gethostbyname($server);
98 (!defined($name)) && die "gethostbyname failed, unknown host $server";
101 my $that = pack($sockaddr, &AF_INET, $port, $thataddr);
102 socket(S, &AF_INET, &SOCK_STREAM, $proto)
103 || die "socket: $ERRNO";
104 print "server = $server\n" if (defined($verbose));
105 &alarm("connect to $server");
106 if (! connect(S, $that)) {
107 die "cannot connect to $server: $ERRNO\n";
110 select((select(S), $OUTPUT_AUTOFLUSH = 1)[0]); # don't buffer output to S
113 &alarm("greeting with $server");
117 if (/^(\d+)([- ])/) {
118 # SMTP's initial greeting response code is 220.
120 &alarm("giving up after bad response from $server");
121 &read_response($2, $verbose);
123 print STDERR "$server: NOT 220 greeting: $ARG"
128 print STDERR "$server: NOT 220 greeting: $ARG"
132 &alarm("greeting with $server");
136 &alarm("sending ehlo to $server");
137 &ps("ehlo $hostname");
138 my $etrn_support = 0;
140 if (/^250([- ])ETRN(.+)$/) {
149 print "ETRN supported\n" if ($verbose);
150 &alarm("sending etrn to $server");
152 $server = shift(@hosts);
161 print "\nETRN not supported\n\n"
164 &alarm("sending 'quit' to $server");
176 # print to the server (also to stdout, if -v)
180 print ">>> $p\n" if $verbose;
186 ($alarm_action) = @_;
188 $SIG{ALRM} = 'handle_alarm';
193 &giveup($alarm_action);
199 (my $pk, my $file, my $line);
200 ($pk, $file, $line) = caller;
202 print "Timed out during $reason\n" if $verbose;
206 # read the rest of the current smtp daemon's response (and toss it away)
209 (my $done, $verbose) = @_;
211 print my $s if $verbose;
212 while (($done eq "-") && ($s = <S>) && ($s =~ /^\d+([- ])/)) {
213 print $s if $verbose;