#!/usr/bin/perl

#  Declare Pragmas.

use strict;

use threads;

#  Load modules.

use Getopt::Long qw(:config no_ignore_case bundling);
use Pod::Usage;

use Thread::Queue;

use Net::IP;
use Net::Ping;
use Socket;

use Win32::ODBC;

#  Declare Global Variabbles.

our $DSN          = 'network_scans';
our $EXIT_CODE    = '|#~THREAD_EXIT~#|';
our $HELP         = 0;
our $INPUT_DB     = 0;
our $INPUT_FILE   = 0;
our $IP_RANGE     = 0;
our $MANUAL       = 0;
our $OUTPUT_FILE  = 0;
our $PROTOCOL     = 'icmp';
our $THREAD_COUNT = 50;
our $VERBOSE      = 0;

#  Define Subroutines.

#  PingThread
#  This sub is the actual trhead that does the ping routines.

#  This subroutine was refined with help from:
#                                   http://perlmonks.org/index.pl?node_id=316601

sub PingThread{
	my $InputQueue  = shift;
	my $OutputQueue = shift;
	my $ExitCode    = shift;
	
	my $pingObj = Net::Ping->new($PROTOCOL , 2, 32);
	until ((my $IpAddress = $InputQueue->dequeue) eq "$ExitCode"){
		unless ($pingObj->ping($IpAddress, 1)){
			my $MachineName = uc(gethostbyaddr (inet_aton($IpAddress), AF_INET)) or '[FAILED]';
				print "$IpAddress\tNo Response!\n" if $VERBOSE;
		} else {
			my $Host = uc(gethostbyaddr(inet_aton($IpAddress), AF_INET)) or '[FAILED]';
			$Host =~ s/(-UDP.*|\..*)//;
			if ($Host eq ''){
				$Host = "${IpAddress}\[\<NULL\>\]";
			}else{
				$Host = "${IpAddress}\[$Host\]";
			}
			$OutputQueue->enqueue($Host);
			print "$IpAddress\t$Host\n" if $VERBOSE;
		}
		threads->yield();
	}
	$pingObj->close();
}

sub ReadRange{
	my $IpRange    = shift;
	my $InputQueue = shift;
	
	my $ip = new Net::IP ($IpRange) or warn (Net::IP::Error());
	open (OUTPUT_FILE, "> $OUTPUT_FILE") or warn "Can open $OUTPUT_FILE for writing: $!\n" if $OUTPUT_FILE;
	print OUTPUT_FILE "$IpRange\n" if $OUTPUT_FILE;
	do{
		my $IpAddress = $ip->ip();
		$InputQueue->enqueue($IpAddress);
	} while (++$ip);
	close OUTPUT_FILE if $OUTPUT_FILE;
}

sub ReadFile{
	my $Input_File = shift;
	my $InputQueue = shift;

	open (INPUT_FILE, "< $Input_File") || die "Could not open $Input_File: $!";
	while (<INPUT_FILE>){
		chomp;
		ReadRange($_, $InputQueue);
	}
	close INPUT_FILE	
}

sub ReadInput_DB{
	my $DSN        = shift;
	my $InputQueue = shift;

	my $db         = new ODBC($DSN);
	
	if ($db->Sql("SELECT * FROM subnets;")){
		print "Error submitting SQL statement: " . $db->Error() . "\n";
	}else{
		while ($db->FetchRow()){
			my %Data = undef;
			%Data = $db->DataHash();
			my $range = "$Data{subnet}$Data{mask}";
			ReadRange ($range, $InputQueue);
		}
	}	
}

sub UpdateDB{
	my $DataQueue   = shift;
	my $ExitCode    = shift;
	
	until ((my $Machine = $DataQueue->dequeue) eq "$ExitCode") {
		my $db        = new ODBC($DSN);
		my ($IpAddress, $MachineName) = ($Machine=~/(.*)\[(.*)\]$/);
		$MachineName = "${IpAddress}${MachineName}" if ($MachineName eq '<NULL>');
		if ($db->Sql ("INSERT INTO computer_names (computer_name, last_ip_address) VALUES ('$MachineName','$IpAddress')")){
			if ($db->Sql("UPDATE computer_names SET last_ip_address = '$IpAddress' WHERE computer_name='$MachineName';")){
				my $Error = $db->Error();;
				print $Error;
			}else{
				print "Updated $MachineName on $DSN\n" if $VERBOSE;
			}
		}else{
			print "Added $MachineName on $DSN\n" if $VERBOSE;
		}
		$db->Close();
		threads->yield();
	}
}

#  Process the config file if it exists



#  Process command line arguments
#  This code is based on suggestions from:
#                                   http://perlmonks.org/index.pl?node_id=300594

GetOptions	(
							'dsn|d=s'        =>\$DSN,
							'help|h|?'       =>\$HELP,
							'Db|D'           =>\$INPUT_DB,
							'input|in|i=s'   =>\$INPUT_FILE,
							'Ip|I=s'         =>\$IP_RANGE,
							'man|m'          =>\$MANUAL,
							'output|out|o=s' =>\$OUTPUT_FILE,
							'protocol|p=s'   =>\$PROTOCOL,
							'threads|t=i'    =>\$THREAD_COUNT,
							'verbose|v'      =>\$VERBOSE
						);

