Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
#!/usr/bin/perl -w # portck.pl # pod at tail use strict; # avoid d'oh! bugs require 5; # for following modules use IO::Socket; # support port connections use Getopt::Long; # support commandline arguments, options use Pod::Usage; # avoid duplicating Usage() in Pod my $start = time; my ( $opt_remote, $opt_firstport, $opt_lastport, $opt_proto, $opt_timeout, $opt_help, $opt_man, ); GetOptions( 'remote=s' => \$opt_remote, 'firstport=i' => \$opt_firstport, 'lastport=i' => \$opt_lastport, 'proto=s' => \$opt_proto, 'timeout=i' => \$opt_timeout, 'help!' => \$opt_help, 'man!' => \$opt_man, ); my $remote = defined $opt_remote ? $opt_remote : 'localhost'; my $firstport = defined $opt_firstport ? $opt_firstport : 1; my $lastport = defined $opt_lastport ? $opt_lastport : 1024; my $proto = defined $opt_proto ? $opt_proto : 'tcp'; my $timeout = defined $opt_timeout ? $opt_timeout : 1; pod2usage(-verbose => 2) if (defined $opt_man); pod2usage(-verbose => 1) if (defined $opt_help); pod2usage(-verbose => 1) unless( $remote =~ /localhost/ and $remote =~ /(^\w+$)/ and $firstport > 0 and $lastport > 0 and $firstport < 65536 and $lastport < 65536 and $lastport >= $firstport and $timeout > 0 ); print "\nChecking $remote for $proto ports $firstport through $lastpor +t\n"; for (my $port=$firstport; $port<$lastport+1; $port++){ my $connect = IO::Socket::INET->new( PeerAddr => $remote, PeerPort => $port, Proto => $proto, ); if ($connect) { if ($proto eq 'udp') { open (ERROR, ">/dev/null") or die $!; STDERR->fdopen(\*ERROR, "w") or die $!; $connect->send('Yo!') or next; $SIG{ALRM} = \&timed_out; eval { alarm ($timeout); $connect->recv($_,1) or next; alarm (0); print " connected to $remote at $proto port $port\n"; close $connect; }; } else { print " connected to $remote at $proto port $port\n"; close $connect; } } } my $done = time; my $runSecs = int($done-$start); print "\nRuntime ", $runSecs, " second"; print 's' if $runSecs != 1; print "\n\n"; print <<EOF; IO::Socket $IO::Socket::VERSION Getopt::Long $Getopt::Long::VERSION Pod::Usage $Pod::Usage::VERSION Perl $] OS $^O EOF ; sub timed_out { die "How long can this go on?!"; } =head1 NAME portck.pl =head1 DESCRIPTION A TCP and UDP port sccaner written in Perl. Requires no additional modules beyond those in the base Perl install. =head1 SYNOPSIS C<portck.pl> to run with default values for arguments =head1 OPTIONS --help display Usage, Arguments, and Options --man display complete man page =head1 ARGUMENTS --remote Name or IPaddr of remote host default of 'localhost' --firstport Integer between 1 and 65535, indicating starting port number default of 1 --lastport Integer between 1 and 65535, indicating ending port number default of 1024 --proto tcp or udp default of tcp --timeout Integer greater than 0, indicating seconds to wait for response default of 1 =head1 EXAMPLES portck.pl check localhost for TCP ports 1 through 1024 portck.pl --remote tux --firstport 80 check named host for TCP ports 80 through 1024 portck.pl -t sparky -f 69 -l 69 -p udp check named host for TFTP port portck.pl -t 172.16.1.1 -l 65535 check numbered host for all TCP ports portck.pl -t enterprise -f 13 -l 13 -p udp -w 10 check named host for daytime, with 10 second response timeout portck.pl -t 192.168.1.1 -w 1 check numbered host with connection timeout of 1 second =head1 BUGS None that I know of. =head1 UPDATE 2002-01-22 08:40 CST Fix numerous tyops Post to PerlMonks More effective regex for $remote sanity-check Pod::Usage Discern betwixt (s)tring and (i)nteger for arguments and options Require Perl 5 Eliminate TCP connection timeout, as appears to do nothing Combine UDP response and TCP connection timeouts to one argument Cleaner syntax for default values Non-repetitive syntax for passel o' &Usage() calls Intelligently print second or seconds runtime &Usage() Input sanity-checks UDP timeout No eval exit errs on UDP by STDERR redirect to /dev/null. No false UDP positives by sending and checking response. POD 2002-01-17 Initial working code. =head1 TODO More clean support for specifying ports =head1 TESTED IO::Socket 1.25, 1.26 Getopt::Long 2.2602, 2.25 Pod::Usage 1.14 Perl 5.00503, 5.006001 OS Debian 2.2r5, Win2k, Cygwin/Win2k =head1 AUTHOR ybiC =head1 CREDITS Props to Screamer for reminder of proper Getopt types for input, jcwren+Russ for ternery to simplify provision for default values, jeffa for pointing to $connect->recv for UDP, c for inspiration of problem with tftp-detect-before-copy-config. Oh yeah, and to some guy named vroom. =head1 DISCLAIMER This software was written to aid in configuring the author's computers in a reasonably secure manner. Anyone using this software is encourag +ed to do so in a responsible and constructive fashion. Remember kids to always use your powers for good, not evil. =cut

In reply to (code) UDP timeout for IO::Socket, plus Pod::Usage with Getopt::Long by ybiC

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others contemplating the Monastery: (5)
As of 2024-03-29 09:22 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found