Monitor

#!/usr/bin/perl -w
use strict;
my $VERSION = '1.00';

###########################################################################
#
# monitor.pl
# --uri www.infocopter.com/diax-intern/ --user diax --pass good1byX
# --uri www.infocopter.com/cgi-bin/wtk_agent.pl --tags monitor-input.txt
# --uri "www.auctionline.ch/public-bin/listitems.dbc?form_language=ger&category=5" --result "NOT,FOR SALE"
# --uri "custhelp.sunrise.ch/cgi-bin/rightnow_de.cfg/php/enduser/std_alp.php"
#
###########################################################################

use CGI qw($SL);
use Fcntl;
use LWP::UserAgent;
use HTTP::Request::Common;
use Getopt::Long;
require MIME::Base64;



####  FORWARD DECLARATIONS & PROTOTYPING
sub Usage ($);
sub Debug ($);
sub Error (%);
sub makeRequest(%);


####  GLOBAL VARIABLES

$| = 1; # Unbuffer

my @getopt_args = (
	'h',		# help
	'uri=s',	# target host & path
	'user=s',	# username
	'pass=s',	# password
	'method=s',	# POST, GET
	'tags=s',	# file, containing hidden tags: key1=value1\nkey2=value2
	'proxy=s',	# proxy host
	'debug' ,	# debug mode for development support
	'proxy_auth=s',	# proxy authorization :
	'result=s',	# result strings, delimited with commas (,)
	'v',		# Verbose mode
);

my %Options;
Getopt::Long::config("noignorecase", "bundling");
Usage "" unless GetOptions(\%Options, @getopt_args);

Usage "Help" if $Options{'h'};

################
####  MAIN  ####
################

print "N1000: Start $0\n" if $Options{'v'};

my ($rc, $res) = makeRequest
	User       => $Options{'user'} ,
	Pass       => $Options{'pass'} ,
	Protocol   => 'http' ,
	URI        => $Options{'uri'};

print "N1003: HTTP code:\t$rc\n";

print qq~
Result is:
${$res}
~ if $Options{'v'};

if ($Options{'result'}) {
	my @occurences = split /,/, $Options{'result'};
	my $f_ERR = 0;
	foreach (@occurences) { $f_ERR = 1 unless ${$res} =~ /$_/; }
	Debug "ERROR = $f_ERR";
}



########################
####  SUB ROUTINES  ####
########################
sub makeRequest (%) {

	my %args = @_;
	my $rc = 0;

	my $User = $args{User} || 'myuser';
	my $Pass = $args{Pass} || 'mypass';

	if ($Options{'debug'}) {
		# ----- debug the following LWP connection
		# Debug "Tracing connection to remote Host...";

		my $eval_code = qq~
			use LWP::Debug qw(+ -conns);
			LWP::Debug::trace("POST $args{URI}");
		~;

		eval $eval_code;
		Error Msg => "E1004" if $@;
	}

	my $ua = LWP::UserAgent->new(agent => "monitor V$VERSION");

	$ua->proxy(['http', 'https'], $Options{'proxy'}) if $Options{'proxy'};

	my $Authorization = 'BASIC ' . MIME::Base64::encode("$User\:$Pass");

	my $Response;
	my $protoURI = $args{Protocol} . '://' . $args{URI};

	if ($Options{'tags'}) {
		my %tags = ();
		open(F, $Options{'tags'}) or Error Msg => "E1006 Could not open '$Options{'tags'}' $!", Exit => 1;
		while() {
			next if /^#/;
			chomp;
			s/[ \t]//g;
			my ($key, $val) = split /\=/;
			$tags{$key} = $val;
		}
		close F;

		foreach (keys %tags) { Debug "$_ = '$tags{$_}'";	}

		Debug "N1010: POST $protoURI";

		$Response = $ua->request(POST $protoURI ,
			Content_Type  => 'form-data',
			Authorization => $Authorization,
			Content => [ %tags ]
			);
	}
	else {
		Debug "N1009: No hidden tags" if $Options{'v'};

		$Options{'method'} ||= 'GET';

		if ($Options{'method'} eq 'POST') {
			Debug "N1006: $Options{'method'} $protoURI\...";
			$Response = $ua->request(POST $protoURI, Authorization => $Authorization);
		}
		else {
			if ($Options{'user'}) {
				$protoURI = $args{Protocol} . '://' . $Options{'user'} . ':' . $Options{'pass'} . '@' . $args{URI};
			}

			Debug "N1008: $Options{'method'}, $protoURI\...";
			my $req = HTTP::Request->new('GET', $protoURI);
			$Response = $ua->request($req);
		}
	}

	$rc = $Response->code();

	Debug "N1005: HTTP string:\t"	. $Response->message();

	if ($Options{'v'}) {
		# debug all return values
		foreach (my $req = $Response->request()) {
			foreach (keys %{$req}) {
				Debug "N1007: '$_' =\t'$req->{$_}'";
			}
		}
	}

	unless ($Response->is_success) {
		# my $Msg = $Response->error_as_HTML;
		Error Msg => "E1000: Could not connect to " . $args{URI};
	}

	my $Result = $Response->content();

	# Remove HTML tags - we're in a DOS shell!
	$Result =~ s/]+>//g;
	$Result =~ s/\{\{META /