#!/usr/bin/perl

# rbltest (c) 2003 Michael Gregorowicz
#             Wayne State University
#             Internet Services
#             ak1520@wayne.edu

# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING,
# WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR
# PURPOSE.

# Hi.  This script connects to your mirapoint router(s), obtains a list of rbl's, and queries
# them using the 'smtp testrblhost' command.  It times them using Time::HiRes.  And can average
# the results to return you a semi-accurate number defining how good or how crappy a given RBL
# is.  Random IP's are generated to ensure that the RBL's aren't caching.

# Usage, well you can just run it.. and it will test each specified host's rbl once.  Or you can
# get in it for the long haul and run:
#
# rbltest 50
#
# this will run the test 50 times using a random ip each time to each rbl for each host you have
# and then average the result.

# use some modules.  you'll have to get Term::ReadKey probably.  You can get by without it if you
# use those $muser and $mpass declarations below, and delete the pretty_*_fetch subs.
use IO::Socket;
use Term::ReadKey;
use Time::HiRes qw(time);    # hi res time baybeh!
use subs qw(gen_rand_ip pretty_data_fetch pretty_pw_fetch);
use strict;

$| = 1;    # buffering is bad for pretty animations.  thats why it's off.

my $muser; # = '';  # for your convienience
my $mpass; # = '';  # <3

# define hosts with rbls you want to check here
my @hosts = qw(
  mirapointmr1.wayne.edu
  mirapointmr2.wayne.edu
  mirapointmr3.wayne.edu
  mirapointmr4.wayne.edu
);

# for those systems that want to make people log in to this thing
# should be the same as your mirapoint user/pass.
$muser = pretty_data_fetch("Login: ")            if !$muser;
$mpass = pretty_pw_fetch("$muser\'s password: ") if !$mpass;

# how many times is a good enough sample? 1? 10? 100? 100000000? (eek)
# i'll leave that up to you ;)
my $t_num = $ARGV[0];
$t_num = 1 unless $t_num;    # unless you forefit!

my $start_time = time;                          # get start time
my $times = get_rbl_times( $t_num, @hosts );    # do the processing
my $end_time = time;    # get end time! *stopwatch click*

# print the float only 4 decimals down!
my $total_time = sprintf( '%.4f', ( $end_time - $start_time ) );
my $time_sum;

# print output out of fun hash
foreach my $router ( sort keys %$times ) {
    print "Router: $router\n";
    foreach my $key ( keys %{ $times->{$router} } ) {
        my $depth =
          sprintf( '%d', ( ( length($key) + 1 ) / 8 ) )
          ;             # how many tabs could a tabtab tab...
        my $tabs = "\t" x ( 4 - $depth );    # if a tabtab could tab tab?
        $time_sum +=
          $times->{$router}->{$key}->[1]
          ;    # take the sum of all the times for use below
        print
"\t$key:$tabs$times->{$router}->{$key}->[0] secs ($times->{$router}->{$key}->[1] ttl secs)\n"
          ;    # print the data!
    }
    print "\n";
}

# just FYI information, not really required.
print "Calibration Information:\n";
print "Time:\t\t$total_time secs\n";
print "Sum of Times:\t$time_sum secs\n";
print "Difference:\t"
  . sprintf( '%.4f', ( $total_time - $time_sum ) )
  . " secs\n";

#
# SUBROUTINES FOLLOW
#

#
# just iterates through the @hosts.
#
sub get_rbl_times {
    my %times;
    my ( $test_number, @hosts ) = @_;
    $test_number = 1 unless $test_number;
    foreach my $host (@hosts) {
        $times{$host} = get_rbl_time( $host, $test_number, $muser, $mpass );
    }
    return \%times;
}

#
# I really could have used Mirapoint::Admin here
# it is a good module.  but i just didnt use it.
#
sub get_rbl_time {
    my ( %data, @rbls, $hdr, $ans, $itr_sum );
    my %nh = (
        "|"    => "\b/",
        "\b*|" => "\b/",
        "\b/"  => "\b-",
        "\b-"  => "\b\\",
        "\b\\" => "\b*|"
    );
    my ( $host, $test_number, $muser, $mpass ) = @_;
    my $socket = IO::Socket::INET->new(
        PeerAddr =>
          $host, # this script doesn't have SSL support - that's all you, buddy.
        PeerPort =>
          10143, # maybe another version will.. but this is just for fun mostly.
        Proto => 'tcp',
        Type  => SOCK_STREAM
      )
      or die "Cannot open socket to $host\n";
    my $hdr = <$socket>;
    print $socket "1 login $muser $mpass\n";
    print $socket "2 smtp listrblhost \"\" \"\" \"\"\n";
    while ( my $line = <$socket> ) {
        chomp $line;
        $line =~ s/\r//g;    # STOP THE VIOLENCE
        last if $line eq '2 OK Completed';
        next unless $line =~ /^\* 2 ([\w\.\-]+)$/;
        push( @rbls, $1 );
    }
    my $anim_cur = "|";
    print "Processing $host:  ";
    for ( my $id = 3 ; $id < ( 3 + scalar(@rbls) ) ; ++$id )
    {    # iterate through the rbl's found.  we start at 3, but we reuse it
        $itr_sum = 0;    # so it's not correct in the sequence.  But it works!
        for ( my $t = 0 ; $t < $test_number ; ++$t ) {
            my $t1 = time;
            print $socket "$id smtp testrblhost $rbls[($id - 3)] "
              . gen_rand_ip
              . "\n";    # run the test against a random ip
            while ( my $line = <$socket> ) {
                chomp $line;
                $line =~ s/\r//g
                  ;  # STOP THE VIOLENCE # STOP THE VIOLENCE # STOP THE VIOLENCE
                last if $line eq "$id OK Completed";
            }
            my $t2 = time;
            $itr_sum += ( $t2 - $t1 );
            print
              "$nh{$anim_cur}"; # fun progress animations make everything better
            $anim_cur = $nh{$anim_cur};
        }

# add the data to the returned hash. first element is the average, second element is the total time taken.
        push(
            @{ $data{ $rbls[ ( $id - 3 ) ] } },
            sprintf( '%.4f', ( $itr_sum / $test_number ) ),
            sprintf( '%.4f', $itr_sum )
        );
    }
    print "\b* ..OK\n";
    print $socket ( scalar(@rbls) + 3 )
      . " logout\n";    # be kind, rewind .. er logout.
    $socket->close();
    return \%data;
}

