#!/usr/bin/perl 
# modify by korolev igor 2012.11.01 korolev-ia[]yandex.ru http://www.unixpin.com
#===============================================================================
#
#         FILE: checklogin.pl
#
#        USAGE: 
#
#  DESCRIPTION:  
#
#      OPTIONS:  ---
# REQUIREMENTS:  ---
#         BUGS:  ---
#        NOTES:  ---
#       AUTHOR:  Tim Pretlove
#      COMPANY:  University of Liverpool
#      VERSION:  0.4
#      CREATED:  19-08-2010 10:37
#     MODIFIED:  30-03-2011 11:22
#      LICENCE: GNU
#      
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#    
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#    
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
#===============================================================================

#use strict;
#use warnings;

use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
use Getopt::Long;
use Time::HiRes qw(gettimeofday tv_interval);
#use lib "/usr/local/nagios/libexec";
#use utils qw(%ERRORS);

my ($get,$nofor,$help,$crit, $warn, $debug, $expect, $form, $url,$ver,$status) ;

my $ua = LWP::UserAgent->new(ssl_opts =>  { verify_hostname => 0});
$ua->cookie_jar( {} );

#$debug=1;
$crit=10;
$warn=6;
$expect="";

my @mess = qw(OK CRITICAL WARNING CRITICAL CRITICAL);
my @mess2 = ("host authenticated successfully","authentication failed","is slow responding","host critical response time","failed to retrieve expect string");

#
# please replace in array @Urls your url, arguments and expected strings
#
# in expected string you can use regular expression and brackets () for cuting id and so on. cuting part will put into variable $e1,$e2...
# this variable can be used in forms requests

my @Urls= (
{
url=>"https://www.mysite.com/pages/j_spring_security_check",
form=>'j_username=user&j_password=user_password',
expect=>"Vasily Pupkin",
},{
url=>"https://www.mysite.com/pages/base3.zul?page=home",
form=>"",
},{
url=>"https://www.mysite.com/pages/base3.zul?page=abon_search",
form=>"",
expect=>q(0,'(\w+)_',.dt:'(z_\w+)',cu:'.pages',uu:'.pages.zkau',ru:'.base3.zul'),
},{
url=>"https://www.mysite.com/pages/zkau",
form=>'dtid=${e2}&cmd_0=onChange&uuid_0=${e1}_1&data_0={"value":"67890","start":5}&cmd_1=onChange&uuid_1=${e1}20&data_1={"value":"1234567890","start":10}',
},{
url=>"https://www.mysite.com/pages/zkau",
form=>'dtid=${e2}&cmd_0=onChange&uuid_0=${e1}80&data_0={"value":null,"start":0}',
},{
url=>"https://www.mysite.com/pages/zkau",
form=>'dtid=${e2}&cmd_0=onClick&uuid_0=${e1}t1&data_0={"pageX":398,"pageY":354,"which":1,"x":36,"y":10.70001220703125}',
},{
url=>"https://www.mysite.com/pages/base3.zul?page=client_card",
form=>"",
expect=>'1234567890',
}
);


my $i=0;
foreach( @Urls ) {
	my $url=$_->{url};
	my $form=$_->{form};
	my $expect=$_->{expect};
	$form=~s/\${(..)}/${$1}/g;

	my ($rc,$elapsed,$content) = testauth1($get,$nofor,$help,$crit, $warn, $debug, $expect, $form, $url,$ver,$status);
	if( $rc ) { 
		print STDERR "HTTPFORM $mess[$rc]: $mess2[$rc]  step $i\n" ; 
		if ($ver) { 
			print "|time=$elapsed" . "s;$warn;$crit;0;$crit"; 
		} 
		exit 1; 
	}
	if( $expect ) {
		if($content=~/$expect/) {
			$e1=$1;
			$e2=$2;
			$e3=$3;
			$e4=$4;
			$e5=$5;
			$e6=$6;
			$e7=$7;
			$e8=$8;
			$e9=$9;
		} else {
			$rc=4;
			print STDERR "HTTPFORM $mess[$rc]: $mess2[$rc]  step $i\n" ; 
			exit 2; 
		} 
	}
	$i++;
}

print STDERR "All ok\n";
exit 0;




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

sub testauth1 {
    my ($get,$nofor,$help,$crit, $warn, $debug, $expect, $form, $url,$ver,$status) = @_;
#	print STDERR "$url\n$form\n";
    my $startsec;
    my $elapsed;
	#$ua = LWP::UserAgent->new(ssl_opts =>  { verify_hostname => 0});
	#my $ua = new LWP::UserAgent;
	my $timeout = $crit + 1;
	my %inputHash;
	my $response;
	my $httpchk = substr $url, 0, 4; 
	if ($httpchk ne "http") { $url = "http://" . $url }
    $ua->timeout($timeout);
	if (!defined $nofor) {
		$ua->requests_redirectable (['GET', 'HEAD', 'POST']);
	}
	my @formInput = split('&',$form);
	foreach (@formInput) {
		my ($name,$value) = split('=');
		$inputHash{$name} = $value;
	}
	$startsec = [gettimeofday()];
	$ua->agent('"Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.4 (KHTML, like Gecko) Chrome/22.0.1229.94 Safari/537.4"');
#	$ua->agent('Mozilla/4.76 [en] (Windows NT 5.0; U)');
	my $req;
	eval {
		local $SIG{ALRM} = sub { die "timeout" };
		alarm($timeout);
		$req = POST $url, [ %inputHash ];
		$response = $ua->request($req);
		alarm(0);
	};
	if ($@) {
		$elapsed = tv_interval ($startsec, [gettimeofday]);
		return 3, $elapsed, '';
	}
	my $rescont = $response->content;
	my $resstat = $response->status_line;
	$elapsed = tv_interval ($startsec, [gettimeofday]);
	if (defined $debug) {
		print "$rescont\n";
	}
	if (defined $status) {
		print "$resstat\n";
	}
	if ((defined $crit) && (defined $warn)) {
		if ($crit <= $elapsed) { return 3, $elapsed, $rescont }
		if ($warn <= $elapsed) { return 2, $elapsed, $rescont  }
	}
	#if ($response->content !~ /$expect/) {	
	#	return 4, $elapsed, $rescont;
	#}
	return 0, $elapsed, $rescont ;
}