1249729Sgshapiro#!/usr/perl5/bin/perl -w 238032Speter# 3249729Sgshapiro# CDDL HEADER START 4249729Sgshapiro# 5249729Sgshapiro# The contents of this file are subject to the terms of the 6249729Sgshapiro# Common Development and Distribution License (the "License"). 7249729Sgshapiro# You may not use this file except in compliance with the License. 8249729Sgshapiro# 9249729Sgshapiro# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE 10249729Sgshapiro# or http://www.opensolaris.org/os/licensing. 11249729Sgshapiro# See the License for the specific language governing permissions 12249729Sgshapiro# and limitations under the License. 13249729Sgshapiro# 14249729Sgshapiro# When distributing Covered Code, include this CDDL HEADER in each 15249729Sgshapiro# file and include the License file at usr/src/OPENSOLARIS.LICENSE. 16249729Sgshapiro# If applicable, add the following below this CDDL HEADER, with the 17249729Sgshapiro# fields enclosed by brackets "[]" replaced with your own identifying 18249729Sgshapiro# information: Portions Copyright [yyyy] [name of copyright owner] 19249729Sgshapiro# 20249729Sgshapiro# CDDL HEADER END 21249729Sgshapiro# 22249729Sgshapiro# 23102528Sgshapiro# Copyright (c) 1996-2000 by John T. Beck <john@beck.org> 24102528Sgshapiro# All rights reserved. 2538032Speter# 26249729Sgshapiro# Copyright 2008 Sun Microsystems, Inc. All rights reserved. 27249729Sgshapiro# Use is subject to license terms. 28102528Sgshapiro# 2938032Speter 30249729Sgshapirorequire 5.8.4; # minimal Perl version required 31102528Sgshapirouse strict; 32249729Sgshapirouse warnings; 33102528Sgshapirouse English; 34102528Sgshapiro 3538032Speteruse Socket; 3638032Speteruse Getopt::Std; 37249729Sgshapiroour ($opt_v, $opt_b); 3838032Speter 3938032Speter# system requirements: 4038032Speter# must have 'hostname' program. 4138032Speter 42102528Sgshapiromy $port = 'smtp'; 4338032Speterselect(STDERR); 4438032Speter 45102528Sgshapirochop(my $name = `hostname || uname -n`); 4638032Speter 47249729Sgshapiromy ($hostname) = (gethostbyname($name))[0]; 4838032Speter 49249729Sgshapiromy $usage = "Usage: $PROGRAM_NAME [-bv] host [args]"; 50249729Sgshapirogetopts('bv'); 51102528Sgshapiromy $verbose = $opt_v; 52249729Sgshapiromy $boot_check = $opt_b; 53102528Sgshapiromy $server = shift(@ARGV); 54102528Sgshapiromy @hosts = @ARGV; 5538032Speterdie $usage unless $server; 56102528Sgshapiromy @cwfiles = (); 57102528Sgshapiromy $alarm_action = ""; 5838032Speter 5938032Speterif (!@hosts) { 60102528Sgshapiro push(@hosts, $hostname); 6138032Speter 62102528Sgshapiro open(CF, "</etc/mail/sendmail.cf") || 63102528Sgshapiro die "open /etc/mail/sendmail.cf: $ERRNO"; 6438032Speter while (<CF>){ 65102528Sgshapiro # look for a line starting with "Fw" 66102528Sgshapiro if (/^Fw.*$/) { 67102528Sgshapiro my $cwfile = $ARG; 6838032Speter chop($cwfile); 69102528Sgshapiro my $optional = /^Fw-o/; 70102528Sgshapiro # extract the file name 71102528Sgshapiro $cwfile =~ s,^Fw[^/]*,,; 7238032Speter 73102528Sgshapiro # strip the options after the filename 74102528Sgshapiro $cwfile =~ s/ [^ ]+$//; 75102528Sgshapiro 7638032Speter if (-r $cwfile) { 77102528Sgshapiro push (@cwfiles, $cwfile); 7838032Speter } else { 79102528Sgshapiro die "$cwfile is not readable" unless $optional; 8038032Speter } 8138032Speter } 82102528Sgshapiro # look for a line starting with "Cw" 83102528Sgshapiro if (/^Cw(.*)$/) { 84102528Sgshapiro my @cws = split (' ', $1); 8538032Speter while (@cws) { 86102528Sgshapiro my $thishost = shift(@cws); 87102528Sgshapiro push(@hosts, $thishost) 88102528Sgshapiro unless $thishost =~ "$hostname|localhost"; 8938032Speter } 9038032Speter } 9138032Speter } 9238032Speter close(CF); 9338032Speter 94102528Sgshapiro for my $cwfile (@cwfiles) { 95102528Sgshapiro if (open(CW, "<$cwfile")) { 96102528Sgshapiro while (<CW>) { 9738032Speter next if /^\#/; 98102528Sgshapiro my $thishost = $ARG; 9938032Speter chop($thishost); 100102528Sgshapiro push(@hosts, $thishost) 101102528Sgshapiro unless $thishost =~ $hostname; 10238032Speter } 10338032Speter close(CW); 10438032Speter } else { 105102528Sgshapiro die "open $cwfile: $ERRNO"; 10638032Speter } 10738032Speter } 108249729Sgshapiro # Do this automatically if no client hosts are specified. 109249729Sgshapiro $boot_check = "yes"; 11038032Speter} 11138032Speter 112249729Sgshapiromy ($proto) = (getprotobyname('tcp'))[2]; 113249729Sgshapiro($port) = (getservbyname($port, 'tcp'))[2] 11438032Speter unless $port =~ /^\d+/; 11538032Speter 116249729Sgshapiroif ($boot_check) { 117249729Sgshapiro # first connect to localhost to verify that we can accept connections 118249729Sgshapiro print "verifying that localhost is accepting SMTP connections\n" 119249729Sgshapiro if ($verbose); 120249729Sgshapiro my $localhost_ok = 0; 121249729Sgshapiro ($name, my $laddr) = (gethostbyname('localhost'))[0, 4]; 122249729Sgshapiro (!defined($name)) && die "gethostbyname failed, unknown host localhost"; 123249729Sgshapiro 124249729Sgshapiro # get a connection 125249729Sgshapiro my $sinl = sockaddr_in($port, $laddr); 126249729Sgshapiro my $save_errno = 0; 127249729Sgshapiro for (my $num_tries = 1; $num_tries < 5; $num_tries++) { 128249729Sgshapiro socket(S, &PF_INET, &SOCK_STREAM, $proto) 129249729Sgshapiro || die "socket: $ERRNO"; 130249729Sgshapiro if (connect(S, $sinl)) { 131249729Sgshapiro &alarm("sending 'quit' to $server"); 132249729Sgshapiro print S "quit\n"; 133249729Sgshapiro alarm(0); 134249729Sgshapiro $localhost_ok = 1; 135249729Sgshapiro close(S); 136249729Sgshapiro alarm(0); 137249729Sgshapiro last; 138249729Sgshapiro } 139249729Sgshapiro print STDERR "localhost connect failed ($num_tries)\n"; 140249729Sgshapiro $save_errno = $ERRNO; 141249729Sgshapiro sleep(1 << $num_tries); 142249729Sgshapiro close(S); 143249729Sgshapiro alarm(0); 144249729Sgshapiro } 145249729Sgshapiro if (! $localhost_ok) { 146249729Sgshapiro die "could not connect to localhost: $save_errno\n"; 147249729Sgshapiro } 148249729Sgshapiro} 149249729Sgshapiro 15038032Speter# look it up 15138032Speter 152249729Sgshapiro($name, my $thataddr) = (gethostbyname($server))[0, 4]; 15364562Sgshapiro(!defined($name)) && die "gethostbyname failed, unknown host $server"; 154249729Sgshapiro 15538032Speter# get a connection 156249729Sgshapiromy $sinr = sockaddr_in($port, $thataddr); 157249729Sgshapirosocket(S, &PF_INET, &SOCK_STREAM, $proto) 158102528Sgshapiro || die "socket: $ERRNO"; 159102528Sgshapiroprint "server = $server\n" if (defined($verbose)); 16064562Sgshapiro&alarm("connect to $server"); 161249729Sgshapiroif (! connect(S, $sinr)) { 162102528Sgshapiro die "cannot connect to $server: $ERRNO\n"; 16338032Speter} 16464562Sgshapiroalarm(0); 165102528Sgshapiroselect((select(S), $OUTPUT_AUTOFLUSH = 1)[0]); # don't buffer output to S 16638032Speter 16738032Speter# read the greeting 16864562Sgshapiro&alarm("greeting with $server"); 169102528Sgshapirowhile (<S>) { 17038032Speter alarm(0); 171102528Sgshapiro print if $verbose; 17238032Speter if (/^(\d+)([- ])/) { 173102528Sgshapiro # SMTP's initial greeting response code is 220. 17438032Speter if ($1 != 220) { 17564562Sgshapiro &alarm("giving up after bad response from $server"); 176102528Sgshapiro &read_response($2, $verbose); 17738032Speter alarm(0); 178102528Sgshapiro print STDERR "$server: NOT 220 greeting: $ARG" 179102528Sgshapiro if ($verbose); 18038032Speter } 18138032Speter last if ($2 eq " "); 18238032Speter } else { 183102528Sgshapiro print STDERR "$server: NOT 220 greeting: $ARG" 184102528Sgshapiro if ($verbose); 18538032Speter close(S); 18638032Speter } 18764562Sgshapiro &alarm("greeting with $server"); 18838032Speter} 18938032Speteralarm(0); 19038032Speter 19164562Sgshapiro&alarm("sending ehlo to $server"); 19238032Speter&ps("ehlo $hostname"); 193102528Sgshapiromy $etrn_support = 0; 194102528Sgshapirowhile (<S>) { 195102528Sgshapiro if (/^250([- ])ETRN(.+)$/) { 19638032Speter $etrn_support = 1; 19738032Speter } 198102528Sgshapiro print if $verbose; 19938032Speter last if /^\d+ /; 20038032Speter} 20138032Speteralarm(0); 20238032Speter 203102528Sgshapiroif ($etrn_support) { 204102528Sgshapiro print "ETRN supported\n" if ($verbose); 20564562Sgshapiro &alarm("sending etrn to $server"); 20638032Speter while (@hosts) { 20738032Speter $server = shift(@hosts); 20838032Speter &ps("etrn $server"); 209102528Sgshapiro while (<S>) { 210102528Sgshapiro print if $verbose; 21138032Speter last if /^\d+ /; 21238032Speter } 21338032Speter sleep(1); 21438032Speter } 21538032Speter} else { 21638032Speter print "\nETRN not supported\n\n" 21738032Speter} 21838032Speter 21964562Sgshapiro&alarm("sending 'quit' to $server"); 22038032Speter&ps("quit"); 221102528Sgshapirowhile (<S>) { 222102528Sgshapiro print if $verbose; 22338032Speter last if /^\d+ /; 22438032Speter} 22538032Speterclose(S); 22638032Speteralarm(0); 22738032Speter 22838032Speterselect(STDOUT); 22938032Speterexit(0); 23038032Speter 231102528Sgshapiro# print to the server (also to stdout, if -v) 23238032Spetersub ps 23338032Speter{ 234102528Sgshapiro my ($p) = @_; 235102528Sgshapiro print ">>> $p\n" if $verbose; 23638032Speter print S "$p\n"; 23738032Speter} 23838032Speter 23938032Spetersub alarm 24038032Speter{ 24164562Sgshapiro ($alarm_action) = @_; 24264562Sgshapiro alarm(10); 24338032Speter $SIG{ALRM} = 'handle_alarm'; 24438032Speter} 24538032Speter 24638032Spetersub handle_alarm 24738032Speter{ 24864562Sgshapiro &giveup($alarm_action); 24938032Speter} 25038032Speter 25164562Sgshapirosub giveup 25264562Sgshapiro{ 253102528Sgshapiro my $reason = @_; 254102528Sgshapiro (my $pk, my $file, my $line); 25564562Sgshapiro ($pk, $file, $line) = caller; 25664562Sgshapiro 257102528Sgshapiro print "Timed out during $reason\n" if $verbose; 25864562Sgshapiro exit(1); 25964562Sgshapiro} 26064562Sgshapiro 26138032Speter# read the rest of the current smtp daemon's response (and toss it away) 26238032Spetersub read_response 26338032Speter{ 264102528Sgshapiro (my $done, $verbose) = @_; 265102528Sgshapiro (my @resp); 266102528Sgshapiro print my $s if $verbose; 267102528Sgshapiro while (($done eq "-") && ($s = <S>) && ($s =~ /^\d+([- ])/)) { 268102528Sgshapiro print $s if $verbose; 26938032Speter $done = $1; 270102528Sgshapiro push(@resp, $s); 27138032Speter } 27238032Speter return @resp; 27338032Speter} 274