Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
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
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            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 avoiding work at the Monastery: (12)
    As of 2015-07-06 19:27 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (81 votes), past polls