bin/check_web2.pl

   1 #! perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use v5.10.1;
   7
   8 use Config::Any;
   9 use File::Basename qw(fileparse);
  10 use File::ConfigDir qw(config_dirs);
  11 use File::Find::Rule;
  12 use Getopt::Long;
  13 use Hash::Merge ();
  14 use Pod::Usage;
  15 use POSIX qw(isatty);
  16
  17 use WWW::Mechanize::Script;
  18
  19 my $VERSION = 0.001;
  20 my %opts;
  21 my @options = ( "file=s", "help|h", "usage|?" );
  22
  23 GetOptions( \%opts, @options ) or pod2usage(2);
  24
  25 defined( $opts{help} )
  26   and $opts{help}
  27   and pod2usage(
  28                  {
  29                    -verbose => 2,
  30                    -exitval => 0
  31                  }
  32                );
  33 defined( $opts{usage} ) and $opts{usage} and pod2usage(1);
  34 defined( $opts{file} ) or isatty(*STDOUT) ? pod2usage(1) : die "Missing --file argument";
  35
  36 my %cfg = (
  37           defaults => {
  38               save_output    => 'yes',
  39               ignore_case    => 'yes',
  40               show_html      => 'yes',
  41               accept_cookies => 'yes',
  42               show_cookie    => 'yes',
  43               show_headers   => 'yes',
  44               send_cookie    => 'yes',
  45               terse          => 'failed_only',
  46               request        => {
  47                   agent => {
  48                       agent => (
  49                           ( $opts{file} =~ /(_w$|^wap\/)/ )
  50                           ? "Nokia6210/1.0 (03.01) UP.Link/5.0.0.4 VZDE-check_wap $VERSION"
  51                           : "Mozilla/5.0 (Windows; U; WinNT4.0; en-US; rv: VZDE-check_web $VERSION)"
  52                       )
  53                   }
  54               },
  55               text_forbid => [
  56                                'Premature end of script headers',
  57                                'Error processing directive',
  58                                'XML Parsing partner document',
  59                                'sun.io.MalformedInputException',
  60                                'an error occurred while processing this directive'
  61                              ],
  62                       },
  63           );
  64
  65 # find config file
  66 my @cfg_dirs    = config_dirs();
  67 my $progname    = fileparse( $0, qr/\.[^.]*$/ );
  68 my @cfg_pattern = map { $progname . "." . $_ } Config::Any->extensions();
  69 my @cfg_files   = File::Find::Rule->file()->name(@cfg_pattern)->maxdepth(1)->in(@cfg_dirs);
  70 if (@cfg_files)
  71 {
  72     my $merger = Hash::Merge->new('LEFT_PRECEDENT');
  73     # read config file(s)
  74     my $all_cfg = Config::Any->load_files(
  75                                            {
  76                                              files           => [@cfg_files],
  77                                              use_ext         => 1,
  78                                              flatten_to_hash => 1,
  79                                            }
  80                                          );
  81
  82     foreach my $filename (@cfg_files)
  83     {
  84         defined( $all_cfg->{$filename} )
  85           or next;    # file not found or not parsable ...
  86                       # merge into default and previous loaded config ...
  87         %cfg = %{ $merger->merge( \%cfg, $all_cfg->{$filename} ) };
  88     }
  89 }
  90
  91 do
  92 {
  93     my %cfgvar = ( OPTS_FILE => $opts{file} );
  94     my $cfgkeys = join( "|", keys %cfgvar );
  95     $cfg{summary}->{target} =~ s/@($cfgkeys)[@]/$cfgvar{$1}/ge;
  96     $cfg{report}->{target}  =~ s/@($cfgkeys)[@]/$cfgvar{$1}/ge;
  97 } while (0);
  98
  99 my $wms = WWW::Mechanize::Script->new( \%cfg );
 100
 101 if ( -f $opts{file} and -r $opts{file} )
 102 {
 103     @cfg_files = ( $opts{file} );
 104 }
 105 else
 106 {
 107     my ( $volume, $directories, $fn ) = File::Spec->splitpath( $opts{file} );
 108     @cfg_dirs = config_dirs( $cfg{script_dir} // "check_web" );
 109     @cfg_dirs =
 110       grep { -d $_ }
 111       map { File::Spec->catdir( $_, $directories ) }
 112       config_dirs( $cfg{script_dir} // "check_web" );    # XXX basename $0
 113     @cfg_pattern = map { $fn . "." . $_ } Config::Any->extensions();
 114     @cfg_files = File::Find::Rule->file()->name(@cfg_pattern)->maxdepth(1)->in(@cfg_dirs);
 115 }
 116
 117 my ( $code, @msgs ) = (0);
 118 eval {
 119     my @script;
 120     my $scripts = Config::Any->load_files(
 121                                            {
 122                                              files           => [@cfg_files],
 123                                              use_ext         => 1,
 124                                              flatten_to_hash => 1,
 125                                            }
 126                                          );
 127     foreach my $filename (@cfg_files)
 128     {
 129         defined( $scripts->{$filename} )
 130           or next;    # file not found or not parsable ...
 131                       # merge into default and previous loaded config ...
 132         push( @script, @{ $scripts->{$filename} } );
 133     }
 134     ( $code, @msgs ) = $wms->run_script(@script);
 135 };
 136 $@ and say("UNKNOWN - $@");
 137 exit( $@ ? 255 : $code );
 138
 139 __END__
 140
 141 =head1 NAME
 142
 143 check_web2 - allows checking of website according to configured specifications
 144
 145 =head1 DESCRIPTION
 146
 147 check_web2 is intended to be used to check web-sites accoring a configuration.
 148 The configuration covers the request configuration (including agent part) and
 149 check configuration to specify check parameters.
 150
 151 See C<WWW::Mechanize::Script> for details about the configuration options.
 152
 153 =head2 HISTORY
 154
 155 This script is created as successor of an check_web script of a nagios setup
 156 based on HTTP::WebCheck. This module isn't longer maintained, so decision
 157 was made to create a new environment simulating the old one basing on
 158 WWW::Mechanize.
 159
 160 =head1 SYNOPSIS
 161
 162   $ check_web2 --file domain1/site1.json
 163   $ check_web2 --file domain2/site1.yml
 164   # for compatibility
 165   $ check_web2 --file domain1/site2.wts
 166
 167 =head1 AUTHOR
 168
 169 Jens Rehsack, C<< <rehsack at cpan.org> >>
 170
 171 =head1 BUGS
 172
 173 Please report any bugs or feature requests to C<bug-www-mechanize-script at rt.cpan.org>, or through
 174 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WWW-Mechanize-Script>.  I will be notified, and then you'll
 175 automatically be notified of progress on your bug as I make changes.
 176
 177 =head1 SUPPORT
 178
 179 You can find documentation for this module with the perldoc command.
 180
 181     perldoc WWW:Mechanize::Script
 182
 183 You can also look for information at:
 184
 185 =over 4
 186
 187 =item * RT: CPAN's request tracker (report bugs here)
 188
 189 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=WWW-Mechanize-Script>
 190
 191 =item * AnnoCPAN: Annotated CPAN documentation
 192
 193 L<http://annocpan.org/dist/WWW-Mechanize-Script>
 194
 195 =item * CPAN Ratings
 196
 197 L<http://cpanratings.perl.org/d/WWW-Mechanize-Script>
 198
 199 =item * Search CPAN
 200
 201 L<http://search.cpan.org/dist/WWW-Mechanize-Script/>
 202
 203 =back
 204
 205 =head1 ACKNOWLEDGEMENTS
 206
 207 =head1 LICENSE AND COPYRIGHT
 208
 209 Copyright 2012 Jens Rehsack.
 210
 211 This program is free software; you can redistribute it and/or modify it
 212 under the terms of either: the GNU General Public License as published
 213 by the Free Software Foundation; or the Artistic License.
 214
 215 See http://dev.perl.org/licenses/ for more information.
 216
 217 =cut