sub pretty_pw_fetch {

# you can specify a prompt by running $pw = pretty_pw_fetch("Prompt: ") or it will use
# the default one i made which is just Password:
    my $prompt = shift;
    unless ($prompt) {
        $prompt = "Password: ";
    }

    # turn off buffering!!
    $| = 1;

    # here i print out the prompt!
    print $prompt;

    # declare pw variable
    my @pw;

    # return!
    my $ret = 0;

    while ( !$ret ) {
        my $bs = 0;
        ReadMode 3
          ; # change the mode to 3 so you can still break out, use 4 if you want no ctrl keys
        my $key = ReadKey;    # take one key at a time (calls c's getc())
        ReadMode 1;           # revert back to normal mode
        $ret = 1
          if $key eq "\n"
          || $key eq "\r\n";    # if it's a carrage return we're done!
        if ( ( $key =~ /\177/ ) || ( $key =~ /\010/ ) ) {
            $bs = 1;
        }
        if ( !$ret ) {          # if we already got a CR dont do anything
            if ( $bs == 1 ) {

                # if we have characters to delete, delete them
                if ( scalar(@pw) > 0 ) {

                    # clear last char, and back up!
                    print STDOUT "\b \b";
                    pop(@pw);
                } else {

                    # if not send the alarm!
                    print STDOUT "\a";
                }
            } else {
                push( @pw, $key );    # append the new key to the password
                print STDOUT "*";     # print a star instead of the character
            }
        }
    }
    print "\n";
    return join( '', @pw );
}

# just a copy of the above, i just print out the actual char
# instead of a star.. could both be one sub, but im lazy.
sub pretty_data_fetch {

# you can specify a prompt by running $pw = pretty_username_fetch("Prompt: ") or it will use
# the default one i made which is just Login:
    my $prompt = shift;
    unless ($prompt) {
        $prompt = "Login: ";
    }

    # turn off buffering!!
    $| = 1;

    # here i print out the prompt!
    print $prompt;

    # declare un variable
    my @data;

    # return!
    my $ret = 0;

    while ( !$ret ) {
        my $bs = 0;
        ReadMode 3
          ; # change the mode to 3 so you can still break out, use 4 if you want no ctrl keys
        my $key = ReadKey;    # take one key at a time (calls c's getc())
        ReadMode 1;           # revert back to normal mode
        $ret = 1
          if $key eq "\n"
          || $key eq "\r\n";    # if it's a carrage return we're done!
        if ( ( $key =~ /\177/ ) || ( $key =~ /\010/ ) ) {
            $bs = 1;
        }
        if ( !$ret ) {          # if we already got a CR dont do anything
            if ( $bs == 1 ) {

                # if we have characters to delete, delete them
                if ( scalar(@data) > 0 ) {

                    # clear last char, and back up!
                    print STDOUT "\b \b";
                    pop(@data);
                } else {

                    # if not send the alarm!
                    print STDOUT "\a";
                }
            } else {
                push( @data, $key );    # append the new key to the password
                print STDOUT "$key";    # print a star instead of the character
            }
        }
    }
    print "\n";
    return join( '', @data );
}

# generates a random ip.
sub gen_rand_ip {
    my $ip;
    for ( my $i = 1 ; $i <= 4 ; ++$i ) {
        if ($ip) {
            while ( my $got_it == 0 ) {
                my $rand = sprintf( '%d', rand(256) );
                if ( $rand > 0 ) {
                    $ip .= "." . $rand;
                    $got_it = 1 && last;
                }
            }
        } else {
            while ( my $got_it == 0 ) {
                my $rand = sprintf( '%d', rand(256) );
                if ( $rand > 0 ) {
                    $ip = $rand;
                    $got_it = 1 && last;
                }
            }
        }
    }
    return $ip;
}

Name:   Url: Subject:

C: