Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Comment on

( #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":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

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

    How do I use this? | Other CB clients
    Other Users?
    Others making s'mores by the fire in the courtyard of the Monastery: (11)
    As of 2014-12-21 16:52 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (106 votes), past polls