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