#!Perl
$^W = 1;
use strict;
use Tk;
use Tk::ROText;

#Optional Modules#
if ($^O eq 'MSWin32') {
    use Win32::Process;
    eval    { require Win32::Console; Win32::Console::Free() };
    if ($@) { warn "Win32::Console is not installed.\n$@";   }
}

#Declarations#
my $VERSION = 2.1;
my ($type, $arg, $pid, $aid1, $aid2,);

#Main#
our $mw = MainWindow->new(-relief => 'groove', -bd => 2);
    $mw->title("Perl Port Scanner");
    $mw->geometry('+44+18');
my $sys_bg = $mw->cget(-background);
&init(); &pps_gui(); &Tk::MainLoop();

#Subroutines#
sub init #--------------------------------------------------------------
{
    if (-e 'pps.tmp')     { unlink 'pps.tmp';     }
    if (-e 'ppstemp.tmp') { unlink 'ppstemp.tmp'; }
    unless (-e 'PPS_C_v2_0.plx') {
        open (FH, '>PPS_C_V2_0.plx')
            or die "Cannot create PPS_C_v2_0.plx\a\n$!";
        while(<DATA>) { chomp; print FH "$_\n";}
        close FH;
    }
}
sub pps_gui #-----------------------------------------------------------
{
    #Widgets
    my  $f1 = $mw->Frame(-bd => 1, -relief => 'groove',);
    my  $f2 = $mw->Frame(-bd => 2, -relief => 'sunken',);
    my  $f3 = $mw->Frame(-bd => 2, -relief => 'ridge',
                         -bg => '#000000',);
    my  ($r1, $r2, $r3, $r4,);
    my  $r1v = my $r2v = my $r3v =  my $r4v = 0;
    $r1 = $mw->Radiobutton(-variable => \$r1v,
                           -command  => sub {
        $type = 'w';
        $r2v = $r3v = $r4v = 0;
    });
    $r2 = $mw->Radiobutton(-variable => \$r2v,
                           -command => sub {
        $type = 'f';
        $r1v = $r3v = $r4v = 0;
    });
    $r3 = $mw->Radiobutton(-variable => \$r3v,
                           -command => sub {
        $type = 's';
        $r1v = $r2v = $r4v = 0;
    });
    $r4 = $mw->Radiobutton(-variable => \$r4v,
                           -command => sub {
        $type = 'r';
        $r1v = $r2v = $r3v = 0;
    });
    our $t1 = $mw->Scrolled('ROText',
                            -scrollbars       => 'e',
                            -relief           => 'flat',
                            -bg               => '#ffffff',
                            -fg               => '#000000',
                            -insertbackground => '#ffffff',
                            -selectforeground => '#fff000',
                            -selectbackground => '#000000',);
        $t1->tagConfigure('Red',  -foreground => '#ff0000');
        my $m = $t1->menu;
        $m->delete('File'); $m->delete('Search'); $m->delete('View');
        $m->configure(-bg => $sys_bg);
        undef $m;
    our $t2 = $mw->ROText(-cursor           => 'arrow',
                          -wrap             => 'none',
                          -relief           => 'flat',
                          -insertbackground => '#000000',
                          -selectforeground => '#66cd00',
                          -selectbackground => '#000000',
                          -bg               => '#000000',
                          -fg               => '#66cd00',
                          -bd               => 0,
                          -height           => 0,
                          -width            => 5,);
         $t2->menu(undef);
    our ($b1, $b2,);
    $b1     = $mw->Button(-text => 'Start',  -width => 6,
                          -activeforeground    => '#00ff00',
                          -disabledforeground  => '#00ff00',
                          -command => sub {
                             $b2->configure(-state  => 'normal',);
                             $b1->configure(-relief => 'sunken',
                                            -state  => 'disabled',);
                             &start();
                         });
    $b2     = $mw->Button(-text => 'Cancel', -width => 6,
                          -activeforeground => '#ff0000',
                          -state            => 'disabled',
                          -command          => \&cancel);
    my  $b3 = $mw->Button(-text => 'Exit',   -width => 6,
                          -activeforeground => '#000fff',
                          -command          => sub {&cancel(); exit;});
    my  $b4 = $mw->Button(-text => 'Help',   -width => 6,
                          -activeforeground => '#000fff',
                          -command          => \&help);
    my  $l1 = $mw->Label(-text  => 'Scan Type',
                         -font  => 'Arial 8 bold',);
    my  $l2 = $mw->Label(-text  => 'Remote Host',
                         -font  => 'Arial 8 bold',);
    my  $l3 = $mw->Label(-text  => 'Normal', -justify => 'left',);
    my  $l4 = $mw->Label(-text  => 'Full',);
    my  $l5 = $mw->Label(-text  => 'Single:',);
    my  $l6 = $mw->Label(-text  => 'Range:  ',);
    my  $l7 = $mw->Label(-text  => '     Example:  75-150',
                         -font  => '{Times New Roman} 8 italic',);
    my  $l8 = $mw->Label(-text  => 'Currently Scanning Port:',
                         -fg    => '#ffffff',
                         -bg    => '#000000',);
    our $e1 = $mw->Entry(-width => 20,
                         -bg    => '#ffffff',
                         -fg    => '#000000');
    our $e2 = $mw->Entry(-width => 6,
                         -bg    => '#ffffff',
                         -fg    => '#000000');
    our $e3 = $mw->Entry(-width => 12,
                         -bg    => '#ffffff',
                         -fg    => '#000000');
    
    our $tl1 = $mw->Toplevel();
        $tl1->title('PPS Help');
        $tl1->geometry("+105+70");
        $tl1->resizable(0, 0);
        $tl1->transient($mw);
        $tl1->withdraw;
    our $t3 = $tl1->ROText(-cursor           => 'arrow',
                           -wrap             => 'word',
                           -bg               => '#ffffff',
                           -fg               => '#000000',
                           -insertbackground => '#ffffff',
                           -selectforeground => '#000000',
                           -selectbackground => '#ffffff',);
        $t3->menu(undef);
    my  $b5 = $tl1->Button(-text => 'Close',   -width => 6,
                           -activeforeground => '#000fff',
                           -command          => sub {$tl1->withdraw;});
    my  $b6 = $tl1->Button(-text => 'About',   -width => 6,
                           -activeforeground => '#000fff',
                           -command          => \&about);
    
    #Bindings
    $mw ->protocol(WM_DELETE_WINDOW => sub {$b3->invoke;});
    $tl1->protocol(WM_DELETE_WINDOW => sub {$tl1->withdraw;});
    $e1 ->bind('<Return>'           => sub {$b1->invoke;});
    $e2 ->bind('<Return>'           => sub {$b1->invoke;});
    $e3 ->bind('<Return>'           => sub {$b1->invoke;});
    
    #Grid
    $f1->grid(-in     => $mw,       -columnspan => '9',
              -column => '1',       -rowspan    => '1',
              -row    => '7',       -sticky     => 'news');
    $f2->grid(-in     => $mw,       -columnspan => '4',
              -column => '3',       -rowspan    => '1',
              -row    => '9',       -sticky     => 'news');
    $f3->grid(-in     => $mw,       -columnspan => '2',
              -column => '3',       -rowspan    => '1',
              -row    => '8',       -sticky     => 'news',
              -padx   => '0',       -pady       => '5',);
    $r1->grid(-in     => $mw,       -columnspan => '1',
              -column => '2',       -rowspan    => '1',
              -row    => '2',       -sticky     => '');
    $r2->grid(-in     => $mw,       -columnspan => '1',
              -column => '2',       -rowspan    => '1',
              -row    => '3',       -sticky     => '');
    $r3->grid(-in     => $mw,       -columnspan => '1',
              -column => '2',       -rowspan    => '1',
              -row    => '4',       -sticky     => '');
    $r4->grid(-in     => $mw,       -columnspan => '1',
              -column => '2',       -rowspan    => '1',
              -row    => '5',       -sticky     => '');
    $e1->grid(-in     => $mw,       -columnspan => '1',
              -column => '5',       -rowspan    => '1',
              -row    => '2',       -sticky     => 'ew');
    $e2->grid(-in     => $mw,       -columnspan => '1',
              -column => '4',       -rowspan    => '1',
              -row    => '4',       -sticky     => 'w');
    $e3->grid(-in     => $mw,       -columnspan => '1',
              -column => '4',       -rowspan    => '1',
              -row    => '5',       -sticky     => 'w');
    $l1->grid(-in     => $mw,       -columnspan => '3',
              -column => '2',       -rowspan    => '1',
              -row    => '1',       -sticky     => 'news');
    $l2->grid(-in     => $mw,       -columnspan => '1',
              -column => '5',       -rowspan    => '1',
              -row    => '1',       -sticky     => 'news');
    $l3->grid(-in     => $mw,       -columnspan => '1',
              -column => '3',       -rowspan    => '1',
              -row    => '2',       -sticky     => 'w');
    $l4->grid(-in     => $mw,       -columnspan => '1',
              -column => '3',       -rowspan    => '1',
              -row    => '3',       -sticky     => 'w');
    $l5->grid(-in     => $mw,       -columnspan => '1',
              -column => '3',       -rowspan    => '1',
              -row    => '4',       -sticky     => 'w');
    $l6->grid(-in     => $mw,       -columnspan => '1',
              -column => '3',       -rowspan    => '1',
              -row    => '5',       -sticky     => 'w');
    $l7->grid(-in     => $mw,       -columnspan => '2',
              -column => '5',       -rowspan    => '1',
              -row    => '5',       -sticky     => 'w');
    $l8->grid(-in     => $f3,       -columnspan => '1',
              -column => '1',       -rowspan    => '1',
              -row    => '1',       -sticky     => 'e');
    $b1->grid(-in     => $mw,       -columnspan => '1',
              -column => '8',       -rowspan    => '1',
              -row    => '2',       -sticky     => '');
    $b2->grid(-in     => $mw,       -columnspan => '1',
              -column => '8',       -rowspan    => '1',
              -row    => '3',       -sticky     => '');
    $b3->grid(-in     => $mw,       -columnspan => '1',
              -column => '8',       -rowspan    => '1',
              -row    => '5',       -sticky     => '');
    $b4->grid(-in     => $mw,       -columnspan => '1',
              -column => '8',       -rowspan    => '1',
              -row    => '4',       -sticky     => '');
    $t1->grid(-in     => $f2,       -columnspan => '1',
              -column => '1',       -rowspan    => '1',
              -row    => '1',       -sticky     => 'news');
    $t2->grid(-in     => $f3,       -columnspan => '1',
              -column => '2',       -rowspan    => '1',
              -row    => '1',       -sticky     => 'news',
              -padx   => '0',       -pady       => '5');
    
    $t3->grid(-in     => $tl1,      -columnspan => '2',
              -column => '2',       -rowspan    => '1',
              -row    => '2',       -sticky     => 'news');
    $b5->grid(-in     => $tl1,      -columnspan => '1',
              -column => '2',       -rowspan    => '1',
              -row    => '4',       -sticky     => '');
    $b6->grid(-in     => $tl1,      -columnspan => '1',
              -column => '3',       -rowspan    => '1',
              -row    => '4',       -sticky     => '');
    
    for (1..5) {
        $mw->gridRowconfigure($_,    -minsize => 8,);
    }
    $mw->gridRowconfigure(6,         -minsize => 8,);
    $mw->gridRowconfigure(7,         -minsize => 2,);
    $mw->gridRowconfigure(8,         -minsize => 8,);
    $mw->gridRowconfigure(9,         -minsize => 8,   -weight => 1);
    $mw->gridRowconfigure(10,        -minsize => 20,);
    $mw->gridColumnconfigure(1,      -minsize => 8,);
    $mw->gridColumnconfigure(2,      -minsize => 52,);
    $mw->gridColumnconfigure(3,      -minsize => 8,);
    $mw->gridColumnconfigure(4,      -minsize => 8,);
    $mw->gridColumnconfigure(5,      -minsize => 8,   -weight => 1);
    for (6..9) {
        $mw->gridColumnconfigure($_, -minsize => 8,);
    }
    
    for (1..5) {
        $tl1->gridRowconfigure($_,   -minsize => 8,);
    }
    for (1..4) {
        $tl1->gridColumnconfigure($_,-minsize => 8,);
    }
    
    $f2->gridRowconfigure(1,         -minsize => 8,);
    $f2->gridColumnconfigure(1,      -minsize => 8,);
    
    $f3->gridRowconfigure(1,         -minsize => 8,);
    $f3->gridColumnconfigure(1,      -minsize => 8,);
    $f3->gridColumnconfigure(2,      -minsize => 8,   -weight => 1,);
    
    #Defaults
    $r1->invoke();
    $t2->insert('end', '  -  ');
    
    #Callbacks
    sub start #---------------------------------------------------------
    {
        $mw->Busy(-recurse => 1); my $target;
        undef $pid; undef $arg;
        
        unless ($target = $e1->get) {
            $target = 'localhost';
            $e1->insert('end', $target);
            $mw->update;
        }
        
        if     ($type eq 'r') {
            my $x = $e3->get;
            unless ($x =~ /^(\d{1,5})-(\d{1,5})$/) {
                &error('start1'); goto start_end;
            }
            unless ($1 < $2) {
                &error('start1'); goto start_end;
            }
            $arg = "$type $x";
        }elsif ($type eq 's') {
            my $x = $e2->get;
            unless ($x =~ /^\d{1,5}$/) {
                &error('start2'); goto start_end;
            }
            $arg .= "$type $x";
        }elsif ($type eq 'f' || $type eq 'w') { $arg = $type; }
        
        unless (-e 'PPS_C_v2_0.plx') {
            &error('start3'); goto start_end;
        }
        if ($^O eq 'MSWin32') {
            Win32::Process::Create($pid,
                $Config::Config{perlpath},
                "$Config::Config{perlpath} PPS_C_v2_0.plx ".
                "$target -$arg -gui",
                0, NORMAL_PRIORITY_CLASS, ".")
            || &error('start4') && goto start_end;
        }else{
            if ($pid = fork){}
            elsif (defined $pid) {
                system("$Config::Config{perlpath}",
                       'PPS_C_v2_0.plx', "$target", "-$arg", '-gui')
                || warn "Cannot start PPS_C_v2_0.plx\a\n$!";
                exit;
            }else{ &error('start4'); goto start_end; }
        }
        for (1..10) { $mw->update; sleep(1); }
        &port_update(); &main_update();
        start_end: $mw->Unbusy; $mw->update;
    }
    sub port_update #---------------------------------------------------
    {
        open (FH, '<pps.tmp');
        my @a = (<FH>); close FH;
        $t2->delete('1.0', 'end');
        $t2->insert('end', $a[0]);
        $mw->update;
        $aid1 = $mw->after(500, \&port_update);
    }
    sub main_update #---------------------------------------------------
    {
        open (TMP, '<ppstemp.tmp');
        my @a = (<TMP>); close TMP;
        $t1->delete('1.0', 'end');
        foreach (@a) {
            chomp;
            $t1->insert('end', "$_\n");
            if (/^Scan\scompleted.*/) {
                &cancel();
                goto main_update_end;
            }
        }
        $aid2 = $mw->after(5000, \&main_update);
        main_update_end: $mw->update;
    }
    sub cancel #--------------------------------------------------------
    {
        $mw->Busy(-recurse => 1);
        if ($aid1) { $mw->afterCancel($aid1); }
        if ($aid2) { $mw->afterCancel($aid2); }
        
        unless ($pid)         { goto cancel_end; }
        if ($^O eq 'MSWin32') { $pid->Kill(0);   }
        else                  { kill(1, $pid);   }
        
        &init();
        
        cancel_end:
        $b1->configure(-relief => 'raised', -state  => 'normal',);
        $b2->configure(-state  => 'disabled',);
        $mw->Unbusy; $mw->update;
    }
    sub help #----------------------------------------------------------
    {
        my $msg;
        $mw->Busy(-recurse => 1);
        $t3->delete('1.0', 'end');
        $tl1->deiconify(); $tl1->raise(); $t3->focus; $mw->update;
        
        $msg  = "PPS - Scans the remote host for open ports.\n\n";
        
        $msg .= "Unless 'Remote Host' is provided, localhost will be ".
                "scanned.  The remote host can be either an IP ".
                "address or DNS name.\n\n".
                "Examples:\t127.0.0.1\n".
                "\t\tlocalhost\n\t\twww.perl.org\n\n";
        
        $msg .= "Normal - Scans all ports to 1024.\n";
        $msg .= "Full   - Scans all ports to 65530.\n";
        $msg .= "Single - Scans a single port.\n";
        $msg .= "Range  - Scans a range of ports.\n";
        $msg .= "         First range must be < than the second.\n";
        $msg .= "         Example: 20-200\n";
        
        $t3->insert('end', "$msg\n");
        $mw->Unbusy; $mw->update;
    }
    sub about #---------------------------------------------------------
    {
        my $msg;
        $mw->Busy(-recurse => 1);
        $t3->delete('1.0', 'end');
        
        $msg = "PPS - Perl Port Scanner version: 2.1\n\n".
               "Created by: Jason McManus\n".
               'Contact:    QoS@cpan.org'."\n";
        
        $t3->insert('end', "$msg\n");
        $mw->Unbusy; $mw->update;
    }
    sub error #---------------------------------------------------------
    {
        my $e = $_[0] || 'x'; my $msg; $t1->bell;
        $t1->delete('1.0', 'end');
        $mw->Busy(-recurse => 1);
        
        if    ($e eq 'start1') {
            $msg = "Invalid range.  Cannot preform 'Range' scan.";
        }
        elsif ($e eq 'start2') {
            $msg = "Invalid port.  Cannot preform 'Single' scan.";
        }
        elsif ($e eq 'start3') {
            $msg = "PPS_C_v2_0.plx not found.  Download it from CPAN.";
        }
        elsif ($e eq 'start4') {
            $msg = "Cannot start new process.";
        }
        else                   {
            $msg = "Unknown error.";
        }
        $msg .= "\n$^E $@ $!";
        
        $t1->insert('end', "$msg\n", 'Red');
        &cancel(); $mw->Unbusy; $mw->update;
    }
}
#POD Section#
=head1 NAME

