BugsSite/testserver.pl

   1 #!/usr/bin/env perl -w
   2 # -*- Mode: perl; indent-tabs-mode: nil -*-
   3 #
   4 # The contents of this file are subject to the Mozilla Public
   5 # License Version 1.1 (the "License"); you may not use this file
   6 # except in compliance with the License. You may obtain a copy of
   7 # the License at http://www.mozilla.org/MPL/
   8 #
   9 # Software distributed under the License is distributed on an "AS
  10 # IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
  11 # implied. See the License for the specific language governing
  12 # rights and limitations under the License.
  13 #
  14 # Contributor(s): Joel Peshkin <bugreport@peshkin.net>
  15 #                 Byron Jones <byron@glob.com.au>
  16
  17 # testserver.pl is invoked with the baseurl of the Bugzilla installation
  18 # as its only argument.  It attempts to troubleshoot as many installation
  19 # issues as possible.
  20
  21 use strict;
  22 use lib qw(. lib);
  23
  24 BEGIN {
  25     my $envpath = $ENV{'PATH'};
  26     require Bugzilla;
  27     # $ENV{'PATH'} is required by the 'ps' command to run correctly.
  28     $ENV{'PATH'} = $envpath;
  29 }
  30
  31 use Bugzilla::Constants;
  32
  33 use Socket;
  34
  35 my $datadir = bz_locations()->{'datadir'};
  36
  37 eval "require LWP; require LWP::UserAgent;";
  38 my $lwp = $@ ? 0 : 1;
  39
  40 if ((@ARGV != 1) || ($ARGV[0] !~ /^https?:/))
  41 {
  42     print "Usage: $0 <URL to this Bugzilla installation>\n";
  43     print "e.g.:  $0 http://www.mycompany.com/bugzilla\n";
  44     exit(1);
  45 }
  46
  47
  48 # Try to determine the GID used by the web server.
  49 my @pscmds = ('ps -eo comm,gid', 'ps -acxo command,gid', 'ps -acxo command,rgid');
  50 my $sgid = 0;
  51 if ($^O !~ /MSWin32/i) {
  52     foreach my $pscmd (@pscmds) {
  53         open PH, "$pscmd 2>/dev/null |";
  54         while (my $line = <PH>) {
  55             if ($line =~ /^(?:\S*\/)?(?:httpd|apache)2?\s+(\d+)$/) {
  56                 $sgid = $1 if $1 > $sgid;
  57             }
  58         }
  59         close(PH);
  60     }
  61 }
  62
  63 # Determine the numeric GID of $webservergroup
  64 my $webgroupnum = 0;
  65 my $webservergroup = Bugzilla->localconfig->{webservergroup};
  66 if ($webservergroup =~ /^(\d+)$/) {
  67     $webgroupnum = $1;
  68 } else {
  69     eval { $webgroupnum = (getgrnam $webservergroup) || 0; };
  70 }
  71
  72 # Check $webservergroup against the server's GID
  73 if ($sgid > 0) {
  74     if ($webservergroup eq "") {
  75         print
  76 "WARNING \$webservergroup is set to an empty string.
  77 That is a very insecure practice. Please refer to the
  78 Bugzilla documentation.\n";
  79     } elsif ($webgroupnum == $sgid) {
  80         print "TEST-OK Webserver is running under group id in \$webservergroup.\n";
  81     } else {
  82         print
  83 "TEST-WARNING Webserver is running under group id not matching \$webservergroup.
  84 This if the tests below fail, this is probably the problem.
  85 Please refer to the web server configuration section of the Bugzilla guide.
  86 If you are using virtual hosts or suexec, this warning may not apply.\n";
  87     }
  88 } elsif ($^O !~ /MSWin32/i) {
  89    print
  90 "TEST-WARNING Failed to find the GID for the 'httpd' process, unable
  91 to validate webservergroup.\n";
  92 }
  93
  94
  95 # Try to fetch a static file (front.png)
  96 $ARGV[0] =~ s/\/$//;
  97 my $url = $ARGV[0] . "/skins/standard/index/front.png";
  98 if (fetch($url)) {
  99     print "TEST-OK Got front picture.\n";
 100 } else {
 101     print
 102 "TEST-FAILED Fetch of skins/standard/index/front.png failed
 103 Your web server could not fetch $url.
 104 Check your web server configuration and try again.\n";
 105     exit(1);
 106 }
 107
 108 # Try to execute a cgi script
 109 my $response = fetch($ARGV[0] . "/testagent.cgi");
 110 if ($response =~ /^OK (.*)$/) {
 111     print "TEST-OK Webserver is executing CGIs via $1.\n";
 112 } elsif ($response =~ /^#!/) {
 113     print
 114 "TEST-FAILED Webserver is fetching rather than executing CGI files.
 115 Check the AddHandler statement in your httpd.conf file.\n";
 116     exit(1);
 117 } else {
 118     print "TEST-FAILED Webserver is not executing CGI files.\n";
 119 }
 120
 121 # Make sure that the web server is honoring .htaccess files
 122 my $localconfig = bz_locations()->{'localconfig'};
 123 $localconfig =~ s~^\./~~;
 124 $url = $ARGV[0] . "/$localconfig";
 125 $response = fetch($url);
 126 if ($response) {
 127     print
 128 "TEST-FAILED Webserver is permitting fetch of $url.
 129 This is a serious security problem.
 130 Check your web server configuration.\n";
 131     exit(1);
 132 } else {
 133     print "TEST-OK Webserver is preventing fetch of $url.\n";
 134 }
 135
 136 # Test chart generation
 137 eval 'use GD';
 138 if ($@ eq '') {
 139     undef $/;
 140
 141     # Ensure major versions of GD and libgd match
 142     # Windows's GD module include libgd.dll, guaranteed to match
 143     if ($^O !~ /MSWin32/i) {
 144         my $gdlib = `gdlib-config --version 2>&1` || "";
 145         $gdlib =~ s/\n$//;
 146         if (!$gdlib) {
 147             print "TEST-WARNING Failed to run gdlib-config; can't compare " .
 148                   "GD versions.\n";
 149         }
 150         else {
 151             my $gd = $GD::VERSION;
 152
 153             my $verstring = "GD version $gd, libgd version $gdlib";
 154
 155             $gdlib =~ s/^([^\.]+)\..*/$1/;
 156             $gd =~ s/^([^\.]+)\..*/$1/;
 157
 158             if ($gdlib == $gd) {
 159                 print "TEST-OK $verstring; Major versions match.\n";
 160             } else {
 161                 print "TEST-FAILED $verstring; Major versions do not match.\n";
 162             }
 163         }
 164     }
 165
 166     # Test GD
 167     eval {
 168         my $image = new GD::Image(100, 100);
 169         my $black = $image->colorAllocate(0, 0, 0);
 170         my $white = $image->colorAllocate(255, 255, 255);
 171         my $red = $image->colorAllocate(255, 0, 0);
 172         my $blue = $image->colorAllocate(0, 0, 255);
 173         $image->transparent($white);
 174         $image->rectangle(0, 0, 99, 99, $black);
 175         $image->arc(50, 50, 95, 75, 0, 360, $blue);
 176         $image->fill(50, 50, $red);
 177
 178         if ($image->can('png')) {
 179             create_file("$datadir/testgd-local.png", $image->png);
 180             check_image("$datadir/testgd-local.png", 'GD');
 181         } else {
 182             print "TEST-FAILED GD doesn't support PNG generation.\n";
 183         }
 184     };
 185     if ($@ ne '') {
 186         print "TEST-FAILED GD returned: $@\n";
 187     }
 188
 189     # Test Chart
 190     eval 'use Chart::Lines';
 191     if ($@) {
 192         print "TEST-FAILED Chart::Lines is not installed.\n";
 193     } else {
 194         eval {
 195             my $chart = Chart::Lines->new(400, 400);
 196
 197             $chart->add_pt('foo', 30, 25);
 198             $chart->add_pt('bar', 16, 32);
 199
 200             $chart->png("$datadir/testchart-local.png");
 201             check_image("$datadir/testchart-local.png", "Chart");
 202         };
 203         if ($@ ne '') {
 204             print "TEST-FAILED Chart returned: $@\n";
 205         }
 206     }
 207
 208     eval 'use Template::Plugin::GD::Image';
 209     if ($@) {
 210         print "TEST-FAILED Template::Plugin::GD is not installed.\n";
 211     }
 212     else {
 213         print "TEST-OK Template::Plugin::GD is installed.\n";
 214     }
 215 }
 216
 217 sub fetch {
 218     my $url = shift;
 219     my $rtn;
 220     if ($lwp) {
 221         my $req = HTTP::Request->new(GET => $url);
 222         my $ua = LWP::UserAgent->new;
 223         my $res = $ua->request($req);
 224         $rtn = ($res->is_success ? $res->content : undef);
 225     } elsif ($url =~ /^https:/i) {
 226         die("You need LWP installed to use https with testserver.pl");
 227     } else {
 228         my($host, $port, $file) = ('', 80, '');
 229         if ($url =~ m#^http://([^:]+):(\d+)(/.*)#i) {
 230             ($host, $port, $file) = ($1, $2, $3);
 231         } elsif ($url =~ m#^http://([^/]+)(/.*)#i) {
 232             ($host, $file) = ($1, $2);
 233         } else {
 234             die("Cannot parse url");
 235         }
 236
 237         my $proto = getprotobyname('tcp');
 238         socket(SOCK, PF_INET, SOCK_STREAM, $proto);
 239         my $sin = sockaddr_in($port, inet_aton($host));
 240         if (connect(SOCK, $sin)) {
 241             binmode SOCK;
 242             select((select(SOCK), $| = 1)[0]);
 243
 244             # get content
 245             print SOCK "GET $file HTTP/1.0\015\012host: $host:$port\015\012\015\012";
 246             my $header = '';
 247             while (defined(my $line = <SOCK>)) {
 248                 last if $line eq "\015\012";
 249                 $header .= $line;
 250             }
 251             my $content = '';
 252             while (defined(my $line = <SOCK>)) {
 253                 $content .= $line;
 254             }
 255
 256             my ($status) = $header =~ m#^HTTP/\d+\.\d+ (\d+)#;
 257             $rtn = (($status =~ /^2\d\d/) ? $content : undef);
 258         }
 259     }
 260     return($rtn);
 261 }
 262
 263 sub check_image {
 264     my ($local_file, $library) = @_;
 265     my $filedata = read_file($local_file);
 266     if ($filedata =~ /^\x89\x50\x4E\x47\x0D\x0A\x1A\x0A/) {
 267         print "TEST-OK $library library generated a good PNG image.\n";
 268         unlink $local_file;
 269     } else {
 270         print "TEST-WARNING $library library did not generate a good PNG.\n";
 271     }
 272 }
 273
 274 sub create_file {
 275     my ($filename, $content) = @_;
 276     open(FH, ">$filename")
 277         or die "Failed to create $filename: $!\n";
 278     binmode FH;
 279     print FH $content;
 280     close FH;
 281 }
 282
 283 sub read_file {
 284     my ($filename) = @_;
 285     open(FH, $filename)
 286         or die "Failed to open $filename: $!\n";
 287     binmode FH;
 288     my $content = <FH>;
 289     close FH;
 290     return $content;
 291 }