contrib/sendmail/contrib/etrn.pl

   1 #!/usr/local/bin/perl
   2 'di ';
   3 'ds 00 \\"';
   4 'ig 00 ';
   5 #
   6 #       THIS PROGRAM IS ITS OWN MANUAL PAGE.  INSTALL IN man & bin.
   7 #
   8
   9 # hardcoded constants, should work fine for BSD-based systems
  10 use Socket;
  11 use Getopt::Std;
  12 $sockaddr = 'S n a4 x8';
  13
  14 # system requirements:
  15 #       must have 'hostname' program.
  16
  17 #############################################################################
  18 #  Copyright (c) 1996 John T. Beck <john@beck.org>
  19 #  All rights reserved.
  20 #
  21 #  Redistribution and use in source and binary forms, with or without
  22 #  modification, are permitted provided that the following conditions
  23 #  are met:
  24 #  1. Redistributions of source code must retain the above copyright
  25 #     notice, this list of conditions and the following disclaimer.
  26 #  2. Redistributions in binary form must reproduce the above copyright
  27 #     notice, this list of conditions and the following disclaimer in the
  28 #     documentation and/or other materials provided with the distribution.
  29 #  3. All advertising materials mentioning features or use of this software
  30 #     must display the following acknowledgement:
  31 #       This product includes software developed by John T. Beck.
  32 #  4. The name of John Beck may not be used to endorse or promote products
  33 #     derived from this software without specific prior written permission.
  34 #
  35 #  THIS SOFTWARE IS PROVIDED BY JOHN T. BECK ``AS IS'' AND ANY EXPRESS OR
  36 #  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  37 #  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  38 #  IN NO EVENT SHALL JOHN T. BECK BE LIABLE FOR ANY DIRECT, INDIRECT,
  39 #  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  40 #  NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  41 #  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY
  42 #  OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  43 #  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
  44 #  EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  45 #
  46 #  This copyright notice derived from material copyrighted by the Regents
  47 #  of the University of California.
  48 #
  49 #  Contributions accepted.
  50 #############################################################################
  51 #  Further disclaimer: the etrn.pl script was highly leveraged from the
  52 #  expn.pl script which is (C) 1993 David Muir Sharnoff.
  53 #############################################################################
  54
  55 $port = 'smtp';
  56 $av0 = $0;
  57 select(STDERR);
  58
  59 $0 = "$av0 - running hostname";
  60 chop($name = `hostname || uname -n`);
  61
  62 $0 = "$av0 - lookup host FQDN and IP addr";
  63 ($hostname,$aliases,$type,$len,$thisaddr) = gethostbyname($name);
  64
  65 $0 = "$av0 - parsing args";
  66 $usage = "Usage: $av0 [-wd] host [args]";
  67 getopts('dw');
  68 $watch = $opt_w;
  69 $debug = $opt_d;
  70 $server = shift(@ARGV);
  71 @hosts = @ARGV;
  72 die $usage unless $server;
  73 @cwfiles = ();
  74
  75 if (!@hosts) {
  76         push(@hosts,$hostname);
  77
  78         $0 = "$av0 - parsing sendmail.cf";
  79         open(CF, "</etc/sendmail.cf") || die "open /etc/sendmail.cf: $!";
  80         while (<CF>){
  81                 if (/^Fw.*$/){                  # look for a line starting with "Fw"
  82                         $cwfile = $_;
  83                         chop($cwfile);
  84                         $optional = /^Fw-o/;
  85                         $cwfile =~ s,^Fw[^/]*,,;        # extract the file name
  86
  87                         if (-r $cwfile) {
  88                             push (@cwfiles, $cwfile);
  89                         } else {
  90                             die "$cwfile is not readable" unless $optional;
  91                         }
  92                 }
  93                 if (/^Cw(.*)$/){                # look for a line starting with "Cw"
  94                         @cws = split (' ', $1);
  95                         while (@cws) {
  96                                 $thishost = shift(@cws);
  97                                 push(@hosts, $thishost) unless $thishost =~ "$hostname|localhost";
  98                         }
  99                 }
 100         }
 101         close(CF);
 102
 103         for $cwfile (@cwfiles) {
 104                 $0 = "$av0 - reading $cwfile";
 105                 if (open(CW, "<$cwfile")){
 106                         while (<CW>){
 107                                 next if /^\#/;
 108                                 $thishost = $_;
 109                                 chop($thishost);
 110                                 push(@hosts, $thishost) unless $thishost =~ $hostname;
 111                         }
 112                         close(CW);
 113                 } else {
 114                         die "open $cwfile: $!";
 115                 }
 116         }
 117 }
 118
 119 $0 = "$av0 - building local socket";
 120 ($name,$aliases,$proto) = getprotobyname('tcp');
 121 ($name,$aliases,$port) = getservbyname($port,'tcp')
 122         unless $port =~ /^\d+/;
 123
 124 # look it up
 125 $0 = "$av0 - gethostbyname($server)";
 126
 127 ($name,$aliases,$type,$len,$thataddr) = gethostbyname($server);
 128
 129 # get a connection
 130 $0 = "$av0 - socket to $server";
 131 $that = pack($sockaddr, &AF_INET, $port, $thataddr);
 132 socket(S, &AF_INET, &SOCK_STREAM, $proto)
 133         || die "socket: $!";
 134 $0 = "$av0 - connect to $server";
 135 print "debug = $debug server = $server\n" if $debug > 8;
 136 if (! connect(S, $that)) {
 137         $0 = "$av0 - $server: could not connect: $!\n";
 138 }
 139 select((select(S),$| = 1)[0]); # don't buffer output to S
 140
 141 # read the greeting
 142 $0 = "$av0 - talking to $server";
 143 &alarm("greeting with $server",'');
 144 while(<S>) {
 145         alarm(0);
 146         print if $watch;
 147         if (/^(\d+)([- ])/) {
 148                 if ($1 != 220) {
 149                         $0 = "$av0 - bad numeric response from $server";
 150                         &alarm("giving up after bad response from $server",'');
 151                         &read_response($2,$watch);
 152                         alarm(0);
 153                         print STDERR "$server: NOT 220 greeting: $_"
 154                                 if ($debug || $watch);
 155                 }
 156                 last if ($2 eq " ");
 157         } else {
 158                 $0 = "$av0 - bad response from $server";
 159                 print STDERR "$server: NOT 220 greeting: $_"
 160                         if ($debug || $watch);
 161                 close(S);
 162         }
 163         &alarm("greeting with $server",'');
 164 }
 165 alarm(0);
 166
 167 # if this causes problems, remove it
 168 $0 = "$av0 - sending helo to $server";
 169 &alarm("sending ehlo to $server","");
 170 &ps("ehlo $hostname");
 171 $etrn_support = 0;
 172 while(<S>) {
 173         if (/^250([- ])ETRN(.+)$/){
 174                 $etrn_support = 1;
 175         }
 176         print if $watch;
 177         last if /^\d+ /;
 178 }
 179 alarm(0);
 180
 181 if ($etrn_support){
 182         print "ETRN supported\n" if ($debug);
 183         &alarm("sending etrn to $server",'');
 184         while (@hosts) {
 185                 $server = shift(@hosts);
 186                 &ps("etrn $server");
 187                 while(<S>) {
 188                         print if $watch;
 189                         last if /^\d+ /;
 190                 }
 191                 sleep(1);
 192         }
 193 } else {
 194         print "\nETRN not supported\n\n"
 195 }
 196
 197 &alarm("sending 'quit' to $server",'');
 198 $0 = "$av0 - sending 'quit' to $server";
 199 &ps("quit");
 200 while(<S>) {
 201         print if $watch;
 202         last if /^\d+ /;
 203 }
 204 close(S);
 205 alarm(0);
 206
 207 select(STDOUT);
 208 exit(0);
 209
 210 # print to the server (also to stdout, if -w)
 211 sub ps
 212 {
 213         local($p) = @_;
 214         print ">>> $p\n" if $watch;
 215         print S "$p\n";
 216 }
 217
 218 sub alarm
 219 {
 220         local($alarm_action,$alarm_redirect,$alarm_user) = @_;
 221         alarm(3600);
 222         $SIG{ALRM} = 'handle_alarm';
 223 }
 224
 225 sub handle_alarm
 226 {
 227         &giveup($alarm_redirect,"Timed out during $alarm_action",$alarm_user);
 228 }
 229
 230 # read the rest of the current smtp daemon's response (and toss it away)
 231 sub read_response
 232 {
 233         local($done,$watch) = @_;
 234         local(@resp);
 235         print $s if $watch;
 236         while(($done eq "-") && ($s = <S>) && ($s =~ /^\d+([- ])/)) {
 237                 print $s if $watch;
 238                 $done = $1;
 239                 push(@resp,$s);
 240         }
 241         return @resp;
 242 }
 243 # to pass perl -w:
 244 @tp;
 245 $flag_a;
 246 $flag_d;
 247 &handle_alarm;
 248 ################### BEGIN PERL/TROFF TRANSITION
 249 .00 ;
 250
 251 'di
 252 .nr nl 0-1
 253 .nr % 0
 254 .\\"'; __END__
 255 .\" ############## END PERL/TROFF TRANSITION
 256 .TH ETRN 1 "January 25, 1997"
 257 .AT 3
 258 .SH NAME
 259 etrn \- start mail queue run
 260 .SH SYNOPSIS
 261 .B etrn
 262 .RI [ -w ]
 263 .RI [ -d ]
 264 .IR hostname
 265 .RI [ args ]
 266 .SH DESCRIPTION
 267 .B etrn
 268 will use the SMTP
 269 .B etrn
 270 command to start mail delivery from the host given on the command line.
 271 .B etrn
 272 usually sends an
 273 .B etrn
 274 for each host the local sendmail accepts e-mail for, but if
 275 .IR args
 276 are specified,
 277 .B etrn
 278 uses these as arguments for the SMTP
 279 .B etrn
 280 commands passed to the host given on the command line.
 281 .SH OPTIONS
 282 .LP
 283 The normal mode of operation for
 284 .B etrn
 285 is to do all of its work silently.
 286 The following options make it more verbose.
 287 It is not necessary to make it verbose to see what it is
 288 doing because as it works, it changes its
 289 .BR argv [0]
 290 variable to reflect its current activity.
 291 The
 292 .IR -w ,
 293 watch, flag will cause
 294 .B etrn
 295 to show you its conversations with the mail daemons.
 296 The
 297 .IR -d ,
 298 debug, flag will expose many of the inner workings so that
 299 it is possible to eliminate bugs.
 300 .SH ENVIRONMENT
 301 No enviroment variables are used.
 302 .SH FILES
 303 .B /etc/sendmail.cf
 304 .SH SEE ALSO
 305 .BR sendmail (8),
 306 RFC 1985.
 307 .SH BUGS
 308 Not all mail daemons will implement
 309 .B etrn .
 310 .LP
 311 It is assumed that you are running domain names.
 312 .SH CREDITS
 313 Leveraged from David Muir Sharnoff's expn.pl script.
 314 Christian von Roques added support for
 315 .IR args
 316 and fixed a couple of bugs.
 317 .SH AVAILABILITY
 318 The latest version of
 319 .B etrn
 320 is available in the contrib directory of the sendmail
 321 distribution through anonymous ftp at
 322 .IR ftp://ftp.sendmail.org/ucb/src/sendmail/ .
 323 .SH AUTHOR
 324 .I John T. Beck\ \ \ \ <john@beck.org>