#!/usr/local/bin/perl
#
# check sakai login-logout response time

# nagios: -epn
# Above line tells nagios not to use ePN.
# Must be in first 10 lines of file.

# 
# by Doke Scott, 2008.9.29
#
# $Header: /opt/home/doke/work/nagios/RCS/check_sakai_login,v 1.8 2013/03/21 14:43:41 doke Exp $
#
#
# This measures response time via two methods.  I started with
# LWPx::TimedHTTP, but it seems to be giving unreasonably small values. 
# The entire program would take 2 or more seconds to run, and it would
# report 10 ms.  So I started using gettimeofday around the mech->get
# calls.  That gives more reasonable numbers.


use warnings;
no warnings 'redefine';
use strict;
use Socket;
use HTTP::Cookies;
use WWW::Mechanize;
use LWPx::TimedHTTP qw(:autoinstall);
use Time::HiRes qw( gettimeofday usleep );
use Getopt::Long;
#use Net::SSL;

# for debugging
#use LWP::Debug qw(+ -conns);
#use Data::Dumper;

############################

use vars qw( $host $default_port $port $ssl $username $password_file $crit_rt
    $warn_rt $verbose $stat_only $help );


$host = 'sakai.udel.edu';
$ssl = 1;
$default_port = 443;
$port = $default_port;
$username = 'traina';
$password_file = '/usr/local/nagios/etc/traina.pw';
$warn_rt = 3.000;   # seconds
$crit_rt = 10.000;   # seconds

$verbose = 0;
$stat_only = 0;
$help = 0;


use vars qw( $total_bytes 
    $rt_sum $rt_cnt $rt_max $rt_min 
    $rt2_sum $rt2_cnt $rt2_max $rt2_min 
    @cur_frames $cookies @dataqueue %image_cache $mech $rc );


############################

sub print_usage { 
    my( $rc ) = @_;
    print qq{Usage: $0 [-svh] [-H host] [-u username] [-p password-file] [-c f] [-w f]
    -H s	hostname
    -S  	use ssl
    -P i	port [$default_port]
    -u s	username
    -p s	password
    -c f	critical response time in seconds, floating point 
    -w f	warning response time in seconds, floating point 
    -s          just give the response time stat in seconds, for cricket
    -v          verbose 
    -h          help 
};
    exit $rc;
    }

Getopt::Long::Configure ("bundling");
GetOptions( 
    'H=s' => \$host,
    'S+' => \$ssl,
    'P=i' => \$port,
    'u=s' => \$username,
    'p=s' => \$password_file,
    'w=f' => \$warn_rt,
    'c=f' => \$crit_rt,
    's' => \$stat_only,
    'v+' => \$verbose,
    'h' => \$help,
    );
print_usage( 0 ) if ( $help );
print_usage( -1 ) if ( ! $host );
print_usage( -1 ) if ( ! $port );

$ssl %= 2;  # so it toggles

$rc = sakai_test( $host, $port, $username, $password_file );

if ( $stat_only ) { 
    printf "%0.6f\n", $rt2_sum;
    exit 0;
    }
elsif ( $rc ) { 
    if ( $rt2_sum >= $crit_rt ) { 
	printf "CRITICAL rt=%0.2fs | rt=%0.3f\n", $rt2_sum, $rt2_sum;
	exit 2;
	}
    elsif ( $rt2_sum >= $warn_rt ) { 
	printf "Warning rt=%0.2fs | rt=%0.3f\n", $rt2_sum, $rt2_sum;
	exit 1;
	}
    else { 
	printf "Ok rt=%0.2fs | rt=%0.3f\n", $rt2_sum, $rt2_sum;
	exit 0;
	}
    }
exit 1;



############################



