Prevent access to the /lib/ directory
[WebKit-https.git] / Websites / bugs.webkit.org / showdependencygraph.cgi
1 #!/usr/bin/env perl -wT
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 # The Original Code is the Bugzilla Bug Tracking System.
15 #
16 # The Initial Developer of the Original Code is Netscape Communications
17 # Corporation. Portions created by Netscape are
18 # Copyright (C) 1998 Netscape Communications Corporation. All
19 # Rights Reserved.
20 #
21 # Contributor(s): Terry Weissman <terry@mozilla.org>
22 #                 Gervase Markham <gerv@gerv.net>
23
24 use strict;
25
26 use lib qw(. lib);
27
28 use File::Temp;
29
30 use Bugzilla;
31 use Bugzilla::Constants;
32 use Bugzilla::Install::Filesystem;
33 use Bugzilla::Util;
34 use Bugzilla::Error;
35 use Bugzilla::Bug;
36 use Bugzilla::Status;
37
38 Bugzilla->login();
39
40 my $cgi = Bugzilla->cgi;
41 my $template = Bugzilla->template;
42 my $vars = {};
43 # Connect to the shadow database if this installation is using one to improve
44 # performance.
45 my $dbh = Bugzilla->switch_to_shadow_db();
46
47 local our (%seen, %edgesdone, %bugtitles);
48
49 # CreateImagemap: This sub grabs a local filename as a parameter, reads the 
50 # dot-generated image map datafile residing in that file and turns it into
51 # an HTML map element. THIS SUB IS ONLY USED FOR LOCAL DOT INSTALLATIONS.
52 # The map datafile won't necessarily contain the bug summaries, so we'll
53 # pull possible HTML titles from the %bugtitles hash (filled elsewhere
54 # in the code)
55
56 # The dot mapdata lines have the following format (\nsummary is optional):
57 # rectangle (LEFTX,TOPY) (RIGHTX,BOTTOMY) URLBASE/show_bug.cgi?id=BUGNUM BUGNUM[\nSUMMARY]
58
59 sub CreateImagemap {
60     my $mapfilename = shift;
61     my $map = "<map name=\"imagemap\">\n";
62     my $default = "";
63
64     open MAP, "<$mapfilename";
65     while(my $line = <MAP>) {
66         if($line =~ /^default ([^ ]*)(.*)$/) {
67             $default = qq{<area alt="" shape="default" href="$1">\n};
68         }
69
70         if ($line =~ /^rectangle \((.*),(.*)\) \((.*),(.*)\) (http[^ ]*) (\d+)(\\n.*)?$/) {
71             my ($leftx, $rightx, $topy, $bottomy, $url, $bugid) = ($1, $3, $2, $4, $5, $6);
72
73             # Pick up bugid from the mapdata label field. Getting the title from
74             # bugtitle hash instead of mapdata allows us to get the summary even
75             # when showsummary is off, and also gives us status and resolution.
76             my $bugtitle = html_quote(clean_text($bugtitles{$bugid}));
77             $map .= qq{<area alt="bug $bugid" name="bug$bugid" shape="rect" } .
78                     qq{title="$bugtitle" href="$url" } .
79                     qq{coords="$leftx,$topy,$rightx,$bottomy">\n};
80         }
81     }
82     close MAP;
83
84     $map .= "$default</map>";
85     return $map;
86 }
87
88 sub AddLink {
89     my ($blocked, $dependson, $fh) = (@_);
90     my $key = "$blocked,$dependson";
91     if (!exists $edgesdone{$key}) {
92         $edgesdone{$key} = 1;
93         print $fh "$dependson -> $blocked\n";
94         $seen{$blocked} = 1;
95         $seen{$dependson} = 1;
96     }
97 }
98
99 ThrowCodeError("missing_bug_id") if !defined $cgi->param('id');
100
101 # The list of valid directions. Some are not proposed in the dropdrown
102 # menu despite the fact that they are valid.
103 my @valid_rankdirs = ('LR', 'RL', 'TB', 'BT');
104
105 my $rankdir = $cgi->param('rankdir') || 'TB';
106 # Make sure the submitted 'rankdir' value is valid.
107 if (!grep { $_ eq $rankdir } @valid_rankdirs) {
108     $rankdir = 'TB';
109 }
110
111 my $display = $cgi->param('display') || 'tree';
112 my $webdotdir = bz_locations()->{'webdotdir'};
113
114 my ($fh, $filename) = File::Temp::tempfile("XXXXXXXXXX",
115                                            SUFFIX => '.dot',
116                                            DIR => $webdotdir,
117                                            UNLINK => 1);
118
119 chmod Bugzilla::Install::Filesystem::CGI_WRITE, $filename
120     or warn install_string('chmod_failed', { path => $filename,
121                                              error => $! });
122
123 my $urlbase = correct_urlbase();
124
125 print $fh "digraph G {";
126 print $fh qq{
127 graph [URL="${urlbase}query.cgi", rankdir=$rankdir]
128 node [URL="${urlbase}show_bug.cgi?id=\\N", style=filled, color=lightgrey]
129 };
130
131 my %baselist;
132
133 foreach my $i (split('[\s,]+', $cgi->param('id'))) {
134     my $bug = Bugzilla::Bug->check($i);
135     $baselist{$bug->id} = 1;
136 }
137
138 my @stack = keys(%baselist);
139
140 if ($display eq 'web') {
141     my $sth = $dbh->prepare(q{SELECT blocked, dependson
142                                 FROM dependencies
143                                WHERE blocked = ? OR dependson = ?});
144
145     foreach my $id (@stack) {
146         my $dependencies = $dbh->selectall_arrayref($sth, undef, ($id, $id));
147         foreach my $dependency (@$dependencies) {
148             my ($blocked, $dependson) = @$dependency;
149             if ($blocked != $id && !exists $seen{$blocked}) {
150                 push @stack, $blocked;
151             }
152             if ($dependson != $id && !exists $seen{$dependson}) {
153                 push @stack, $dependson;
154             }
155             AddLink($blocked, $dependson, $fh);
156         }
157     }
158 }
159 # This is the default: a tree instead of a spider web.
160 else {
161     my @blocker_stack = @stack;
162     foreach my $id (@blocker_stack) {
163         my $blocker_ids = Bugzilla::Bug::EmitDependList('blocked', 'dependson', $id);
164         foreach my $blocker_id (@$blocker_ids) {
165             push(@blocker_stack, $blocker_id) unless $seen{$blocker_id};
166             AddLink($id, $blocker_id, $fh);
167         }
168     }
169     my @dependent_stack = @stack;
170     foreach my $id (@dependent_stack) {
171         my $dep_bug_ids = Bugzilla::Bug::EmitDependList('dependson', 'blocked', $id);
172         foreach my $dep_bug_id (@$dep_bug_ids) {
173             push(@dependent_stack, $dep_bug_id) unless $seen{$dep_bug_id};
174             AddLink($dep_bug_id, $id, $fh);
175         }
176     }
177 }
178
179 foreach my $k (keys(%baselist)) {
180     $seen{$k} = 1;
181 }
182
183 my $sth = $dbh->prepare(
184               q{SELECT bug_status, resolution, short_desc
185                   FROM bugs
186                  WHERE bugs.bug_id = ?});
187 foreach my $k (keys(%seen)) {
188     # Retrieve bug information from the database
189     my ($stat, $resolution, $summary) = $dbh->selectrow_array($sth, undef, $k);
190
191     # Resolution and summary are shown only if user can see the bug
192     if (!Bugzilla->user->can_see_bug($k)) {
193         $resolution = $summary = '';
194     }
195
196     $vars->{'short_desc'} = $summary if ($k eq $cgi->param('id'));
197
198     my @params;
199
200     if ($summary ne "" && $cgi->param('showsummary')) {
201         # Wide characters cause GraphViz to die.
202         if (Bugzilla->params->{'utf8'}) {
203             utf8::encode($summary) if utf8::is_utf8($summary);
204         }
205         $summary =~ s/([\\\"])/\\$1/g;
206         push(@params, qq{label="$k\\n$summary"});
207     }
208
209     if (exists $baselist{$k}) {
210         push(@params, "shape=box");
211     }
212
213     if (is_open_state($stat)) {
214         push(@params, "color=green");
215     }
216
217     if (@params) {
218         print $fh "$k [" . join(',', @params) . "]\n";
219     } else {
220         print $fh "$k\n";
221     }
222
223     # Push the bug tooltip texts into a global hash so that 
224     # CreateImagemap sub (used with local dot installations) can
225     # use them later on.
226     $bugtitles{$k} = trim("$stat $resolution");
227
228     # Show the bug summary in tooltips only if not shown on 
229     # the graph and it is non-empty (the user can see the bug)
230     if (!$cgi->param('showsummary') && $summary ne "") {
231         $bugtitles{$k} .= " - $summary";
232     }
233 }
234
235
236 print $fh "}\n";
237 close $fh;
238
239 my $webdotbase = Bugzilla->params->{'webdotbase'};
240
241 if ($webdotbase =~ /^https?:/) {
242      # Remote dot server. We don't hardcode 'urlbase' here in case
243      # 'sslbase' is in use.
244      $webdotbase =~ s/%([a-z]*)%/Bugzilla->params->{$1}/eg;
245      my $url = $webdotbase . $filename;
246      $vars->{'image_url'} = $url . ".gif";
247      $vars->{'map_url'} = $url . ".map";
248 } else {
249     # Local dot installation
250
251     # First, generate the png image file from the .dot source
252
253     my ($pngfh, $pngfilename) = File::Temp::tempfile("XXXXXXXXXX",
254                                                      SUFFIX => '.png',
255                                                      DIR => $webdotdir);
256
257     chmod Bugzilla::Install::Filesystem::WS_SERVE, $pngfilename
258         or warn install_string('chmod_failed', { path => $pngfilename,
259                                                  error => $! });
260
261     binmode $pngfh;
262     open(DOT, "\"$webdotbase\" -Tpng $filename|");
263     binmode DOT;
264     print $pngfh $_ while <DOT>;
265     close DOT;
266     close $pngfh;
267
268     # On Windows $pngfilename will contain \ instead of /
269     $pngfilename =~ s|\\|/|g if ON_WINDOWS;
270
271     # Under mod_perl, pngfilename will have an absolute path, and we
272     # need to make that into a relative path.
273     my $cgi_root = bz_locations()->{cgi_path};
274     $pngfilename =~ s#^\Q$cgi_root\E/?##;
275     
276     $vars->{'image_url'} = $pngfilename;
277
278     # Then, generate a imagemap datafile that contains the corner data
279     # for drawn bug objects. Pass it on to CreateImagemap that
280     # turns this monster into html.
281
282     my ($mapfh, $mapfilename) = File::Temp::tempfile("XXXXXXXXXX",
283                                                      SUFFIX => '.map',
284                                                      DIR => $webdotdir);
285
286     chmod Bugzilla::Install::Filesystem::WS_SERVE, $mapfilename
287         or warn install_string('chmod_failed', { path => $mapfilename,
288                                                  error => $! });
289
290     binmode $mapfh;
291     open(DOT, "\"$webdotbase\" -Tismap $filename|");
292     binmode DOT;
293     print $mapfh $_ while <DOT>;
294     close DOT;
295     close $mapfh;
296
297     $vars->{'image_map'} = CreateImagemap($mapfilename);
298 }
299
300 # Cleanup any old .dot files created from previous runs.
301 my $since = time() - 24 * 60 * 60;
302 # Can't use glob, since even calling that fails taint checks for perl < 5.6
303 opendir(DIR, $webdotdir);
304 my @files = grep { /\.dot$|\.png$|\.map$/ && -f "$webdotdir/$_" } readdir(DIR);
305 closedir DIR;
306 foreach my $f (@files)
307 {
308     $f = "$webdotdir/$f";
309     # Here we are deleting all old files. All entries are from the
310     # $webdot directory. Since we're deleting the file (not following
311     # symlinks), this can't escape to delete anything it shouldn't
312     # (unless someone moves the location of $webdotdir, of course)
313     trick_taint($f);
314     if (file_mod_time($f) < $since) {
315         unlink $f;
316     }
317 }
318
319 # Make sure we only include valid integers (protects us from XSS attacks).
320 my @bugs = grep(detaint_natural($_), split(/[\s,]+/, $cgi->param('id')));
321 $vars->{'bug_id'} = join(', ', @bugs);
322 $vars->{'multiple_bugs'} = ($cgi->param('id') =~ /[ ,]/);
323 $vars->{'display'} = $display;
324 $vars->{'rankdir'} = $rankdir;
325 $vars->{'showsummary'} = $cgi->param('showsummary');
326
327 # Generate and return the UI (HTML page) from the appropriate template.
328 print $cgi->header();
329 $template->process("bug/dependency-graph.html.tmpl", $vars)
330   || ThrowTemplateError($template->error());