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     # kill all processes, sometimes checks are still running and prevent us from removing the site
 252     test_command({ cmd => "/usr/bin/pkill -2 -U $site; sleep 1;".TestUtils::get_omd_bin()." rm $site", stdin => "yes\n" });
 253     return;
 254 }
 255
 256
 257 ##################################################
 258
 259 =head2 test_url
 260
 261   test a url
 262
 263   needs test hash
 264   {
 265     url              => url to request
 266     auth             => authentication (realm:user:pass)
 267     code             => expected response code
 268     like             => (list of) regular expressions which have to match content
 269     unlike           => (list of) regular expressions which must not match content
 270     skip_html_lint   => flag to disable the html lint checking
 271     skip_link_check  => (list of) regular expressions to skip the link checks for
 272     waitfor          => wait till regex occurs (max 120sec)
 273   }
 274
 275 =cut
 276 sub test_url {
 277     my $test = shift;
 278
 279     my $start = time();
 280     my $page  = _request($test);
 281
 282     # wait for something?
 283     if(defined $test->{'waitfor'}) {
 284         my $now = time();
 285         my $waitfor = $test->{'waitfor'};
 286         my $found   = 0;
 287         while($now < $start + 120) {
 288             if($page->{'content'} =~ m/$waitfor/mx) {
 289                 ok(1, "content ".$waitfor." found after ".($now - $start)."seconds");
 290                 $found = 1;
 291                 last;
 292             }
 293             sleep(1);
 294             $now = time();
 295             $page = _request($test);
 296         }
 297         fail("content did not occur within 120 seconds") unless $found;
 298         return $page;
 299     }
 300
 301     # response code?
 302     $test->{'code'} = 200 unless exists $test->{'code'};
 303     if(defined $test->{'code'}) {
 304         is($page->{'code'}, $test->{'code'}, "response code for ".$test->{'url'}." is: ".$test->{'code'}) or _diag_request($test, $page);
 305     }
 306
 307     # content type?
 308     if(defined $test->{'content_type'}) {
 309         is($page->{'content_type'}, $test->{'content_type'}, 'Content-Type is: '.$test->{'content_type'});
 310     }
 311
 312     # matches output?
 313     if(defined $test->{'like'}) {
 314         defined $page->{'content'} or _diag_request($test, $page);
 315         for my $expr (ref $test->{'like'} eq 'ARRAY' ? @{$test->{'like'}} : $test->{'like'} ) {
 316             like($page->{'content'}, $expr, "content like ".$expr);
 317         }
 318     }
 319
 320     # not matching output
 321     if(defined $test->{'unlike'}) {
 322         for my $expr (ref $test->{'unlike'} eq 'ARRAY' ? @{$test->{'unlike'}} : $test->{'unlike'} ) {
 323             unlike($page->{'content'}, $expr, "content unlike ".$expr)  or _diag_request($test, $page);
 324         }
 325     }
 326
 327     # html valitidy
 328     SKIP: {
 329         if($page->{'content_type'} =~ 'text\/html') {
 330             unless(defined $test->{'skip_html_lint'} && $test->{'skip_html_lint'} == 1) {
 331                 if($use_html_lint == 0) {
 332                     skip "no HTML::Lint installed", 2;
 333                 }
 334                 if($page->{'content'} =~ /^\[.*\]$/mx || $page->{'content'} =~ /^\{.*\}$/mx) {
 335                     skip "no lint check for json data", 2;
 336                 }
 337                 if($ENV{LINTSKIPPATTERN} && $test->{'url'} =~ m|/$ENV{LINTSKIPPATTERN}/|mx) {
 338                     skip "lint check skipped by LINTSKIPPATTERN: ".$ENV{LINTSKIPPATTERN}, 2;
 339                 }
 340                 my $lint = new HTML::Lint;
 341                 isa_ok( $lint, "HTML::Lint" );
 342
 343                 $lint->parse($page->{'content'});
 344                 my @errors = $lint->errors;
 345                 @errors = _diag_lint_errors_and_remove_some_exceptions($lint);
 346                 is( scalar @errors, 0, "No errors found in HTML (".$test->{'url'}.")" );
 347                 $lint->clear_errors();
 348             }
 349         }
 350     }
 351
 352     # check for missing images / css or js
 353     if($page->{'content_type'} =~ 'text\/html'
 354        and (!defined $test->{'skip_html_links'} or $test->{'skip_html_links'} == 0)
 355       ) {
 356         my $content = $page->{'content'};
 357         $content =~ s/<\!\-\-.*?\-\->//gsmx;
 358         my @matches = $content =~ m/(src|href)=['|"](.+?)['|"]/gi;
 359         my $links_to_check;
 360         my $x=0;
 361         for my $match (@matches) {
 362             $x++;
 363             next if $x%2==1;
 364             next if $match =~ m/^http/;
 365             next if $match =~ m/^mailto:/;
 366             next if $match =~ m/^#/;
 367             next if $match =~ m/^javascript:/;
 368             next if $match =~ m/internal&srv=runtime/;
 369             next if $match =~ m/this\./;
 370             if(defined $test->{'skip_link_check'}) {
 371                 my $skip = 0;
 372                 for my $expr (ref $test->{'skip_link_check'} eq 'ARRAY' ? @{$test->{'skip_link_check'}} : $test->{'skip_link_check'} ) {
 373                     if($skip == 0 and $match =~ m/$expr/) {
 374                         $skip = 1;
 375                     }
 376                 }
 377                 next if $skip == 1;
 378             }
 379             $links_to_check->{$match} = 1;
 380         }
 381         my $errors = 0;
 382         for my $test_url (keys %{$links_to_check}) {
 383             $test_url = _get_url($test->{'url'}, $test_url);
 384             our $already_checked;
 385             $already_checked = {} unless defined $already_checked;
 386             next if defined $already_checked->{$test_url};
 387             #diag("checking link: ".$test_url);
 388             my $req = _request({url => $test_url, auth => $test->{'auth'}});
 389             if($req->{'response'}->is_redirect) {
 390                 my $redirects = 0;
 391                 while(my $location = $req->{'response'}->{'_headers'}->{'location'}) {
 392                     if($location !~ m/^(http|\/)/gmx) { $location = _relative_url($location, $req->{'response'}->base()->as_string()); }
 393                     $req= _request($location);
 394                     $redirects++;
 395                     last if $redirects > 10;
 396                 }
 397             }
 398             if($req->{'code'} == 200) {
 399                 $already_checked->{$test_url} = 1;
 400             } else {
 401                 $errors++;
 402                 diag("got status ".$req->{'code'}." for url: '$test_url'");
 403                 diag(Dumper($req));
 404                 my $tmp_test = { 'url' => $test_url };
 405                 _diag_request($tmp_test, $req);
 406                 TestUtils::bail_out_clean("error in url '$test_url' linked from '".$test->{'url'}."'");
 407             }
 408         }
 409         is( $errors, 0, 'All stylesheets, images and javascript exist' );
 410     }
 411     return $page;
 412 }
 413
 414 ##################################################
 415
 416 =head2 config
 417
 418   return config value
 419
 420 =cut
 421 sub config {
 422     my $key = shift;
 423     our $config;
 424     return $config->{$key} if defined $config;
 425
 426     my $conf_file = "/omd/versions/default/share/omd/distro.info";
 427     $config = read_config($conf_file);
 428
 429     return $config->{$key};
 430 }
 431
 432
 433 ##################################################
 434
 435 =head2 read_config
 436
 437   return config from file
 438
 439 =cut
 440 sub read_config {
 441     my $conf_file = shift;
 442
 443     my $config = {};
 444     open(my $fh, '<', $conf_file) or carp("cannot open $conf_file: $!");
 445     while(<$fh>) {
 446         my $line = $_;
 447         chomp($line);
 448         next if $line =~ m/^\s*(#|$)/;
 449         $line =~ s/\s*#.*$//;
 450         my $append = 0;
 451         my($key,$value) = split/\s+\+=\s*/,$line,2;
 452         if(defined $value) {
 453             $append = 1;
 454         } else {
 455             ($key,$value) = split/\s+=\s*/,$line,2;
 456         }
 457         $key   =~ s/^\s+//;
 458         $value =~ s/\s+$// if defined $value;
 459         if($append) {
 460             $config->{$key} .= " ".$value;
 461         } else {
 462             $config->{$key} = $value;
 463         }
 464     }
 465     close($fh);
 466     return $config;
 467 }
 468
 469
 470
 471 ##################################################
 472
 473 =head2 config
 474
 475   return config value
 476
 477 =cut
 478 sub wait_for_file {
 479     my $file    = shift;
 480     my $timeout = shift || 120;
 481
 482     my $testfile = glob($file);
 483     $file = $testfile if defined $testfile;
 484
 485     my $x = 0;
 486     if(-e $file) {
 487         pass("file: $file does already exist");
 488         return 1;
 489     }
 490     while($x < $timeout) {
 491         if(-e $file) {
 492             pass("file: $file appeared after $x seconds");
 493             return 1;
 494         }
 495         $x++;
 496         sleep(1);
 497     }
 498     fail("file: $file did not appear within $x seconds");
 499     return 0;
 500 }
 501
 502
 503 ##################################################
 504
 505 =head2 wait_for_content
 506
 507   waits for web page content until timeout
 508
 509   needs test hash
 510   {
 511     url            => url to request
 512     auth           => authentication (realm:user:pass)
 513     code           => expected response code
 514     like           => (list of) regular expressions which have to match content
 515   }
 516
 517 =cut
 518 sub wait_for_content {
 519     my $test    = shift;
 520     my $timeout = shift || 120;
 521
 522     my $req;
 523     my $x = 0;
 524     while ($x < $timeout) {
 525         $req = _request($test);
 526         if($req->{'code'} == 200) {
 527             #diag("code:$req->{code} url:$test->{url} auth:$test->{auth}");
 528             my $errors=0;
 529             for my $pattern (@{$test->{'like'}}) {
 530                 if ($req->{'content'}!~/$pattern/) {
 531                     #diag("errors:$errors pattern:$pattern");
 532                     $errors++;
 533                 }
 534             }
 535             if ($errors == 0) {
 536                 pass(sprintf "content: [ %s ] appeared after $x seconds", join(',',@{$test->{'like'}}));
 537                 return 1;
 538             }
 539         } else {
 540             diag("Error searching for web content:\ncode:$req->{code}\nurl:$test->{url}\nauth:$test->{auth}\ncontent:$req->{content}");
 541         }
 542         $x++;
 543         sleep(1);
 544     }
 545     fail(sprintf "content: [ %s ] did not appear within $x seconds", join(',',@{$test->{'like'}}));
 546     return 0;
 547 }
 548
 549
 550 ##################################################
 551
 552 =head2 prepare_obj_config
 553
 554   prepare test object config
 555
 556 =cut
 557 sub prepare_obj_config {
 558     my $src  = shift;
 559     my $dst  = shift;
 560     my $site = shift;
 561
 562     my $files = join(" ", (ref $src eq 'ARRAY' ? @{$src} : $src));
 563     for my $file (`find $files -type f`) {
 564         chomp($file);
 565         my $dstfile = $dst;
 566         if(-d $dst) { $dstfile = $dst.'/'.basename($file); }
 567         cp($file, $dstfile) or die("copy $file $dstfile failed: $!");
 568         test_command({ cmd => "/usr/bin/env sed -i $dstfile -e 's/###SITE###/".$site."/' -e 's|###ROOT###|/omd/sites/".$site."|'" }) if defined $site;
 569     }
 570
 571     return;
 572 }
 573
 574
 575 ##################################################
 576
 577 =head2 bail_out_clean
 578
 579   bail out from testing but some minor cleanup before
 580
 581 =cut
 582 sub bail_out_clean {
 583     my $msg = shift;
 584
 585     carp("cleaning up before bailout");
 586
 587     my $omd_bin = get_omd_bin();
 588     for my $site (qw/testsite testsite2 testsite3/) {
 589         test_command({ cmd => $omd_bin." rm $site", stdin => "yes\n", 'exit' => undef, errlike => undef });
 590     }
 591
 592     BAIL_OUT($msg);
 593     return;
 594 }
 595
 596 ##################################################
 597
 598 =head2 _diag_lint_errors_and_remove_some_exceptions
 599
 600   removes some lint errors we want to ignore
 601
 602 =cut
 603 sub _diag_lint_errors_and_remove_some_exceptions {
 604     my $lint = shift;
 605     my @return;
 606     LINT_ERROR: for my $error ( $lint->errors ) {
 607         my $err_str = $error->as_string;
 608         for my $exclude_pattern (
 609             "<IMG SRC=[^>]*>\ tag\ has\ no\ HEIGHT\ and\ WIDTH\ attributes",
 610             "<IMG SRC=[^>]*>\ does\ not\ have\ ALT\ text\ defined",
 611             "<input>\ is\ not\ a\ container\ \-\-\ <\/input>\ is\ not\ allowed",
 612             "Unknown attribute \"start\" for tag <div>",
 613             "Unknown attribute \"end\" for tag <div>",
 614             "for tag <meta>",
 615             "Unknown\ attribute\ \"placeholder\"\ for\ tag\ <input>",
 616             "Unknown\ attribute\ \"autocomplete\"\ for\ tag\ <form>",
 617             "Unknown\ attribute\ \"autocomplete\"\ for\ tag\ <input>",
 618         ) {
 619             next LINT_ERROR if($err_str =~ m/$exclude_pattern/i);
 620         }
 621         diag($error->as_string."\n");
 622         push @return, $error;
 623     }
 624     return @return;
 625 }
 626
 627
 628 ##################################################
 629
 630 =head2 _request
 631
 632   returns a page
 633
 634   expects a hash
 635   {
 636     url     => url to request
 637     auth    => authentication (realm:user:pass)
 638   }
 639
 640 =cut
 641 sub _request {
 642     my $data = shift;
 643
 644     my $return = {};
 645     our($fh, $cookie_jar, $cookie_file);
 646
 647     if(!defined $cookie_jar) {
 648         ($fh, $cookie_file) = tempfile();
 649         unlink ($cookie_file);
 650         $cookie_jar = HTTP::Cookies::Netscape->new(
 651                                        file     => $cookie_file,
 652                                        autosave => 1,
 653                                        );
 654     }
 655
 656     my $ua = LWP::UserAgent->new(
 657         keep_alive   => 1,
 658         max_redirect => 10,
 659         timeout      => 60,
 660         requests_redirectable => ['GET', 'POST'],
 661     );
 662     $ua->timeout(60);
 663     $ua->env_proxy;
 664     $ua->cookie_jar($cookie_jar);
 665
 666     if(defined $data->{'auth'}) {
 667         $data->{'url'} =~ m/(http|https):\/\/(.*?)(\/|:\d+)/;
 668         my $netloc = $2;
 669         my $port   = $3;
 670         if(defined $port and $port =~ m/^:(\d+)/) { $port = $1; } else { $port = 80; }
 671         my($realm,$user,$pass) = split(/:/, $data->{'auth'}, 3);
 672         $ua->credentials($netloc.":".$port, $realm, $user, $pass);
 673     }
 674
 675     my $response;
 676     if(defined $data->{'post'}) {
 677         $response = $ua->post($data->{'url'}, $data->{'post'});
 678     } else {
 679         $response = $ua->get($data->{'url'});
 680     }
 681
 682     $return->{'response'}     = $response;
 683     $return->{'code'}         = $response->code;
 684     $return->{'content'}      = $response->decoded_content || $response->content;
 685     $return->{'content_type'} = $response->header('Content-Type');
 686
 687     return($return);
 688 }
 689
 690
 691 ##################################################
 692
 693 =head2 _get_url
 694
 695   returns a absolute url
 696
 697   expects
 698   $VAR1 = origin url
 699   $VAR2 = target link
 700
 701 =cut
 702 sub _get_url {
 703     my $url  = shift;
 704     my $link = shift;
 705     my $newurl;
 706
 707     # split original url in host, path and file
 708     if($url =~ m/^(http|https):\/\/([^\/]*)(|\/|:\d+)(.*?)$/) {
 709         my $host     = $1."://".$2.$3;
 710         $host        =~ s/\/$//;      # remove last /
 711         my $fullpath = $4 || '';
 712         $fullpath    =~ s/\?.*$//;
 713         $fullpath    =~ s/^\///;
 714         my($path,$file) = ('', '');
 715         if($fullpath =~ m/^(.+)\/(.*)$/) {
 716             $path = $1;
 717             $file = $2;
 718         }
 719         else {
 720             $file = $fullpath;
 721         }
 722         $path =~ s/^\///; # remove first /
 723
 724         if($link =~ m/^(http|https):\/\//) {
 725             return $link;
 726         }
 727         elsif($link =~ m/^\//) { # absolute link
 728             return $host.$link;
 729         }
 730         elsif($path eq '') {
 731             return $host."/".$link;
 732         } else {
 733             return $host."/".$path."/".$link;
 734         }
 735     }
 736     else {
 737         TestUtils::bail_out_clean("unknown url scheme in _get_url: '".$url."'");
 738     }
 739
 740     return $newurl;
 741 }
 742
 743
 744 ##################################################
 745
 746 =head2 _clean_stderr
 747
 748   remove some know errors from stderr
 749
 750 =cut
 751 sub _clean_stderr {
 752     my $text = shift || '';
 753     $text =~ s/[\w\-]+: Could not reliably determine the server's fully qualified domain name, using .*? for ServerName//g;
 754     $text =~ s/\[warn\] module \w+ is already loaded, skipping//g;
 755     $text =~ s/Syntax OK//g;
 756     $text =~ s/no crontab for \w+//g;
 757     return $text;
 758 }
 759
 760 ##################################################
 761
 762 =head2 _diag_cmd
 763
 764   print diagnostic output for failed commands
 765
 766 =cut
 767 sub _diag_cmd {
 768     my $test = shift;
 769     my $cmd  = shift;
 770     my $stdout = $cmd->stdout || '';
 771     my $stderr = $cmd->stderr || '';
 772     diag("\ncmd: '".$test->{'cmd'}."' failed\n");
 773     diag("stdout: ".$stdout."\n");
 774     diag("stderr: ".$stderr."\n");
 775
 776     # check logfiles on apache errors
 777     if(   $stdout =~ m/Starting dedicated Apache for site (\w+)[\.\ ]*ERROR/
 778        or $stdout =~ m/500 Internal Server Error/) {
 779         my $site = $1;
 780         _tail("apache logs:", "/omd/sites/$site/var/log/apache/error_log") if defined $site;
 781         _tail_apache_logs();
 782     }
 783     if( $stderr =~ m/User '(\w+)' still logged in or running processes/ ) {
 784         my $site = $1;
 785         diag("ps: ".`ps -fu $site`) if $site;
 786     }
 787     return;
 788 }
 789
 790 ##################################################
 791
 792 =head2 _diag_request
 793
 794   print diagnostic output for failed requests
 795
 796 =cut
 797 sub _diag_request {
 798     my $test  = shift;
 799     my $page  = shift;
 800
 801     diag(Dumper($page->{'response'}));
 802
 803     $test->{'url'} =~ m/localhost\/(\w+)\//;
 804     my $site = $1;
 805     return unless defined $site;
 806
 807     # check logfiles on apache errors
 808     _tail("apache logs:", "/omd/sites/$site/var/log/apache/error_log");
 809     _tail_apache_logs();
 810     _tail("thruk logs:", "/omd/sites/$site/var/log/thruk.log") if $test->{'url'} =~ m/\/thruk\//;
 811
 812     return;
 813 }
 814
 815 ##################################################
 816
 817 =head2 _tail
 818
 819   print tail of fail
 820
 821 =cut
 822 sub _tail {
 823     my $name = shift;
 824     my $file = shift;
 825     return unless defined $file;
 826     diag($name);
 827     if(-f $file) {
 828         diag(`tail -n100 $file`);
 829     } else {
 830         diag("cannot read $file: $!");
 831     }
 832     return;
 833 }
 834
 835
 836 ##################################################
 837
 838 =head2 _tail_apache_logs
 839
 840   print tail of all apache logs
 841
 842 =cut
 843 sub _tail_apache_logs {
 844     _tail("global apache logs:", glob('/var/log/apache*/error*log'));
 845     _tail("global apache logs:", glob('/var/log/httpd*/error*log'));
 846     return;
 847 }
 848
 849 ##################################################
 850
 851 =head2 restart_system_apache
 852
 853   restart system apache
 854
 855 =cut
 856 sub restart_system_apache {
 857     my $name  = TestUtils::config('APACHE_INIT_NAME');
 858     my $init  = TestUtils::config('INIT_CMD');
 859     my $cmd   = $init;
 860     $cmd      =~ s/\Q%(name)s\E/$name/mx;
 861     my $stop  = $cmd;
 862     $stop     =~ s/\Q%(action)s\E/stop/mx;
 863     my $start = $cmd;
 864     $start    =~ s/\Q%(action)s\E/start/mx;
 865     $cmd      = $stop.'; sleep 3; '.$start;
 866     TestUtils::test_command({ cmd => $cmd });
 867 }
 868
 869 ##################################################
 870
 871 END {
 872     our($cookie_file);
 873     unlink($cookie_file) if $cookie_file;
 874     if(defined $omd_symlink_created and $omd_symlink_created == 1) {
 875         unlink('/omd');
 876     }
 877 };
 878
 879 1;
 880
 881 __END__