PPS - Perl Port Scanner

=head1 DESCRIPTION

A Multi-Threaded port scanner.

=head1 README

PPS - Perl Port Scanner (pps_v2_1)

A multi-threaded port scanner, with single scan, range scan, full scan,
and well-known port numbers scan.  Can be runs as a GUI or Command line.

=head1 History

0.2 - Initial release.

0.3 - POD fixes, Trapped error if getservbyport fails.

      Improved &loader().  (Thanks Mark D).

0.4 - Changed the subroutine for running the script with no args.

0.5 - Re-structured code, reduced script size. Improved memory usage.

1.0   Removed &loader() and @ports. Improved memory use and speed.

      Implemented possible replacement for Win32::Console

1.1   Fixed a bug with small range scans.

      Fixed a bug with port numbers during range scans.

2.0   Initial GUI enabled version.

2.1   Minor GUI improvements.

=head1 ToDo

*Replace Win32::Console (for portability).

*Make non-threaded version (multiplexed).

*Improve GUI

*Implement history function

=head1 Copyright

PPS - Perl Port Scanner.
Copyright (C) 2003-2005 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

Tk
Getopt::Long
Thread Support

=head1 COREQUISITES

Win32::Console (for MSWin32)
Term::ANSIScreen (for non-MSWin32)
Net::Ping (Optional)