pod2usage(1) if $HELP;
pod2usage(-exitstatus=>0 -verbose =>2) if $MANUAL;
pod2usage (1) unless (($INPUT_FILE or $IP_RANGE) or $INPUT_DB);

#  Verify DSN before continuing

my $db = new ODBC($DSN);
die "Error connecting to $DSN:".Win32::ODBC::Error()."\n" unless $db;
$db->Close();

#  Set up Variables for the threads.

my $InputQueue  = Thread::Queue->new;
my $OutputQueue = Thread::Queue->new;
my $DataThread  = threads->new(\&UpdateDB, $OutputQueue, $EXIT_CODE);
my @Threads;


#  Destroy variables when they are not needed.

undef $HELP;
undef $MANUAL;

#  Prepare the threads

foreach (1..$THREAD_COUNT){
	my $thread = threads->new(\&PingThread, $InputQueue, $OutputQueue, $EXIT_CODE);
	push (@Threads, $thread);
	}

ReadInput_DB($DSN, $InputQueue) if $INPUT_DB;

#  Destroy variable when it is not needed.

undef $INPUT_DB;
	
ReadFile($INPUT_FILE, $InputQueue) if $INPUT_FILE;

#  Destroy variable when it is not needed.

undef $INPUT_FILE;

ReadRange($IP_RANGE, $InputQueue) if $IP_RANGE;

#  Destroy variable when it is not needed.

undef $IP_RANGE;

#  Bring the threads back in.

foreach my $count (1..$THREAD_COUNT){
	$InputQueue->enqueue($EXIT_CODE);
	print "Ending Ping Thread\n" if $VERBOSE;
}

foreach my $ithread (@Threads){
	$ithread->join();
}

#  Tell the updatedb thread to exit.

$OutputQueue->enqueue($EXIT_CODE);
print "Ending Data Thread\n" if $VERBOSE;
$DataThread->join();


__END__

=head1 NAME

scan

=head1 SYNOPSIS

B<scan.pl> [B<-i> I<Ip Address Range> B<-I> I<Input File> B<-d> I<DSN> B<-h -m -v>]

=head1 DESCRIPTION

B<scan.pl> scans network addresses gather data on the computer state of
the machines found on the network.  This is used as the scanning agent for the
full Patch Adams suite of software to manage hotfixes. Output is stored in a database. The Ip Address can be supplied either via an I<Ip Address Range> or via an I<Input File>. The database is connected using an I<DSN> ODBC datasource.

=head1 OPTIONS

=over 4 

=item B<-I --input> I<Input File>

Reads the ip addresses from I<Input File>.

=item B<-i --ip> I<Ip Address Range>

Supplies an I<Ip Address Range>.

=item B<-d --dsn> I<DSN>

Uses the supplied I<DSN> for database connections.

=item B<-h|? --help>

Prints the basic help syntax.

=item B<-m --manual>

Prints the full manual page.

=back

=head1 FILES

=over 4

=item I<Input File>

I<Input File> is a user supplied file for input of Ip Addresses.

=item I<DSN>

I<DSN> is an ODBC data source used for storing the database information generated by the scan.

=back

=head1 DIAGNOSTICS

=over 4

=item Error Message

Description

=back

=head1 REQUIRES

Perl 5.8.2, Thread::Queue , Net::Ping , Win32::ODBC , Win32::TieRegistry ,  Pod::Usage

=head1 SEE ALSO

perl(1)

=head1 AUTHOR

=over 4

=item Jeff Thompson

Jeff Thompson I<jeff@ninthwave.us>

=item Gordon McKeown

Gordon McKeown I<perl@thefluffyone.net>

=back

=head1 VERSION CONTROL

=over 4

=item CREATED

28112003:10:32:00

=item VERSION

0.5

=back

=head1 ACKNOWLEDGEMENTS

=over 4

=item Perl Monks

L<http://perlmonks.org>

=item Perl Monks Offering Plate

L<http://perlmonks.org/index.pl?node=Offering%20Plate>

=item Perl Monks Discussion - Getopt::Long validation

L<http://perlmonks.org/index.pl?node_id=300594> With code supplied from jeffa L<http://jeffa.perlmonk.org/> used as the basis for argument processing in this code.

=item Perl Monks Discussion - Self Extracting Cabinet File in Perl

L<http://perlmonks.org/index.pl?node_id=306580> With the insight of Limbic~Region L<http://perlmonks.org/index.pl?node_id=180961> for research on how cabinet.dll works. With some code suggestions from graff L<http://perlmonks.org/index.pl?node_id=44715> used in reflection of the original methods.

=item Perl Monks Discussion - Non-blockin pings on Win32

L<http://perlmonks.org/index.pl?node_id=309673> With code supplied from meetraz L<http://perlmonks.org/index.pl?node_id=174574> and modified by NetWallah L<http://perlmonks.org/index.pl?node_id=159887>.  These ideas became the basis of the use of threads.

=item Microsoft Cabinet SDK

L<http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dncabsdk/html/cabdl.asp>

=item Stuart Caie's Cab extract

L<http://www.kyz.uklinux.net/cabextract.php>

=back

=cut