Chooser

 view release on metacpan or  search on metacpan

lib/Chooser.pm  view on Meta::CPAN

package Chooser;

use warnings;
use strict;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use IO::Socket::SSL;
use Sys::Hostname;
use Text::NeatTemplate;

our @ISA         = qw(Exporter);
our @EXPORT      = qw(choose);
our @EXPORT_OK   = qw(choose);
our %EXPORT_TAGS = (DEFAULT => [qw(choose)]);

sub argstohash{
	my $argsString=$_[0];
	my %vars=%{$_[1]};
	
	my @argsStringSplit=split(/\|/, $argsString);

	my %args=();

	#puts the hash together
	my %targs;
	$targs{hostname}=hostname;
	$targs{pipe}='|';
	$targs{newline}="\n";
	#adds %ENV stuff
	my @keys=keys(%ENV);
	my $keysInt=0;
	while (defined($keys[$keysInt])) {
		$targs{'ENV'.$keys[$keysInt]}=$ENV{$keys[$keysInt]};

		$keysInt++;
	}
	#add the var stuff
	@keys=keys(%vars);
	$keysInt=0;
	while (defined($keys[$keysInt])) {
		$targs{'VAR'.$keys[$keysInt]}=$vars{$keys[$keysInt]};

		$keysInt++;
	}	

	#puts a hash of arguements together
	my $argInt=0; #starting at 2 as it is the next in the line
	while(defined($argsStringSplit[$argInt])){
		my @argsplit=split(/=/, $argsStringSplit[$argInt], 2);
		
		#runs the template over it
		my $tobj = Text::NeatTemplate->new();
		$args{$argsplit[0]}=$tobj->fill_in(
										   data_hash=>\%targs,
										   template=>$argsplit[1],
										   );
		
		$argInt++;
	}
	
	return %args;
}

#checks if a check is good or not
sub checklegit{
	my $check=$_[0];
	

lib/Chooser.pm  view on Meta::CPAN

}

#do a default gateway test
sub cidr{
	my %args= %{$_[0]};
	
	my $cidr = Net::CIDR::Lite->new;
	
	$cidr->add($args{cidr});
	
	my $socket = IO::Socket::INET->new(Proto=>'udp');
	
	my @iflist=$socket->if_list();
	
	#if a interface is not specified, make sure it exists
	if(defined($args{if})){
		my $iflistInt=0;#used for intering through @iflist
		while(defined($iflist[$iflistInt])){
			#checks if this is the interface in question
			if($iflist[$iflistInt] eq $args{if}){
				#gets the address
				my $address=$socket->if_addr($args{if});
				#if the interface does not have a address, don't check it
				if(defined($address)){
					#checks this address is with in this cidr
					if ($cidr->find($address)){
						return 1;
					}
				}
			}
			
			$iflistInt++;
		}
		
		#if a specific IP is defined and it reaches this point, it means it was now found
		return "0";
	}

	#if a interface is not specified, make sure it exists
	my $iflistInt=0;#used for intering through @iflist
	while(defined($iflist[$iflistInt])){
		#gets the address
		my $address=$socket->if_addr($iflist[$iflistInt]);
		#if the interface does not have a address, don't check it
		if(defined($address)){
			#checks this address is with in this cidr
			if ($cidr->find($address)){
				return 1;
			}
		}
		$iflistInt++;
	}

	return "0";
}

#handles the the sslcert test
sub sslcert{
	my %args=%{$_[0]};

	my $client=IO::Socket::SSL->new( $args{host}.':'.$args{port},
									 SSL_version=>$args{version},
									 SSL_cipher_list=>$args{cipher_list},
									 SSL_ca_file=>$args{ca_file},
									 SSL_ca_path=>$args{ca_path},
									 SSL_crl_file=>$args{crl_file},
									 SSL_verify_mode=>$args{verify_mode},
									 SSL_verifycn_name=>$args{verifycn_name},
									 SSL_verifycn_scheme=>$args{verifycn_scheme},
									);

	if (!$client) {
		return 0;
	}

	my $certinfo=$client->dump_peer_certificate;

	# 0 is the subject
	# 1 is the issuer
	my @certinfoA=split(/\n/, $certinfo);

	#process the subject
	my $subject=$certinfoA[0];
	$subject=~s/^Subject\ Name\:\ //;

	if ($args{subject} ne $subject) {
		return 0
	}

	#process the issuer
	if (defined($args{issuer})) {
		my $issuer=$certinfoA[1];
		$issuer=s/^Issuer\ \ Name\:\ //g;

		if ($args{issuer} ne $issuer) {
			return 0
		}
	}

	#it is all good
	return 1;
}

#process the value
sub valueProcess{
	my $value=$_[0];
	my $returned=$_[1];
	my %vars=%{$_[2]};
	
	if (!$value =~ /^\%/){
		return $value;
	}
	
	#puts the hash together
	my %targs;
	$targs{returned}=$returned;
	$targs{value}=$value;
	$targs{hostname}=hostname;
	$targs{pipe}='|';
	$targs{newline}="\n";
	#adds %ENV stuff

lib/Chooser.pm  view on Meta::CPAN

=head3 args

=head4 ip

The arguement "ip" is used for the default gateway.

=head2 eval

This runs some perl code. This requires two things being returned. The first
thing that needs returned is success of check. This is if the if there as a error
or not with the check. It needs to return true or the choose function returns with
an error condition. The second returned value is the value that is checked against
expect value.

=head3 args

=head4 eval

The arguement "eval" is the arguement that contains the code used for this.

=head2 hostregex

This runs a regex over the hostname and turns true if it matches.

=head3 args

=head4 regex

The arguement "regex" is the regex to use.

=head2 netidentflag

This tests to see if a flag created by netident is present. The directory used is the
default netident flag directory, unless the enviromental variable 'NETIDENTFLAGDIR' is
set.

The arguement "flag" is used to specify the flag to look for.

=head2 pingmac

This test pings a IP to make sure it is in the ARP table and then checks to see if the MAC maches.

=head3 args

=head4 ip

The IP to ping

=head4 mac

The MAC to check for.

=head2 sslcert

=head3 args

To get the values to for the subject and issure, use the
code below and use everything after /\: /.

    use IO::Socket::SSL;
    my $client->new($host.':'.$port);
    print $client->dump_peer_certificate;

The required values are listed below.

    host
    port
    subject

For more information about most of these options, please
see the documentation for IO::Socket::SSL for the new
method.

=head4 CAfile

The CA file to use.

=head4 CApath

CA path to use.

=head4 check_crl

Check to see if it has been revoked.

=head4 cipher_list

The cipher list to use.

=head4 crl_file

The CRL file to use.

=head4 host

This is either the hostname or IP address to connect to.

=head4 port

This is the port to connect to.

=head4 subject

This is the subject name to check for. To get what this should be, run the
code below.

=head4 verify_mode

The verify mode to use.

=head4 verifycn_name

The name to use to verify the hostname.

=head4 verifycn_scheme

The scheme to use when verifying the hostname.

=head4 version

The SSL version to use.

=head1 TEMPLATING

Templating for choosen values and arg values is done using Text::NeatTemplate.

=head2 TEMPLATE KEYS

=head3 {$ENV*}

All enviromental variables have 'ENV' appended to them in the hash ref that