=pod OSNAMES

OS Names: MSWin32, others?

=pod SCRIPT CATEGORIES

Networking

=cut

__DATA__
#!
$| = 1;
$^W = 1;
use strict;
use threads;
use IO::Socket;
use Getopt::Long;

#Optional Modules#
my $con; my $Net_Ping_installed = 0;
eval {require Net::Ping; $Net_Ping_installed = 1};
if ($^O eq 'MSWin32') {
    use Win32::Console;
    $con = Win32::Console->new(STD_OUTPUT_HANDLE);
}else{
    use Term::ANSIScreen;
    $con = Term::ANSIScreen->new;
}

#Declarations#
my $VERSION = 2.0;
my (@rng, $hlp, $sgl, $ful, $wel, $gui);
my (@queue, $target, $scan_type, $st1, $st2, $to,);

#Get Options#
GetOptions (
    'h|?' => \$hlp, 's=i' => \$sgl, 'f'   => \$ful,
    'w'   => \$wel, 'r=s' => \@rng, 'gui' => \$gui,
);
if ($target = shift) { unshift (@ARGV, $target);   }
else                 { &help(); exit;              }
if    ($gui) { $con->Free();                       }
if    (@rng) { @rng = split('-', join('-', @rng)); }
if    ($sgl) { $scan_type = "Single"; }
elsif (@rng) { $scan_type = "Range";  }
elsif ($wel) { $scan_type = "Normal"; }
elsif ($ful) { $scan_type = "Full";   }
else         { &help(); exit;         }
    

