1 #!/usr/perl5/bin/perl -w
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.
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.
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]
23 # Copyright (c) 1996-2000 by John T. Beck <john@beck.org>
24 # All rights reserved.
26 # Copyright 2008 Sun Microsystems, Inc. All rights reserved.
27 # Use is subject to license terms.
30 require 5.8.4; # minimal Perl version required
39 # system requirements:
40 # must have 'hostname' program.
45 chop(my $name = `hostname || uname -n`);
47 my ($hostname) = (gethostbyname($name))[0];
49 my $usage = "Usage: $PROGRAM_NAME [-bv] host [args]";
52 my $boot_check = $opt_b;
53 my $server = shift(@ARGV);
55 die $usage unless $server;
57 my $alarm_action = "";
60 push(@hosts, $hostname);
62 open(CF, "</etc/mail/sendmail.cf") ||
63 die "open /etc/mail/sendmail.cf: $ERRNO";
65 # look for a line starting with "Fw"
69 my $optional = /^Fw-o/;
70 # extract the file name
71 $cwfile =~ s,^Fw[^/]*,,;
73 # strip the options after the filename
74 $cwfile =~ s/ [^ ]+$//;
77 push (@cwfiles, $cwfile);
79 die "$cwfile is not readable" unless $optional;
82 # look for a line starting with "Cw"
84 my @cws = split (' ', $1);
86 my $thishost = shift(@cws);
87 push(@hosts, $thishost)
88 unless $thishost =~ "$hostname|localhost";
94 for my $cwfile (@cwfiles) {
95 if (open(CW, "<$cwfile")) {
100 push(@hosts, $thishost)
101 unless $thishost =~ $hostname;
105 die "open $cwfile: $ERRNO";
108 # Do this automatically if no client hosts are specified.
112 my ($proto) = (getprotobyname('tcp'))[2];
113 ($port) = (getservbyname($port, 'tcp'))[2]
114 unless $port =~ /^\d+/;
117 # first connect to localhost to verify that we can accept connections
118 print "verifying that localhost is accepting SMTP connections\n"
120 my $localhost_ok = 0;
121 ($name, my $laddr) = (gethostbyname('localhost'))[0, 4];
122 (!defined($name)) && die "gethostbyname failed, unknown host localhost";
125 my $sinl = sockaddr_in($port, $laddr);
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");
139 print STDERR "localhost connect failed ($num_tries)\n";
140 $save_errno = $ERRNO;
141 sleep(1 << $num_tries);
145 if (! $localhost_ok) {
146 die "could not connect to localhost: $save_errno\n";
152 ($name, my $thataddr) = (gethostbyname($server))[0, 4];
153 (!defined($name)) && die "gethostbyname failed, unknown host $server";
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";
165 select((select(S), $OUTPUT_AUTOFLUSH = 1)[0]); # don't buffer output to S
168 &alarm("greeting with $server");
172 if (/^(\d+)([- ])/) {
173 # SMTP's initial greeting response code is 220.
175 &alarm("giving up after bad response from $server");
176 &read_response($2, $verbose);
178 print STDERR "$server: NOT 220 greeting: $ARG"
183 print STDERR "$server: NOT 220 greeting: $ARG"
187 &alarm("greeting with $server");
191 &alarm("sending ehlo to $server");
192 &ps("ehlo $hostname");
193 my $etrn_support = 0;
195 if (/^250([- ])ETRN(.+)$/) {
204 print "ETRN supported\n" if ($verbose);
205 &alarm("sending etrn to $server");
207 $server = shift(@hosts);
216 print "\nETRN not supported\n\n"
219 &alarm("sending 'quit' to $server");
231 # print to the server (also to stdout, if -v)
235 print ">>> $p\n" if $verbose;
241 ($alarm_action) = @_;
243 $SIG{ALRM} = 'handle_alarm';
248 &giveup($alarm_action);
254 (my $pk, my $file, my $line);
255 ($pk, $file, $line) = caller;
257 print "Timed out during $reason\n" if $verbose;
261 # read the rest of the current smtp daemon's response (and toss it away)
264 (my $done, $verbose) = @_;
266 print my $s if $verbose;
267 while (($done eq "-") && ($s = <S>) && ($s =~ /^\d+([- ])/)) {
268 print $s if $verbose;