#!/usr/bin/perl -w
#
# A check to log in a website
#
# By Igor Gubenko (igubenko@Princeton.EDU), 12/15/2011
#

use strict;
use warnings;
use lib qw(/usr/local/perl/lib/perl5);
use Switch;
use Getopt::Std;

use IO::Socket::SSL;

my $context = new IO::Socket::SSL::SSL_Context(
	SSL_version => 'tlsv1_2',
	SSL_verify_mode => Net::SSLeay::VERIFY_NONE(),
);
IO::Socket::SSL::set_default_context($context);

use LWP::UserAgent;
use HTTP::Request::Common;

#use Net::SSL; # From Crypt-SSLeay
#use LWP::Protocol::https;
#BEGIN {
#        $Net::HTTPS::SSL_SOCKET_CLASS = "Net::SSL"; # Force use of Net::SSL
#        $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS}="IO::Socket::SSL";
#}      
#$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0;
#$ENV{HTTPS_VERSION} = 3;

sub usage;
my $progname = $0;

my %opt;
# (U)RL, Auth (t)ype, (h)elp, (u)sername, (p)assword, (s)tring to expect, (w)arning threshold, (c)ritical threshold
getopts ("U:t:hu:p:s:w:c:", \%opt);

foreach (qw(U u p)) {
	usage unless exists $opt{$_} && not exists $opt{h};
}

my ($url, $type, $user, $pass, $str, $warn, $crit) = (
	$opt{U},
	exists $opt{t} ? $opt{t} : 'basic',
	$opt{u},
	$opt{p},
	exists $opt{s} ? $opt{s} : undef,
	exists $opt{w} ? $opt{w} : 3,
	exists $opt{c} ? $opt{c} : 5
	);

$url =~ m#^http([s]?)://([^/]+)#i;
my $hst = $2;
$hst .= defined $1 && $1 eq 's' ? ':443' : ':80';

#$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}=0;
#$ENV{PERL_LWP_SSL_VERIFY_MODE}='SSL_VERIFY_NONE';

#$ENV{'HTTPS_PROXY'} = 'http://malka.princeton.edu:8888';

my $ua = LWP::UserAgent->new( keep_alive => 1 );
my $tstart = time;
#$ua->proxy ('https', 'http://malka.princeton.edu:8888');
#$ua->proxy ('http', 'http://malka.princeton.edu:3128');

$ua->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)');
#### FOR DEBUG
#$ua->add_handler("request_send",  sub { shift->dump; return });
#$ua->add_handler("response_done", sub { shift->dump; return });

my ($req, $response);
$req = GET $url;

switch ($type) {
	case 'ntlm' {
		$user =~ s#%#\\#;
		$ua->credentials ($hst, '', $user, $pass);
		#$ua->credentials ('140.180.227.33:8888', '', $user, $pass);
#print "hst = #$hst#, user = #$user#\n";
	}
	case 'digest' {
		$user =~ m#^([^\\%]+)[\\%]{1}(.*)#;
		my $realm = $1;
		$user = $2;
#print "user = #$user#, realm = #$realm#\n";
		$ua->credentials ($hst, $realm, $user, $pass);
	}
	case 'basic' {
		$req->authorization_basic($user, $pass);
	}
	else { usage; }
}

#$response = $ua -> request ($req);
$response = $ua -> request ($req, undef, 1024 * 1024);

my $tdiff = time - $tstart;

unless ($response->is_success && (defined $str ? $response->decoded_content =~ m#$str# : 1)) {
	print "Error retrieving \"$url\". Error: " . $response->status_line . "\n";
	exit 2;
}

#print $response->decoded_content . "\n";

if ($tdiff > $crit) {
	print "CRITICAL: Login succeeded, but the request took $tdiff seconds!\n";
	exit 2;
} elsif ($tdiff > $warn) {
	print "WARNING: Login succeeded, but the request took $tdiff seconds!\n";
	exit 1;
}

print "Success retrieving and logging in to \"$url\". Response: " . $response->status_line . "; Time elapsed: $tdiff seconds\n";
exit 0;

sub usage {
	print "Usage: $progname <-U URL> <-u username> <-p password> [-w warn_thres] [-c crit_thres] [-t type] [-h] [-s regex_in_response]\n";
	print "For digest or ntlm auth, username **MUST** be in the form of DOMAIN%username\n";
	exit 2;
}