#Main#
if ($gui) { open (TMP, '>ppstemp.tmp'); }
else      { &title(); }

if ($scan_type =~ /^Normal$|^Full$/) {
    if ($scan_type eq 'Normal') { $st1 = 1; $st2 = 1024;  $to = 31; }
    else                        { $st1 = 1; $st2 = 65530; $to = 31; }
}elsif ($scan_type eq 'Range')  { $st1 = $rng[0]; $st2 = $rng[1];
    if ($st2 - $st1 <= 256 )    { $to = 7;  $scan_type = 'Range8';  }
    else                        { $to = 31; $scan_type = 'Range32'; }
}elsif ($scan_type eq 'Single') { $to = 0;  $st1=$st2  = $sgl;      }

if ($gui) { &title(); }
if (inet_aton($target)) { if ($Net_Ping_installed == 1) { &ping(); } }
else { die "Couldn't resolve $target" . "'s address.\n($^E)\n$!"; }
undef @rng; undef $wel; undef $ful; undef $sgl; undef $hlp;
if ($gui) { close TMP; }

for (0..$to) {
    my $t = threads->new(\&scanner, $_);
    push (@queue, $t);
}&detach(\@queue);

print "\n". 'Scan completed (' . localtime() . ").\n";
if ($gui) {
    open (TMP, '>>ppstemp.tmp');
    print TMP "\n". 'Scan completed (' . localtime() . ").\n";
    close TMP;
}
exit;

