#!
package pps_cmdline;
use strict;
use warnings;
use threads;
use IO::Socket;
use Getopt::Long;
use Win32::Console;
$| = 1;

#Optional Modules#
my $Net_Ping_installed = 0;
eval {require Net::Ping; $Net_Ping_installed = 1;};

my $VERSION = 0.1;
my (@ports1, @ports2, @ports3, @ports4, @ports5, @ports6, @ports7,
    @ports8, @ports9, @ports10, @ports11, @ports12, @ports13,
    @ports14, @ports15, @ports16, @ports17, @ports18, @ports19,
    @ports20, @ports21, @ports22, @ports23, @ports24, @ports25,
    @ports26, @ports27, @ports28, @ports29, @ports30, @ports31,
    @ports32, $target, $scan_type, $st_var, $help_var);

#Get options#
my $opt_help = 0;           # -h  Help.
my $opt_single;             # -s  Scans a single port.
my @opt_range;              # -r  Scans a range of ports.
my $opt_normal = 0;         # -w  Scans all ports to 1024.
my $opt_full = 0;           # -f  Scans all ports to 65530.
GetOptions ('h|?' => \$opt_help,  's=i' => \$opt_single,
            'f'   => \$opt_full,  'w'   => \$opt_normal,
            'r=s' => \@opt_range,);

#Main#
my $con = Win32::Console->new(STD_OUTPUT_HANDLE);
if ($opt_help == 1) {$help_var = 0; help(); exit;}
if (@opt_range) {@opt_range = split(/-/, join('-', @opt_range));}
if ($target = shift) {unshift (@ARGV, $target);}
else {$help_var = 1; &help($help_var); $target = 'localhost';}
$con->Title("Perl Port Scanner");
$con->Cls();
print ' Created by: QoS@cpan.org' . "\n" . ' ' . '='x78 . "\n";
print "\t\t\t     Perl Port Scanner\n";
print ' ' . '='x78 . "\n\n\n\n\n\n";

inet_aton($target) || die "Couldn't resolve $target"."'s address
($!)\n($^E)\n*";

if ($opt_single) {$scan_type = "Single";}
elsif (@opt_range) {$scan_type = "Range";}
elsif ($opt_normal ==1) {$scan_type = "Normal";}
elsif ($opt_full == 1) {$scan_type = "Full";}
else {$scan_type = "Normal";}

my $scan_type_var = &loader($scan_type);

&ping() if $Net_Ping_installed == 1;

if ($scan_type_var eq 'X') {my $thr0 = threads->new(\&scanner, @ports1);
                            my @thr0_data = $thr0->join; exit;}
if ($scan_type_var eq 'Y')
    {
    my $thr1 = threads->new(\&scanner, @ports1);
    my $thr2 = threads->new(\&scanner, @ports2);
    my $thr3 = threads->new(\&scanner, @ports3);
    my $thr4 = threads->new(\&scanner, @ports4);
    my $thr5 = threads->new(\&scanner, @ports5);
    my $thr6 = threads->new(\&scanner, @ports6);
    my $thr7 = threads->new(\&scanner, @ports7);
    my $thr8 = threads->new(\&scanner, @ports8);
    my @thr1_data = $thr1->join;
    my @thr2_data = $thr2->join;
    my @thr3_data = $thr3->join;
    my @thr4_data = $thr4->join;
    my @thr5_data = $thr5->join;
    my @thr6_data = $thr6->join;
    my @thr7_data = $thr7->join;
    my @thr8_data = $thr8->join;
    exit;
    }
