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