# This is a shell archive. Save it in a file, remove anything before # this line, and then unpack it by entering "sh file". Note, it may # create directories; files and directories will be owned by you and # have default permissions. # # This archive contains: # # etrn.pl # echo x - etrn.pl sed 's/^X//' >etrn.pl << 'END-of-etrn.pl' X#!/usr/local/bin/perl X'di '; X'ds 00 \\"'; X'ig 00 '; X# X# THIS PROGRAM IS ITS OWN MANUAL PAGE. INSTALL IN man & bin. X# X X# hardcoded constants, should work fine for BSD-based systems Xuse Socket; Xuse Getopt::Std; X$sockaddr = 'S n a4 x8'; X X# system requirements: X# must have 'hostname' program. X X############################################################################# X# Copyright (c) 1996 John T. Beck X# All rights reserved. X# X# Redistribution and use in source and binary forms, with or without X# modification, are permitted provided that the following conditions X# are met: X# 1. Redistributions of source code must retain the above copyright X# notice, this list of conditions and the following disclaimer. X# 2. Redistributions in binary form must reproduce the above copyright X# notice, this list of conditions and the following disclaimer in the X# documentation and/or other materials provided with the distribution. X# 3. All advertising materials mentioning features or use of this software X# must display the following acknowledgement: X# This product includes software developed by John T. Beck. X# 4. The name of John Beck may not be used to endorse or promote products X# derived from this software without specific prior written permission. X# X# THIS SOFTWARE IS PROVIDED BY JOHN T. BECK ``AS IS'' AND ANY EXPRESS OR X# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES X# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. X# IN NO EVENT SHALL JOHN T. BECK BE LIABLE FOR ANY DIRECT, INDIRECT, X# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT X# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, X# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY X# OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING X# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, X# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. X# X# This copyright notice derived from material copyrighted by the Regents X# of the University of California. X# X# Contributions accepted. X############################################################################# X# Further disclaimer: the etrn.pl script was highly leveraged from the X# expn.pl script which is (C) 1993 David Muir Sharnoff. X############################################################################# X X$port = 'smtp'; X$av0 = $0; Xselect(STDERR); X X$0 = "$av0 - running hostname"; Xchop($name = `hostname || uname -n`); X X$0 = "$av0 - lookup host FQDN and IP addr"; X($hostname,$aliases,$type,$len,$thisaddr) = gethostbyname($name); X X$0 = "$av0 - parsing args"; X$usage = "Usage: $av0 [-wd] host [args]"; Xgetopts('dw'); X$watch = $opt_w; X$debug = $opt_d; X$server = shift(@ARGV); X@hosts = @ARGV; Xdie $usage unless $server; X@cwfiles = (); X Xif (!@hosts) { X push(@hosts,$hostname); X X $0 = "$av0 - parsing sendmail.cf"; X open(CF, "){ X if (/^Fw.*$/){ # look for a line starting with "Fw" X $cwfile = $_; X chop($cwfile); X $optional = /^Fw-o/; X $cwfile =~ s,^Fw[^/]*,,; # extract the file name X X if (-r $cwfile) { X push (@cwfiles, $cwfile); X } else { X die "$cwfile is not readable" unless $optional; X } X } X if (/^Cw(.*)$/){ # look for a line starting with "Cw" X @cws = split (' ', $1); X while (@cws) { X $thishost = shift(@cws); X push(@hosts, $thishost) unless $thishost =~ "$hostname|localhost"; X } X } X } X close(CF); X X for $cwfile (@cwfiles) { X $0 = "$av0 - reading $cwfile"; X if (open(CW, "<$cwfile")){ X while (){ X next if /^\#/; X $thishost = $_; X chop($thishost); X push(@hosts, $thishost) unless $thishost =~ $hostname; X } X close(CW); X } else { X die "open $cwfile: $!"; X } X } X} X X$0 = "$av0 - building local socket"; X($name,$aliases,$proto) = getprotobyname('tcp'); X($name,$aliases,$port) = getservbyname($port,'tcp') X unless $port =~ /^\d+/; X X# look it up X$0 = "$av0 - gethostbyname($server)"; X X($name,$aliases,$type,$len,$thataddr) = gethostbyname($server); X X# get a connection X$0 = "$av0 - socket to $server"; X$that = pack($sockaddr, &AF_INET, $port, $thataddr); Xsocket(S, &AF_INET, &SOCK_STREAM, $proto) X || die "socket: $!"; X$0 = "$av0 - connect to $server"; Xprint "debug = $debug server = $server\n" if $debug > 8; Xif (! connect(S, $that)) { X $0 = "$av0 - $server: could not connect: $!\n"; X} Xselect((select(S),$| = 1)[0]); # don't buffer output to S X X# read the greeting X$0 = "$av0 - talking to $server"; X&alarm("greeting with $server",''); Xwhile() { X alarm(0); X print if $watch; X if (/^(\d+)([- ])/) { X if ($1 != 220) { X $0 = "$av0 - bad numeric response from $server"; X &alarm("giving up after bad response from $server",''); X &read_response($2,$watch); X alarm(0); X print STDERR "$server: NOT 220 greeting: $_" X if ($debug || $watch); X } X last if ($2 eq " "); X } else { X $0 = "$av0 - bad response from $server"; X print STDERR "$server: NOT 220 greeting: $_" X if ($debug || $watch); X close(S); X } X &alarm("greeting with $server",''); X} Xalarm(0); X X# if this causes problems, remove it X$0 = "$av0 - sending helo to $server"; X&alarm("sending ehlo to $server",""); X&ps("ehlo $hostname"); X$etrn_support = 0; Xwhile() { X if (/^250([- ])ETRN(.+)$/){ X $etrn_support = 1; X } X print if $watch; X last if /^\d+ /; X} Xalarm(0); X Xif ($etrn_support){ X print "ETRN supported\n" if ($debug); X &alarm("sending etrn to $server",''); X while (@hosts) { X $server = shift(@hosts); X &ps("etrn $server"); X while() { X print if $watch; X last if /^\d+ /; X } X sleep(1); X } X} else { X print "\nETRN not supported\n\n" X} X X&alarm("sending 'quit' to $server",''); X$0 = "$av0 - sending 'quit' to $server"; X&ps("quit"); Xwhile() { X print if $watch; X last if /^\d+ /; X} Xclose(S); Xalarm(0); X Xselect(STDOUT); Xexit(0); X X# print to the server (also to stdout, if -w) Xsub ps X{ X local($p) = @_; X print ">>> $p\n" if $watch; X print S "$p\n"; X} X Xsub alarm X{ X local($alarm_action,$alarm_redirect,$alarm_user) = @_; X alarm(3600); X $SIG{ALRM} = 'handle_alarm'; X} X Xsub handle_alarm X{ X &giveup($alarm_redirect,"Timed out during $alarm_action",$alarm_user); X} X X# read the rest of the current smtp daemon's response (and toss it away) Xsub read_response X{ X local($done,$watch) = @_; X local(@resp); X print $s if $watch; X while(($done eq "-") && ($s = ) && ($s =~ /^\d+([- ])/)) { X print $s if $watch; X $done = $1; X push(@resp,$s); X } X return @resp; X} X# to pass perl -w: X@tp; X$flag_a; X$flag_d; X&handle_alarm; X################### BEGIN PERL/TROFF TRANSITION X.00 ; X X'di X.nr nl 0-1 X.nr % 0 X.\\"'; __END__ X.\" ############## END PERL/TROFF TRANSITION X.TH ETRN 1 "January 25, 1997" X.AT 3 X.SH NAME Xetrn \- start mail queue run X.SH SYNOPSIS X.B etrn X.RI [ -w ] X.RI [ -d ] X.IR hostname X.RI [ args ] X.SH DESCRIPTION X.B etrn Xwill use the SMTP X.B etrn Xcommand to start mail delivery from the host given on the command line. X.B etrn Xusually sends an X.B etrn Xfor each host the local sendmail accepts e-mail for, but if X.IR args Xare specified, X.B etrn Xuses these as arguments for the SMTP X.B etrn Xcommands passed to the host given on the command line. X.SH OPTIONS X.LP XThe normal mode of operation for X.B etrn Xis to do all of its work silently. XThe following options make it more verbose. XIt is not necessary to make it verbose to see what it is Xdoing because as it works, it changes its X.BR argv [0] Xvariable to reflect its current activity. XThe X.IR -w , Xwatch, flag will cause X.B etrn Xto show you its conversations with the mail daemons. XThe X.IR -d , Xdebug, flag will expose many of the inner workings so that Xit is possible to eliminate bugs. X.SH ENVIRONMENT XNo enviroment variables are used. X.SH FILES X.B /etc/sendmail.cf X.SH SEE ALSO X.BR sendmail (8), XRFC 1985. X.SH BUGS XNot all mail daemons will implement X.B etrn . X.LP XIt is assumed that you are running domain names. X.SH CREDITS XLeveraged from David Muir Sharnoff's expn.pl script. XChristian von Roques added support for X.IR args Xand fixed a couple of bugs. X.SH AVAILABILITY XThe latest version of X.B etrn Xis available in the contrib directory of the sendmail Xdistribution through anonymous ftp at X.IR ftp://ftp.sendmail.org/ucb/src/sendmail/ . X.SH AUTHOR X.I John T. Beck\ \ \ \ END-of-etrn.pl exit