sub sakai_test { 
    my( $host, $port, $username, $password_file ) = @_; 
    my( $password, $url_start );

    $url_start = "http"; 
    $url_start .= "s" if ( $ssl ); 
    $url_start .= "://$host:$port/";  

    undef @cur_frames;
    $total_bytes = 0;
    $rt_sum = 0;
    $rt_cnt = 0;
    $rt_max = 0.0;
    $rt_min = 999999.9;

    $rt2_sum = 0;
    $rt2_cnt = 0;
    $rt2_max = 0.0;
    $rt2_min = 999999.9;

    #$ENV{ PERL_LWP_SSL_VERIFY_HOSTNAME } = 0;

    # make our own cookie jar, so it can be shared between mechs
    # and so we can reinstall it when LWP:: looses it
    $cookies = HTTP::Cookies->new();
    $mech = WWW::Mechanize->new( 
	cookie_jar => $cookies,
	timeout => 30,
	);

    #$mech->ssl_opts(
    #    SSL_verify_mode => SSL_VERIFY_NONE,
    #    );

    $verbose && print "getting start url '$url_start'\n";
    #$mech->get( $url_start );
    timed_get( $url_start );
    &handle_response( $mech ) || return 0;

    if ( $mech->content =~ m/Redirecting/is )  { 
	$verbose && print "got redirect\n";
	&follow( '/portal' ) || return 0;
	}

    &check_content( 'user id:' ) || return 0;

    $verbose && print "\n\nsubmitting login form\n";
    $password = get_password( $password_file ) || return 0;
    $verbose && print "using username '$username', password '$password'\n";
    $mech->form_number( 1 );
    #$mech->form_name( 'loginForm' );
    #$mech->set_visible( $username, $password );
    $mech->field( 'eid', $username ); 
    $mech->field( 'pw', $password );
    #$mech->submit();
    timed_submit();
    &handle_response( $mech ) || return 0;

    &check_content( 'My Workspace' ) || return 0;

    &follow( 'Logout' ) || return 0;
    &check_content( 'user id:' ) || return 0;

    if ( $verbose ) {  
	printf "total bytes %d\n", $total_bytes;
	printf "rt sum %.2f ms, cnt %d, avg %.2f ms, max %.2f ms, min %.2f ms\n", 
	    $rt_sum * 1000, $rt_cnt,
	    $rt_sum * 1000 / $rt_cnt,
	    $rt_max * 1000, $rt_min * 1000;
	printf "rt2 sum %.2f ms, cnt %d, avg %.2f ms, max %.2f ms, min %.2f ms\n", 
	    $rt2_sum * 1000, $rt2_cnt,
	    $rt2_sum * 1000 / $rt2_cnt,
	    $rt2_max * 1000, $rt2_min * 1000;
	}
    return 1;
    }
    


########################

sub timed_get { 
    my( $url ) = @_; 
    my( $before, $rt2 );

    $verbose && print "timed_get( $url )\n";
    $before = gettimeofday();

    $mech->get( $url );

    $rt2 = gettimeofday() - $before;
    $rt2_sum += $rt2;
    $rt2_cnt++;
    $rt2_max = $rt2 if ( $rt2 > $rt2_max );
    $rt2_min = $rt2 if ( $rt2 < $rt2_min );
    $verbose && print "rt2 $rt2, rt2_sum $rt2_sum\n";
    }




sub timed_submit { 
    my( $before, $rt2 );

    $verbose && print "timed_submit()\n";
    $before = gettimeofday();

    $mech->submit();

    $rt2 = gettimeofday() - $before;
    $rt2_sum += $rt2;
    $rt2_cnt++;
    $rt2_max = $rt2 if ( $rt2 > $rt2_max );
    $rt2_min = $rt2 if ( $rt2 < $rt2_min );
    $verbose && print "rt2 $rt2, rt2_sum $rt2_sum\n";
    }





sub get_frameset { 
    my( @links, $link, $i, $m, @frames );

    print "\n\ngetting frameset\n";
    $i = 0;
    @links = $mech->find_all_links( tag => 'frame' );
    foreach $link ( @links ) { 
	print "\nframe ", ++$i, "\n"; 
	print "    ", $link->url(), "\n";
	$m = WWW::Mechanize->new( cookie_jar => $cookies );
	#$m->get( $link->url() );
	timed_get( $link->url );
	&handle_response( $m );
	push @frames, $m;
	}
    return @frames;
    }



