#!/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 IMAP 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: imapstat.pl,v 1.1 2003/09/10 15:53:28 josh Exp $
#
#-------------------------------------------------------------------------
#
# Usage:
#
#   imapstat.pl [<interval>]
#
#   Without any options, this script will connect to the
#   imap server specified by the information in the CONFIG
#   section below, and attempt to authenticate.  Upon
#   successful authentication it will 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 );

### CONFIG

my $port = '143';
my $host = '127.0.0.1';
my $user = 'username';
my $pass = 'password';
my $debug = 0;

### /CONFIG

my $timedout = 0;

sub main
{
    my $proto = getprotobyname('tcp');
    my $state;
    my $lines = 0;

    defined $ARGV[0] and my $interval = $ARGV[0];

    do {
        if (($lines % 44) == 0) {
            print "host          | stat |  total |   conn |  greet |   pass |  quit \n";
            print "-----------------------------------------------------------------\n";
        }
        $lines++;
        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);
    my $status = "FAIL";
    my $state = 0;
    my $line;

    $t0 = [gettimeofday];
    eval {
    
    local $SIG{ALRM} = sub { die "TIME\n"; };
    alarm 10;

    connect($sock,$sin);
    $t1 = [gettimeofday];
    
    LOOP: while($line = <$sock>) {
        $line =~ s/\015\012$//g;
        if ($debug > 0) {
            print "[$line]\n"
        }
        if ($line =~ m/^\* OK/) {
            if ($state == 0) {          # initial state, send USER first
                $t2 = [gettimeofday];
                print $sock "* LOGIN $user $pass\015\012";
            } elsif ($state == 1) {     # sent USER + PASS time to logout
                $t3 = [gettimeofday];
                $status = "PASS";
                print $sock "* LOGOUT\015\012";
            } else { 
                # done should not get here, because we QUIT already
                last LOOP;
            }
            $state++;
        } else {
            if ($line =~ m/^\* NO/) {
                # authentication failed
            } elsif ($line =~ m/^\* BYE/) {
                next LOOP;
            } else {
                print STDERR "Unhandled Server Message [$line]\n";
            }
            last LOOP;
        }
    } # end LOOP: while

    }; # eval
    alarm 0;
    $t4 = [gettimeofday];
    
    if ($@) {
         $status = $@;
         chomp($status);
    }

    $status = "$host\t$status";
    outputStats($status, $t0, $t1, $t2, $t3, $t4);
    return (0);
}


sub outputStats
{
    my ($status, $t0, $t1, $t2, $t3, $t4) = @_;

    print "$status   ";
    if ((defined $t0) && (defined $t4)) {
        printf("%02.5f  ", tv_interval ( $t0, $t4 ));
    }
    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 ));
    }
    print "\n";
}


# call main
main();