#Subroutines#
sub scanner #-----------------------------------------------------------
{
    my $c1 = $_[0]; my $c2; undef @queue;
    
    if     ($scan_type eq 'Normal')  { $c2 = 32;   $c1 *= $c2;
    }elsif ($scan_type eq 'Full')    { $c2 = 2048; $c1 *= $c2;
    }elsif ($scan_type eq 'Single')  { $c2 = 1;    $c1  = $st1 - 1;
    }elsif ($scan_type eq 'Range8')  {
        $scan_type = 'Range';
        my $tot = $st2 - $st1;
        while ($tot % 8) { $tot++; }   $c2 = $tot / 8;
                                       $c1 = ($c1 * $c2) + ($st1 - 1);
    }elsif ($scan_type eq 'Range32') {
        $scan_type = 'Range';
        my $tot = $st2 - $st1;
        while ($tot % 32)  { $tot++; } $c2 = $tot / 32;
                                       $c1 = ($c1 * $c2) + ($st1 - 1);
    }
    for ($c1 + 1..$c1 + $c2) {
        unless ($_ <= $st2) { next; }
        if ($gui) {
            open (FH, '>pps.tmp');
            print FH "$_\n";
            close FH;
        }
        $con->WriteChar("Scanning Host:  $target", 0, 5);
        $con->WriteChar("Scan Type:      $scan_type ($st1-$st2)",0,7);
        $con->WriteChar("Port:", 63, 7);
        $con->WriteChar("          ", 70, 7);
        $con->WriteChar("$_", 70, 7);
        my $sock = IO::Socket::INET->new(PeerAddr  => $target,
                                         PeerPort  => $_,
                                         Type      => SOCK_STREAM,
                                         Proto     => 'tcp',
                                         Timeout   => 1) or next;
        my $pname = getservbyport($_, 'tcp');
        unless ($pname) { $pname = 'unknown'; }
        print "Port: $_ ($pname) is open.\n";
        if ($gui) {
            open (TMP, '>>ppstemp.tmp');
            print TMP "Port: $_ ($pname) is open.\n";
            close TMP;
        }
        shutdown ($sock, 2); close ($sock);
    }
    return (1);
}
sub detach #------------------------------------------------------------
{
    my $q = $_[0];
    foreach (@$q) { eval {my @a = $_->join}; if (@$) { $_->detach; } }
}
sub 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";
    if ($gui) {
        print TMP "$target [$ip] is ";
        print TMP "NOT " unless $ret;
        print TMP "reachable via ICMP ping.\n";
        print TMP 'round trip time: ', $rtt, " second(s).\n" if $ret;
        print TMP "\n";
    }
    sleep(1);
    $p->close();
}
sub title #-------------------------------------------------------------
{
    $con->Cls(); $con->Title("Perl Port Scanner");
    print ' ' . localtime() . "\n" . ' ' . '='x78 . "\n";
    print "\t\t\t     Perl Port Scanner\n";
    print ' ' . '='x78 . "\n\n\n\n\n\n";
    if ($gui) {
        print TMP ' ' . localtime() . "\n" . ' ' . '='x78 . "\n";
        print TMP "\t\t\t     Perl Port Scanner\n";
        print TMP ' ' . '='x78 . "\n\n";
        print TMP "Scanning Host:  $target\n";
        print TMP "Scan Type:      $scan_type ($st1-$st2)\n\n";
    }
}
sub help #--------------------------------------------------------------
{
    my $opt = shift || 0;
    $con->Title("Perl Port Scanner - Help");
    $con->Cls(); my $email = 'QOS@cpan.org';
    print <<HELPTEXT;
    Usage:      pps_v1_0 <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_v1_0 127.0.0.1 -w
                pps_v1_0 127.0.0.1 -f
                pps_v1_0 localhost -r 20-140
                pps_v1_0 www.perl.org -s 80

    About:      PPS - Version 2.0
                Please send bug reports to $email

HELPTEXT
    sleep 5;
    if ($opt == 1) {
        die "Error: First range value must be < than the second.\a\n";
    }
}