You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
126 lines
3.3 KiB
Perl
126 lines
3.3 KiB
Perl
#!/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;
|
|
}
|
|
|