#!/usr/bin/perl -w
#
# Summary:
#
# This is a script designed to provide information similar
# to that generated by the "vmstat" command, but with data
# indicating SMTP server performance.
#
#--------------------------------------------------------------------------
# COPYRIGHT INFORMATION - DO NOT REMOVE
# "Portions Copyright (c) 2000-2001 LinuxMagic Inc. All Rights Reserved.
#
# This file contains Original Code and/or Modifications of Original Code as
# defined in and that are subject to the Free Source Code License Version
# 1.0 (the 'License'). You may not use this file except in compliance with
# the License. Please obtain a copy of the License at:
#
# http://www.linuxmagic.com/opensource/licensing/
#
# and read it before using this file.
#
# The Original Code and all software distributed under the License are
# distributed on an 'AS IS' basis, WITHOUT WARRANTY OF ANY KIND, EITHER
# EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES,
# INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY, FITNESS
# FOR A PARTICULAR PURPOSE, QUIET ENJOYMENT OR NON-INFRINGEMENT. Please see
# the License for the specific language governing rights and limitations
# under the License."
#
# Please read the terms of this license carefully. By using or downloading
# this software or file, you are accepting and agreeing to the terms of this
# license with LinuxMagic Inc. If you are agreeing to this license on behalf
# of a company, you represent that you are authorized to bind the company to
# such a license. If you do not meet this criterion or you do not agree to
# any of the terms of this license, do NOT download, distribute, use or alter
# this software or file in any way.
#
# Authors: Josh Wilsdon <josh@wizard.ca>
#
# DO NOT MODIFY WITHOUT CONSULTING THE LICENSE
#
# $Id: smtpstat.pl,v 1.1 2003年09月10日 15:53:28 josh Exp $
#
#-------------------------------------------------------------------------
#
# Usage:
#
# smtpstat.pl [<interval>]
#
# Without any options, this script will connect to the
# SMTP server specified by the information in the CONFIG
# section below, and execute a "MAIL FROM" command 
# followed by a "RCPT TO" command and will subsequently 
# quit.
#
# If a numeric argument is provided on the command line
# when executing this script, it will perform the above
# actions in a loop with a period of <interval> seconds
# between each attempt.
#
# A header is printed upon invocation, and each test run
# will generate a line of data.
#
#-------------------------------------------------------------------------
use IO::Handle;
use Socket;
use Time::HiRes qw( gettimeofday tv_interval );
$&#124;=1;
### CONFIG
my $port = '25';
my $host = '127.0.0.1';
my $mail = 'username';
my $rcpt = 'password';
my $debug = 0;
### /CONFIG
my $timedout = 0;
sub main
{
 my $proto = getprotobyname('tcp');
 my $state;
 defined $ARGV[0] and my $interval = $ARGV[0];
 print "stat &#124; total &#124; conn &#124; banner &#124; MAIL &#124; RCPT &#124; QUIT\n";
 print "----------------------------------------------------------\n";
 do {
 socket($sock, PF_INET, SOCK_STREAM, $proto);
 $sock->autoflush();
 $sin = sockaddr_in($port,inet_aton($host));
 runTest($sock, $sin);
 close($sock);
 } while ((defined $interval) && (sleep($interval)));
 exit(0);
}
sub runTest
{
 my ($sock, $sin) = @_;
 my ($t0, $t1, $t2, $t3, $t4, $t5);
 my $status = "FAIL";
 my $state = 0;
 my $line;
 # TODO set an alarm and timeout if fails
 #
 # eval {
 #
 # local $SIG{ALRM} = sub { die "TIME\n"; };
 # alarm 1;
 $t0 = [gettimeofday];
 connect($sock,$sin);
 $t1 = [gettimeofday];
 
 LOOP: while($line = <$sock>) {
 $line =~ s/015円012円$//g;
 if ($debug> 0) {
 print "[$line]\n"
 }
 if ($line =~ m/^(2\d\d)/) {
 if ($state == 0) { # initial state, send MAIL first
 $t2 = [gettimeofday];
 $server = $line;
 $server =~ s/^\d\d\d\s//g;
 $server =~ s/\sESMTP.*$//g;
 print "$server ";
 print $sock "MAIL FROM: <$mail>015円012円";
 } elsif ($state == 1) { # sent MAIL, time for RCPT
 $t3 = [gettimeofday];
 print $sock "RCPT TO: <$rcpt>015円012円";
 } elsif ($state == 2) { # authenticated check for messages
 $t4 = [gettimeofday];
 $status = "PASS";
 print $sock "QUIT015円012円";
 } else { 
 # done should not get here, because we QUIT already
 last LOOP;
 }
 $state++;
 } else {
 if ($line =~ m/^[45]\d\d/) {
 # failed
 } else {
 print STDERR "Unhandled Server Message [$line]\n";
 }
 last LOOP;
 }
 } # end LOOP: while
 $t5 = [gettimeofday];
 # alarm 0;
 # } # eval
 #
 # if ($@) {
 # $status = $@;
 # chomp($status);
 # }
 outputStats($status, $t0, $t1, $t2, $t3, $t4, $t5);
 return (0);
}
sub outputStats
{
 my ($status, $t0, $t1, $t2, $t3, $t4, $t5) = @_;
 print "$status ";
 if ((defined $t0) && (defined $t5)) {
 printf("%02.5f ", tv_interval ( $t0, $t5 ));
 }
 if ((defined $t0) && (defined $t1)) {
 printf("%02.5f ", tv_interval ( $t0, $t1 ));
 }
 if ((defined $t1) && (defined $t2)) {
 printf("%02.5f ", tv_interval ( $t1, $t2 ));
 }
 if ((defined $t2) && (defined $t3)) {
 printf("%02.5f ", tv_interval ( $t2, $t3 ));
 }
 if ((defined $t3) && (defined $t4)) {
 printf("%02.5f ", tv_interval ( $t3, $t4 ));
 }
 if ((defined $t4) && (defined $t5)) {
 printf("%02.5f ", tv_interval ( $t4, $t5 ));
 }
 print "\n";
}
# call main
main();
</div><div class="naked_ctrl">
<form action="/index.cgi/contrast" method="get" name="gate">
<p><a href="http://altstyle.alfasado.net">AltStyle</a> によって変換されたページ <a href="https://www.linuxmagic.com/opensource/tools/smtpstat.pl">(-&gt;オリジナル)</a>
/ <label>アドレス: <input type="text" name="naked_post_url" value="https://www.linuxmagic.com/opensource/tools/smtpstat.pl" size="22" /></label> <label>モード: <select name="naked_post_mode">
<option value="default">デフォルト</option>
<option value="speech">音声ブラウザ</option>
<option value="ruby">ルビ付き</option>
<option value="contrast" selected="selected">配色反転</option>
<option value="larger-text">文字拡大</option>
<option value="mobile">モバイル</option>
</select>
<input type="submit" value="表示" />
</p>
</form>
</div>