my $thr1 = threads->new(\&scanner, @ports1);
my $thr2 = threads->new(\&scanner, @ports2);
my $thr3 = threads->new(\&scanner, @ports3);
my $thr4 = threads->new(\&scanner, @ports4);
my $thr5 = threads->new(\&scanner, @ports5);
my $thr6 = threads->new(\&scanner, @ports6);
my $thr7 = threads->new(\&scanner, @ports7);
my $thr8 = threads->new(\&scanner, @ports8);
my $thr9 = threads->new(\&scanner, @ports9);
my $thr10 = threads->new(\&scanner, @ports10);
my $thr11 = threads->new(\&scanner, @ports11);
my $thr12 = threads->new(\&scanner, @ports12);
my $thr13 = threads->new(\&scanner, @ports13);
my $thr14 = threads->new(\&scanner, @ports14);
my $thr15 = threads->new(\&scanner, @ports15);
my $thr16 = threads->new(\&scanner, @ports16);
my $thr17 = threads->new(\&scanner, @ports17);
my $thr18 = threads->new(\&scanner, @ports18);
my $thr19 = threads->new(\&scanner, @ports19);
my $thr20 = threads->new(\&scanner, @ports20);
my $thr21 = threads->new(\&scanner, @ports21);
my $thr22 = threads->new(\&scanner, @ports22);
my $thr23 = threads->new(\&scanner, @ports23);
my $thr24 = threads->new(\&scanner, @ports24);
my $thr25 = threads->new(\&scanner, @ports25);
my $thr26 = threads->new(\&scanner, @ports26);
my $thr27 = threads->new(\&scanner, @ports27);
my $thr28 = threads->new(\&scanner, @ports28);
my $thr29 = threads->new(\&scanner, @ports29);
my $thr30 = threads->new(\&scanner, @ports30);
my $thr31 = threads->new(\&scanner, @ports31);
my $thr32 = threads->new(\&scanner, @ports32);
my @thr1_data = $thr1->join;
my @thr2_data = $thr2->join;
my @thr3_data = $thr3->join;
my @thr4_data = $thr4->join;
my @thr5_data = $thr5->join;
my @thr6_data = $thr6->join;
my @thr7_data = $thr7->join;
my @thr8_data = $thr8->join;
my @thr9_data = $thr9->join;
my @thr10_data = $thr10->join;
my @thr11_data = $thr11->join;
my @thr12_data = $thr12->join;
my @thr13_data = $thr13->join;
my @thr14_data = $thr14->join;
my @thr15_data = $thr15->join;
my @thr16_data = $thr16->join;
my @thr17_data = $thr17->join;
my @thr18_data = $thr18->join;
my @thr19_data = $thr19->join;
my @thr20_data = $thr20->join;
my @thr21_data = $thr21->join;
my @thr22_data = $thr22->join;
my @thr23_data = $thr23->join;
my @thr24_data = $thr24->join;
my @thr25_data = $thr25->join;
my @thr26_data = $thr26->join;
my @thr27_data = $thr27->join;
my @thr28_data = $thr28->join;
my @thr29_data = $thr29->join;
my @thr30_data = $thr30->join;
my @thr31_data = $thr31->join;
my @thr32_data = $thr32->join;

#Subroutines#
sub loader #------------------------------------------------------loader
{
    my ($counter_var, $loader_var);
    my $p1_loader = 1; my $p2_loader = 2; my $p3_loader = 3;
    my $p4_loader = 4; my $p5_loader = 5; my $p6_loader = 6;
    my $p7_loader = 7; my $p8_loader = 8; my $p9_loader = 9;
    my $p10_loader = 10; my $p11_loader = 11; my $p12_loader = 12;
    my $p13_loader = 13; my $p14_loader = 14; my $p15_loader = 15;
    my $p16_loader = 16; my $p17_loader = 17; my $p18_loader = 18;
    my $p19_loader = 19; my $p20_loader = 20; my $p21_loader = 21;
    my $p22_loader = 22; my $p23_loader = 23; my $p24_loader = 24;
    my $p25_loader = 25; my $p26_loader = 26; my $p27_loader = 27;
    my $p28_loader = 28; my $p29_loader = 29; my $p30_loader = 30;
    my $p31_loader = 31; my $p32_loader = 32;

    if ($scan_type eq "Single") {$st_var = $opt_single;
                                 push (@ports1, $opt_single);
                                 return('X');}
    elsif ($scan_type eq "Range")
    {
        $st_var = "$opt_range[0]" . '-' . "$opt_range[1]";
        unless ($opt_range[0] < $opt_range[1]) {$help_var = 2;
                                                &help($help_var);}
        @opt_range = ($opt_range[0]..$opt_range[1]);
        while (@opt_range)
        {
            my $p1_loader = shift @opt_range;
            push (@ports1, $p1_loader);
            my $p2_loader = shift @opt_range;
            push (@ports2, $p2_loader);
            my $p3_loader = shift @opt_range;
            push (@ports3, $p3_loader);
            my $p4_loader = shift @opt_range;
            push (@ports4, $p4_loader);
            my $p5_loader = shift @opt_range;
            push (@ports5, $p5_loader);
            my $p6_loader = shift @opt_range;
            push (@ports6, $p6_loader);
            my $p7_loader = shift @opt_range;
            push (@ports7, $p7_loader);
            my $p8_loader = shift @opt_range;
            push (@ports8, $p8_loader);
        }
    return('Y');
    }
    elsif ($scan_type eq "Normal") {$st_var = '1-1024';
                                    $counter_var = 32;
                                    $loader_var = 32;}
    elsif ($scan_type eq "Full") {$st_var = '1-65530';
                                  $counter_var = 2048;
                                  $loader_var = 32;}
    else {$st_var = '1-1024'; $counter_var = 32; $loader_var = 32;}

    my @work_queue = (
    [\@ports1,  $p1_loader], [\@ports2,  $p2_loader],
    [\@ports3,  $p3_loader], [\@ports4,  $p4_loader],
    [\@ports5,  $p5_loader], [\@ports6,  $p6_loader],
    [\@ports7,  $p7_loader], [\@ports8,  $p8_loader],
    [\@ports9,  $p9_loader], [\@ports10, $p10_loader],
    [\@ports11, $p11_loader],[\@ports12, $p12_loader],
    [\@ports13, $p13_loader],[\@ports14, $p14_loader],
    [\@ports15, $p15_loader],[\@ports16, $p16_loader],
    [\@ports17, $p17_loader],[\@ports18, $p18_loader],
    [\@ports19, $p19_loader],[\@ports20, $p20_loader],
    [\@ports21, $p21_loader],[\@ports22, $p22_loader],
    [\@ports23, $p23_loader],[\@ports24, $p24_loader],
    [\@ports25, $p25_loader],[\@ports26, $p26_loader],
    [\@ports27, $p27_loader],[\@ports28, $p28_loader],
    [\@ports29, $p29_loader],[\@ports30, $p30_loader],
    [\@ports31, $p31_loader],[\@ports32, $p32_loader],
    );
    foreach (@work_queue)
    {
        my $counter = 1;
        while ($counter <= $counter_var) #1, 33, 65,
        {
            push (@{$_->[0]}, $_->[1]);
            $_->[1] += $loader_var;
            $counter++;
        }
    }
}

