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