Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/usr/bin/perl -w # nailup.pl # pod at tail $|++; # STDOUT hot require 5; # support following modules use strict; # avoid d'oh! bugs use Getopt::Long; # support commandline args, opts use Pod::Usage; # avoid redundant &Usage() use LWP::UserAgent; # virtual web client use Carp; # support daemonization option use integer; # whole numbers in calc outputs my $nailup_VER = '0.99.48'; ###################################################################### +##### # BEGIN CONFIG PARAMS ###################################################################### +##### my $logFile = './nailup.log'; my $errFile = './nailup.err'; my $analogPidFile = '/var/run/ppp0.pid'; my $browser = 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0rc1) Gecko/20020417'; my @sitelist = qw( http://www.whitehouse.gov http://www.microsoft.com http://www.crosswalk.com http://www.slashdot.org http://www.gateway.com http://www.google.com http://www.debian.org http://www.compaq.com http://www.novell.com http://www.msnbc.com http://java.sun.com http://www.sony.com http://www.dell.com http://www.nba.com http://www.ibm.com http://www.hp.com ); ###################################################################### +##### # END CONFIG PARAMS ###################################################################### +##### # Default values and other stuff not to be mucked with: my $current_run = 0; # Optional features, so optional modules: my $havePOSIX; my $haveIOTee; BEGIN { # facilitate option to run as background process $havePOSIX = 0; eval { require POSIX }; unless ($@) { POSIX->import(); $havePOSIX = 1; } # facilitate option to log to file $haveIOTee = 0; eval { require IO::Tee }; unless ($@) { IO::Tee->import(); $haveIOTee = 1; } } # Setup options and arguments: my $opt_verbose = my $def_verbose = 2; my $opt_biggestDelay = my $def_biggestDelay = 900; my $opt_smallestDelay = my $def_smallestDelay = 300; my $opt_errDelay = my $def_errDelay = 1; my $opt_runs = my $def_runs = 3; my $opt_timeout = my $def_timeout = 120; my ( $opt_help, $opt_man, $opt_quiet, $opt_daemonize, $opt_analog, $opt_logging, ); GetOptions( 'help!' => \$opt_help, 'man!' => \$opt_man, 'verbose=i' => \$opt_verbose, 'quiet!' => \$opt_quiet, 'daemonize!' => \$opt_daemonize, 'runs=i' => \$opt_runs, 'biggestDelay=i' => \$opt_biggestDelay, 'smallestDelay=i' => \$opt_smallestDelay, 'errDelay=i' => \$opt_errDelay, 'timeout=i' => \$opt_timeout, 'analog!' => \$opt_analog, 'logging!' => \$opt_logging, ) or pod2usage(verbose => 1) && exit; ###################################################################### +##### # BEGIN PROCESS OPTIONS, ARGUMENTS ###################################################################### +##### # order of following args/opts is important! # test well after any change or invite unexpected behavior! # and update the pod too! # you've been warned! if ($opt_help) { pod2usage(verbose => 1); ex +it; } if ($opt_man) { pod2usage(verbose => 2); ex +it; } if ($opt_runs < -1) { pod2usage(verbose => 1); ex +it; } if ($opt_biggestDelay<$opt_smallestDelay){ pod2usage(verbose => 1); ex +it; } if ($opt_errDelay < 0) { pod2usage(verbose => 1); ex +it; } if ($opt_timeout < 1) { pod2usage(verbose => 1); ex +it; } if ($opt_quiet) { $opt_verbose = 0; } my $out; if ($opt_logging){ unless ($haveIOTee == 1){ print "\nSorry - logging requires CPAN module IO::Tee\n\n"; exit; } if ($opt_verbose < 1){ print "\nSorry - logging not allowed in quiet/silent mode\n\n"; exit; } $out = new IO::Tee( \*STDOUT, new IO::File("> $logFile"),); new IO::Tee( \*STDERR, new IO::File("> $errFile"),); print $out "\n", " Logging to $logFile\n", " Catastrophic errors to $errFile\n", "\n", ; $out->flush if $opt_logging; }else{ $out = \*STDOUT;} if ($opt_analog){ unless (-e $analogPidFile){ print $out "\n", "You specified dial connection, but no PID file was found.\n", "Are you on a *nix host?\n", "Are you using an analog dial connection?\n", "Is your dialup connection established?\n", "\n", ; $out->flush if $opt_logging; exit; } } if($opt_verbose >= 3) { # singular/plural second(s) appropriately: my %plural = ( b => 's', s => 's', e => 's', t => 's',); $plural{b} = '' if $opt_biggestDelay == 1; $plural{s} = '' if $opt_smallestDelay == 1; $plural{e} = '' if $opt_errDelay == 1; $plural{t} = '' if $opt_timeout == 1; my %pluralDef = ( b => 's', s => 's', e => 's', t => 's',); $pluralDef{b} = '' if $def_biggestDelay == 1; $pluralDef{s} = '' if $def_smallestDelay == 1; $pluralDef{e} = '' if $def_errDelay == 1; $pluralDef{t} = '' if $def_timeout == 1; print $out <<EOF $0 Current values number of runs $opt_runs biggest delay $opt_biggestDelay second$plural{b} smallest delay $opt_smallestDelay second$plural{s} error delay $opt_errDelay second$plural{e} timeout $opt_timeout second$plural{t} Defaults number of runs $def_runs biggest delay $def_biggestDelay second$pluralDef{b} smallest delay $def_smallestDelay second$pluralDef{s} error delay $def_errDelay second$pluralDef{e} timeout $def_timeout second$pluralDef{t} Versions LWP::UserAgent $LWP::UserAgent::VERSION IO::Tee $IO::Tee::VERSION POSIX $POSIX::VERSION Pod::Usage $Pod::Usage::VERSION Getopt::Long $Getopt::Long::VERSION Perl $] OS $^O $0 $nailup_VER EOF ; $out->flush if $opt_logging; } if ($opt_daemonize){ Daemonize(); } ###################################################################### +##### # END PROCESS OPTIONS, ARGUMENTS ###################################################################### +##### # first attempt logged regardless of success/failure # success = 1, failure = 0 my $oldSuccess = 3; # Call the Main Chunk o'Code: # (run indefinately, or run specified number of times) if ($opt_runs == -1) { randomFetch() while(1) } if ($opt_runs > -1) { randomFetch() for(1..$opt_runs) } print $out "\n"; ###################################################################### +##### # Main Chunk o'Code: # Fetch random page then wait to doit again # yeah yeah, it's a wee bit looooong for a sub, # but is only reasonable way I could find to # support selecting betwixt while(...) and for(...) ###################################################################### +##### sub randomFetch { # randomly choose page: for (my $i = @sitelist; -- $i;) { my $r = int rand (1 + $i); @sitelist [$i, $r] = @sitelist [$r, $i] unless $r == $i; } my $site = $sitelist[0]; # try to fetch da page: my $hdrs = new HTTP::Headers( Accept => 'text/HTML', user_agent => $browser, ); my $url = new URI($site); my $req = new HTTP::Request('GET', $url, $hdrs); my $ua = new LWP::UserAgent; # $ua->proxy('http', "http://host.dom.tld:port"); $ua->timeout($opt_timeout); my $resp = $ua->request($req); # check da response: my $success = 1 if $resp->is_success; $success = 0 if $resp->is_error; my $delay; ++$current_run; my $randomDelay = rand($opt_biggestDelay-$opt_smallestDelay)+$opt_smallestDelay; # human-readable date+timestamp: my ($sec, $min, $hour, $mday, $mon, $year) = localtime(time); my $stamp = sprintf( "%04d-%02d-%02d %02d:%02d:%02d", $year+1900, $mon+1, $mday, $hour, $min, $sec ); # and report da response: # tell a lot: if ($opt_verbose >= 2){ if ($success == 1){ print $out " $stamp $site $success "; if ($current_run < $opt_runs or $opt_runs == -1){ print $out "Next loop in $randomDelay second"; print $out 's' if $randomDelay != 1; print $out ".\n"; }else{ print $out "\nRun complete.\n\n"; } } if ($success == 0){ print $out "\nError $stamp $site\n", $resp->message, "\n"; if ($current_run < $opt_runs or $opt_runs == -1){ print $out "Next loop in $opt_errDelay second"; print $out 's' if $opt_errDelay != 1; print $out ".\n\n"; }else{ print $out "\nRun complete.\n\n"; } } $out->flush if $opt_logging; } # tell a little: if($opt_verbose == 1){ if ($success != $oldSuccess){ print $out " $stamp $site $success\n"; $out->flush if $opt_logging; } } # cone of silence: if($opt_verbose == 0){ } # how long can this go on? if ($current_run < $opt_runs or $opt_runs == -1){ $oldSuccess = $success; sleep $opt_errDelay if $success == 0; sleep $randomDelay if $success == 1; } } ###################################################################### +##### # Background and disconnect from controlling vty, so vty can be closed +: # fork() backgrounds, but doesn't disconnect from controlling vty # hence stolen Proc::Daemon subs # Unix-family OSen only # $^O strings known to me: # aix freebsd netbsd openbsd # cygwin darwin hpux irix # linux sco solaris sunos # dec_osf macos msdos mswin32 os390 ###################################################################### +##### sub Daemonize { if ($^O =~ /(MSWin32|MSDOS|MacOS)/i){ print $out "\nSorry, --daemon only works on *nix hosts. ", "You appear to be running $^O.\n\n", ; $out->flush if $opt_logging; exit; } if ($havePOSIX != 1){ print $out "\nSorry, --daemon requires the CPAN POSIX module.\n\n" +; $out->flush if $opt_logging; exit; } if ($opt_verbose > 0){ ### BUG ### ### next line prints output thrice ### print $out <<EOF print <<EOF $0 launched and daemonizing. Something like 'ps x|grep nailup.pl' for PID to kill program. EOF ; } Init(); } ###################################################################### +##### # Shamelessly copied from Proc::Daemon v0.02 # Try to fork if at all possible. # Function will croak if unable to fork. sub Fork { my($pid); FORK: { if (defined($pid = fork)) { return $pid; } elsif ($! =~ /No more process/) { sleep 5; redo FORK; } else { croak "Can't fork: $!"; } } } ###################################################################### +##### # Shamelessly copied from Proc::Daemon v0.02 # Return the maximum number of possible file descriptors. # If sysconf() does not give us value, we punt with our own value. sub OpenMax { my $openmax = POSIX::sysconf( &POSIX::_SC_OPEN_MAX ); (!defined($openmax) || $openmax < 0) ? 64 : $openmax; } ###################################################################### +##### # Shamelessly copied from Proc::Daemon v0.02 # Become a daemon. sub Init { my $oldmode = shift || 0; my($pid, $sess_id, $i); ## Fork and exit parent if ($pid = Fork) { exit 0; } ## Detach ourselves from the terminal croak "Cannot detach from controlling terminal" unless $sess_id = POSIX::setsid(); ## Prevent possibility of acquiring a controling terminal if (!$oldmode) { $SIG{'HUP'} = 'IGNORE'; if ($pid = Fork) { exit 0; } } ### ybiC ### --logging # Change working directory # chdir "/"; ## Clear file creation mask umask 0; ### ybiC ### --logging # Close open file descriptors # foreach $i (0 .. OpenMax) { POSIX::close($i); } ## Reopen stderr, stdout, stdin to /dev/null open(STDIN, "+>/dev/null"); open(STDOUT, "+>&STDIN"); open(STDERR, "+>&STDIN"); $oldmode ? $sess_id : 0; } ### ybiC ### Name "main::init" used only once. Possible typo at line... # *init = \&Init; ###################################################################### +##### =head1 TITLE nailup.pl =head1 SYNOPSIS nailup.pl [options arguments] =head1 DESCRIPTION Randomly fetch a remote web page from a list of URLs. Waits a random length of time between fetches. Optionally log results to file, daemonize, and/or check for ppp0 PID f +ile. Written with two purposes in mind: * log internet connectivity * nail up analog dial connection =head1 ARGUMENTS -r=10 --runs=10 numbers of times to fetch a random page (-1 means indefinat +ely) -b=500 --biggestDelay=500 biggest wait between fetches (seco +nds) -s=60 --smallestDelay=60 smallest wait between fetches (seco +nds) -e=1 --errDelay=1 wait after failed fetch (seco +nds) -t=30 --timeout=30 wait for response this long (seco +nds) -v=0 --verbose=0 silent 1 $timestamp $site $success (on success/fail cha +nge) 2 $timestamp $site $success 'next in N seconds' 3 same as 2 plus current+default params at head (default verbosity i +s 2) Longest delay must be greater than or equal to smallest delay. Any value entered must be a positive integer (except for --runs). All are optional, as default values exist. =head1 OPTIONS -h --help brief help message (overrides all options be +low) -m --man full documentation (overrides all options be +low) -q --quiet silent; equivelent to -v=0 (overrides --verbos +e=N) -d --daemon background+disconnect so can close vty w/o killing ru +n ('ps x|grep nailup.pl' or such for PID to k +ill) (UNIX-family o +nly) -l --logging output to screen and logfile (not allowed with --qu +iet) -a --analog check for ppp0 PID file, abort if not present (localhost using analog modem for net-connect +ion) Short options cannot be bundled. For example, C<nailup.pl -adl> is *not* valid. But you could do C<nailup.pl -a -d -l> for analog/daemon/log combinati +on. =head1 CONFIG PARAMS The following parameters can be changed by editing in CONFIG PARAMS near the top of the program code: $logFile filespec to write to if --logging default is ./nailup.log $errFile filespec to write catastropic errors to if --logging default is ./nailup.err $analogPidFile absolute path to ppp0 PID file for live dialup connection *must* be set if using --analog commandline option $browser What browser this program reports itself as to web servers Program will run fine with this unchanged @sitelist List of websites to fetch Can be specific page, or just site address Must include leading 'http://' Trailing slash optional Program will run fine with this unchanged =head1 AUTHOR ybiC =head1 CREDITS Props to: tye and others for $fh tips, Fletch and tachyon for URI::URL tip, lemming for link to semi-complete $^O list, http://testers.cpan.org/search?request=by-config zeno for [id://57865] which inspired this code. Oh yeah, and to some guy named vroom =head1 TESTED Perl 5.00503, Debian 2.2r6 Full functionality Getopt::Long 2.01, 1.90 Pod::Usage 1.14 POSIX 1.02 IO::Tee 0.64 LWP::UserAgent 2.29, 2.262 Perl 5.00601, Cygwin on Win2k Full functionality Getopt::Long 2.25 Pod::Usage 1.14 POSIX 1.03 IO::Tee 0.64 LWP::UserAgent 2.001 Perl 5.00601, Win2k cmd.exe Daemonization not available Getopt::Long 2.25 Pod::Usage 1.14 POSIX 1.03 IO::Tee 0.64 LWP::UserAgent 1.77 =head1 BUGS --daemon initial message prints thrice if --logging and print $out Workaround fitted: print instead of print $out Daemonization works on Cygwin, but how to determine the PID ?? =head1 UPDATE 2002-04-22 20:25 CDT Fix thai-pos Post to PerlMonks Test on Win32-ActivePerl and also Cygwin Enclose POSIX, IO::Tee in BEGIN{ eval... require... } blocks so can run on hosts without those modules --logging with --daemon copy+tweak code from Proc::Daemon v0.02 Revise verbosity levels/results Option to specify analog dial connection (check for /var/run/ppp0.pid) 2002-04-16 06:50 CDT Initial working code =head1 TODO Squash above known bug(s) if any --sitelist arg to override default @sitelist trailing ' -- ' and what follows is passed to @ARGV sanity-check, untaint Enable bundling of short options eg; -lda Getopt::Long::Configure qw(bundling ignore_case_always); above syntax errs if long or short switches entered >8^( =cut

In reply to (code) HTTP connectivity log, or nail up dial connection 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 wandering the Monastery: (14)
    As of 2015-07-31 15:53 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 (279 votes), past polls