t/TestUtils.pm

   1 #!/usr/bin/env perl
   2
   3 package TestUtils;
   4
   5 ##################################################
   6 # Test Utils
   7 ##################################################
   8
   9 use warnings;
  10 use strict;
  11 use Carp;
  12 use Cwd;
  13 use Test::More;
  14 use Data::Dumper;
  15 use LWP::UserAgent;
  16 use HTTP::Cookies::Netscape;
  17 use File::Temp qw/ tempfile /;
  18 use File::Copy qw/ cp /;
  19 use File::Basename;
  20 use Test::Cmd;
  21
  22 if($> != 0) {
  23     plan( skip_all => "creating testsites requires root permission" );
  24 }
  25 our $omd_symlink_created = 0;
  26
  27 ##################################################
  28 # HTML::Lint installed?
  29 my $use_html_lint = 0;
  30 eval {
  31     require HTML::Lint;
  32     $use_html_lint = 1;
  33 };
  34
  35 ##################################################
  36 # dont test over a proxy
  37 delete $ENV{'HTTP_PROXY'};
  38 delete $ENV{'HTTPS_PROXY'};
  39 delete $ENV{'FTP_PROXY'};
  40 delete $ENV{'http_proxy'};
  41 delete $ENV{'https_proxy'};
  42 delete $ENV{'ftp_proxy'};
  43
  44
  45 ##################################################
  46
  47 =head2 get_omd_bin
  48
  49   returns path to omd binary
  50
  51 =cut
  52
  53 sub get_omd_bin {
  54     our $omd_bin;
  55     return $omd_bin if defined $omd_bin;
  56
  57     $omd_bin = $ENV{'OMD_BIN'} || '/usr/bin/omd';
  58
  59     # first check /omd
  60     if( ! -e '/omd' ) {
  61         if($omd_bin eq '/usr/bin/omd') {
  62             BAIL_OUT('Broken installation, got /usr/bin/omd but no /omd')
  63         } elsif($omd_bin eq 'destdir/opt/omd/versions/default/bin/omd') {
  64             symlink(getcwd()."/destdir/omd", '/omd');
  65             $omd_symlink_created = 1;
  66         } else {
  67             BAIL_OUT('did not find a valid /omd, please make sure it exists')
  68         }
  69     }
  70     else {
  71         if(-l '/omd') {
  72             my $target = readlink('/omd');
  73             if($omd_bin eq '/usr/bin/omd') {
  74                 if($target ne "/opt/omd" && $target ne "opt/omd") {
  75                     BAIL_OUT('symlink for /omd already exists but is wrong: should be: /opt/omd but got: '.$target);
  76                 }
  77             }
  78             elsif($omd_bin eq 'destdir/opt/omd/versions/default/bin/omd') {
  79                 if($target ne getcwd()."/destdir/omd") {
  80                     BAIL_OUT('symlink for /omd already exists but is wrong: should be: '.getcwd().'/destdir/omd but got: '.$target);
  81                 }
  82             }
  83         } else {
  84             BAIL_OUT('cannot run tests, /omd has to be a symlink to '.getcwd().'/destdir/omd (or /opt/omd for testing packages) in order to run tests for the source version');
  85         }
  86     }
  87
  88     -x $omd_bin or BAIL_OUT($omd_bin." is required for further tests: $!");
  89
  90     return $omd_bin;
  91 }
  92
  93 ##################################################
  94
  95 =head2 test_command
  96
  97   execute a test command
  98
  99   needs test hash
 100   {
 101     cmd     => command line to execute
 102     exit    => expected exit code (set to undef to ignore exit code verification)
 103     like    => (list of) regular expressions which have to match stdout
 104     errlike => (list of) regular expressions which have to match stderr, default: empty
 105     sleep   => time to wait after executing the command
 106   }
 107
 108 =cut
 109 sub test_command {
 110     my $test = shift;
 111     my($rc, $stderr) = ( -1, '') ;
 112     my $return = 1;
 113
 114     # run the command
 115     isnt($test->{'cmd'}, undef, "running cmd: ".$test->{'cmd'}) or $return = 0;
 116
 117     my($prg,$arg) = split(/\s+/, $test->{'cmd'}, 2);
 118     my $t = Test::Cmd->new(prog => $prg, workdir => '') or die($!);
 119     alarm(300);
 120     eval {
 121         local $SIG{ALRM} = sub { die "timeout on cmd: ".$test->{'cmd'}."\n" };
 122         $t->run(args => $arg, stdin => $test->{'stdin'});
 123         $rc = $?>>8;
 124     };
 125     if($@) {
 126         $stderr = $@;
 127     } else {
 128         $stderr = $t->stderr;
 129         $stderr = TestUtils::_clean_stderr($stderr);
 130     }
 131     alarm(0);
 132
 133     # exit code?
 134     $test->{'exit'} = 0 unless exists $test->{'exit'};
 135     if(defined $test->{'exit'} and $test->{'exit'} != -1) {
 136         ok($rc == $test->{'exit'}, "exit code: ".$rc." == ".$test->{'exit'}) or do { _diag_cmd($test, $t); $return = 0 };
 137     }
 138
 139     # matches on stdout?
 140     if(defined $test->{'like'}) {
 141         for my $expr (ref $test->{'like'} eq 'ARRAY' ? @{$test->{'like'}} : $test->{'like'} ) {
 142             like($t->stdout, $expr, "stdout like ".$expr) or do { diag("\ncmd: '".$test->{'cmd'}."' failed\n"); $return = 0 };
 143         }
 144     }
 145
 146     # matches on stderr?
 147     $test->{'errlike'} = '/^\s*$/' unless exists $test->{'errlike'};
 148     if(defined $test->{'errlike'}) {
 149         for my $expr (ref $test->{'errlike'} eq 'ARRAY' ? @{$test->{'errlike'}} : $test->{'errlike'} ) {
 150             like($stderr, $expr, "stderr like ".$expr) or do { diag("\ncmd: '".$test->{'cmd'}."' failed"); $return = 0 };
 151         }
 152     }
 153
 154     # sleep after the command?
 155     if(defined $test->{'sleep'}) {
 156         ok(sleep($test->{'sleep'}), "slept $test->{'sleep'} seconds") or do { $return = 0 };
 157     }
 158
 159     # set some values
 160     $test->{'stdout'} = $t->stdout;
 161     $test->{'stderr'} = $t->stderr;
 162     $test->{'exit'}   = $rc;
 163
 164     return $return;
 165 }
 166
 167
 168 ##################################################
 169
 170 =head2 file_contains
 171
 172   verify contents of a file
 173
 174   needs test hash
 175   {
 176     file    => file to check
 177     like    => (list of) regular expressions which have to match
 178     unlike  => (list of) regular expressions which must not match stderr
 179   }
 180
 181 =cut
 182 sub file_contains {
 183     my $test    = shift;
 184     my $failed  = 0;
 185     my $content = "";
 186
 187     my @like = ();
 188     if(defined $test->{'like'}) {
 189         @like   = ref $test->{'like'}   eq 'ARRAY' ? @{$test->{'like'}}   : $test->{'like'};
 190     }
 191     my @unlike = ();
 192     if(defined $test->{'unlike'}) {
 193         @unlike = ref $test->{'unlike'} eq 'ARRAY' ? @{$test->{'unlike'}} : $test->{'unlike'};
 194     }
 195
 196     ok(-r $test->{'file'}, $test->{'file'}." does exist");
 197
 198     SKIP: {
 199         skip 'file missing', (scalar @like + scalar @unlike) unless -r $test->{'file'};
 200
 201         local $/ = undef;
 202         open my $fh, $test->{'file'} or die "Couldn't open file ".$test->{'file'}.": $!";
 203         binmode $fh;
 204         $content = <$fh>;
 205
 206         # matches?
 207         if(defined $test->{'like'}) {
 208             for my $expr (@like) {
 209                 like($content, $expr, "content like ".$expr) or $failed++;
 210             }
 211         }
 212
 213         # don't matches
 214         if(defined $test->{'unlike'}) {
 215             for my $expr (@unlike) {
 216                 unlike($content, $expr, "output unlike ".$expr) or $failed++;
 217             }
 218         }
 219     };
 220
 221     return 1 unless $failed;
 222     return 0;
 223 }
 224
 225
 226 ##################################################
 227
 228 =head2 create_test_site
 229
 230   creates a test site and returns the name
 231
 232 =cut
 233 sub create_test_site {
 234     my $site = $_[0] || "testsite";
 235     if(test_command({ cmd => TestUtils::get_omd_bin()." create $site" })) {
 236         return $site;
 237     }
 238     return;
 239 }
 240
 241
 242 ##################################################
 243
 244 =head2 remove_test_site
 245
 246   removes a test site
 247
 248 =cut
 249 sub remove_test_site {
 250     my $site = shift;
 251     test_command({ cmd => TestUtils::get_omd_bin()." rm $site", stdin => "yes\n" });
 252     return;
 253 }
 254
 255
 256 ##################################################
 257
 258 =head2 test_url
 259
 260   test a url
 261
 262   needs test hash
 263   {
 264     url              => url to request
 265     auth             => authentication (realm:user:pass)
 266     code             => expected response code
 267     like             => (list of) regular expressions which have to match content
 268     unlike           => (list of) regular expressions which must not match content
 269     skip_html_lint   => flag to disable the html lint checking
 270     skip_link_check  => (list of) regular expressions to skip the link checks for
 271     waitfor          => wait till regex occurs (max 60sec)
 272   }
 273
 274 =cut
 275 sub test_url {
 276     my $test = shift;
 277
 278     my $start = time();
 279     my $page  = _request($test);
 280
 281     # wait for something?
 282     if(defined $test->{'waitfor'}) {
 283         my $now = time();
 284         my $waitfor = $test->{'waitfor'};
 285         my $found   = 0;
 286         while($now < $start + 60) {
 287             if($page->{'content'} =~ m/$waitfor/mx) {
 288                 ok(1, "content ".$waitfor." found after ".($now - $start)."seconds");
 289                 $found = 1;
 290                 last;
 291             }
 292             sleep(1);
 293             $now = time();
 294             $page = _request($test);
 295         }
 296         fail("content did not occur within 60 seconds") unless $found;
 297         return $page;
 298     }
 299
 300     # response code?
 301     $test->{'code'} = 200 unless exists $test->{'code'};
 302     if(defined $test->{'code'}) {
 303         is($page->{'code'}, $test->{'code'}, "response code for ".$test->{'url'}." is: ".$test->{'code'}) or _diag_request($test, $page);
 304     }
 305
 306     # content type?
 307     if(defined $test->{'content_type'}) {
 308         is($page->{'content_type'}, $test->{'content_type'}, 'Content-Type is: '.$test->{'content_type'});
 309     }
 310
 311     # matches output?
 312     if(defined $test->{'like'}) {
 313         for my $expr (ref $test->{'like'} eq 'ARRAY' ? @{$test->{'like'}} : $test->{'like'} ) {
 314             like($page->{'content'}, $expr, "content like ".$expr);
 315         }
 316     }
 317
 318     # not matching output
 319     if(defined $test->{'unlike'}) {
 320         for my $expr (ref $test->{'unlike'} eq 'ARRAY' ? @{$test->{'unlike'}} : $test->{'unlike'} ) {
 321             unlike($page->{'content'}, $expr, "content unlike ".$expr)  or _diag_request($test, $page);
 322         }
 323     }
 324
 325     # html valitidy
 326     SKIP: {
 327         if($page->{'content_type'} =~ 'text\/html') {
 328             unless(defined $test->{'skip_html_lint'} && $test->{'skip_html_lint'} == 1) {
 329                 if($use_html_lint == 0) {
 330                     skip "no HTML::Lint installed", 2;
 331                 }
 332                 if($page->{'content'} =~ /^\[.*\]$/mx) {
 333                     skip "no lint check for json data", 2;
 334                 }
 335                 my $lint = new HTML::Lint;
 336                 isa_ok( $lint, "HTML::Lint" );
 337
 338                 $lint->parse($page->{'content'});
 339                 my @errors = $lint->errors;
 340                 @errors = _diag_lint_errors_and_remove_some_exceptions($lint);
 341                 is( scalar @errors, 0, "No errors found in HTML (".$test->{'url'}.")" );
 342                 $lint->clear_errors();
 343             }
 344         }
 345     }
 346
 347     # check for missing images / css or js
 348     if($page->{'content_type'} =~ 'text\/html'
 349        and (!defined $test->{'skip_html_links'} or $test->{'skip_html_links'} == 0)
 350       ) {
 351         my $content = $page->{'content'};
 352         $content =~ s/<\!\-\-.*?\-\->//gsmx;
 353         my @matches = $content =~ m/(src|href)=['|"](.+?)['|"]/gi;
 354         my $links_to_check;
 355         my $x=0;
 356         for my $match (@matches) {
 357             $x++;
 358             next if $x%2==1;
 359             next if $match =~ m/^http/;
 360             next if $match =~ m/^mailto:/;
 361             next if $match =~ m/^#/;
 362             next if $match =~ m/^javascript:/;
 363             next if $match =~ m/internal&srv=runtime/;
 364             if(defined $test->{'skip_link_check'}) {
 365                 my $skip = 0;
 366                 for my $expr (ref $test->{'skip_link_check'} eq 'ARRAY' ? @{$test->{'skip_link_check'}} : $test->{'skip_link_check'} ) {
 367                     if($skip == 0 and $match =~ m/$expr/) {
 368                         $skip = 1;
 369                     }
 370                 }
 371                 next if $skip == 1;
 372             }
 373             $links_to_check->{$match} = 1;
 374         }
 375         my $errors = 0;
 376         for my $test_url (keys %{$links_to_check}) {
 377             $test_url = _get_url($test->{'url'}, $test_url);
 378             our $already_checked;
 379             $already_checked = {} unless defined $already_checked;
 380             next if defined $already_checked->{$test_url};
 381             #diag("checking link: ".$test_url);
 382             my $req = _request({url => $test_url, auth => $test->{'auth'}});
 383             if($req->{'response'}->is_redirect) {
 384                 my $redirects = 0;
 385                 while(my $location = $req->{'response'}->{'_headers'}->{'location'}) {
 386                     if($location !~ m/^(http|\/)/gmx) { $location = _relative_url($location, $req->{'response'}->base()->as_string()); }
 387                     $req= _request($location);
 388                     $redirects++;
 389                     last if $redirects > 10;
 390                 }
 391             }
 392             if($req->{'code'} == 200) {
 393                 $already_checked->{$test_url} = 1;
 394             } else {
 395                 $errors++;
 396                 diag("got status ".$req->{'code'}." for url: '$test_url'");
 397                 diag(Dumper($req));
 398                 my $tmp_test = { 'url' => $test_url };
 399                 _diag_request($tmp_test, $req);
 400                 TestUtils::bail_out_clean("error in url '$test_url' linked from '".$test->{'url'}."'");
 401             }
 402         }
 403         is( $errors, 0, 'All stylesheets, images and javascript exist' );
 404     }
 405     return $page;
 406 }
 407
 408 ##################################################
 409
 410 =head2 config
 411
 412   return config value
 413
 414 =cut
 415 sub config {
 416     my $key = shift;
 417     our $config;
 418     return $config->{$key} if defined $config;
 419
 420     my $conf_file = "/omd/versions/default/share/omd/distro.info";
 421     $config = read_config($conf_file);
 422
 423     return $config->{$key};
 424 }
 425
 426
 427 ##################################################
 428
 429 =head2 read_config
 430
 431   return config from file
 432
 433 =cut
 434 sub read_config {
 435     my $conf_file = shift;
 436
 437     my $config = {};
 438     open(my $fh, '<', $conf_file) or carp("cannot open $conf_file: $!");
 439     while(<$fh>) {
 440         my $line = $_;
 441         chomp($line);
 442         next if $line =~ m/^\s*(#|$)/;
 443         $line =~ s/\s*#.*$//;
 444         my $append = 0;
 445         my($key,$value) = split/\s+\+=\s*/,$line,2;
 446         if(defined $value) {
 447             $append = 1;
 448         } else {
 449             ($key,$value) = split/\s+=\s*/,$line,2;
 450         }
 451         $key   =~ s/^\s+//;
 452         $value =~ s/\s+$// if defined $value;
 453         if($append) {
 454             $config->{$key} .= " ".$value;
 455         } else {
 456             $config->{$key} = $value;
 457         }
 458     }
 459     close($fh);
 460     return $config;
 461 }
 462
 463
 464
 465 ##################################################
 466
 467 =head2 config
 468
 469   return config value
 470
 471 =cut
 472 sub wait_for_file {
 473     my $file    = shift;
 474     my $timeout = shift || 120;
 475
 476     my $testfile = glob($file);
 477     $file = $testfile if defined $testfile;
 478
 479     my $x = 0;
 480     if(-e $file) {
 481         pass("file: $file does already exist");
 482         return 1;
 483     }
 484     while($x < $timeout) {
 485         if(-e $file) {
 486             pass("file: $file appeared after $x seconds");
 487             return 1;
 488         }
 489         $x++;
 490         sleep(1);
 491     }
 492     fail("file: $file did not appear within $x seconds");
 493     return 0;
 494 }
 495
 496
 497 ##################################################
 498
 499 =head2 wait_for_content
 500
 501   waits for web page content until timeout
 502
 503   needs test hash
 504   {
 505     url            => url to request
 506     auth           => authentication (realm:user:pass)
 507     code           => expected response code
 508     like           => (list of) regular expressions which have to match content
 509   }
 510
 511 =cut
 512 sub wait_for_content {
 513     my $test    = shift;
 514     my $timeout = shift || 120;
 515
 516     my $req;
 517     my $x = 0;
 518     while ($x < $timeout) {
 519         $req = _request($test);
 520         if($req->{'code'} == 200) {
 521             #diag("code:$req->{code} url:$test->{url} auth:$test->{auth}");
 522             my $errors=0;
 523             for my $pattern (@{$test->{'like'}}) {
 524                 if ($req->{'content'}!~/$pattern/) {
 525                     #diag("errors:$errors pattern:$pattern");
 526                     $errors++;
 527                 }
 528             }
 529             if ($errors == 0) {
 530                 pass(sprintf "content: [ %s ] appeared after $x seconds", join(',',@{$test->{'like'}}));
 531                 return 1;
 532             }
 533         } else {
 534             diag("Error searching for web content:\ncode:$req->{code}\nurl:$test->{url}\nauth:$test->{auth}\ncontent:$req->{content}");
 535         }
 536         $x++;
 537         sleep(1);
 538     }
 539     fail(sprintf "content: [ %s ] did not appear within $x seconds", join(',',@{$test->{'like'}}));
 540     return 0;
 541 }
 542
 543
 544 ##################################################
 545
 546 =head2 prepare_obj_config
 547
 548   prepare test object config
 549
 550 =cut
 551 sub prepare_obj_config {
 552     my $src  = shift;
 553     my $dst  = shift;
 554     my $site = shift;
 555
 556     my $files = join(" ", (ref $src eq 'ARRAY' ? @{$src} : $src));
 557     for my $file (`find $files -type f`) {
 558         chomp($file);
 559         my $dstfile = $dst;
 560         if(-d $dst) { $dstfile = $dst.'/'.basename($file); }
 561         cp($file, $dstfile) or die("copy $file $dstfile failed: $!");
 562         test_command({ cmd => "/usr/bin/env sed -i $dstfile -e 's/###SITE###/".$site."/' -e 's|###ROOT###|/omd/sites/".$site."|'" }) if defined $site;
 563     }
 564
 565     return;
 566 }
 567
 568
 569 ##################################################
 570
 571 =head2 bail_out_clean
 572
 573   bail out from testing but some minor cleanup before
 574
 575 =cut
 576 sub bail_out_clean {
 577     my $msg = shift;
 578
 579     carp("cleaning up before bailout");
 580
 581     my $omd_bin = get_omd_bin();
 582     for my $site (qw/testsite testsite2 testsite3/) {
 583         test_command({ cmd => $omd_bin." rm $site", stdin => "yes\n", 'exit' => undef, errlike => undef });
 584     }
 585
 586     BAIL_OUT($msg);
 587     return;
 588 }
 589
 590 ##################################################
 591
 592 =head2 _diag_lint_errors_and_remove_some_exceptions
 593
 594   removes some lint errors we want to ignore
 595
 596 =cut
 597 sub _diag_lint_errors_and_remove_some_exceptions {
 598     my $lint = shift;
 599     my @return;
 600     LINT_ERROR: for my $error ( $lint->errors ) {
 601         my $err_str = $error->as_string;
 602         for my $exclude_pattern (
 603             "<IMG SRC=[^>]*>\ tag\ has\ no\ HEIGHT\ and\ WIDTH\ attributes",
 604             "<IMG SRC=[^>]*>\ does\ not\ have\ ALT\ text\ defined",
 605             "<input>\ is\ not\ a\ container\ \-\-\ <\/input>\ is\ not\ allowed",
 606             "Unknown attribute \"start\" for tag <div>",
 607             "Unknown attribute \"end\" for tag <div>",
 608             "for tag <meta>",
 609             "Unknown\ attribute\ \"placeholder\"\ for\ tag\ <input>",
 610         ) {
 611             next LINT_ERROR if($err_str =~ m/$exclude_pattern/i);
 612         }
 613         diag($error->as_string."\n");
 614         push @return, $error;
 615     }
 616     return @return;
 617 }
 618
 619
 620 ##################################################
 621
 622 =head2 _request
 623
 624   returns a page
 625
 626   expects a hash
 627   {
 628     url     => url to request
 629     auth    => authentication (realm:user:pass)
 630   }
 631
 632 =cut
 633 sub _request {
 634     my $data = shift;
 635
 636     my $return = {};
 637     our $cookie_jar;
 638
 639     if(!defined $cookie_jar) {
 640         my($fh, $cookie_file) = tempfile(undef, UNLINK => 1);
 641         unlink ($cookie_file);
 642         $cookie_jar = HTTP::Cookies::Netscape->new(
 643                                        file     => $cookie_file,
 644                                        autosave => 1,
 645                                        );
 646     }
 647
 648     my $ua = LWP::UserAgent->new;
 649     $ua->timeout(30);
 650     $ua->env_proxy;
 651     $ua->cookie_jar($cookie_jar);
 652
 653     if(defined $data->{'auth'}) {
 654         $data->{'url'} =~ m/(http|https):\/\/(.*?)(\/|:\d+)/;
 655         my $netloc = $2;
 656         my $port   = $3;
 657         if(defined $port and $port =~ m/^:(\d+)/) { $port = $1; } else { $port = 80; }
 658         my($realm,$user,$pass) = split(/:/, $data->{'auth'}, 3);
 659         $ua->credentials($netloc.":".$port, $realm, $user, $pass);
 660     }
 661
 662     my $response;
 663     if(defined $data->{'post'}) {
 664         $response = $ua->post($data->{'url'}, $data->{'post'});
 665     } else {
 666         $response = $ua->get($data->{'url'});
 667     }
 668
 669     $return->{'response'}     = $response;
 670     $return->{'code'}         = $response->code;
 671     $return->{'content'}      = $response->decoded_content;
 672     $return->{'content_type'} = $response->header('Content-Type');
 673
 674     return($return);
 675 }
 676
 677
 678 ##################################################
 679
 680 =head2 _get_url
 681
 682   returns a absolute url
 683
 684   expects
 685   $VAR1 = origin url
 686   $VAR2 = target link
 687
 688 =cut
 689 sub _get_url {
 690     my $url  = shift;
 691     my $link = shift;
 692     my $newurl;
 693
 694     # split original url in host, path and file
 695     if($url =~ m/^(http|https):\/\/([^\/]*)(|\/|:\d+)(.*?)$/) {
 696         my $host     = $1."://".$2.$3;
 697         $host        =~ s/\/$//;      # remove last /
 698         my $fullpath = $4 || '';
 699         $fullpath    =~ s/\?.*$//;
 700         $fullpath    =~ s/^\///;
 701         my($path,$file) = ('', '');
 702         if($fullpath =~ m/^(.+)\/(.*)$/) {
 703             $path = $1;
 704             $file = $2;
 705         }
 706         else {
 707             $file = $fullpath;
 708         }
 709         $path =~ s/^\///; # remove first /
 710
 711         if($link =~ m/^(http|https):\/\//) {
 712             return $link;
 713         }
 714         elsif($link =~ m/^\//) { # absolute link
 715             return $host.$link;
 716         }
 717         elsif($path eq '') {
 718             return $host."/".$link;
 719         } else {
 720             return $host."/".$path."/".$link;
 721         }
 722     }
 723     else {
 724         TestUtils::bail_out_clean("unknown url scheme in _get_url: '".$url."'");
 725     }
 726
 727     return $newurl;
 728 }
 729
 730
 731 ##################################################
 732
 733 =head2 _clean_stderr
 734
 735   remove some know errors from stderr
 736
 737 =cut
 738 sub _clean_stderr {
 739     my $text = shift || '';
 740     $text =~ s/[\w\-]+: Could not reliably determine the server's fully qualified domain name, using .*? for ServerName//g;
 741     $text =~ s/\[warn\] module \w+ is already loaded, skipping//g;
 742     $text =~ s/Syntax OK//g;
 743     $text =~ s/no crontab for \w+//g;
 744     return $text;
 745 }
 746
 747 ##################################################
 748
 749 =head2 _diag_cmd
 750
 751   print diagnostic output for failed commands
 752
 753 =cut
 754 sub _diag_cmd {
 755     my $test = shift;
 756     my $cmd  = shift;
 757     my $stdout = $cmd->stdout || '';
 758     my $stderr = $cmd->stderr || '';
 759     diag("\ncmd: '".$test->{'cmd'}."' failed\n");
 760     diag("stdout: ".$stdout."\n");
 761     diag("stderr: ".$stderr."\n");
 762
 763     # check logfiles on apache errors
 764     if(   $stdout =~ m/Starting dedicated Apache for site (\w+)[\.\ ]*ERROR/
 765        or $stdout =~ m/500 Internal Server Error/) {
 766         my $site = $1;
 767         _tail("apache logs:", "/omd/sites/$site/var/log/apache/error_log") if defined $site;
 768         _tail_apache_logs();
 769     }
 770     if( $stderr =~ m/User '(\w+)' still logged in or running processes/ ) {
 771         my $site = $1;
 772         diag("ps: ".`ps -fu $site`) if $site;
 773     }
 774     return;
 775 }
 776
 777 ##################################################
 778
 779 =head2 _diag_request
 780
 781   print diagnostic output for failed requests
 782
 783 =cut
 784 sub _diag_request {
 785     my $test  = shift;
 786     my $page  = shift;
 787
 788     diag(Dumper($page->{'response'}));
 789
 790     $test->{'url'} =~ m/localhost\/(\w+)\//;
 791     my $site = $1;
 792     return unless defined $site;
 793
 794     # check logfiles on apache errors
 795     _tail("apache logs:", "/omd/sites/$site/var/log/apache/error_log");
 796     _tail_apache_logs();
 797     _tail("thruk logs:", "/omd/sites/$site/var/log/thruk.log") if $test->{'url'} =~ m/\/thruk\//;
 798
 799     return;
 800 }
 801
 802 ##################################################
 803
 804 =head2 _tail
 805
 806   print tail of fail
 807
 808 =cut
 809 sub _tail {
 810     my $name = shift;
 811     my $file = shift;
 812     return unless defined $file;
 813     diag($name);
 814     if(-f $file) {
 815         diag(`tail -n100 $file`);
 816     } else {
 817         diag("cannot read $file: $!");
 818     }
 819     return;
 820 }
 821
 822
 823 ##################################################
 824
 825 =head2 _tail_apache_logs
 826
 827   print tail of all apache logs
 828
 829 =cut
 830 sub _tail_apache_logs {
 831     _tail("global apache logs:", glob('/var/log/apache*/error*log'));
 832     _tail("global apache logs:", glob('/var/log/httpd*/error*log'));
 833     return;
 834 }
 835
 836 ##################################################
 837
 838 END {
 839     if(defined $omd_symlink_created and $omd_symlink_created == 1) {
 840         unlink('/omd');
 841     }
 842 };
 843
 844 1;
 845
 846 __END__