sub scanner #----------------------------------------------------scanner
{
my @ports = @_;
foreach my $remote_port (@ports)
    {
    unless ($remote_port) {next;}
    $con->WriteChar("Scanning Host:  $target", 0, 5);
    $con->WriteChar("Scan Type:      $scan_type ($st_var)", 0, 7);
    $con->WriteChar("Port:", 63, 7);
    $con->WriteChar("          ", 70, 7);
    $con->WriteChar("$remote_port", 70, 7);
    my $sock = IO::Socket::INET->new(PeerAddr  => $target,
                                     PeerPort  => $remote_port,
                                     Type      => SOCK_STREAM,
                                     Proto     => 'tcp',
                                     Timeout   => 1)
    or next;
    my $pname = getservbyport($remote_port, 'tcp');
    if ($sock) {print "Port: $remote_port ($pname) is open.\n";}
    close($sock) && $sock->shutdown(2);
    }
{return 1;}
}

sub ping #----------------------------------------------------------ping
{
my $p = Net::Ping->new("icmp");
my ($ret, $rtt, $ip) = $p->ping($target);
print "$target [$ip] is ";
print "NOT " unless $ret;
print "reachable via ICMP ping.\n";
print 'round trip time: ', $rtt, " second(s).\n" if $ret;
print "\n";
sleep(1);
$p->close();
}

sub help #----------------------------------------------------------help
{
$con->Title("Perl Port Scanner Help");
$con->Cls();
print <<HELPTEXT;
    Usage:      pps <target> [options]

    Options:    -h  Help.
                -s  Scans a single port.
                -r  Scans a range of ports.
                -w  Scans all ports to 1024.
                -f  Scans all ports to 65530.

    Examples:   pps
                pps 127.0.0.1 -f
                pps localhost -r 20-140
                pps www.perl.org -s 80

    Notes:      If no scan options are used then only the
                well-known port range will be scanned (same as -w).

HELPTEXT
sleep 5;
if ($help_var == 1) {$con->Cls();}
elsif ($help_var == 2)
    {die "Error: First range value must be lower than the second.\n";}
}

#POD Section#
=head1 NAME

pps - Perl Port Scanner

=head1 DESCRIPTION

A Multi-Threaded port scanner.

=head1 README

    PPS - Multi-Threaded port scanner.
    Copyright (C) 2003 Jason David McManus

    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 2 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, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

=head1 PREREQUISITES

This script requires these modules:
Getopt::Long
Win32::Console

And optionally requires the Net::Ping module.

=head1 COREQUISITES

=pod OSNAMES

Win32
and thread support

=pod SCRIPT CATEGORIES

Networking

=cut