contrib/sendmail/contrib/etrn.pl

   1 #!/usr/perl5/bin/perl -w
   2 #
   3 # CDDL HEADER START
   4 #
   5 # The contents of this file are subject to the terms of the
   6 # Common Development and Distribution License (the "License").
   7 # You may not use this file except in compliance with the License.
   8 #
   9 # You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
  10 # or http://www.opensolaris.org/os/licensing.
  11 # See the License for the specific language governing permissions
  12 # and limitations under the License.
  13 #
  14 # When distributing Covered Code, include this CDDL HEADER in each
  15 # file and include the License file at usr/src/OPENSOLARIS.LICENSE.
  16 # If applicable, add the following below this CDDL HEADER, with the
  17 # fields enclosed by brackets "[]" replaced with your own identifying
  18 # information: Portions Copyright [yyyy] [name of copyright owner]
  19 #
  20 # CDDL HEADER END
  21 #
  22 #
  23 # Copyright (c) 1996-2000 by John T. Beck <john@beck.org>
  24 # All rights reserved.
  25 #
  26 # Copyright 2008 Sun Microsystems, Inc.  All rights reserved.
  27 # Use is subject to license terms.
  28 #
  29
  30 require 5.8.4;                          # minimal Perl version required
  31 use strict;
  32 use warnings;
  33 use English;
  34
  35 use Socket;
  36 use Getopt::Std;
  37 our ($opt_v, $opt_b);
  38
  39 # system requirements:
  40 #       must have 'hostname' program.
  41
  42 my $port = 'smtp';
  43 select(STDERR);
  44
  45 chop(my $name = `hostname || uname -n`);
  46
  47 my ($hostname) = (gethostbyname($name))[0];
  48
  49 my $usage = "Usage: $PROGRAM_NAME [-bv] host [args]";
  50 getopts('bv');
  51 my $verbose = $opt_v;
  52 my $boot_check = $opt_b;
  53 my $server = shift(@ARGV);
  54 my @hosts = @ARGV;
  55 die $usage unless $server;
  56 my @cwfiles = ();
  57 my $alarm_action = "";
  58
  59 if (!@hosts) {
  60         push(@hosts, $hostname);
  61
  62         open(CF, "</etc/mail/sendmail.cf") ||
  63             die "open /etc/mail/sendmail.cf: $ERRNO";
  64         while (<CF>){
  65                 # look for a line starting with "Fw"
  66                 if (/^Fw.*$/) {
  67                         my $cwfile = $ARG;
  68                         chop($cwfile);
  69                         my $optional = /^Fw-o/;
  70                         # extract the file name
  71                         $cwfile =~ s,^Fw[^/]*,,;
  72
  73                         # strip the options after the filename
  74                         $cwfile =~ s/ [^ ]+$//;
  75
  76                         if (-r $cwfile) {
  77                                 push (@cwfiles, $cwfile);
  78                         } else {
  79                                 die "$cwfile is not readable" unless $optional;
  80                         }
  81                 }
  82                 # look for a line starting with "Cw"
  83                 if (/^Cw(.*)$/) {
  84                         my @cws = split (' ', $1);
  85                         while (@cws) {
  86                                 my $thishost = shift(@cws);
  87                                 push(@hosts, $thishost)
  88                                     unless $thishost =~ "$hostname|localhost";
  89                         }
  90                 }
  91         }
  92         close(CF);
  93
  94         for my $cwfile (@cwfiles) {
  95                 if (open(CW, "<$cwfile")) {
  96                         while (<CW>) {
  97                                 next if /^\#/;
  98                                 my $thishost = $ARG;
  99                                 chop($thishost);
 100                                 push(@hosts, $thishost)
 101                                     unless $thishost =~ $hostname;
 102                         }
 103                         close(CW);
 104                 } else {
 105                         die "open $cwfile: $ERRNO";
 106                 }
 107         }
 108         # Do this automatically if no client hosts are specified.
 109         $boot_check = "yes";
 110 }
 111
 112 my ($proto) = (getprotobyname('tcp'))[2];
 113 ($port) = (getservbyname($port, 'tcp'))[2]
 114         unless $port =~ /^\d+/;
 115
 116 if ($boot_check) {
 117         # first connect to localhost to verify that we can accept connections
 118         print "verifying that localhost is accepting SMTP connections\n"
 119                 if ($verbose);
 120         my $localhost_ok = 0;
 121         ($name, my $laddr) = (gethostbyname('localhost'))[0, 4];
 122         (!defined($name)) && die "gethostbyname failed, unknown host localhost";
 123
 124         # get a connection
 125         my $sinl = sockaddr_in($port, $laddr);
 126         my $save_errno = 0;
 127         for (my $num_tries = 1; $num_tries < 5; $num_tries++) {
 128                 socket(S, &PF_INET, &SOCK_STREAM, $proto)
 129                         || die "socket: $ERRNO";
 130                 if (connect(S, $sinl)) {
 131                         &alarm("sending 'quit' to $server");
 132                         print S "quit\n";
 133                         alarm(0);
 134                         $localhost_ok = 1;
 135                         close(S);
 136                         alarm(0);
 137                         last;
 138                 }
 139                 print STDERR "localhost connect failed ($num_tries)\n";
 140                 $save_errno = $ERRNO;
 141                 sleep(1 << $num_tries);
 142                 close(S);
 143                 alarm(0);
 144         }
 145         if (! $localhost_ok) {
 146                 die "could not connect to localhost: $save_errno\n";
 147         }
 148 }
 149
 150 # look it up
 151
 152 ($name, my $thataddr) = (gethostbyname($server))[0, 4];
 153 (!defined($name)) && die "gethostbyname failed, unknown host $server";
 154
 155 # get a connection
 156 my $sinr = sockaddr_in($port, $thataddr);
 157 socket(S, &PF_INET, &SOCK_STREAM, $proto)
 158         || die "socket: $ERRNO";
 159 print "server = $server\n" if (defined($verbose));
 160 &alarm("connect to $server");
 161 if (! connect(S, $sinr)) {
 162         die "cannot connect to $server: $ERRNO\n";
 163 }
 164 alarm(0);
 165 select((select(S), $OUTPUT_AUTOFLUSH = 1)[0]);  # don't buffer output to S
 166
 167 # read the greeting
 168 &alarm("greeting with $server");
 169 while (<S>) {
 170         alarm(0);
 171         print if $verbose;
 172         if (/^(\d+)([- ])/) {
 173                 # SMTP's initial greeting response code is 220.
 174                 if ($1 != 220) {
 175                         &alarm("giving up after bad response from $server");
 176                         &read_response($2, $verbose);
 177                         alarm(0);
 178                         print STDERR "$server: NOT 220 greeting: $ARG"
 179                                 if ($verbose);
 180                 }
 181                 last if ($2 eq " ");
 182         } else {
 183                 print STDERR "$server: NOT 220 greeting: $ARG"
 184                         if ($verbose);
 185                 close(S);
 186         }
 187         &alarm("greeting with $server");
 188 }
 189 alarm(0);
 190
 191 &alarm("sending ehlo to $server");
 192 &ps("ehlo $hostname");
 193 my $etrn_support = 0;
 194 while (<S>) {
 195         if (/^250([- ])ETRN(.+)$/) {
 196                 $etrn_support = 1;
 197         }
 198         print if $verbose;
 199         last if /^\d+ /;
 200 }
 201 alarm(0);
 202
 203 if ($etrn_support) {
 204         print "ETRN supported\n" if ($verbose);
 205         &alarm("sending etrn to $server");
 206         while (@hosts) {
 207                 $server = shift(@hosts);
 208                 &ps("etrn $server");
 209                 while (<S>) {
 210                         print if $verbose;
 211                         last if /^\d+ /;
 212                 }
 213                 sleep(1);
 214         }
 215 } else {
 216         print "\nETRN not supported\n\n"
 217 }
 218
 219 &alarm("sending 'quit' to $server");
 220 &ps("quit");
 221 while (<S>) {
 222         print if $verbose;
 223         last if /^\d+ /;
 224 }
 225 close(S);
 226 alarm(0);
 227
 228 select(STDOUT);
 229 exit(0);
 230
 231 # print to the server (also to stdout, if -v)
 232 sub ps
 233 {
 234         my ($p) = @_;
 235         print ">>> $p\n" if $verbose;
 236         print S "$p\n";
 237 }
 238
 239 sub alarm
 240 {
 241         ($alarm_action) = @_;
 242         alarm(10);
 243         $SIG{ALRM} = 'handle_alarm';
 244 }
 245
 246 sub handle_alarm
 247 {
 248         &giveup($alarm_action);
 249 }
 250
 251 sub giveup
 252 {
 253         my $reason = @_;
 254         (my $pk, my $file, my $line);
 255         ($pk, $file, $line) = caller;
 256
 257         print "Timed out during $reason\n" if $verbose;
 258         exit(1);
 259 }
 260
 261 # read the rest of the current smtp daemon's response (and toss it away)
 262 sub read_response
 263 {
 264         (my $done, $verbose) = @_;
 265         (my @resp);
 266         print my $s if $verbose;
 267         while (($done eq "-") && ($s = <S>) && ($s =~ /^\d+([- ])/)) {
 268                 print $s if $verbose;
 269                 $done = $1;
 270                 push(@resp, $s);
 271         }
 272         return @resp;
 273 }