sub follow { 
    my( $pat ) = @_;
    my( $link, $frame, $delay );

    $verbose && print "\n\nfollowing $pat link\n";

    #$delay = int( ( rand() * ( $click_delay_max - $click_delay_min ) 
    #	+ $click_delay_min ) * 1000000 );
    #print "usleep $delay\n";
    #usleep( $delay );
    if ( @cur_frames ) {   # global list of current frames
	foreach $frame ( @cur_frames ) { 
	    next if ( ! $frame );
	    print "searching ", $frame->uri(), "\n";
	    $link = $frame->find_link( text_regex => qr/$pat/ );
	    last if ( $link );
	    }
	}
    else { 
	$link = $mech->find_link( text_regex => qr/$pat/is );
	}
    if ( ! $link ) { 
	print "can't find $pat link\n";
	return 0;
	}
    #$mech->get( $link->url() );
    timed_get( $link->url );
    &handle_response( $mech ) || return 0;

    undef @cur_frames;
    if ( $mech->content =~ m/<frameset/i ) { 
	@cur_frames = &get_frameset();  # global list of current frames
	}
    return 1;
    }


sub check_content { 
    my( $pat ) = @_;
    my( $frame );

    $verbose && print "\nchecking content for '$pat'\n";
    if ( $#cur_frames >= 0 ) {  # global list of current frames
	foreach $frame ( @cur_frames ) { 
	    if ( $frame && $frame->success() && $frame->content =~ m/$pat/ )  { 
		return $frame;
		}
	    }
	print "content match failed\n";
	return 0;
	}
    else { 
	if ( ! $mech->success() ) { 
	    print "get failed\n";
	    return 0;
	    }
	elsif ( $mech->content !~ m/$pat/ )  { 
	    print "content match failed for '$pat'\n";
	    return 0;
	    }
	return $mech;
	}
    }


#######################


# show info from response, and grab all images
sub handle_response { 
    my( $mech ) = @_;
    my( @images, $image, $i, $j, @forms, $form, @inputs, $input, $rt );

    $verbose && print "handle_response()\n";

    if ( ! $mech->success() ) { 
	print "get failed; content: ", $mech->content, "\n"; 
	return 0;    
	}

    $verbose && printf "    size %d\n", length( $mech->content );
    $total_bytes += length( $mech->content );
    $rt = $mech->response->header('Client-Response-Receive-Time');
    $rt_sum += $rt;
    $rt_cnt++;
    $rt_max = $rt if ( $rt > $rt_max );
    $rt_min = $rt if ( $rt < $rt_min );
    $verbose && print "rt $rt, rt_sum $rt_sum\n";
    $verbose && print $mech->content;

    $i = 0;
    @images = $mech->images();
    $verbose && printf "%d images\n", scalar( @images );
    foreach $image ( @images ) { 
	next if ( $image_cache{ $image->url_abs() } ); 

	$verbose && print "image ", $image->url_abs(), "\n";
	#$mech->get( $image->url_abs() );
	timed_get( $image->url_abs() );
	if ( $mech->success() ) { 
	    $verbose && print "    size ", length( $mech->content ), "\n";
	    $total_bytes += length( $mech->content );
	    $rt = $mech->response->header('Client-Response-Receive-Time');
	    $rt_sum += $rt;
	    $rt_cnt++;
	    $rt_max = $rt if ( $rt > $rt_max );
	    $rt_min = $rt if ( $rt < $rt_min );
	    $verbose && print "rt $rt, rt_sum $rt_sum\n";
	    $mech->back();
	    }
	$image_cache{ $image->url_abs() } = 1;
	}

    # for some unknown reason, on gjallarhorn, getting the images wipes out 
    # LWP::UserAgent's memory that it has a cookie jar.  Maybe because sakai  
    # doesn't return cookies with them?  Anyway we have to reestablish it.  
    $mech->cookie_jar( $cookies );

    $i = 0;
    @forms = $mech->forms();
    if ( $verbose ) { 
	foreach $form ( @forms ) { 
	    print "form ", ++$i, "\n";
	    print "    method ", $form->method(), "\n";
	    print "    action ", $form->action(), "\n";
	    $j = 0;
	    @inputs = $form->inputs;
	    foreach $input ( @inputs ) { 
		printf "    input %d, type %s, name %s, value %s\n", 
		    ++$j, $input->type(), $input->name(), $input->value();
		}
	    }
	}
    return 1;
    }
	    






sub get_password { 
    my( $file ) = @_;
    my( $pw );

    if ( ! open( fH, $file ) ) {
	warn "can't open passwd file '$file': $!\n";
	return 0;
	}
    chomp( $pw = <fH> );
    close fH;
    return $pw;
    }