]> git.ipfire.org Git - thirdparty/git.git/blob - gitweb/gitweb.perl
is_ntfs_dotgit(): only verify the leading segment
[thirdparty/git.git] / gitweb / gitweb.perl
1 #!/usr/bin/perl
2
3 # gitweb - simple web interface to track changes in git repositories
4 #
5 # (C) 2005-2006, Kay Sievers <kay.sievers@vrfy.org>
6 # (C) 2005, Christian Gierke
7 #
8 # This program is licensed under the GPLv2
9
10 use 5.008;
11 use strict;
12 use warnings;
13 use CGI qw(:standard :escapeHTML -nosticky);
14 use CGI::Util qw(unescape);
15 use CGI::Carp qw(fatalsToBrowser set_message);
16 use Encode;
17 use Fcntl ':mode';
18 use File::Find qw();
19 use File::Basename qw(basename);
20 use Time::HiRes qw(gettimeofday tv_interval);
21 binmode STDOUT, ':utf8';
22
23 if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
24 eval 'sub CGI::multi_param { CGI::param(@_) }'
25 }
26
27 our $t0 = [ gettimeofday() ];
28 our $number_of_git_cmds = 0;
29
30 BEGIN {
31 CGI->compile() if $ENV{'MOD_PERL'};
32 }
33
34 our $version = "++GIT_VERSION++";
35
36 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
37 sub evaluate_uri {
38 our $cgi;
39
40 our $my_url = $cgi->url();
41 our $my_uri = $cgi->url(-absolute => 1);
42
43 # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
44 # needed and used only for URLs with nonempty PATH_INFO
45 our $base_url = $my_url;
46
47 # When the script is used as DirectoryIndex, the URL does not contain the name
48 # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
49 # have to do it ourselves. We make $path_info global because it's also used
50 # later on.
51 #
52 # Another issue with the script being the DirectoryIndex is that the resulting
53 # $my_url data is not the full script URL: this is good, because we want
54 # generated links to keep implying the script name if it wasn't explicitly
55 # indicated in the URL we're handling, but it means that $my_url cannot be used
56 # as base URL.
57 # Therefore, if we needed to strip PATH_INFO, then we know that we have
58 # to build the base URL ourselves:
59 our $path_info = decode_utf8($ENV{"PATH_INFO"});
60 if ($path_info) {
61 # $path_info has already been URL-decoded by the web server, but
62 # $my_url and $my_uri have not. URL-decode them so we can properly
63 # strip $path_info.
64 $my_url = unescape($my_url);
65 $my_uri = unescape($my_uri);
66 if ($my_url =~ s,\Q$path_info\E$,, &&
67 $my_uri =~ s,\Q$path_info\E$,, &&
68 defined $ENV{'SCRIPT_NAME'}) {
69 $base_url = $cgi->url(-base => 1) . $ENV{'SCRIPT_NAME'};
70 }
71 }
72
73 # target of the home link on top of all pages
74 our $home_link = $my_uri || "/";
75 }
76
77 # core git executable to use
78 # this can just be "git" if your webserver has a sensible PATH
79 our $GIT = "++GIT_BINDIR++/git";
80
81 # absolute fs-path which will be prepended to the project path
82 #our $projectroot = "/pub/scm";
83 our $projectroot = "++GITWEB_PROJECTROOT++";
84
85 # fs traversing limit for getting project list
86 # the number is relative to the projectroot
87 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
88
89 # string of the home link on top of all pages
90 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
91
92 # extra breadcrumbs preceding the home link
93 our @extra_breadcrumbs = ();
94
95 # name of your site or organization to appear in page titles
96 # replace this with something more descriptive for clearer bookmarks
97 our $site_name = "++GITWEB_SITENAME++"
98 || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
99
100 # html snippet to include in the <head> section of each page
101 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
102 # filename of html text to include at top of each page
103 our $site_header = "++GITWEB_SITE_HEADER++";
104 # html text to include at home page
105 our $home_text = "++GITWEB_HOMETEXT++";
106 # filename of html text to include at bottom of each page
107 our $site_footer = "++GITWEB_SITE_FOOTER++";
108
109 # URI of stylesheets
110 our @stylesheets = ("++GITWEB_CSS++");
111 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
112 our $stylesheet = undef;
113 # URI of GIT logo (72x27 size)
114 our $logo = "++GITWEB_LOGO++";
115 # URI of GIT favicon, assumed to be image/png type
116 our $favicon = "++GITWEB_FAVICON++";
117 # URI of gitweb.js (JavaScript code for gitweb)
118 our $javascript = "++GITWEB_JS++";
119
120 # URI and label (title) of GIT logo link
121 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
122 #our $logo_label = "git documentation";
123 our $logo_url = "http://git-scm.com/";
124 our $logo_label = "git homepage";
125
126 # source of projects list
127 our $projects_list = "++GITWEB_LIST++";
128
129 # the width (in characters) of the projects list "Description" column
130 our $projects_list_description_width = 25;
131
132 # group projects by category on the projects list
133 # (enabled if this variable evaluates to true)
134 our $projects_list_group_categories = 0;
135
136 # default category if none specified
137 # (leave the empty string for no category)
138 our $project_list_default_category = "";
139
140 # default order of projects list
141 # valid values are none, project, descr, owner, and age
142 our $default_projects_order = "project";
143
144 # show repository only if this file exists
145 # (only effective if this variable evaluates to true)
146 our $export_ok = "++GITWEB_EXPORT_OK++";
147
148 # don't generate age column on the projects list page
149 our $omit_age_column = 0;
150
151 # don't generate information about owners of repositories
152 our $omit_owner=0;
153
154 # show repository only if this subroutine returns true
155 # when given the path to the project, for example:
156 # sub { return -e "$_[0]/git-daemon-export-ok"; }
157 our $export_auth_hook = undef;
158
159 # only allow viewing of repositories also shown on the overview page
160 our $strict_export = "++GITWEB_STRICT_EXPORT++";
161
162 # list of git base URLs used for URL to where fetch project from,
163 # i.e. full URL is "$git_base_url/$project"
164 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
165
166 # default blob_plain mimetype and default charset for text/plain blob
167 our $default_blob_plain_mimetype = 'text/plain';
168 our $default_text_plain_charset = undef;
169
170 # file to use for guessing MIME types before trying /etc/mime.types
171 # (relative to the current git repository)
172 our $mimetypes_file = undef;
173
174 # assume this charset if line contains non-UTF-8 characters;
175 # it should be valid encoding (see Encoding::Supported(3pm) for list),
176 # for which encoding all byte sequences are valid, for example
177 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
178 # could be even 'utf-8' for the old behavior)
179 our $fallback_encoding = 'latin1';
180
181 # rename detection options for git-diff and git-diff-tree
182 # - default is '-M', with the cost proportional to
183 # (number of removed files) * (number of new files).
184 # - more costly is '-C' (which implies '-M'), with the cost proportional to
185 # (number of changed files + number of removed files) * (number of new files)
186 # - even more costly is '-C', '--find-copies-harder' with cost
187 # (number of files in the original tree) * (number of new files)
188 # - one might want to include '-B' option, e.g. '-B', '-M'
189 our @diff_opts = ('-M'); # taken from git_commit
190
191 # Disables features that would allow repository owners to inject script into
192 # the gitweb domain.
193 our $prevent_xss = 0;
194
195 # Path to the highlight executable to use (must be the one from
196 # http://www.andre-simon.de due to assumptions about parameters and output).
197 # Useful if highlight is not installed on your webserver's PATH.
198 # [Default: highlight]
199 our $highlight_bin = "++HIGHLIGHT_BIN++";
200
201 # information about snapshot formats that gitweb is capable of serving
202 our %known_snapshot_formats = (
203 # name => {
204 # 'display' => display name,
205 # 'type' => mime type,
206 # 'suffix' => filename suffix,
207 # 'format' => --format for git-archive,
208 # 'compressor' => [compressor command and arguments]
209 # (array reference, optional)
210 # 'disabled' => boolean (optional)}
211 #
212 'tgz' => {
213 'display' => 'tar.gz',
214 'type' => 'application/x-gzip',
215 'suffix' => '.tar.gz',
216 'format' => 'tar',
217 'compressor' => ['gzip', '-n']},
218
219 'tbz2' => {
220 'display' => 'tar.bz2',
221 'type' => 'application/x-bzip2',
222 'suffix' => '.tar.bz2',
223 'format' => 'tar',
224 'compressor' => ['bzip2']},
225
226 'txz' => {
227 'display' => 'tar.xz',
228 'type' => 'application/x-xz',
229 'suffix' => '.tar.xz',
230 'format' => 'tar',
231 'compressor' => ['xz'],
232 'disabled' => 1},
233
234 'zip' => {
235 'display' => 'zip',
236 'type' => 'application/x-zip',
237 'suffix' => '.zip',
238 'format' => 'zip'},
239 );
240
241 # Aliases so we understand old gitweb.snapshot values in repository
242 # configuration.
243 our %known_snapshot_format_aliases = (
244 'gzip' => 'tgz',
245 'bzip2' => 'tbz2',
246 'xz' => 'txz',
247
248 # backward compatibility: legacy gitweb config support
249 'x-gzip' => undef, 'gz' => undef,
250 'x-bzip2' => undef, 'bz2' => undef,
251 'x-zip' => undef, '' => undef,
252 );
253
254 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
255 # are changed, it may be appropriate to change these values too via
256 # $GITWEB_CONFIG.
257 our %avatar_size = (
258 'default' => 16,
259 'double' => 32
260 );
261
262 # Used to set the maximum load that we will still respond to gitweb queries.
263 # If server load exceed this value then return "503 server busy" error.
264 # If gitweb cannot determined server load, it is taken to be 0.
265 # Leave it undefined (or set to 'undef') to turn off load checking.
266 our $maxload = 300;
267
268 # configuration for 'highlight' (http://www.andre-simon.de/)
269 # match by basename
270 our %highlight_basename = (
271 #'Program' => 'py',
272 #'Library' => 'py',
273 'SConstruct' => 'py', # SCons equivalent of Makefile
274 'Makefile' => 'make',
275 );
276 # match by extension
277 our %highlight_ext = (
278 # main extensions, defining name of syntax;
279 # see files in /usr/share/highlight/langDefs/ directory
280 (map { $_ => $_ } qw(py rb java css js tex bib xml awk bat ini spec tcl sql)),
281 # alternate extensions, see /etc/highlight/filetypes.conf
282 (map { $_ => 'c' } qw(c h)),
283 (map { $_ => 'sh' } qw(sh bash zsh ksh)),
284 (map { $_ => 'cpp' } qw(cpp cxx c++ cc)),
285 (map { $_ => 'php' } qw(php php3 php4 php5 phps)),
286 (map { $_ => 'pl' } qw(pl perl pm)), # perhaps also 'cgi'
287 (map { $_ => 'make'} qw(make mak mk)),
288 (map { $_ => 'xml' } qw(xml xhtml html htm)),
289 );
290
291 # You define site-wide feature defaults here; override them with
292 # $GITWEB_CONFIG as necessary.
293 our %feature = (
294 # feature => {
295 # 'sub' => feature-sub (subroutine),
296 # 'override' => allow-override (boolean),
297 # 'default' => [ default options...] (array reference)}
298 #
299 # if feature is overridable (it means that allow-override has true value),
300 # then feature-sub will be called with default options as parameters;
301 # return value of feature-sub indicates if to enable specified feature
302 #
303 # if there is no 'sub' key (no feature-sub), then feature cannot be
304 # overridden
305 #
306 # use gitweb_get_feature(<feature>) to retrieve the <feature> value
307 # (an array) or gitweb_check_feature(<feature>) to check if <feature>
308 # is enabled
309
310 # Enable the 'blame' blob view, showing the last commit that modified
311 # each line in the file. This can be very CPU-intensive.
312
313 # To enable system wide have in $GITWEB_CONFIG
314 # $feature{'blame'}{'default'} = [1];
315 # To have project specific config enable override in $GITWEB_CONFIG
316 # $feature{'blame'}{'override'} = 1;
317 # and in project config gitweb.blame = 0|1;
318 'blame' => {
319 'sub' => sub { feature_bool('blame', @_) },
320 'override' => 0,
321 'default' => [0]},
322
323 # Enable the 'snapshot' link, providing a compressed archive of any
324 # tree. This can potentially generate high traffic if you have large
325 # project.
326
327 # Value is a list of formats defined in %known_snapshot_formats that
328 # you wish to offer.
329 # To disable system wide have in $GITWEB_CONFIG
330 # $feature{'snapshot'}{'default'} = [];
331 # To have project specific config enable override in $GITWEB_CONFIG
332 # $feature{'snapshot'}{'override'} = 1;
333 # and in project config, a comma-separated list of formats or "none"
334 # to disable. Example: gitweb.snapshot = tbz2,zip;
335 'snapshot' => {
336 'sub' => \&feature_snapshot,
337 'override' => 0,
338 'default' => ['tgz']},
339
340 # Enable text search, which will list the commits which match author,
341 # committer or commit text to a given string. Enabled by default.
342 # Project specific override is not supported.
343 #
344 # Note that this controls all search features, which means that if
345 # it is disabled, then 'grep' and 'pickaxe' search would also be
346 # disabled.
347 'search' => {
348 'override' => 0,
349 'default' => [1]},
350
351 # Enable grep search, which will list the files in currently selected
352 # tree containing the given string. Enabled by default. This can be
353 # potentially CPU-intensive, of course.
354 # Note that you need to have 'search' feature enabled too.
355
356 # To enable system wide have in $GITWEB_CONFIG
357 # $feature{'grep'}{'default'} = [1];
358 # To have project specific config enable override in $GITWEB_CONFIG
359 # $feature{'grep'}{'override'} = 1;
360 # and in project config gitweb.grep = 0|1;
361 'grep' => {
362 'sub' => sub { feature_bool('grep', @_) },
363 'override' => 0,
364 'default' => [1]},
365
366 # Enable the pickaxe search, which will list the commits that modified
367 # a given string in a file. This can be practical and quite faster
368 # alternative to 'blame', but still potentially CPU-intensive.
369 # Note that you need to have 'search' feature enabled too.
370
371 # To enable system wide have in $GITWEB_CONFIG
372 # $feature{'pickaxe'}{'default'} = [1];
373 # To have project specific config enable override in $GITWEB_CONFIG
374 # $feature{'pickaxe'}{'override'} = 1;
375 # and in project config gitweb.pickaxe = 0|1;
376 'pickaxe' => {
377 'sub' => sub { feature_bool('pickaxe', @_) },
378 'override' => 0,
379 'default' => [1]},
380
381 # Enable showing size of blobs in a 'tree' view, in a separate
382 # column, similar to what 'ls -l' does. This cost a bit of IO.
383
384 # To disable system wide have in $GITWEB_CONFIG
385 # $feature{'show-sizes'}{'default'} = [0];
386 # To have project specific config enable override in $GITWEB_CONFIG
387 # $feature{'show-sizes'}{'override'} = 1;
388 # and in project config gitweb.showsizes = 0|1;
389 'show-sizes' => {
390 'sub' => sub { feature_bool('showsizes', @_) },
391 'override' => 0,
392 'default' => [1]},
393
394 # Make gitweb use an alternative format of the URLs which can be
395 # more readable and natural-looking: project name is embedded
396 # directly in the path and the query string contains other
397 # auxiliary information. All gitweb installations recognize
398 # URL in either format; this configures in which formats gitweb
399 # generates links.
400
401 # To enable system wide have in $GITWEB_CONFIG
402 # $feature{'pathinfo'}{'default'} = [1];
403 # Project specific override is not supported.
404
405 # Note that you will need to change the default location of CSS,
406 # favicon, logo and possibly other files to an absolute URL. Also,
407 # if gitweb.cgi serves as your indexfile, you will need to force
408 # $my_uri to contain the script name in your $GITWEB_CONFIG.
409 'pathinfo' => {
410 'override' => 0,
411 'default' => [0]},
412
413 # Make gitweb consider projects in project root subdirectories
414 # to be forks of existing projects. Given project $projname.git,
415 # projects matching $projname/*.git will not be shown in the main
416 # projects list, instead a '+' mark will be added to $projname
417 # there and a 'forks' view will be enabled for the project, listing
418 # all the forks. If project list is taken from a file, forks have
419 # to be listed after the main project.
420
421 # To enable system wide have in $GITWEB_CONFIG
422 # $feature{'forks'}{'default'} = [1];
423 # Project specific override is not supported.
424 'forks' => {
425 'override' => 0,
426 'default' => [0]},
427
428 # Insert custom links to the action bar of all project pages.
429 # This enables you mainly to link to third-party scripts integrating
430 # into gitweb; e.g. git-browser for graphical history representation
431 # or custom web-based repository administration interface.
432
433 # The 'default' value consists of a list of triplets in the form
434 # (label, link, position) where position is the label after which
435 # to insert the link and link is a format string where %n expands
436 # to the project name, %f to the project path within the filesystem,
437 # %h to the current hash (h gitweb parameter) and %b to the current
438 # hash base (hb gitweb parameter); %% expands to %.
439
440 # To enable system wide have in $GITWEB_CONFIG e.g.
441 # $feature{'actions'}{'default'} = [('graphiclog',
442 # '/git-browser/by-commit.html?r=%n', 'summary')];
443 # Project specific override is not supported.
444 'actions' => {
445 'override' => 0,
446 'default' => []},
447
448 # Allow gitweb scan project content tags of project repository,
449 # and display the popular Web 2.0-ish "tag cloud" near the projects
450 # list. Note that this is something COMPLETELY different from the
451 # normal Git tags.
452
453 # gitweb by itself can show existing tags, but it does not handle
454 # tagging itself; you need to do it externally, outside gitweb.
455 # The format is described in git_get_project_ctags() subroutine.
456 # You may want to install the HTML::TagCloud Perl module to get
457 # a pretty tag cloud instead of just a list of tags.
458
459 # To enable system wide have in $GITWEB_CONFIG
460 # $feature{'ctags'}{'default'} = [1];
461 # Project specific override is not supported.
462
463 # In the future whether ctags editing is enabled might depend
464 # on the value, but using 1 should always mean no editing of ctags.
465 'ctags' => {
466 'override' => 0,
467 'default' => [0]},
468
469 # The maximum number of patches in a patchset generated in patch
470 # view. Set this to 0 or undef to disable patch view, or to a
471 # negative number to remove any limit.
472
473 # To disable system wide have in $GITWEB_CONFIG
474 # $feature{'patches'}{'default'} = [0];
475 # To have project specific config enable override in $GITWEB_CONFIG
476 # $feature{'patches'}{'override'} = 1;
477 # and in project config gitweb.patches = 0|n;
478 # where n is the maximum number of patches allowed in a patchset.
479 'patches' => {
480 'sub' => \&feature_patches,
481 'override' => 0,
482 'default' => [16]},
483
484 # Avatar support. When this feature is enabled, views such as
485 # shortlog or commit will display an avatar associated with
486 # the email of the committer(s) and/or author(s).
487
488 # Currently available providers are gravatar and picon.
489 # If an unknown provider is specified, the feature is disabled.
490
491 # Gravatar depends on Digest::MD5.
492 # Picon currently relies on the indiana.edu database.
493
494 # To enable system wide have in $GITWEB_CONFIG
495 # $feature{'avatar'}{'default'} = ['<provider>'];
496 # where <provider> is either gravatar or picon.
497 # To have project specific config enable override in $GITWEB_CONFIG
498 # $feature{'avatar'}{'override'} = 1;
499 # and in project config gitweb.avatar = <provider>;
500 'avatar' => {
501 'sub' => \&feature_avatar,
502 'override' => 0,
503 'default' => ['']},
504
505 # Enable displaying how much time and how many git commands
506 # it took to generate and display page. Disabled by default.
507 # Project specific override is not supported.
508 'timed' => {
509 'override' => 0,
510 'default' => [0]},
511
512 # Enable turning some links into links to actions which require
513 # JavaScript to run (like 'blame_incremental'). Not enabled by
514 # default. Project specific override is currently not supported.
515 'javascript-actions' => {
516 'override' => 0,
517 'default' => [0]},
518
519 # Enable and configure ability to change common timezone for dates
520 # in gitweb output via JavaScript. Enabled by default.
521 # Project specific override is not supported.
522 'javascript-timezone' => {
523 'override' => 0,
524 'default' => [
525 'local', # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
526 # or undef to turn off this feature
527 'gitweb_tz', # name of cookie where to store selected timezone
528 'datetime', # CSS class used to mark up dates for manipulation
529 ]},
530
531 # Syntax highlighting support. This is based on Daniel Svensson's
532 # and Sham Chukoury's work in gitweb-xmms2.git.
533 # It requires the 'highlight' program present in $PATH,
534 # and therefore is disabled by default.
535
536 # To enable system wide have in $GITWEB_CONFIG
537 # $feature{'highlight'}{'default'} = [1];
538
539 'highlight' => {
540 'sub' => sub { feature_bool('highlight', @_) },
541 'override' => 0,
542 'default' => [0]},
543
544 # Enable displaying of remote heads in the heads list
545
546 # To enable system wide have in $GITWEB_CONFIG
547 # $feature{'remote_heads'}{'default'} = [1];
548 # To have project specific config enable override in $GITWEB_CONFIG
549 # $feature{'remote_heads'}{'override'} = 1;
550 # and in project config gitweb.remoteheads = 0|1;
551 'remote_heads' => {
552 'sub' => sub { feature_bool('remote_heads', @_) },
553 'override' => 0,
554 'default' => [0]},
555
556 # Enable showing branches under other refs in addition to heads
557
558 # To set system wide extra branch refs have in $GITWEB_CONFIG
559 # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
560 # To have project specific config enable override in $GITWEB_CONFIG
561 # $feature{'extra-branch-refs'}{'override'} = 1;
562 # and in project config gitweb.extrabranchrefs = dirs of choice
563 # Every directory is separated with whitespace.
564
565 'extra-branch-refs' => {
566 'sub' => \&feature_extra_branch_refs,
567 'override' => 0,
568 'default' => []},
569 );
570
571 sub gitweb_get_feature {
572 my ($name) = @_;
573 return unless exists $feature{$name};
574 my ($sub, $override, @defaults) = (
575 $feature{$name}{'sub'},
576 $feature{$name}{'override'},
577 @{$feature{$name}{'default'}});
578 # project specific override is possible only if we have project
579 our $git_dir; # global variable, declared later
580 if (!$override || !defined $git_dir) {
581 return @defaults;
582 }
583 if (!defined $sub) {
584 warn "feature $name is not overridable";
585 return @defaults;
586 }
587 return $sub->(@defaults);
588 }
589
590 # A wrapper to check if a given feature is enabled.
591 # With this, you can say
592 #
593 # my $bool_feat = gitweb_check_feature('bool_feat');
594 # gitweb_check_feature('bool_feat') or somecode;
595 #
596 # instead of
597 #
598 # my ($bool_feat) = gitweb_get_feature('bool_feat');
599 # (gitweb_get_feature('bool_feat'))[0] or somecode;
600 #
601 sub gitweb_check_feature {
602 return (gitweb_get_feature(@_))[0];
603 }
604
605
606 sub feature_bool {
607 my $key = shift;
608 my ($val) = git_get_project_config($key, '--bool');
609
610 if (!defined $val) {
611 return ($_[0]);
612 } elsif ($val eq 'true') {
613 return (1);
614 } elsif ($val eq 'false') {
615 return (0);
616 }
617 }
618
619 sub feature_snapshot {
620 my (@fmts) = @_;
621
622 my ($val) = git_get_project_config('snapshot');
623
624 if ($val) {
625 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
626 }
627
628 return @fmts;
629 }
630
631 sub feature_patches {
632 my @val = (git_get_project_config('patches', '--int'));
633
634 if (@val) {
635 return @val;
636 }
637
638 return ($_[0]);
639 }
640
641 sub feature_avatar {
642 my @val = (git_get_project_config('avatar'));
643
644 return @val ? @val : @_;
645 }
646
647 sub feature_extra_branch_refs {
648 my (@branch_refs) = @_;
649 my $values = git_get_project_config('extrabranchrefs');
650
651 if ($values) {
652 $values = config_to_multi ($values);
653 @branch_refs = ();
654 foreach my $value (@{$values}) {
655 push @branch_refs, split /\s+/, $value;
656 }
657 }
658
659 return @branch_refs;
660 }
661
662 # checking HEAD file with -e is fragile if the repository was
663 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
664 # and then pruned.
665 sub check_head_link {
666 my ($dir) = @_;
667 my $headfile = "$dir/HEAD";
668 return ((-e $headfile) ||
669 (-l $headfile && readlink($headfile) =~ /^refs\/heads\//));
670 }
671
672 sub check_export_ok {
673 my ($dir) = @_;
674 return (check_head_link($dir) &&
675 (!$export_ok || -e "$dir/$export_ok") &&
676 (!$export_auth_hook || $export_auth_hook->($dir)));
677 }
678
679 # process alternate names for backward compatibility
680 # filter out unsupported (unknown) snapshot formats
681 sub filter_snapshot_fmts {
682 my @fmts = @_;
683
684 @fmts = map {
685 exists $known_snapshot_format_aliases{$_} ?
686 $known_snapshot_format_aliases{$_} : $_} @fmts;
687 @fmts = grep {
688 exists $known_snapshot_formats{$_} &&
689 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
690 }
691
692 sub filter_and_validate_refs {
693 my @refs = @_;
694 my %unique_refs = ();
695
696 foreach my $ref (@refs) {
697 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
698 # 'heads' are added implicitly in get_branch_refs().
699 $unique_refs{$ref} = 1 if ($ref ne 'heads');
700 }
701 return sort keys %unique_refs;
702 }
703
704 # If it is set to code reference, it is code that it is to be run once per
705 # request, allowing updating configurations that change with each request,
706 # while running other code in config file only once.
707 #
708 # Otherwise, if it is false then gitweb would process config file only once;
709 # if it is true then gitweb config would be run for each request.
710 our $per_request_config = 1;
711
712 # read and parse gitweb config file given by its parameter.
713 # returns true on success, false on recoverable error, allowing
714 # to chain this subroutine, using first file that exists.
715 # dies on errors during parsing config file, as it is unrecoverable.
716 sub read_config_file {
717 my $filename = shift;
718 return unless defined $filename;
719 # die if there are errors parsing config file
720 if (-e $filename) {
721 do $filename;
722 die $@ if $@;
723 return 1;
724 }
725 return;
726 }
727
728 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
729 sub evaluate_gitweb_config {
730 our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
731 our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
732 our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
733
734 # Protect against duplications of file names, to not read config twice.
735 # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
736 # there possibility of duplication of filename there doesn't matter.
737 $GITWEB_CONFIG = "" if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
738 $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
739
740 # Common system-wide settings for convenience.
741 # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
742 read_config_file($GITWEB_CONFIG_COMMON);
743
744 # Use first config file that exists. This means use the per-instance
745 # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
746 read_config_file($GITWEB_CONFIG) and return;
747 read_config_file($GITWEB_CONFIG_SYSTEM);
748 }
749
750 # Get loadavg of system, to compare against $maxload.
751 # Currently it requires '/proc/loadavg' present to get loadavg;
752 # if it is not present it returns 0, which means no load checking.
753 sub get_loadavg {
754 if( -e '/proc/loadavg' ){
755 open my $fd, '<', '/proc/loadavg'
756 or return 0;
757 my @load = split(/\s+/, scalar <$fd>);
758 close $fd;
759
760 # The first three columns measure CPU and IO utilization of the last one,
761 # five, and 10 minute periods. The fourth column shows the number of
762 # currently running processes and the total number of processes in the m/n
763 # format. The last column displays the last process ID used.
764 return $load[0] || 0;
765 }
766 # additional checks for load average should go here for things that don't export
767 # /proc/loadavg
768
769 return 0;
770 }
771
772 # version of the core git binary
773 our $git_version;
774 sub evaluate_git_version {
775 our $git_version = qx("$GIT" --version) =~ m/git version (.*)$/ ? $1 : "unknown";
776 $number_of_git_cmds++;
777 }
778
779 sub check_loadavg {
780 if (defined $maxload && get_loadavg() > $maxload) {
781 die_error(503, "The load average on the server is too high");
782 }
783 }
784
785 # ======================================================================
786 # input validation and dispatch
787
788 # input parameters can be collected from a variety of sources (presently, CGI
789 # and PATH_INFO), so we define an %input_params hash that collects them all
790 # together during validation: this allows subsequent uses (e.g. href()) to be
791 # agnostic of the parameter origin
792
793 our %input_params = ();
794
795 # input parameters are stored with the long parameter name as key. This will
796 # also be used in the href subroutine to convert parameters to their CGI
797 # equivalent, and since the href() usage is the most frequent one, we store
798 # the name -> CGI key mapping here, instead of the reverse.
799 #
800 # XXX: Warning: If you touch this, check the search form for updating,
801 # too.
802
803 our @cgi_param_mapping = (
804 project => "p",
805 action => "a",
806 file_name => "f",
807 file_parent => "fp",
808 hash => "h",
809 hash_parent => "hp",
810 hash_base => "hb",
811 hash_parent_base => "hpb",
812 page => "pg",
813 order => "o",
814 searchtext => "s",
815 searchtype => "st",
816 snapshot_format => "sf",
817 extra_options => "opt",
818 search_use_regexp => "sr",
819 ctag => "by_tag",
820 diff_style => "ds",
821 project_filter => "pf",
822 # this must be last entry (for manipulation from JavaScript)
823 javascript => "js"
824 );
825 our %cgi_param_mapping = @cgi_param_mapping;
826
827 # we will also need to know the possible actions, for validation
828 our %actions = (
829 "blame" => \&git_blame,
830 "blame_incremental" => \&git_blame_incremental,
831 "blame_data" => \&git_blame_data,
832 "blobdiff" => \&git_blobdiff,
833 "blobdiff_plain" => \&git_blobdiff_plain,
834 "blob" => \&git_blob,
835 "blob_plain" => \&git_blob_plain,
836 "commitdiff" => \&git_commitdiff,
837 "commitdiff_plain" => \&git_commitdiff_plain,
838 "commit" => \&git_commit,
839 "forks" => \&git_forks,
840 "heads" => \&git_heads,
841 "history" => \&git_history,
842 "log" => \&git_log,
843 "patch" => \&git_patch,
844 "patches" => \&git_patches,
845 "remotes" => \&git_remotes,
846 "rss" => \&git_rss,
847 "atom" => \&git_atom,
848 "search" => \&git_search,
849 "search_help" => \&git_search_help,
850 "shortlog" => \&git_shortlog,
851 "summary" => \&git_summary,
852 "tag" => \&git_tag,
853 "tags" => \&git_tags,
854 "tree" => \&git_tree,
855 "snapshot" => \&git_snapshot,
856 "object" => \&git_object,
857 # those below don't need $project
858 "opml" => \&git_opml,
859 "project_list" => \&git_project_list,
860 "project_index" => \&git_project_index,
861 );
862
863 # finally, we have the hash of allowed extra_options for the commands that
864 # allow them
865 our %allowed_options = (
866 "--no-merges" => [ qw(rss atom log shortlog history) ],
867 );
868
869 # fill %input_params with the CGI parameters. All values except for 'opt'
870 # should be single values, but opt can be an array. We should probably
871 # build an array of parameters that can be multi-valued, but since for the time
872 # being it's only this one, we just single it out
873 sub evaluate_query_params {
874 our $cgi;
875
876 while (my ($name, $symbol) = each %cgi_param_mapping) {
877 if ($symbol eq 'opt') {
878 $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
879 } else {
880 $input_params{$name} = decode_utf8($cgi->param($symbol));
881 }
882 }
883 }
884
885 # now read PATH_INFO and update the parameter list for missing parameters
886 sub evaluate_path_info {
887 return if defined $input_params{'project'};
888 return if !$path_info;
889 $path_info =~ s,^/+,,;
890 return if !$path_info;
891
892 # find which part of PATH_INFO is project
893 my $project = $path_info;
894 $project =~ s,/+$,,;
895 while ($project && !check_head_link("$projectroot/$project")) {
896 $project =~ s,/*[^/]*$,,;
897 }
898 return unless $project;
899 $input_params{'project'} = $project;
900
901 # do not change any parameters if an action is given using the query string
902 return if $input_params{'action'};
903 $path_info =~ s,^\Q$project\E/*,,;
904
905 # next, check if we have an action
906 my $action = $path_info;
907 $action =~ s,/.*$,,;
908 if (exists $actions{$action}) {
909 $path_info =~ s,^$action/*,,;
910 $input_params{'action'} = $action;
911 }
912
913 # list of actions that want hash_base instead of hash, but can have no
914 # pathname (f) parameter
915 my @wants_base = (
916 'tree',
917 'history',
918 );
919
920 # we want to catch, among others
921 # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
922 my ($parentrefname, $parentpathname, $refname, $pathname) =
923 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
924
925 # first, analyze the 'current' part
926 if (defined $pathname) {
927 # we got "branch:filename" or "branch:dir/"
928 # we could use git_get_type(branch:pathname), but:
929 # - it needs $git_dir
930 # - it does a git() call
931 # - the convention of terminating directories with a slash
932 # makes it superfluous
933 # - embedding the action in the PATH_INFO would make it even
934 # more superfluous
935 $pathname =~ s,^/+,,;
936 if (!$pathname || substr($pathname, -1) eq "/") {
937 $input_params{'action'} ||= "tree";
938 $pathname =~ s,/$,,;
939 } else {
940 # the default action depends on whether we had parent info
941 # or not
942 if ($parentrefname) {
943 $input_params{'action'} ||= "blobdiff_plain";
944 } else {
945 $input_params{'action'} ||= "blob_plain";
946 }
947 }
948 $input_params{'hash_base'} ||= $refname;
949 $input_params{'file_name'} ||= $pathname;
950 } elsif (defined $refname) {
951 # we got "branch". In this case we have to choose if we have to
952 # set hash or hash_base.
953 #
954 # Most of the actions without a pathname only want hash to be
955 # set, except for the ones specified in @wants_base that want
956 # hash_base instead. It should also be noted that hand-crafted
957 # links having 'history' as an action and no pathname or hash
958 # set will fail, but that happens regardless of PATH_INFO.
959 if (defined $parentrefname) {
960 # if there is parent let the default be 'shortlog' action
961 # (for http://git.example.com/repo.git/A..B links); if there
962 # is no parent, dispatch will detect type of object and set
963 # action appropriately if required (if action is not set)
964 $input_params{'action'} ||= "shortlog";
965 }
966 if ($input_params{'action'} &&
967 grep { $_ eq $input_params{'action'} } @wants_base) {
968 $input_params{'hash_base'} ||= $refname;
969 } else {
970 $input_params{'hash'} ||= $refname;
971 }
972 }
973
974 # next, handle the 'parent' part, if present
975 if (defined $parentrefname) {
976 # a missing pathspec defaults to the 'current' filename, allowing e.g.
977 # someproject/blobdiff/oldrev..newrev:/filename
978 if ($parentpathname) {
979 $parentpathname =~ s,^/+,,;
980 $parentpathname =~ s,/$,,;
981 $input_params{'file_parent'} ||= $parentpathname;
982 } else {
983 $input_params{'file_parent'} ||= $input_params{'file_name'};
984 }
985 # we assume that hash_parent_base is wanted if a path was specified,
986 # or if the action wants hash_base instead of hash
987 if (defined $input_params{'file_parent'} ||
988 grep { $_ eq $input_params{'action'} } @wants_base) {
989 $input_params{'hash_parent_base'} ||= $parentrefname;
990 } else {
991 $input_params{'hash_parent'} ||= $parentrefname;
992 }
993 }
994
995 # for the snapshot action, we allow URLs in the form
996 # $project/snapshot/$hash.ext
997 # where .ext determines the snapshot and gets removed from the
998 # passed $refname to provide the $hash.
999 #
1000 # To be able to tell that $refname includes the format extension, we
1001 # require the following two conditions to be satisfied:
1002 # - the hash input parameter MUST have been set from the $refname part
1003 # of the URL (i.e. they must be equal)
1004 # - the snapshot format MUST NOT have been defined already (e.g. from
1005 # CGI parameter sf)
1006 # It's also useless to try any matching unless $refname has a dot,
1007 # so we check for that too
1008 if (defined $input_params{'action'} &&
1009 $input_params{'action'} eq 'snapshot' &&
1010 defined $refname && index($refname, '.') != -1 &&
1011 $refname eq $input_params{'hash'} &&
1012 !defined $input_params{'snapshot_format'}) {
1013 # We loop over the known snapshot formats, checking for
1014 # extensions. Allowed extensions are both the defined suffix
1015 # (which includes the initial dot already) and the snapshot
1016 # format key itself, with a prepended dot
1017 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1018 my $hash = $refname;
1019 unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1020 next;
1021 }
1022 my $sfx = $1;
1023 # a valid suffix was found, so set the snapshot format
1024 # and reset the hash parameter
1025 $input_params{'snapshot_format'} = $fmt;
1026 $input_params{'hash'} = $hash;
1027 # we also set the format suffix to the one requested
1028 # in the URL: this way a request for e.g. .tgz returns
1029 # a .tgz instead of a .tar.gz
1030 $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1031 last;
1032 }
1033 }
1034 }
1035
1036 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1037 $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1038 $searchtext, $search_regexp, $project_filter);
1039 sub evaluate_and_validate_params {
1040 our $action = $input_params{'action'};
1041 if (defined $action) {
1042 if (!is_valid_action($action)) {
1043 die_error(400, "Invalid action parameter");
1044 }
1045 }
1046
1047 # parameters which are pathnames
1048 our $project = $input_params{'project'};
1049 if (defined $project) {
1050 if (!is_valid_project($project)) {
1051 undef $project;
1052 die_error(404, "No such project");
1053 }
1054 }
1055
1056 our $project_filter = $input_params{'project_filter'};
1057 if (defined $project_filter) {
1058 if (!is_valid_pathname($project_filter)) {
1059 die_error(404, "Invalid project_filter parameter");
1060 }
1061 }
1062
1063 our $file_name = $input_params{'file_name'};
1064 if (defined $file_name) {
1065 if (!is_valid_pathname($file_name)) {
1066 die_error(400, "Invalid file parameter");
1067 }
1068 }
1069
1070 our $file_parent = $input_params{'file_parent'};
1071 if (defined $file_parent) {
1072 if (!is_valid_pathname($file_parent)) {
1073 die_error(400, "Invalid file parent parameter");
1074 }
1075 }
1076
1077 # parameters which are refnames
1078 our $hash = $input_params{'hash'};
1079 if (defined $hash) {
1080 if (!is_valid_refname($hash)) {
1081 die_error(400, "Invalid hash parameter");
1082 }
1083 }
1084
1085 our $hash_parent = $input_params{'hash_parent'};
1086 if (defined $hash_parent) {
1087 if (!is_valid_refname($hash_parent)) {
1088 die_error(400, "Invalid hash parent parameter");
1089 }
1090 }
1091
1092 our $hash_base = $input_params{'hash_base'};
1093 if (defined $hash_base) {
1094 if (!is_valid_refname($hash_base)) {
1095 die_error(400, "Invalid hash base parameter");
1096 }
1097 }
1098
1099 our @extra_options = @{$input_params{'extra_options'}};
1100 # @extra_options is always defined, since it can only be (currently) set from
1101 # CGI, and $cgi->param() returns the empty array in array context if the param
1102 # is not set
1103 foreach my $opt (@extra_options) {
1104 if (not exists $allowed_options{$opt}) {
1105 die_error(400, "Invalid option parameter");
1106 }
1107 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1108 die_error(400, "Invalid option parameter for this action");
1109 }
1110 }
1111
1112 our $hash_parent_base = $input_params{'hash_parent_base'};
1113 if (defined $hash_parent_base) {
1114 if (!is_valid_refname($hash_parent_base)) {
1115 die_error(400, "Invalid hash parent base parameter");
1116 }
1117 }
1118
1119 # other parameters
1120 our $page = $input_params{'page'};
1121 if (defined $page) {
1122 if ($page =~ m/[^0-9]/) {
1123 die_error(400, "Invalid page parameter");
1124 }
1125 }
1126
1127 our $searchtype = $input_params{'searchtype'};
1128 if (defined $searchtype) {
1129 if ($searchtype =~ m/[^a-z]/) {
1130 die_error(400, "Invalid searchtype parameter");
1131 }
1132 }
1133
1134 our $search_use_regexp = $input_params{'search_use_regexp'};
1135
1136 our $searchtext = $input_params{'searchtext'};
1137 our $search_regexp = undef;
1138 if (defined $searchtext) {
1139 if (length($searchtext) < 2) {
1140 die_error(403, "At least two characters are required for search parameter");
1141 }
1142 if ($search_use_regexp) {
1143 $search_regexp = $searchtext;
1144 if (!eval { qr/$search_regexp/; 1; }) {
1145 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1146 die_error(400, "Invalid search regexp '$search_regexp'",
1147 esc_html($error));
1148 }
1149 } else {
1150 $search_regexp = quotemeta $searchtext;
1151 }
1152 }
1153 }
1154
1155 # path to the current git repository
1156 our $git_dir;
1157 sub evaluate_git_dir {
1158 our $git_dir = "$projectroot/$project" if $project;
1159 }
1160
1161 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1162 sub configure_gitweb_features {
1163 # list of supported snapshot formats
1164 our @snapshot_fmts = gitweb_get_feature('snapshot');
1165 @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1166
1167 # check that the avatar feature is set to a known provider name,
1168 # and for each provider check if the dependencies are satisfied.
1169 # if the provider name is invalid or the dependencies are not met,
1170 # reset $git_avatar to the empty string.
1171 our ($git_avatar) = gitweb_get_feature('avatar');
1172 if ($git_avatar eq 'gravatar') {
1173 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1174 } elsif ($git_avatar eq 'picon') {
1175 # no dependencies
1176 } else {
1177 $git_avatar = '';
1178 }
1179
1180 our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1181 @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1182 }
1183
1184 sub get_branch_refs {
1185 return ('heads', @extra_branch_refs);
1186 }
1187
1188 # custom error handler: 'die <message>' is Internal Server Error
1189 sub handle_errors_html {
1190 my $msg = shift; # it is already HTML escaped
1191
1192 # to avoid infinite loop where error occurs in die_error,
1193 # change handler to default handler, disabling handle_errors_html
1194 set_message("Error occurred when inside die_error:\n$msg");
1195
1196 # you cannot jump out of die_error when called as error handler;
1197 # the subroutine set via CGI::Carp::set_message is called _after_
1198 # HTTP headers are already written, so it cannot write them itself
1199 die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1200 }
1201 set_message(\&handle_errors_html);
1202
1203 # dispatch
1204 sub dispatch {
1205 if (!defined $action) {
1206 if (defined $hash) {
1207 $action = git_get_type($hash);
1208 $action or die_error(404, "Object does not exist");
1209 } elsif (defined $hash_base && defined $file_name) {
1210 $action = git_get_type("$hash_base:$file_name");
1211 $action or die_error(404, "File or directory does not exist");
1212 } elsif (defined $project) {
1213 $action = 'summary';
1214 } else {
1215 $action = 'project_list';
1216 }
1217 }
1218 if (!defined($actions{$action})) {
1219 die_error(400, "Unknown action");
1220 }
1221 if ($action !~ m/^(?:opml|project_list|project_index)$/ &&
1222 !$project) {
1223 die_error(400, "Project needed");
1224 }
1225 $actions{$action}->();
1226 }
1227
1228 sub reset_timer {
1229 our $t0 = [ gettimeofday() ]
1230 if defined $t0;
1231 our $number_of_git_cmds = 0;
1232 }
1233
1234 our $first_request = 1;
1235 sub run_request {
1236 reset_timer();
1237
1238 evaluate_uri();
1239 if ($first_request) {
1240 evaluate_gitweb_config();
1241 evaluate_git_version();
1242 }
1243 if ($per_request_config) {
1244 if (ref($per_request_config) eq 'CODE') {
1245 $per_request_config->();
1246 } elsif (!$first_request) {
1247 evaluate_gitweb_config();
1248 }
1249 }
1250 check_loadavg();
1251
1252 # $projectroot and $projects_list might be set in gitweb config file
1253 $projects_list ||= $projectroot;
1254
1255 evaluate_query_params();
1256 evaluate_path_info();
1257 evaluate_and_validate_params();
1258 evaluate_git_dir();
1259
1260 configure_gitweb_features();
1261
1262 dispatch();
1263 }
1264
1265 our $is_last_request = sub { 1 };
1266 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1267 our $CGI = 'CGI';
1268 our $cgi;
1269 sub configure_as_fcgi {
1270 require CGI::Fast;
1271 our $CGI = 'CGI::Fast';
1272
1273 my $request_number = 0;
1274 # let each child service 100 requests
1275 our $is_last_request = sub { ++$request_number > 100 };
1276 }
1277 sub evaluate_argv {
1278 my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1279 configure_as_fcgi()
1280 if $script_name =~ /\.fcgi$/;
1281
1282 return unless (@ARGV);
1283
1284 require Getopt::Long;
1285 Getopt::Long::GetOptions(
1286 'fastcgi|fcgi|f' => \&configure_as_fcgi,
1287 'nproc|n=i' => sub {
1288 my ($arg, $val) = @_;
1289 return unless eval { require FCGI::ProcManager; 1; };
1290 my $proc_manager = FCGI::ProcManager->new({
1291 n_processes => $val,
1292 });
1293 our $pre_listen_hook = sub { $proc_manager->pm_manage() };
1294 our $pre_dispatch_hook = sub { $proc_manager->pm_pre_dispatch() };
1295 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1296 },
1297 );
1298 }
1299
1300 sub run {
1301 evaluate_argv();
1302
1303 $first_request = 1;
1304 $pre_listen_hook->()
1305 if $pre_listen_hook;
1306
1307 REQUEST:
1308 while ($cgi = $CGI->new()) {
1309 $pre_dispatch_hook->()
1310 if $pre_dispatch_hook;
1311
1312 run_request();
1313
1314 $post_dispatch_hook->()
1315 if $post_dispatch_hook;
1316 $first_request = 0;
1317
1318 last REQUEST if ($is_last_request->());
1319 }
1320
1321 DONE_GITWEB:
1322 1;
1323 }
1324
1325 run();
1326
1327 if (defined caller) {
1328 # wrapped in a subroutine processing requests,
1329 # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1330 return;
1331 } else {
1332 # pure CGI script, serving single request
1333 exit;
1334 }
1335
1336 ## ======================================================================
1337 ## action links
1338
1339 # possible values of extra options
1340 # -full => 0|1 - use absolute/full URL ($my_uri/$my_url as base)
1341 # -replay => 1 - start from a current view (replay with modifications)
1342 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1343 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1344 sub href {
1345 my %params = @_;
1346 # default is to use -absolute url() i.e. $my_uri
1347 my $href = $params{-full} ? $my_url : $my_uri;
1348
1349 # implicit -replay, must be first of implicit params
1350 $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1351
1352 $params{'project'} = $project unless exists $params{'project'};
1353
1354 if ($params{-replay}) {
1355 while (my ($name, $symbol) = each %cgi_param_mapping) {
1356 if (!exists $params{$name}) {
1357 $params{$name} = $input_params{$name};
1358 }
1359 }
1360 }
1361
1362 my $use_pathinfo = gitweb_check_feature('pathinfo');
1363 if (defined $params{'project'} &&
1364 (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1365 # try to put as many parameters as possible in PATH_INFO:
1366 # - project name
1367 # - action
1368 # - hash_parent or hash_parent_base:/file_parent
1369 # - hash or hash_base:/filename
1370 # - the snapshot_format as an appropriate suffix
1371
1372 # When the script is the root DirectoryIndex for the domain,
1373 # $href here would be something like http://gitweb.example.com/
1374 # Thus, we strip any trailing / from $href, to spare us double
1375 # slashes in the final URL
1376 $href =~ s,/$,,;
1377
1378 # Then add the project name, if present
1379 $href .= "/".esc_path_info($params{'project'});
1380 delete $params{'project'};
1381
1382 # since we destructively absorb parameters, we keep this
1383 # boolean that remembers if we're handling a snapshot
1384 my $is_snapshot = $params{'action'} eq 'snapshot';
1385
1386 # Summary just uses the project path URL, any other action is
1387 # added to the URL
1388 if (defined $params{'action'}) {
1389 $href .= "/".esc_path_info($params{'action'})
1390 unless $params{'action'} eq 'summary';
1391 delete $params{'action'};
1392 }
1393
1394 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1395 # stripping nonexistent or useless pieces
1396 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1397 || $params{'hash_parent'} || $params{'hash'});
1398 if (defined $params{'hash_base'}) {
1399 if (defined $params{'hash_parent_base'}) {
1400 $href .= esc_path_info($params{'hash_parent_base'});
1401 # skip the file_parent if it's the same as the file_name
1402 if (defined $params{'file_parent'}) {
1403 if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1404 delete $params{'file_parent'};
1405 } elsif ($params{'file_parent'} !~ /\.\./) {
1406 $href .= ":/".esc_path_info($params{'file_parent'});
1407 delete $params{'file_parent'};
1408 }
1409 }
1410 $href .= "..";
1411 delete $params{'hash_parent'};
1412 delete $params{'hash_parent_base'};
1413 } elsif (defined $params{'hash_parent'}) {
1414 $href .= esc_path_info($params{'hash_parent'}). "..";
1415 delete $params{'hash_parent'};
1416 }
1417
1418 $href .= esc_path_info($params{'hash_base'});
1419 if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1420 $href .= ":/".esc_path_info($params{'file_name'});
1421 delete $params{'file_name'};
1422 }
1423 delete $params{'hash'};
1424 delete $params{'hash_base'};
1425 } elsif (defined $params{'hash'}) {
1426 $href .= esc_path_info($params{'hash'});
1427 delete $params{'hash'};
1428 }
1429
1430 # If the action was a snapshot, we can absorb the
1431 # snapshot_format parameter too
1432 if ($is_snapshot) {
1433 my $fmt = $params{'snapshot_format'};
1434 # snapshot_format should always be defined when href()
1435 # is called, but just in case some code forgets, we
1436 # fall back to the default
1437 $fmt ||= $snapshot_fmts[0];
1438 $href .= $known_snapshot_formats{$fmt}{'suffix'};
1439 delete $params{'snapshot_format'};
1440 }
1441 }
1442
1443 # now encode the parameters explicitly
1444 my @result = ();
1445 for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1446 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1447 if (defined $params{$name}) {
1448 if (ref($params{$name}) eq "ARRAY") {
1449 foreach my $par (@{$params{$name}}) {
1450 push @result, $symbol . "=" . esc_param($par);
1451 }
1452 } else {
1453 push @result, $symbol . "=" . esc_param($params{$name});
1454 }
1455 }
1456 }
1457 $href .= "?" . join(';', @result) if scalar @result;
1458
1459 # final transformation: trailing spaces must be escaped (URI-encoded)
1460 $href =~ s/(\s+)$/CGI::escape($1)/e;
1461
1462 if ($params{-anchor}) {
1463 $href .= "#".esc_param($params{-anchor});
1464 }
1465
1466 return $href;
1467 }
1468
1469
1470 ## ======================================================================
1471 ## validation, quoting/unquoting and escaping
1472
1473 sub is_valid_action {
1474 my $input = shift;
1475 return undef unless exists $actions{$input};
1476 return 1;
1477 }
1478
1479 sub is_valid_project {
1480 my $input = shift;
1481
1482 return unless defined $input;
1483 if (!is_valid_pathname($input) ||
1484 !(-d "$projectroot/$input") ||
1485 !check_export_ok("$projectroot/$input") ||
1486 ($strict_export && !project_in_list($input))) {
1487 return undef;
1488 } else {
1489 return 1;
1490 }
1491 }
1492
1493 sub is_valid_pathname {
1494 my $input = shift;
1495
1496 return undef unless defined $input;
1497 # no '.' or '..' as elements of path, i.e. no '.' or '..'
1498 # at the beginning, at the end, and between slashes.
1499 # also this catches doubled slashes
1500 if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1501 return undef;
1502 }
1503 # no null characters
1504 if ($input =~ m!\0!) {
1505 return undef;
1506 }
1507 return 1;
1508 }
1509
1510 sub is_valid_ref_format {
1511 my $input = shift;
1512
1513 return undef unless defined $input;
1514 # restrictions on ref name according to git-check-ref-format
1515 if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1516 return undef;
1517 }
1518 return 1;
1519 }
1520
1521 sub is_valid_refname {
1522 my $input = shift;
1523
1524 return undef unless defined $input;
1525 # textual hashes are O.K.
1526 if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1527 return 1;
1528 }
1529 # it must be correct pathname
1530 is_valid_pathname($input) or return undef;
1531 # check git-check-ref-format restrictions
1532 is_valid_ref_format($input) or return undef;
1533 return 1;
1534 }
1535
1536 # decode sequences of octets in utf8 into Perl's internal form,
1537 # which is utf-8 with utf8 flag set if needed. gitweb writes out
1538 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
1539 sub to_utf8 {
1540 my $str = shift;
1541 return undef unless defined $str;
1542
1543 if (utf8::is_utf8($str) || utf8::decode($str)) {
1544 return $str;
1545 } else {
1546 return decode($fallback_encoding, $str, Encode::FB_DEFAULT);
1547 }
1548 }
1549
1550 # quote unsafe chars, but keep the slash, even when it's not
1551 # correct, but quoted slashes look too horrible in bookmarks
1552 sub esc_param {
1553 my $str = shift;
1554 return undef unless defined $str;
1555 $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
1556 $str =~ s/ /\+/g;
1557 return $str;
1558 }
1559
1560 # the quoting rules for path_info fragment are slightly different
1561 sub esc_path_info {
1562 my $str = shift;
1563 return undef unless defined $str;
1564
1565 # path_info doesn't treat '+' as space (specially), but '?' must be escaped
1566 $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
1567
1568 return $str;
1569 }
1570
1571 # quote unsafe chars in whole URL, so some characters cannot be quoted
1572 sub esc_url {
1573 my $str = shift;
1574 return undef unless defined $str;
1575 $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
1576 $str =~ s/ /\+/g;
1577 return $str;
1578 }
1579
1580 # quote unsafe characters in HTML attributes
1581 sub esc_attr {
1582
1583 # for XHTML conformance escaping '"' to '&quot;' is not enough
1584 return esc_html(@_);
1585 }
1586
1587 # replace invalid utf8 character with SUBSTITUTION sequence
1588 sub esc_html {
1589 my $str = shift;
1590 my %opts = @_;
1591
1592 return undef unless defined $str;
1593
1594 $str = to_utf8($str);
1595 $str = $cgi->escapeHTML($str);
1596 if ($opts{'-nbsp'}) {
1597 $str =~ s/ /&nbsp;/g;
1598 }
1599 $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
1600 return $str;
1601 }
1602
1603 # quote control characters and escape filename to HTML
1604 sub esc_path {
1605 my $str = shift;
1606 my %opts = @_;
1607
1608 return undef unless defined $str;
1609
1610 $str = to_utf8($str);
1611 $str = $cgi->escapeHTML($str);
1612 if ($opts{'-nbsp'}) {
1613 $str =~ s/ /&nbsp;/g;
1614 }
1615 $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
1616 return $str;
1617 }
1618
1619 # Sanitize for use in XHTML + application/xml+xhtml (valid XML 1.0)
1620 sub sanitize {
1621 my $str = shift;
1622
1623 return undef unless defined $str;
1624
1625 $str = to_utf8($str);
1626 $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
1627 return $str;
1628 }
1629
1630 # Make control characters "printable", using character escape codes (CEC)
1631 sub quot_cec {
1632 my $cntrl = shift;
1633 my %opts = @_;
1634 my %es = ( # character escape codes, aka escape sequences
1635 "\t" => '\t', # tab (HT)
1636 "\n" => '\n', # line feed (LF)
1637 "\r" => '\r', # carrige return (CR)
1638 "\f" => '\f', # form feed (FF)
1639 "\b" => '\b', # backspace (BS)
1640 "\a" => '\a', # alarm (bell) (BEL)
1641 "\e" => '\e', # escape (ESC)
1642 "\013" => '\v', # vertical tab (VT)
1643 "\000" => '\0', # nul character (NUL)
1644 );
1645 my $chr = ( (exists $es{$cntrl})
1646 ? $es{$cntrl}
1647 : sprintf('\%2x', ord($cntrl)) );
1648 if ($opts{-nohtml}) {
1649 return $chr;
1650 } else {
1651 return "<span class=\"cntrl\">$chr</span>";
1652 }
1653 }
1654
1655 # Alternatively use unicode control pictures codepoints,
1656 # Unicode "printable representation" (PR)
1657 sub quot_upr {
1658 my $cntrl = shift;
1659 my %opts = @_;
1660
1661 my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
1662 if ($opts{-nohtml}) {
1663 return $chr;
1664 } else {
1665 return "<span class=\"cntrl\">$chr</span>";
1666 }
1667 }
1668
1669 # git may return quoted and escaped filenames
1670 sub unquote {
1671 my $str = shift;
1672
1673 sub unq {
1674 my $seq = shift;
1675 my %es = ( # character escape codes, aka escape sequences
1676 't' => "\t", # tab (HT, TAB)
1677 'n' => "\n", # newline (NL)
1678 'r' => "\r", # return (CR)
1679 'f' => "\f", # form feed (FF)
1680 'b' => "\b", # backspace (BS)
1681 'a' => "\a", # alarm (bell) (BEL)
1682 'e' => "\e", # escape (ESC)
1683 'v' => "\013", # vertical tab (VT)
1684 );
1685
1686 if ($seq =~ m/^[0-7]{1,3}$/) {
1687 # octal char sequence
1688 return chr(oct($seq));
1689 } elsif (exists $es{$seq}) {
1690 # C escape sequence, aka character escape code
1691 return $es{$seq};
1692 }
1693 # quoted ordinary character
1694 return $seq;
1695 }
1696
1697 if ($str =~ m/^"(.*)"$/) {
1698 # needs unquoting
1699 $str = $1;
1700 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
1701 }
1702 return $str;
1703 }
1704
1705 # escape tabs (convert tabs to spaces)
1706 sub untabify {
1707 my $line = shift;
1708
1709 while ((my $pos = index($line, "\t")) != -1) {
1710 if (my $count = (8 - ($pos % 8))) {
1711 my $spaces = ' ' x $count;
1712 $line =~ s/\t/$spaces/;
1713 }
1714 }
1715
1716 return $line;
1717 }
1718
1719 sub project_in_list {
1720 my $project = shift;
1721 my @list = git_get_projects_list();
1722 return @list && scalar(grep { $_->{'path'} eq $project } @list);
1723 }
1724
1725 ## ----------------------------------------------------------------------
1726 ## HTML aware string manipulation
1727
1728 # Try to chop given string on a word boundary between position
1729 # $len and $len+$add_len. If there is no word boundary there,
1730 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
1731 # (marking chopped part) would be longer than given string.
1732 sub chop_str {
1733 my $str = shift;
1734 my $len = shift;
1735 my $add_len = shift || 10;
1736 my $where = shift || 'right'; # 'left' | 'center' | 'right'
1737
1738 # Make sure perl knows it is utf8 encoded so we don't
1739 # cut in the middle of a utf8 multibyte char.
1740 $str = to_utf8($str);
1741
1742 # allow only $len chars, but don't cut a word if it would fit in $add_len
1743 # if it doesn't fit, cut it if it's still longer than the dots we would add
1744 # remove chopped character entities entirely
1745
1746 # when chopping in the middle, distribute $len into left and right part
1747 # return early if chopping wouldn't make string shorter
1748 if ($where eq 'center') {
1749 return $str if ($len + 5 >= length($str)); # filler is length 5
1750 $len = int($len/2);
1751 } else {
1752 return $str if ($len + 4 >= length($str)); # filler is length 4
1753 }
1754
1755 # regexps: ending and beginning with word part up to $add_len
1756 my $endre = qr/.{$len}\w{0,$add_len}/;
1757 my $begre = qr/\w{0,$add_len}.{$len}/;
1758
1759 if ($where eq 'left') {
1760 $str =~ m/^(.*?)($begre)$/;
1761 my ($lead, $body) = ($1, $2);
1762 if (length($lead) > 4) {
1763 $lead = " ...";
1764 }
1765 return "$lead$body";
1766
1767 } elsif ($where eq 'center') {
1768 $str =~ m/^($endre)(.*)$/;
1769 my ($left, $str) = ($1, $2);
1770 $str =~ m/^(.*?)($begre)$/;
1771 my ($mid, $right) = ($1, $2);
1772 if (length($mid) > 5) {
1773 $mid = " ... ";
1774 }
1775 return "$left$mid$right";
1776
1777 } else {
1778 $str =~ m/^($endre)(.*)$/;
1779 my $body = $1;
1780 my $tail = $2;
1781 if (length($tail) > 4) {
1782 $tail = "... ";
1783 }
1784 return "$body$tail";
1785 }
1786 }
1787
1788 # takes the same arguments as chop_str, but also wraps a <span> around the
1789 # result with a title attribute if it does get chopped. Additionally, the
1790 # string is HTML-escaped.
1791 sub chop_and_escape_str {
1792 my ($str) = @_;
1793
1794 my $chopped = chop_str(@_);
1795 $str = to_utf8($str);
1796 if ($chopped eq $str) {
1797 return esc_html($chopped);
1798 } else {
1799 $str =~ s/[[:cntrl:]]/?/g;
1800 return $cgi->span({-title=>$str}, esc_html($chopped));
1801 }
1802 }
1803
1804 # Highlight selected fragments of string, using given CSS class,
1805 # and escape HTML. It is assumed that fragments do not overlap.
1806 # Regions are passed as list of pairs (array references).
1807 #
1808 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
1809 # '<span class="mark">foo</span>bar'
1810 sub esc_html_hl_regions {
1811 my ($str, $css_class, @sel) = @_;
1812 my %opts = grep { ref($_) ne 'ARRAY' } @sel;
1813 @sel = grep { ref($_) eq 'ARRAY' } @sel;
1814 return esc_html($str, %opts) unless @sel;
1815
1816 my $out = '';
1817 my $pos = 0;
1818
1819 for my $s (@sel) {
1820 my ($begin, $end) = @$s;
1821
1822 # Don't create empty <span> elements.
1823 next if $end <= $begin;
1824
1825 my $escaped = esc_html(substr($str, $begin, $end - $begin),
1826 %opts);
1827
1828 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
1829 if ($begin - $pos > 0);
1830 $out .= $cgi->span({-class => $css_class}, $escaped);
1831
1832 $pos = $end;
1833 }
1834 $out .= esc_html(substr($str, $pos), %opts)
1835 if ($pos < length($str));
1836
1837 return $out;
1838 }
1839
1840 # return positions of beginning and end of each match
1841 sub matchpos_list {
1842 my ($str, $regexp) = @_;
1843 return unless (defined $str && defined $regexp);
1844
1845 my @matches;
1846 while ($str =~ /$regexp/g) {
1847 push @matches, [$-[0], $+[0]];
1848 }
1849 return @matches;
1850 }
1851
1852 # highlight match (if any), and escape HTML
1853 sub esc_html_match_hl {
1854 my ($str, $regexp) = @_;
1855 return esc_html($str) unless defined $regexp;
1856
1857 my @matches = matchpos_list($str, $regexp);
1858 return esc_html($str) unless @matches;
1859
1860 return esc_html_hl_regions($str, 'match', @matches);
1861 }
1862
1863
1864 # highlight match (if any) of shortened string, and escape HTML
1865 sub esc_html_match_hl_chopped {
1866 my ($str, $chopped, $regexp) = @_;
1867 return esc_html_match_hl($str, $regexp) unless defined $chopped;
1868
1869 my @matches = matchpos_list($str, $regexp);
1870 return esc_html($chopped) unless @matches;
1871
1872 # filter matches so that we mark chopped string
1873 my $tail = "... "; # see chop_str
1874 unless ($chopped =~ s/\Q$tail\E$//) {
1875 $tail = '';
1876 }
1877 my $chop_len = length($chopped);
1878 my $tail_len = length($tail);
1879 my @filtered;
1880
1881 for my $m (@matches) {
1882 if ($m->[0] > $chop_len) {
1883 push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
1884 last;
1885 } elsif ($m->[1] > $chop_len) {
1886 push @filtered, [ $m->[0], $chop_len + $tail_len ];
1887 last;
1888 }
1889 push @filtered, $m;
1890 }
1891
1892 return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
1893 }
1894
1895 ## ----------------------------------------------------------------------
1896 ## functions returning short strings
1897
1898 # CSS class for given age value (in seconds)
1899 sub age_class {
1900 my $age = shift;
1901
1902 if (!defined $age) {
1903 return "noage";
1904 } elsif ($age < 60*60*2) {
1905 return "age0";
1906 } elsif ($age < 60*60*24*2) {
1907 return "age1";
1908 } else {
1909 return "age2";
1910 }
1911 }
1912
1913 # convert age in seconds to "nn units ago" string
1914 sub age_string {
1915 my $age = shift;
1916 my $age_str;
1917
1918 if ($age > 60*60*24*365*2) {
1919 $age_str = (int $age/60/60/24/365);
1920 $age_str .= " years ago";
1921 } elsif ($age > 60*60*24*(365/12)*2) {
1922 $age_str = int $age/60/60/24/(365/12);
1923 $age_str .= " months ago";
1924 } elsif ($age > 60*60*24*7*2) {
1925 $age_str = int $age/60/60/24/7;
1926 $age_str .= " weeks ago";
1927 } elsif ($age > 60*60*24*2) {
1928 $age_str = int $age/60/60/24;
1929 $age_str .= " days ago";
1930 } elsif ($age > 60*60*2) {
1931 $age_str = int $age/60/60;
1932 $age_str .= " hours ago";
1933 } elsif ($age > 60*2) {
1934 $age_str = int $age/60;
1935 $age_str .= " min ago";
1936 } elsif ($age > 2) {
1937 $age_str = int $age;
1938 $age_str .= " sec ago";
1939 } else {
1940 $age_str .= " right now";
1941 }
1942 return $age_str;
1943 }
1944
1945 use constant {
1946 S_IFINVALID => 0030000,
1947 S_IFGITLINK => 0160000,
1948 };
1949
1950 # submodule/subproject, a commit object reference
1951 sub S_ISGITLINK {
1952 my $mode = shift;
1953
1954 return (($mode & S_IFMT) == S_IFGITLINK)
1955 }
1956
1957 # convert file mode in octal to symbolic file mode string
1958 sub mode_str {
1959 my $mode = oct shift;
1960
1961 if (S_ISGITLINK($mode)) {
1962 return 'm---------';
1963 } elsif (S_ISDIR($mode & S_IFMT)) {
1964 return 'drwxr-xr-x';
1965 } elsif (S_ISLNK($mode)) {
1966 return 'lrwxrwxrwx';
1967 } elsif (S_ISREG($mode)) {
1968 # git cares only about the executable bit
1969 if ($mode & S_IXUSR) {
1970 return '-rwxr-xr-x';
1971 } else {
1972 return '-rw-r--r--';
1973 };
1974 } else {
1975 return '----------';
1976 }
1977 }
1978
1979 # convert file mode in octal to file type string
1980 sub file_type {
1981 my $mode = shift;
1982
1983 if ($mode !~ m/^[0-7]+$/) {
1984 return $mode;
1985 } else {
1986 $mode = oct $mode;
1987 }
1988
1989 if (S_ISGITLINK($mode)) {
1990 return "submodule";
1991 } elsif (S_ISDIR($mode & S_IFMT)) {
1992 return "directory";
1993 } elsif (S_ISLNK($mode)) {
1994 return "symlink";
1995 } elsif (S_ISREG($mode)) {
1996 return "file";
1997 } else {
1998 return "unknown";
1999 }
2000 }
2001
2002 # convert file mode in octal to file type description string
2003 sub file_type_long {
2004 my $mode = shift;
2005
2006 if ($mode !~ m/^[0-7]+$/) {
2007 return $mode;
2008 } else {
2009 $mode = oct $mode;
2010 }
2011
2012 if (S_ISGITLINK($mode)) {
2013 return "submodule";
2014 } elsif (S_ISDIR($mode & S_IFMT)) {
2015 return "directory";
2016 } elsif (S_ISLNK($mode)) {
2017 return "symlink";
2018 } elsif (S_ISREG($mode)) {
2019 if ($mode & S_IXUSR) {
2020 return "executable";
2021 } else {
2022 return "file";
2023 };
2024 } else {
2025 return "unknown";
2026 }
2027 }
2028
2029
2030 ## ----------------------------------------------------------------------
2031 ## functions returning short HTML fragments, or transforming HTML fragments
2032 ## which don't belong to other sections
2033
2034 # format line of commit message.
2035 sub format_log_line_html {
2036 my $line = shift;
2037
2038 $line = esc_html($line, -nbsp=>1);
2039 $line =~ s{
2040 \b
2041 (
2042 # The output of "git describe", e.g. v2.10.0-297-gf6727b0
2043 # or hadoop-20160921-113441-20-g094fb7d
2044 (?<!-) # see strbuf_check_tag_ref(). Tags can't start with -
2045 [A-Za-z0-9.-]+
2046 (?!\.) # refs can't end with ".", see check_refname_format()
2047 -g[0-9a-fA-F]{7,40}
2048 |
2049 # Just a normal looking Git SHA1
2050 [0-9a-fA-F]{7,40}
2051 )
2052 \b
2053 }{
2054 $cgi->a({-href => href(action=>"object", hash=>$1),
2055 -class => "text"}, $1);
2056 }egx;
2057
2058 return $line;
2059 }
2060
2061 # format marker of refs pointing to given object
2062
2063 # the destination action is chosen based on object type and current context:
2064 # - for annotated tags, we choose the tag view unless it's the current view
2065 # already, in which case we go to shortlog view
2066 # - for other refs, we keep the current view if we're in history, shortlog or
2067 # log view, and select shortlog otherwise
2068 sub format_ref_marker {
2069 my ($refs, $id) = @_;
2070 my $markers = '';
2071
2072 if (defined $refs->{$id}) {
2073 foreach my $ref (@{$refs->{$id}}) {
2074 # this code exploits the fact that non-lightweight tags are the
2075 # only indirect objects, and that they are the only objects for which
2076 # we want to use tag instead of shortlog as action
2077 my ($type, $name) = qw();
2078 my $indirect = ($ref =~ s/\^\{\}$//);
2079 # e.g. tags/v2.6.11 or heads/next
2080 if ($ref =~ m!^(.*?)s?/(.*)$!) {
2081 $type = $1;
2082 $name = $2;
2083 } else {
2084 $type = "ref";
2085 $name = $ref;
2086 }
2087
2088 my $class = $type;
2089 $class .= " indirect" if $indirect;
2090
2091 my $dest_action = "shortlog";
2092
2093 if ($indirect) {
2094 $dest_action = "tag" unless $action eq "tag";
2095 } elsif ($action =~ /^(history|(short)?log)$/) {
2096 $dest_action = $action;
2097 }
2098
2099 my $dest = "";
2100 $dest .= "refs/" unless $ref =~ m!^refs/!;
2101 $dest .= $ref;
2102
2103 my $link = $cgi->a({
2104 -href => href(
2105 action=>$dest_action,
2106 hash=>$dest
2107 )}, esc_html($name));
2108
2109 $markers .= " <span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2110 $link . "</span>";
2111 }
2112 }
2113
2114 if ($markers) {
2115 return ' <span class="refs">'. $markers . '</span>';
2116 } else {
2117 return "";
2118 }
2119 }
2120
2121 # format, perhaps shortened and with markers, title line
2122 sub format_subject_html {
2123 my ($long, $short, $href, $extra) = @_;
2124 $extra = '' unless defined($extra);
2125
2126 if (length($short) < length($long)) {
2127 $long =~ s/[[:cntrl:]]/?/g;
2128 return $cgi->a({-href => $href, -class => "list subject",
2129 -title => to_utf8($long)},
2130 esc_html($short)) . $extra;
2131 } else {
2132 return $cgi->a({-href => $href, -class => "list subject"},
2133 esc_html($long)) . $extra;
2134 }
2135 }
2136
2137 # Rather than recomputing the url for an email multiple times, we cache it
2138 # after the first hit. This gives a visible benefit in views where the avatar
2139 # for the same email is used repeatedly (e.g. shortlog).
2140 # The cache is shared by all avatar engines (currently gravatar only), which
2141 # are free to use it as preferred. Since only one avatar engine is used for any
2142 # given page, there's no risk for cache conflicts.
2143 our %avatar_cache = ();
2144
2145 # Compute the picon url for a given email, by using the picon search service over at
2146 # http://www.cs.indiana.edu/picons/search.html
2147 sub picon_url {
2148 my $email = lc shift;
2149 if (!$avatar_cache{$email}) {
2150 my ($user, $domain) = split('@', $email);
2151 $avatar_cache{$email} =
2152 "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2153 "$domain/$user/" .
2154 "users+domains+unknown/up/single";
2155 }
2156 return $avatar_cache{$email};
2157 }
2158
2159 # Compute the gravatar url for a given email, if it's not in the cache already.
2160 # Gravatar stores only the part of the URL before the size, since that's the
2161 # one computationally more expensive. This also allows reuse of the cache for
2162 # different sizes (for this particular engine).
2163 sub gravatar_url {
2164 my $email = lc shift;
2165 my $size = shift;
2166 $avatar_cache{$email} ||=
2167 "//www.gravatar.com/avatar/" .
2168 Digest::MD5::md5_hex($email) . "?s=";
2169 return $avatar_cache{$email} . $size;
2170 }
2171
2172 # Insert an avatar for the given $email at the given $size if the feature
2173 # is enabled.
2174 sub git_get_avatar {
2175 my ($email, %opts) = @_;
2176 my $pre_white = ($opts{-pad_before} ? "&nbsp;" : "");
2177 my $post_white = ($opts{-pad_after} ? "&nbsp;" : "");
2178 $opts{-size} ||= 'default';
2179 my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2180 my $url = "";
2181 if ($git_avatar eq 'gravatar') {
2182 $url = gravatar_url($email, $size);
2183 } elsif ($git_avatar eq 'picon') {
2184 $url = picon_url($email);
2185 }
2186 # Other providers can be added by extending the if chain, defining $url
2187 # as needed. If no variant puts something in $url, we assume avatars
2188 # are completely disabled/unavailable.
2189 if ($url) {
2190 return $pre_white .
2191 "<img width=\"$size\" " .
2192 "class=\"avatar\" " .
2193 "src=\"".esc_url($url)."\" " .
2194 "alt=\"\" " .
2195 "/>" . $post_white;
2196 } else {
2197 return "";
2198 }
2199 }
2200
2201 sub format_search_author {
2202 my ($author, $searchtype, $displaytext) = @_;
2203 my $have_search = gitweb_check_feature('search');
2204
2205 if ($have_search) {
2206 my $performed = "";
2207 if ($searchtype eq 'author') {
2208 $performed = "authored";
2209 } elsif ($searchtype eq 'committer') {
2210 $performed = "committed";
2211 }
2212
2213 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2214 searchtext=>$author,
2215 searchtype=>$searchtype), class=>"list",
2216 title=>"Search for commits $performed by $author"},
2217 $displaytext);
2218
2219 } else {
2220 return $displaytext;
2221 }
2222 }
2223
2224 # format the author name of the given commit with the given tag
2225 # the author name is chopped and escaped according to the other
2226 # optional parameters (see chop_str).
2227 sub format_author_html {
2228 my $tag = shift;
2229 my $co = shift;
2230 my $author = chop_and_escape_str($co->{'author_name'}, @_);
2231 return "<$tag class=\"author\">" .
2232 format_search_author($co->{'author_name'}, "author",
2233 git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2234 $author) .
2235 "</$tag>";
2236 }
2237
2238 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
2239 sub format_git_diff_header_line {
2240 my $line = shift;
2241 my $diffinfo = shift;
2242 my ($from, $to) = @_;
2243
2244 if ($diffinfo->{'nparents'}) {
2245 # combined diff
2246 $line =~ s!^(diff (.*?) )"?.*$!$1!;
2247 if ($to->{'href'}) {
2248 $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2249 esc_path($to->{'file'}));
2250 } else { # file was deleted (no href)
2251 $line .= esc_path($to->{'file'});
2252 }
2253 } else {
2254 # "ordinary" diff
2255 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
2256 if ($from->{'href'}) {
2257 $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
2258 'a/' . esc_path($from->{'file'}));
2259 } else { # file was added (no href)
2260 $line .= 'a/' . esc_path($from->{'file'});
2261 }
2262 $line .= ' ';
2263 if ($to->{'href'}) {
2264 $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2265 'b/' . esc_path($to->{'file'}));
2266 } else { # file was deleted
2267 $line .= 'b/' . esc_path($to->{'file'});
2268 }
2269 }
2270
2271 return "<div class=\"diff header\">$line</div>\n";
2272 }
2273
2274 # format extended diff header line, before patch itself
2275 sub format_extended_diff_header_line {
2276 my $line = shift;
2277 my $diffinfo = shift;
2278 my ($from, $to) = @_;
2279
2280 # match <path>
2281 if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
2282 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2283 esc_path($from->{'file'}));
2284 }
2285 if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
2286 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2287 esc_path($to->{'file'}));
2288 }
2289 # match single <mode>
2290 if ($line =~ m/\s(\d{6})$/) {
2291 $line .= '<span class="info"> (' .
2292 file_type_long($1) .
2293 ')</span>';
2294 }
2295 # match <hash>
2296 if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
2297 # can match only for combined diff
2298 $line = 'index ';
2299 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2300 if ($from->{'href'}[$i]) {
2301 $line .= $cgi->a({-href=>$from->{'href'}[$i],
2302 -class=>"hash"},
2303 substr($diffinfo->{'from_id'}[$i],0,7));
2304 } else {
2305 $line .= '0' x 7;
2306 }
2307 # separator
2308 $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
2309 }
2310 $line .= '..';
2311 if ($to->{'href'}) {
2312 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2313 substr($diffinfo->{'to_id'},0,7));
2314 } else {
2315 $line .= '0' x 7;
2316 }
2317
2318 } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
2319 # can match only for ordinary diff
2320 my ($from_link, $to_link);
2321 if ($from->{'href'}) {
2322 $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
2323 substr($diffinfo->{'from_id'},0,7));
2324 } else {
2325 $from_link = '0' x 7;
2326 }
2327 if ($to->{'href'}) {
2328 $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2329 substr($diffinfo->{'to_id'},0,7));
2330 } else {
2331 $to_link = '0' x 7;
2332 }
2333 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
2334 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
2335 }
2336
2337 return $line . "<br/>\n";
2338 }
2339
2340 # format from-file/to-file diff header
2341 sub format_diff_from_to_header {
2342 my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
2343 my $line;
2344 my $result = '';
2345
2346 $line = $from_line;
2347 #assert($line =~ m/^---/) if DEBUG;
2348 # no extra formatting for "^--- /dev/null"
2349 if (! $diffinfo->{'nparents'}) {
2350 # ordinary (single parent) diff
2351 if ($line =~ m!^--- "?a/!) {
2352 if ($from->{'href'}) {
2353 $line = '--- a/' .
2354 $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2355 esc_path($from->{'file'}));
2356 } else {
2357 $line = '--- a/' .
2358 esc_path($from->{'file'});
2359 }
2360 }
2361 $result .= qq!<div class="diff from_file">$line</div>\n!;
2362
2363 } else {
2364 # combined diff (merge commit)
2365 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2366 if ($from->{'href'}[$i]) {
2367 $line = '--- ' .
2368 $cgi->a({-href=>href(action=>"blobdiff",
2369 hash_parent=>$diffinfo->{'from_id'}[$i],
2370 hash_parent_base=>$parents[$i],
2371 file_parent=>$from->{'file'}[$i],
2372 hash=>$diffinfo->{'to_id'},
2373 hash_base=>$hash,
2374 file_name=>$to->{'file'}),
2375 -class=>"path",
2376 -title=>"diff" . ($i+1)},
2377 $i+1) .
2378 '/' .
2379 $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
2380 esc_path($from->{'file'}[$i]));
2381 } else {
2382 $line = '--- /dev/null';
2383 }
2384 $result .= qq!<div class="diff from_file">$line</div>\n!;
2385 }
2386 }
2387
2388 $line = $to_line;
2389 #assert($line =~ m/^\+\+\+/) if DEBUG;
2390 # no extra formatting for "^+++ /dev/null"
2391 if ($line =~ m!^\+\+\+ "?b/!) {
2392 if ($to->{'href'}) {
2393 $line = '+++ b/' .
2394 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2395 esc_path($to->{'file'}));
2396 } else {
2397 $line = '+++ b/' .
2398 esc_path($to->{'file'});
2399 }
2400 }
2401 $result .= qq!<div class="diff to_file">$line</div>\n!;
2402
2403 return $result;
2404 }
2405
2406 # create note for patch simplified by combined diff
2407 sub format_diff_cc_simplified {
2408 my ($diffinfo, @parents) = @_;
2409 my $result = '';
2410
2411 $result .= "<div class=\"diff header\">" .
2412 "diff --cc ";
2413 if (!is_deleted($diffinfo)) {
2414 $result .= $cgi->a({-href => href(action=>"blob",
2415 hash_base=>$hash,
2416 hash=>$diffinfo->{'to_id'},
2417 file_name=>$diffinfo->{'to_file'}),
2418 -class => "path"},
2419 esc_path($diffinfo->{'to_file'}));
2420 } else {
2421 $result .= esc_path($diffinfo->{'to_file'});
2422 }
2423 $result .= "</div>\n" . # class="diff header"
2424 "<div class=\"diff nodifferences\">" .
2425 "Simple merge" .
2426 "</div>\n"; # class="diff nodifferences"
2427
2428 return $result;
2429 }
2430
2431 sub diff_line_class {
2432 my ($line, $from, $to) = @_;
2433
2434 # ordinary diff
2435 my $num_sign = 1;
2436 # combined diff
2437 if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
2438 $num_sign = scalar @{$from->{'href'}};
2439 }
2440
2441 my @diff_line_classifier = (
2442 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
2443 { regexp => qr/^\\/, class => "incomplete" },
2444 { regexp => qr/^ {$num_sign}/, class => "ctx" },
2445 # classifier for context must come before classifier add/rem,
2446 # or we would have to use more complicated regexp, for example
2447 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
2448 { regexp => qr/^[+ ]{$num_sign}/, class => "add" },
2449 { regexp => qr/^[- ]{$num_sign}/, class => "rem" },
2450 );
2451 for my $clsfy (@diff_line_classifier) {
2452 return $clsfy->{'class'}
2453 if ($line =~ $clsfy->{'regexp'});
2454 }
2455
2456 # fallback
2457 return "";
2458 }
2459
2460 # assumes that $from and $to are defined and correctly filled,
2461 # and that $line holds a line of chunk header for unified diff
2462 sub format_unidiff_chunk_header {
2463 my ($line, $from, $to) = @_;
2464
2465 my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
2466 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
2467
2468 $from_lines = 0 unless defined $from_lines;
2469 $to_lines = 0 unless defined $to_lines;
2470
2471 if ($from->{'href'}) {
2472 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
2473 -class=>"list"}, $from_text);
2474 }
2475 if ($to->{'href'}) {
2476 $to_text = $cgi->a({-href=>"$to->{'href'}#l$to_start",
2477 -class=>"list"}, $to_text);
2478 }
2479 $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
2480 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
2481 return $line;
2482 }
2483
2484 # assumes that $from and $to are defined and correctly filled,
2485 # and that $line holds a line of chunk header for combined diff
2486 sub format_cc_diff_chunk_header {
2487 my ($line, $from, $to) = @_;
2488
2489 my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
2490 my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
2491
2492 @from_text = split(' ', $ranges);
2493 for (my $i = 0; $i < @from_text; ++$i) {
2494 ($from_start[$i], $from_nlines[$i]) =
2495 (split(',', substr($from_text[$i], 1)), 0);
2496 }
2497
2498 $to_text = pop @from_text;
2499 $to_start = pop @from_start;
2500 $to_nlines = pop @from_nlines;
2501
2502 $line = "<span class=\"chunk_info\">$prefix ";
2503 for (my $i = 0; $i < @from_text; ++$i) {
2504 if ($from->{'href'}[$i]) {
2505 $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
2506 -class=>"list"}, $from_text[$i]);
2507 } else {
2508 $line .= $from_text[$i];
2509 }
2510 $line .= " ";
2511 }
2512 if ($to->{'href'}) {
2513 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
2514 -class=>"list"}, $to_text);
2515 } else {
2516 $line .= $to_text;
2517 }
2518 $line .= " $prefix</span>" .
2519 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
2520 return $line;
2521 }
2522
2523 # process patch (diff) line (not to be used for diff headers),
2524 # returning HTML-formatted (but not wrapped) line.
2525 # If the line is passed as a reference, it is treated as HTML and not
2526 # esc_html()'ed.
2527 sub format_diff_line {
2528 my ($line, $diff_class, $from, $to) = @_;
2529
2530 if (ref($line)) {
2531 $line = $$line;
2532 } else {
2533 chomp $line;
2534 $line = untabify($line);
2535
2536 if ($from && $to && $line =~ m/^\@{2} /) {
2537 $line = format_unidiff_chunk_header($line, $from, $to);
2538 } elsif ($from && $to && $line =~ m/^\@{3}/) {
2539 $line = format_cc_diff_chunk_header($line, $from, $to);
2540 } else {
2541 $line = esc_html($line, -nbsp=>1);
2542 }
2543 }
2544
2545 my $diff_classes = "diff";
2546 $diff_classes .= " $diff_class" if ($diff_class);
2547 $line = "<div class=\"$diff_classes\">$line</div>\n";
2548
2549 return $line;
2550 }
2551
2552 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
2553 # linked. Pass the hash of the tree/commit to snapshot.
2554 sub format_snapshot_links {
2555 my ($hash) = @_;
2556 my $num_fmts = @snapshot_fmts;
2557 if ($num_fmts > 1) {
2558 # A parenthesized list of links bearing format names.
2559 # e.g. "snapshot (_tar.gz_ _zip_)"
2560 return "snapshot (" . join(' ', map
2561 $cgi->a({
2562 -href => href(
2563 action=>"snapshot",
2564 hash=>$hash,
2565 snapshot_format=>$_
2566 )
2567 }, $known_snapshot_formats{$_}{'display'})
2568 , @snapshot_fmts) . ")";
2569 } elsif ($num_fmts == 1) {
2570 # A single "snapshot" link whose tooltip bears the format name.
2571 # i.e. "_snapshot_"
2572 my ($fmt) = @snapshot_fmts;
2573 return
2574 $cgi->a({
2575 -href => href(
2576 action=>"snapshot",
2577 hash=>$hash,
2578 snapshot_format=>$fmt
2579 ),
2580 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
2581 }, "snapshot");
2582 } else { # $num_fmts == 0
2583 return undef;
2584 }
2585 }
2586
2587 ## ......................................................................
2588 ## functions returning values to be passed, perhaps after some
2589 ## transformation, to other functions; e.g. returning arguments to href()
2590
2591 # returns hash to be passed to href to generate gitweb URL
2592 # in -title key it returns description of link
2593 sub get_feed_info {
2594 my $format = shift || 'Atom';
2595 my %res = (action => lc($format));
2596 my $matched_ref = 0;
2597
2598 # feed links are possible only for project views
2599 return unless (defined $project);
2600 # some views should link to OPML, or to generic project feed,
2601 # or don't have specific feed yet (so they should use generic)
2602 return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
2603
2604 my $branch = undef;
2605 # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
2606 # (fullname) to differentiate from tag links; this also makes
2607 # possible to detect branch links
2608 for my $ref (get_branch_refs()) {
2609 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
2610 (defined $hash && $hash =~ m!^refs/\Q$ref\E/(.*)$!)) {
2611 $branch = $1;
2612 $matched_ref = $ref;
2613 last;
2614 }
2615 }
2616 # find log type for feed description (title)
2617 my $type = 'log';
2618 if (defined $file_name) {
2619 $type = "history of $file_name";
2620 $type .= "/" if ($action eq 'tree');
2621 $type .= " on '$branch'" if (defined $branch);
2622 } else {
2623 $type = "log of $branch" if (defined $branch);
2624 }
2625
2626 $res{-title} = $type;
2627 $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
2628 $res{'file_name'} = $file_name;
2629
2630 return %res;
2631 }
2632
2633 ## ----------------------------------------------------------------------
2634 ## git utility subroutines, invoking git commands
2635
2636 # returns path to the core git executable and the --git-dir parameter as list
2637 sub git_cmd {
2638 $number_of_git_cmds++;
2639 return $GIT, '--git-dir='.$git_dir;
2640 }
2641
2642 # quote the given arguments for passing them to the shell
2643 # quote_command("command", "arg 1", "arg with ' and ! characters")
2644 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
2645 # Try to avoid using this function wherever possible.
2646 sub quote_command {
2647 return join(' ',
2648 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
2649 }
2650
2651 # get HEAD ref of given project as hash
2652 sub git_get_head_hash {
2653 return git_get_full_hash(shift, 'HEAD');
2654 }
2655
2656 sub git_get_full_hash {
2657 return git_get_hash(@_);
2658 }
2659
2660 sub git_get_short_hash {
2661 return git_get_hash(@_, '--short=7');
2662 }
2663
2664 sub git_get_hash {
2665 my ($project, $hash, @options) = @_;
2666 my $o_git_dir = $git_dir;
2667 my $retval = undef;
2668 $git_dir = "$projectroot/$project";
2669 if (open my $fd, '-|', git_cmd(), 'rev-parse',
2670 '--verify', '-q', @options, $hash) {
2671 $retval = <$fd>;
2672 chomp $retval if defined $retval;
2673 close $fd;
2674 }
2675 if (defined $o_git_dir) {
2676 $git_dir = $o_git_dir;
2677 }
2678 return $retval;
2679 }
2680
2681 # get type of given object
2682 sub git_get_type {
2683 my $hash = shift;
2684
2685 open my $fd, "-|", git_cmd(), "cat-file", '-t', $hash or return;
2686 my $type = <$fd>;
2687 close $fd or return;
2688 chomp $type;
2689 return $type;
2690 }
2691
2692 # repository configuration
2693 our $config_file = '';
2694 our %config;
2695
2696 # store multiple values for single key as anonymous array reference
2697 # single values stored directly in the hash, not as [ <value> ]
2698 sub hash_set_multi {
2699 my ($hash, $key, $value) = @_;
2700
2701 if (!exists $hash->{$key}) {
2702 $hash->{$key} = $value;
2703 } elsif (!ref $hash->{$key}) {
2704 $hash->{$key} = [ $hash->{$key}, $value ];
2705 } else {
2706 push @{$hash->{$key}}, $value;
2707 }
2708 }
2709
2710 # return hash of git project configuration
2711 # optionally limited to some section, e.g. 'gitweb'
2712 sub git_parse_project_config {
2713 my $section_regexp = shift;
2714 my %config;
2715
2716 local $/ = "\0";
2717
2718 open my $fh, "-|", git_cmd(), "config", '-z', '-l',
2719 or return;
2720
2721 while (my $keyval = <$fh>) {
2722 chomp $keyval;
2723 my ($key, $value) = split(/\n/, $keyval, 2);
2724
2725 hash_set_multi(\%config, $key, $value)
2726 if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
2727 }
2728 close $fh;
2729
2730 return %config;
2731 }
2732
2733 # convert config value to boolean: 'true' or 'false'
2734 # no value, number > 0, 'true' and 'yes' values are true
2735 # rest of values are treated as false (never as error)
2736 sub config_to_bool {
2737 my $val = shift;
2738
2739 return 1 if !defined $val; # section.key
2740
2741 # strip leading and trailing whitespace
2742 $val =~ s/^\s+//;
2743 $val =~ s/\s+$//;
2744
2745 return (($val =~ /^\d+$/ && $val) || # section.key = 1
2746 ($val =~ /^(?:true|yes)$/i)); # section.key = true
2747 }
2748
2749 # convert config value to simple decimal number
2750 # an optional value suffix of 'k', 'm', or 'g' will cause the value
2751 # to be multiplied by 1024, 1048576, or 1073741824
2752 sub config_to_int {
2753 my $val = shift;
2754
2755 # strip leading and trailing whitespace
2756 $val =~ s/^\s+//;
2757 $val =~ s/\s+$//;
2758
2759 if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
2760 $unit = lc($unit);
2761 # unknown unit is treated as 1
2762 return $num * ($unit eq 'g' ? 1073741824 :
2763 $unit eq 'm' ? 1048576 :
2764 $unit eq 'k' ? 1024 : 1);
2765 }
2766 return $val;
2767 }
2768
2769 # convert config value to array reference, if needed
2770 sub config_to_multi {
2771 my $val = shift;
2772
2773 return ref($val) ? $val : (defined($val) ? [ $val ] : []);
2774 }
2775
2776 sub git_get_project_config {
2777 my ($key, $type) = @_;
2778
2779 return unless defined $git_dir;
2780
2781 # key sanity check
2782 return unless ($key);
2783 # only subsection, if exists, is case sensitive,
2784 # and not lowercased by 'git config -z -l'
2785 if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
2786 $lo =~ s/_//g;
2787 $key = join(".", lc($hi), $mi, lc($lo));
2788 return if ($lo =~ /\W/ || $hi =~ /\W/);
2789 } else {
2790 $key = lc($key);
2791 $key =~ s/_//g;
2792 return if ($key =~ /\W/);
2793 }
2794 $key =~ s/^gitweb\.//;
2795
2796 # type sanity check
2797 if (defined $type) {
2798 $type =~ s/^--//;
2799 $type = undef
2800 unless ($type eq 'bool' || $type eq 'int');
2801 }
2802
2803 # get config
2804 if (!defined $config_file ||
2805 $config_file ne "$git_dir/config") {
2806 %config = git_parse_project_config('gitweb');
2807 $config_file = "$git_dir/config";
2808 }
2809
2810 # check if config variable (key) exists
2811 return unless exists $config{"gitweb.$key"};
2812
2813 # ensure given type
2814 if (!defined $type) {
2815 return $config{"gitweb.$key"};
2816 } elsif ($type eq 'bool') {
2817 # backward compatibility: 'git config --bool' returns true/false
2818 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
2819 } elsif ($type eq 'int') {
2820 return config_to_int($config{"gitweb.$key"});
2821 }
2822 return $config{"gitweb.$key"};
2823 }
2824
2825 # get hash of given path at given ref
2826 sub git_get_hash_by_path {
2827 my $base = shift;
2828 my $path = shift || return undef;
2829 my $type = shift;
2830
2831 $path =~ s,/+$,,;
2832
2833 open my $fd, "-|", git_cmd(), "ls-tree", $base, "--", $path
2834 or die_error(500, "Open git-ls-tree failed");
2835 my $line = <$fd>;
2836 close $fd or return undef;
2837
2838 if (!defined $line) {
2839 # there is no tree or hash given by $path at $base
2840 return undef;
2841 }
2842
2843 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c'
2844 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
2845 if (defined $type && $type ne $2) {
2846 # type doesn't match
2847 return undef;
2848 }
2849 return $3;
2850 }
2851
2852 # get path of entry with given hash at given tree-ish (ref)
2853 # used to get 'from' filename for combined diff (merge commit) for renames
2854 sub git_get_path_by_hash {
2855 my $base = shift || return;
2856 my $hash = shift || return;
2857
2858 local $/ = "\0";
2859
2860 open my $fd, "-|", git_cmd(), "ls-tree", '-r', '-t', '-z', $base
2861 or return undef;
2862 while (my $line = <$fd>) {
2863 chomp $line;
2864
2865 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423 gitweb'
2866 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f gitweb/README'
2867 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
2868 close $fd;
2869 return $1;
2870 }
2871 }
2872 close $fd;
2873 return undef;
2874 }
2875
2876 ## ......................................................................
2877 ## git utility functions, directly accessing git repository
2878
2879 # get the value of config variable either from file named as the variable
2880 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
2881 # configuration variable in the repository config file.
2882 sub git_get_file_or_project_config {
2883 my ($path, $name) = @_;
2884
2885 $git_dir = "$projectroot/$path";
2886 open my $fd, '<', "$git_dir/$name"
2887 or return git_get_project_config($name);
2888 my $conf = <$fd>;
2889 close $fd;
2890 if (defined $conf) {
2891 chomp $conf;
2892 }
2893 return $conf;
2894 }
2895
2896 sub git_get_project_description {
2897 my $path = shift;
2898 return git_get_file_or_project_config($path, 'description');
2899 }
2900
2901 sub git_get_project_category {
2902 my $path = shift;
2903 return git_get_file_or_project_config($path, 'category');
2904 }
2905
2906
2907 # supported formats:
2908 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
2909 # - if its contents is a number, use it as tag weight,
2910 # - otherwise add a tag with weight 1
2911 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
2912 # the same value multiple times increases tag weight
2913 # * `gitweb.ctag' multi-valued repo config variable
2914 sub git_get_project_ctags {
2915 my $project = shift;
2916 my $ctags = {};
2917
2918 $git_dir = "$projectroot/$project";
2919 if (opendir my $dh, "$git_dir/ctags") {
2920 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
2921 foreach my $tagfile (@files) {
2922 open my $ct, '<', $tagfile
2923 or next;
2924 my $val = <$ct>;
2925 chomp $val if $val;
2926 close $ct;
2927
2928 (my $ctag = $tagfile) =~ s#.*/##;
2929 if ($val =~ /^\d+$/) {
2930 $ctags->{$ctag} = $val;
2931 } else {
2932 $ctags->{$ctag} = 1;
2933 }
2934 }
2935 closedir $dh;
2936
2937 } elsif (open my $fh, '<', "$git_dir/ctags") {
2938 while (my $line = <$fh>) {
2939 chomp $line;
2940 $ctags->{$line}++ if $line;
2941 }
2942 close $fh;
2943
2944 } else {
2945 my $taglist = config_to_multi(git_get_project_config('ctag'));
2946 foreach my $tag (@$taglist) {
2947 $ctags->{$tag}++;
2948 }
2949 }
2950
2951 return $ctags;
2952 }
2953
2954 # return hash, where keys are content tags ('ctags'),
2955 # and values are sum of weights of given tag in every project
2956 sub git_gather_all_ctags {
2957 my $projects = shift;
2958 my $ctags = {};
2959
2960 foreach my $p (@$projects) {
2961 foreach my $ct (keys %{$p->{'ctags'}}) {
2962 $ctags->{$ct} += $p->{'ctags'}->{$ct};
2963 }
2964 }
2965
2966 return $ctags;
2967 }
2968
2969 sub git_populate_project_tagcloud {
2970 my $ctags = shift;
2971
2972 # First, merge different-cased tags; tags vote on casing
2973 my %ctags_lc;
2974 foreach (keys %$ctags) {
2975 $ctags_lc{lc $_}->{count} += $ctags->{$_};
2976 if (not $ctags_lc{lc $_}->{topcount}
2977 or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
2978 $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
2979 $ctags_lc{lc $_}->{topname} = $_;
2980 }
2981 }
2982
2983 my $cloud;
2984 my $matched = $input_params{'ctag'};
2985 if (eval { require HTML::TagCloud; 1; }) {
2986 $cloud = HTML::TagCloud->new;
2987 foreach my $ctag (sort keys %ctags_lc) {
2988 # Pad the title with spaces so that the cloud looks
2989 # less crammed.
2990 my $title = esc_html($ctags_lc{$ctag}->{topname});
2991 $title =~ s/ /&nbsp;/g;
2992 $title =~ s/^/&nbsp;/g;
2993 $title =~ s/$/&nbsp;/g;
2994 if (defined $matched && $matched eq $ctag) {
2995 $title = qq(<span class="match">$title</span>);
2996 }
2997 $cloud->add($title, href(project=>undef, ctag=>$ctag),
2998 $ctags_lc{$ctag}->{count});
2999 }
3000 } else {
3001 $cloud = {};
3002 foreach my $ctag (keys %ctags_lc) {
3003 my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3004 if (defined $matched && $matched eq $ctag) {
3005 $title = qq(<span class="match">$title</span>);
3006 }
3007 $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3008 $cloud->{$ctag}{ctag} =
3009 $cgi->a({-href=>href(project=>undef, ctag=>$ctag)}, $title);
3010 }
3011 }
3012 return $cloud;
3013 }
3014
3015 sub git_show_project_tagcloud {
3016 my ($cloud, $count) = @_;
3017 if (ref $cloud eq 'HTML::TagCloud') {
3018 return $cloud->html_and_css($count);
3019 } else {
3020 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3021 return
3022 '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3023 join (', ', map {
3024 $cloud->{$_}->{'ctag'}
3025 } splice(@tags, 0, $count)) .
3026 '</div>';
3027 }
3028 }
3029
3030 sub git_get_project_url_list {
3031 my $path = shift;
3032
3033 $git_dir = "$projectroot/$path";
3034 open my $fd, '<', "$git_dir/cloneurl"
3035 or return wantarray ?
3036 @{ config_to_multi(git_get_project_config('url')) } :
3037 config_to_multi(git_get_project_config('url'));
3038 my @git_project_url_list = map { chomp; $_ } <$fd>;
3039 close $fd;
3040
3041 return wantarray ? @git_project_url_list : \@git_project_url_list;
3042 }
3043
3044 sub git_get_projects_list {
3045 my $filter = shift || '';
3046 my $paranoid = shift;
3047 my @list;
3048
3049 if (-d $projects_list) {
3050 # search in directory
3051 my $dir = $projects_list;
3052 # remove the trailing "/"
3053 $dir =~ s!/+$!!;
3054 my $pfxlen = length("$dir");
3055 my $pfxdepth = ($dir =~ tr!/!!);
3056 # when filtering, search only given subdirectory
3057 if ($filter && !$paranoid) {
3058 $dir .= "/$filter";
3059 $dir =~ s!/+$!!;
3060 }
3061
3062 File::Find::find({
3063 follow_fast => 1, # follow symbolic links
3064 follow_skip => 2, # ignore duplicates
3065 dangling_symlinks => 0, # ignore dangling symlinks, silently
3066 wanted => sub {
3067 # global variables
3068 our $project_maxdepth;
3069 our $projectroot;
3070 # skip project-list toplevel, if we get it.
3071 return if (m!^[/.]$!);
3072 # only directories can be git repositories
3073 return unless (-d $_);
3074 # need search permission
3075 return unless (-x $_);
3076 # don't traverse too deep (Find is super slow on os x)
3077 # $project_maxdepth excludes depth of $projectroot
3078 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3079 $File::Find::prune = 1;
3080 return;
3081 }
3082
3083 my $path = substr($File::Find::name, $pfxlen + 1);
3084 # paranoidly only filter here
3085 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3086 next;
3087 }
3088 # we check related file in $projectroot
3089 if (check_export_ok("$projectroot/$path")) {
3090 push @list, { path => $path };
3091 $File::Find::prune = 1;
3092 }
3093 },
3094 }, "$dir");
3095
3096 } elsif (-f $projects_list) {
3097 # read from file(url-encoded):
3098 # 'git%2Fgit.git Linus+Torvalds'
3099 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3100 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3101 open my $fd, '<', $projects_list or return;
3102 PROJECT:
3103 while (my $line = <$fd>) {
3104 chomp $line;
3105 my ($path, $owner) = split ' ', $line;
3106 $path = unescape($path);
3107 $owner = unescape($owner);
3108 if (!defined $path) {
3109 next;
3110 }
3111 # if $filter is rpovided, check if $path begins with $filter
3112 if ($filter && $path !~ m!^\Q$filter\E/!) {
3113 next;
3114 }
3115 if (check_export_ok("$projectroot/$path")) {
3116 my $pr = {
3117 path => $path
3118 };
3119 if ($owner) {
3120 $pr->{'owner'} = to_utf8($owner);
3121 }
3122 push @list, $pr;
3123 }
3124 }
3125 close $fd;
3126 }
3127 return @list;
3128 }
3129
3130 # written with help of Tree::Trie module (Perl Artistic License, GPL compatible)
3131 # as side effects it sets 'forks' field to list of forks for forked projects
3132 sub filter_forks_from_projects_list {
3133 my $projects = shift;
3134
3135 my %trie; # prefix tree of directories (path components)
3136 # generate trie out of those directories that might contain forks
3137 foreach my $pr (@$projects) {
3138 my $path = $pr->{'path'};
3139 $path =~ s/\.git$//; # forks of 'repo.git' are in 'repo/' directory
3140 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3141 next unless ($path); # skip '.git' repository: tests, git-instaweb
3142 next unless (-d "$projectroot/$path"); # containing directory exists
3143 $pr->{'forks'} = []; # there can be 0 or more forks of project
3144
3145 # add to trie
3146 my @dirs = split('/', $path);
3147 # walk the trie, until either runs out of components or out of trie
3148 my $ref = \%trie;
3149 while (scalar @dirs &&
3150 exists($ref->{$dirs[0]})) {
3151 $ref = $ref->{shift @dirs};
3152 }
3153 # create rest of trie structure from rest of components
3154 foreach my $dir (@dirs) {
3155 $ref = $ref->{$dir} = {};
3156 }
3157 # create end marker, store $pr as a data
3158 $ref->{''} = $pr if (!exists $ref->{''});
3159 }
3160
3161 # filter out forks, by finding shortest prefix match for paths
3162 my @filtered;
3163 PROJECT:
3164 foreach my $pr (@$projects) {
3165 # trie lookup
3166 my $ref = \%trie;
3167 DIR:
3168 foreach my $dir (split('/', $pr->{'path'})) {
3169 if (exists $ref->{''}) {
3170 # found [shortest] prefix, is a fork - skip it
3171 push @{$ref->{''}{'forks'}}, $pr;
3172 next PROJECT;
3173 }
3174 if (!exists $ref->{$dir}) {
3175 # not in trie, cannot have prefix, not a fork
3176 push @filtered, $pr;
3177 next PROJECT;
3178 }
3179 # If the dir is there, we just walk one step down the trie.
3180 $ref = $ref->{$dir};
3181 }
3182 # we ran out of trie
3183 # (shouldn't happen: it's either no match, or end marker)
3184 push @filtered, $pr;
3185 }
3186
3187 return @filtered;
3188 }
3189
3190 # note: fill_project_list_info must be run first,
3191 # for 'descr_long' and 'ctags' to be filled
3192 sub search_projects_list {
3193 my ($projlist, %opts) = @_;
3194 my $tagfilter = $opts{'tagfilter'};
3195 my $search_re = $opts{'search_regexp'};
3196
3197 return @$projlist
3198 unless ($tagfilter || $search_re);
3199
3200 # searching projects require filling to be run before it;
3201 fill_project_list_info($projlist,
3202 $tagfilter ? 'ctags' : (),
3203 $search_re ? ('path', 'descr') : ());
3204 my @projects;
3205 PROJECT:
3206 foreach my $pr (@$projlist) {
3207
3208 if ($tagfilter) {
3209 next unless ref($pr->{'ctags'}) eq 'HASH';
3210 next unless
3211 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3212 }
3213
3214 if ($search_re) {
3215 next unless
3216 $pr->{'path'} =~ /$search_re/ ||
3217 $pr->{'descr_long'} =~ /$search_re/;
3218 }
3219
3220 push @projects, $pr;
3221 }
3222
3223 return @projects;
3224 }
3225
3226 our $gitweb_project_owner = undef;
3227 sub git_get_project_list_from_file {
3228
3229 return if (defined $gitweb_project_owner);
3230
3231 $gitweb_project_owner = {};
3232 # read from file (url-encoded):
3233 # 'git%2Fgit.git Linus+Torvalds'
3234 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3235 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3236 if (-f $projects_list) {
3237 open(my $fd, '<', $projects_list);
3238 while (my $line = <$fd>) {
3239 chomp $line;
3240 my ($pr, $ow) = split ' ', $line;
3241 $pr = unescape($pr);
3242 $ow = unescape($ow);
3243 $gitweb_project_owner->{$pr} = to_utf8($ow);
3244 }
3245 close $fd;
3246 }
3247 }
3248
3249 sub git_get_project_owner {
3250 my $project = shift;
3251 my $owner;
3252
3253 return undef unless $project;
3254 $git_dir = "$projectroot/$project";
3255
3256 if (!defined $gitweb_project_owner) {
3257 git_get_project_list_from_file();
3258 }
3259
3260 if (exists $gitweb_project_owner->{$project}) {
3261 $owner = $gitweb_project_owner->{$project};
3262 }
3263 if (!defined $owner){
3264 $owner = git_get_project_config('owner');
3265 }
3266 if (!defined $owner) {
3267 $owner = get_file_owner("$git_dir");
3268 }
3269
3270 return $owner;
3271 }
3272
3273 sub git_get_last_activity {
3274 my ($path) = @_;
3275 my $fd;
3276
3277 $git_dir = "$projectroot/$path";
3278 open($fd, "-|", git_cmd(), 'for-each-ref',
3279 '--format=%(committer)',
3280 '--sort=-committerdate',
3281 '--count=1',
3282 map { "refs/$_" } get_branch_refs ()) or return;
3283 my $most_recent = <$fd>;
3284 close $fd or return;
3285 if (defined $most_recent &&
3286 $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
3287 my $timestamp = $1;
3288 my $age = time - $timestamp;
3289 return ($age, age_string($age));
3290 }
3291 return (undef, undef);
3292 }
3293
3294 # Implementation note: when a single remote is wanted, we cannot use 'git
3295 # remote show -n' because that command always work (assuming it's a remote URL
3296 # if it's not defined), and we cannot use 'git remote show' because that would
3297 # try to make a network roundtrip. So the only way to find if that particular
3298 # remote is defined is to walk the list provided by 'git remote -v' and stop if
3299 # and when we find what we want.
3300 sub git_get_remotes_list {
3301 my $wanted = shift;
3302 my %remotes = ();
3303
3304 open my $fd, '-|' , git_cmd(), 'remote', '-v';
3305 return unless $fd;
3306 while (my $remote = <$fd>) {
3307 chomp $remote;
3308 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
3309 next if $wanted and not $remote eq $wanted;
3310 my ($url, $key) = ($1, $2);
3311
3312 $remotes{$remote} ||= { 'heads' => () };
3313 $remotes{$remote}{$key} = $url;
3314 }
3315 close $fd or return;
3316 return wantarray ? %remotes : \%remotes;
3317 }
3318
3319 # Takes a hash of remotes as first parameter and fills it by adding the
3320 # available remote heads for each of the indicated remotes.
3321 sub fill_remote_heads {
3322 my $remotes = shift;
3323 my @heads = map { "remotes/$_" } keys %$remotes;
3324 my @remoteheads = git_get_heads_list(undef, @heads);
3325 foreach my $remote (keys %$remotes) {
3326 $remotes->{$remote}{'heads'} = [ grep {
3327 $_->{'name'} =~ s!^$remote/!!
3328 } @remoteheads ];
3329 }
3330 }
3331
3332 sub git_get_references {
3333 my $type = shift || "";
3334 my %refs;
3335 # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
3336 # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
3337 open my $fd, "-|", git_cmd(), "show-ref", "--dereference",
3338 ($type ? ("--", "refs/$type") : ()) # use -- <pattern> if $type
3339 or return;
3340
3341 while (my $line = <$fd>) {
3342 chomp $line;
3343 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
3344 if (defined $refs{$1}) {
3345 push @{$refs{$1}}, $2;
3346 } else {
3347 $refs{$1} = [ $2 ];
3348 }
3349 }
3350 }
3351 close $fd or return;
3352 return \%refs;
3353 }
3354
3355 sub git_get_rev_name_tags {
3356 my $hash = shift || return undef;
3357
3358 open my $fd, "-|", git_cmd(), "name-rev", "--tags", $hash
3359 or return;
3360 my $name_rev = <$fd>;
3361 close $fd;
3362
3363 if ($name_rev =~ m|^$hash tags/(.*)$|) {
3364 return $1;
3365 } else {
3366 # catches also '$hash undefined' output
3367 return undef;
3368 }
3369 }
3370
3371 ## ----------------------------------------------------------------------
3372 ## parse to hash functions
3373
3374 sub parse_date {
3375 my $epoch = shift;
3376 my $tz = shift || "-0000";
3377
3378 my %date;
3379 my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
3380 my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
3381 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
3382 $date{'hour'} = $hour;
3383 $date{'minute'} = $min;
3384 $date{'mday'} = $mday;
3385 $date{'day'} = $days[$wday];
3386 $date{'month'} = $months[$mon];
3387 $date{'rfc2822'} = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
3388 $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
3389 $date{'mday-time'} = sprintf "%d %s %02d:%02d",
3390 $mday, $months[$mon], $hour ,$min;
3391 $date{'iso-8601'} = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
3392 1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
3393
3394 my ($tz_sign, $tz_hour, $tz_min) =
3395 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
3396 $tz_sign = ($tz_sign eq '-' ? -1 : +1);
3397 my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
3398 ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
3399 $date{'hour_local'} = $hour;
3400 $date{'minute_local'} = $min;
3401 $date{'tz_local'} = $tz;
3402 $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
3403 1900+$year, $mon+1, $mday,
3404 $hour, $min, $sec, $tz);
3405 return %date;
3406 }
3407
3408 sub parse_tag {
3409 my $tag_id = shift;
3410 my %tag;
3411 my @comment;
3412
3413 open my $fd, "-|", git_cmd(), "cat-file", "tag", $tag_id or return;
3414 $tag{'id'} = $tag_id;
3415 while (my $line = <$fd>) {
3416 chomp $line;
3417 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
3418 $tag{'object'} = $1;
3419 } elsif ($line =~ m/^type (.+)$/) {
3420 $tag{'type'} = $1;
3421 } elsif ($line =~ m/^tag (.+)$/) {
3422 $tag{'name'} = $1;
3423 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
3424 $tag{'author'} = $1;
3425 $tag{'author_epoch'} = $2;
3426 $tag{'author_tz'} = $3;
3427 if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
3428 $tag{'author_name'} = $1;
3429 $tag{'author_email'} = $2;
3430 } else {
3431 $tag{'author_name'} = $tag{'author'};
3432 }
3433 } elsif ($line =~ m/--BEGIN/) {
3434 push @comment, $line;
3435 last;
3436 } elsif ($line eq "") {
3437 last;
3438 }
3439 }
3440 push @comment, <$fd>;
3441 $tag{'comment'} = \@comment;
3442 close $fd or return;
3443 if (!defined $tag{'name'}) {
3444 return
3445 };
3446 return %tag
3447 }
3448
3449 sub parse_commit_text {
3450 my ($commit_text, $withparents) = @_;
3451 my @commit_lines = split '\n', $commit_text;
3452 my %co;
3453
3454 pop @commit_lines; # Remove '\0'
3455
3456 if (! @commit_lines) {
3457 return;
3458 }
3459
3460 my $header = shift @commit_lines;
3461 if ($header !~ m/^[0-9a-fA-F]{40}/) {
3462 return;
3463 }
3464 ($co{'id'}, my @parents) = split ' ', $header;
3465 while (my $line = shift @commit_lines) {
3466 last if $line eq "\n";
3467 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
3468 $co{'tree'} = $1;
3469 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
3470 push @parents, $1;
3471 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
3472 $co{'author'} = to_utf8($1);
3473 $co{'author_epoch'} = $2;
3474 $co{'author_tz'} = $3;
3475 if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
3476 $co{'author_name'} = $1;
3477 $co{'author_email'} = $2;
3478 } else {
3479 $co{'author_name'} = $co{'author'};
3480 }
3481 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
3482 $co{'committer'} = to_utf8($1);
3483 $co{'committer_epoch'} = $2;
3484 $co{'committer_tz'} = $3;
3485 if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
3486 $co{'committer_name'} = $1;
3487 $co{'committer_email'} = $2;
3488 } else {
3489 $co{'committer_name'} = $co{'committer'};
3490 }
3491 }
3492 }
3493 if (!defined $co{'tree'}) {
3494 return;
3495 };
3496 $co{'parents'} = \@parents;
3497 $co{'parent'} = $parents[0];
3498
3499 foreach my $title (@commit_lines) {
3500 $title =~ s/^ //;
3501 if ($title ne "") {
3502 $co{'title'} = chop_str($title, 80, 5);
3503 # remove leading stuff of merges to make the interesting part visible
3504 if (length($title) > 50) {
3505 $title =~ s/^Automatic //;
3506 $title =~ s/^merge (of|with) /Merge ... /i;
3507 if (length($title) > 50) {
3508 $title =~ s/(http|rsync):\/\///;
3509 }
3510 if (length($title) > 50) {
3511 $title =~ s/(master|www|rsync)\.//;
3512 }
3513 if (length($title) > 50) {
3514 $title =~ s/kernel.org:?//;
3515 }
3516 if (length($title) > 50) {
3517 $title =~ s/\/pub\/scm//;
3518 }
3519 }
3520 $co{'title_short'} = chop_str($title, 50, 5);
3521 last;
3522 }
3523 }
3524 if (! defined $co{'title'} || $co{'title'} eq "") {
3525 $co{'title'} = $co{'title_short'} = '(no commit message)';
3526 }
3527 # remove added spaces
3528 foreach my $line (@commit_lines) {
3529 $line =~ s/^ //;
3530 }
3531 $co{'comment'} = \@commit_lines;
3532
3533 my $age = time - $co{'committer_epoch'};
3534 $co{'age'} = $age;
3535 $co{'age_string'} = age_string($age);
3536 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($co{'committer_epoch'});
3537 if ($age > 60*60*24*7*2) {
3538 $co{'age_string_date'} = sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
3539 $co{'age_string_age'} = $co{'age_string'};
3540 } else {
3541 $co{'age_string_date'} = $co{'age_string'};
3542 $co{'age_string_age'} = sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
3543 }
3544 return %co;
3545 }
3546
3547 sub parse_commit {
3548 my ($commit_id) = @_;
3549 my %co;
3550
3551 local $/ = "\0";
3552
3553 open my $fd, "-|", git_cmd(), "rev-list",
3554 "--parents",
3555 "--header",
3556 "--max-count=1",
3557 $commit_id,
3558 "--",
3559 or die_error(500, "Open git-rev-list failed");
3560 %co = parse_commit_text(<$fd>, 1);
3561 close $fd;
3562
3563 return %co;
3564 }
3565
3566 sub parse_commits {
3567 my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
3568 my @cos;
3569
3570 $maxcount ||= 1;
3571 $skip ||= 0;
3572
3573 local $/ = "\0";
3574
3575 open my $fd, "-|", git_cmd(), "rev-list",
3576 "--header",
3577 @args,
3578 ("--max-count=" . $maxcount),
3579 ("--skip=" . $skip),
3580 @extra_options,
3581 $commit_id,
3582 "--",
3583 ($filename ? ($filename) : ())
3584 or die_error(500, "Open git-rev-list failed");
3585 while (my $line = <$fd>) {
3586 my %co = parse_commit_text($line);
3587 push @cos, \%co;
3588 }
3589 close $fd;
3590
3591 return wantarray ? @cos : \@cos;
3592 }
3593
3594 # parse line of git-diff-tree "raw" output
3595 sub parse_difftree_raw_line {
3596 my $line = shift;
3597 my %res;
3598
3599 # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M ls-files.c'
3600 # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M rev-tree.c'
3601 if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
3602 $res{'from_mode'} = $1;
3603 $res{'to_mode'} = $2;
3604 $res{'from_id'} = $3;
3605 $res{'to_id'} = $4;
3606 $res{'status'} = $5;
3607 $res{'similarity'} = $6;
3608 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
3609 ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
3610 } else {
3611 $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
3612 }
3613 }
3614 # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
3615 # combined diff (for merge commit)
3616 elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
3617 $res{'nparents'} = length($1);
3618 $res{'from_mode'} = [ split(' ', $2) ];
3619 $res{'to_mode'} = pop @{$res{'from_mode'}};
3620 $res{'from_id'} = [ split(' ', $3) ];
3621 $res{'to_id'} = pop @{$res{'from_id'}};
3622 $res{'status'} = [ split('', $4) ];
3623 $res{'to_file'} = unquote($5);
3624 }
3625 # 'c512b523472485aef4fff9e57b229d9d243c967f'
3626 elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
3627 $res{'commit'} = $1;
3628 }
3629
3630 return wantarray ? %res : \%res;
3631 }
3632
3633 # wrapper: return parsed line of git-diff-tree "raw" output
3634 # (the argument might be raw line, or parsed info)
3635 sub parsed_difftree_line {
3636 my $line_or_ref = shift;
3637
3638 if (ref($line_or_ref) eq "HASH") {
3639 # pre-parsed (or generated by hand)
3640 return $line_or_ref;
3641 } else {
3642 return parse_difftree_raw_line($line_or_ref);
3643 }
3644 }
3645
3646 # parse line of git-ls-tree output
3647 sub parse_ls_tree_line {
3648 my $line = shift;
3649 my %opts = @_;
3650 my %res;
3651
3652 if ($opts{'-l'}) {
3653 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa 16717 panic.c'
3654 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
3655
3656 $res{'mode'} = $1;
3657 $res{'type'} = $2;
3658 $res{'hash'} = $3;
3659 $res{'size'} = $4;
3660 if ($opts{'-z'}) {
3661 $res{'name'} = $5;
3662 } else {
3663 $res{'name'} = unquote($5);
3664 }
3665 } else {
3666 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c'
3667 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
3668
3669 $res{'mode'} = $1;
3670 $res{'type'} = $2;
3671 $res{'hash'} = $3;
3672 if ($opts{'-z'}) {
3673 $res{'name'} = $4;
3674 } else {
3675 $res{'name'} = unquote($4);
3676 }
3677 }
3678
3679 return wantarray ? %res : \%res;
3680 }
3681
3682 # generates _two_ hashes, references to which are passed as 2 and 3 argument
3683 sub parse_from_to_diffinfo {
3684 my ($diffinfo, $from, $to, @parents) = @_;
3685
3686 if ($diffinfo->{'nparents'}) {
3687 # combined diff
3688 $from->{'file'} = [];
3689 $from->{'href'} = [];
3690 fill_from_file_info($diffinfo, @parents)
3691 unless exists $diffinfo->{'from_file'};
3692 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3693 $from->{'file'}[$i] =
3694 defined $diffinfo->{'from_file'}[$i] ?
3695 $diffinfo->{'from_file'}[$i] :
3696 $diffinfo->{'to_file'};
3697 if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
3698 $from->{'href'}[$i] = href(action=>"blob",
3699 hash_base=>$parents[$i],
3700 hash=>$diffinfo->{'from_id'}[$i],
3701 file_name=>$from->{'file'}[$i]);
3702 } else {
3703 $from->{'href'}[$i] = undef;
3704 }
3705 }
3706 } else {
3707 # ordinary (not combined) diff
3708 $from->{'file'} = $diffinfo->{'from_file'};
3709 if ($diffinfo->{'status'} ne "A") { # not new (added) file
3710 $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
3711 hash=>$diffinfo->{'from_id'},
3712 file_name=>$from->{'file'});
3713 } else {
3714 delete $from->{'href'};
3715 }
3716 }
3717
3718 $to->{'file'} = $diffinfo->{'to_file'};
3719 if (!is_deleted($diffinfo)) { # file exists in result
3720 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
3721 hash=>$diffinfo->{'to_id'},
3722 file_name=>$to->{'file'});
3723 } else {
3724 delete $to->{'href'};
3725 }
3726 }
3727
3728 ## ......................................................................
3729 ## parse to array of hashes functions
3730
3731 sub git_get_heads_list {
3732 my ($limit, @classes) = @_;
3733 @classes = get_branch_refs() unless @classes;
3734 my @patterns = map { "refs/$_" } @classes;
3735 my @headslist;
3736
3737 open my $fd, '-|', git_cmd(), 'for-each-ref',
3738 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
3739 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
3740 @patterns
3741 or return;
3742 while (my $line = <$fd>) {
3743 my %ref_item;
3744
3745 chomp $line;
3746 my ($refinfo, $committerinfo) = split(/\0/, $line);
3747 my ($hash, $name, $title) = split(' ', $refinfo, 3);
3748 my ($committer, $epoch, $tz) =
3749 ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
3750 $ref_item{'fullname'} = $name;
3751 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
3752 $name =~ s!^refs/($strip_refs|remotes)/!!;
3753 $ref_item{'name'} = $name;
3754 # for refs neither in 'heads' nor 'remotes' we want to
3755 # show their ref dir
3756 my $ref_dir = (defined $1) ? $1 : '';
3757 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
3758 $ref_item{'name'} .= ' (' . $ref_dir . ')';
3759 }
3760
3761 $ref_item{'id'} = $hash;
3762 $ref_item{'title'} = $title || '(no commit message)';
3763 $ref_item{'epoch'} = $epoch;
3764 if ($epoch) {
3765 $ref_item{'age'} = age_string(time - $ref_item{'epoch'});
3766 } else {
3767 $ref_item{'age'} = "unknown";
3768 }
3769
3770 push @headslist, \%ref_item;
3771 }
3772 close $fd;
3773
3774 return wantarray ? @headslist : \@headslist;
3775 }
3776
3777 sub git_get_tags_list {
3778 my $limit = shift;
3779 my @tagslist;
3780
3781 open my $fd, '-|', git_cmd(), 'for-each-ref',
3782 ($limit ? '--count='.($limit+1) : ()), '--sort=-creatordate',
3783 '--format=%(objectname) %(objecttype) %(refname) '.
3784 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
3785 'refs/tags'
3786 or return;
3787 while (my $line = <$fd>) {
3788 my %ref_item;
3789
3790 chomp $line;
3791 my ($refinfo, $creatorinfo) = split(/\0/, $line);
3792 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
3793 my ($creator, $epoch, $tz) =
3794 ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
3795 $ref_item{'fullname'} = $name;
3796 $name =~ s!^refs/tags/!!;
3797
3798 $ref_item{'type'} = $type;
3799 $ref_item{'id'} = $id;
3800 $ref_item{'name'} = $name;
3801 if ($type eq "tag") {
3802 $ref_item{'subject'} = $title;
3803 $ref_item{'reftype'} = $reftype;
3804 $ref_item{'refid'} = $refid;
3805 } else {
3806 $ref_item{'reftype'} = $type;
3807 $ref_item{'refid'} = $id;
3808 }
3809
3810 if ($type eq "tag" || $type eq "commit") {
3811 $ref_item{'epoch'} = $epoch;
3812 if ($epoch) {
3813 $ref_item{'age'} = age_string(time - $ref_item{'epoch'});
3814 } else {
3815 $ref_item{'age'} = "unknown";
3816 }
3817 }
3818
3819 push @tagslist, \%ref_item;
3820 }
3821 close $fd;
3822
3823 return wantarray ? @tagslist : \@tagslist;
3824 }
3825
3826 ## ----------------------------------------------------------------------
3827 ## filesystem-related functions
3828
3829 sub get_file_owner {
3830 my $path = shift;
3831
3832 my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
3833 my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
3834 if (!defined $gcos) {
3835 return undef;
3836 }
3837 my $owner = $gcos;
3838 $owner =~ s/[,;].*$//;
3839 return to_utf8($owner);
3840 }
3841
3842 # assume that file exists
3843 sub insert_file {
3844 my $filename = shift;
3845
3846 open my $fd, '<', $filename;
3847 print map { to_utf8($_) } <$fd>;
3848 close $fd;
3849 }
3850
3851 ## ......................................................................
3852 ## mimetype related functions
3853
3854 sub mimetype_guess_file {
3855 my $filename = shift;
3856 my $mimemap = shift;
3857 -r $mimemap or return undef;
3858
3859 my %mimemap;
3860 open(my $mh, '<', $mimemap) or return undef;
3861 while (<$mh>) {
3862 next if m/^#/; # skip comments
3863 my ($mimetype, @exts) = split(/\s+/);
3864 foreach my $ext (@exts) {
3865 $mimemap{$ext} = $mimetype;
3866 }
3867 }
3868 close($mh);
3869
3870 $filename =~ /\.([^.]*)$/;
3871 return $mimemap{$1};
3872 }
3873
3874 sub mimetype_guess {
3875 my $filename = shift;
3876 my $mime;
3877 $filename =~ /\./ or return undef;
3878
3879 if ($mimetypes_file) {
3880 my $file = $mimetypes_file;
3881 if ($file !~ m!^/!) { # if it is relative path
3882 # it is relative to project
3883 $file = "$projectroot/$project/$file";
3884 }
3885 $mime = mimetype_guess_file($filename, $file);
3886 }
3887 $mime ||= mimetype_guess_file($filename, '/etc/mime.types');
3888 return $mime;
3889 }
3890
3891 sub blob_mimetype {
3892 my $fd = shift;
3893 my $filename = shift;
3894
3895 if ($filename) {
3896 my $mime = mimetype_guess($filename);
3897 $mime and return $mime;
3898 }
3899
3900 # just in case
3901 return $default_blob_plain_mimetype unless $fd;
3902
3903 if (-T $fd) {
3904 return 'text/plain';
3905 } elsif (! $filename) {
3906 return 'application/octet-stream';
3907 } elsif ($filename =~ m/\.png$/i) {
3908 return 'image/png';
3909 } elsif ($filename =~ m/\.gif$/i) {
3910 return 'image/gif';
3911 } elsif ($filename =~ m/\.jpe?g$/i) {
3912 return 'image/jpeg';
3913 } else {
3914 return 'application/octet-stream';
3915 }
3916 }
3917
3918 sub blob_contenttype {
3919 my ($fd, $file_name, $type) = @_;
3920
3921 $type ||= blob_mimetype($fd, $file_name);
3922 if ($type eq 'text/plain' && defined $default_text_plain_charset) {
3923 $type .= "; charset=$default_text_plain_charset";
3924 }
3925
3926 return $type;
3927 }
3928
3929 # guess file syntax for syntax highlighting; return undef if no highlighting
3930 # the name of syntax can (in the future) depend on syntax highlighter used
3931 sub guess_file_syntax {
3932 my ($highlight, $file_name) = @_;
3933 return undef unless ($highlight && defined $file_name);
3934 my $basename = basename($file_name, '.in');
3935 return $highlight_basename{$basename}
3936 if exists $highlight_basename{$basename};
3937
3938 $basename =~ /\.([^.]*)$/;
3939 my $ext = $1 or return undef;
3940 return $highlight_ext{$ext}
3941 if exists $highlight_ext{$ext};
3942
3943 return undef;
3944 }
3945
3946 # run highlighter and return FD of its output,
3947 # or return original FD if no highlighting
3948 sub run_highlighter {
3949 my ($fd, $highlight, $syntax) = @_;
3950 return $fd unless ($highlight);
3951
3952 close $fd;
3953 my $syntax_arg = (defined $syntax) ? "--syntax $syntax" : "--force";
3954 open $fd, quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
3955 quote_command($^X, '-CO', '-MEncode=decode,FB_DEFAULT', '-pse',
3956 '$_ = decode($fe, $_, FB_DEFAULT) if !utf8::decode($_);',
3957 '--', "-fe=$fallback_encoding")." | ".
3958 quote_command($highlight_bin).
3959 " --replace-tabs=8 --fragment $syntax_arg |"
3960 or die_error(500, "Couldn't open file or run syntax highlighter");
3961 return $fd;
3962 }
3963
3964 ## ======================================================================
3965 ## functions printing HTML: header, footer, error page
3966
3967 sub get_page_title {
3968 my $title = to_utf8($site_name);
3969
3970 unless (defined $project) {
3971 if (defined $project_filter) {
3972 $title .= " - projects in '" . esc_path($project_filter) . "'";
3973 }
3974 return $title;
3975 }
3976 $title .= " - " . to_utf8($project);
3977
3978 return $title unless (defined $action);
3979 $title .= "/$action"; # $action is US-ASCII (7bit ASCII)
3980
3981 return $title unless (defined $file_name);
3982 $title .= " - " . esc_path($file_name);
3983 if ($action eq "tree" && $file_name !~ m|/$|) {
3984 $title .= "/";
3985 }
3986
3987 return $title;
3988 }
3989
3990 sub get_content_type_html {
3991 # require explicit support from the UA if we are to send the page as
3992 # 'application/xhtml+xml', otherwise send it as plain old 'text/html'.
3993 # we have to do this because MSIE sometimes globs '*/*', pretending to
3994 # support xhtml+xml but choking when it gets what it asked for.
3995 if (defined $cgi->http('HTTP_ACCEPT') &&
3996 $cgi->http('HTTP_ACCEPT') =~ m/(,|;|\s|^)application\/xhtml\+xml(,|;|\s|$)/ &&
3997 $cgi->Accept('application/xhtml+xml') != 0) {
3998 return 'application/xhtml+xml';
3999 } else {
4000 return 'text/html';
4001 }
4002 }
4003
4004 sub print_feed_meta {
4005 if (defined $project) {
4006 my %href_params = get_feed_info();
4007 if (!exists $href_params{'-title'}) {
4008 $href_params{'-title'} = 'log';
4009 }
4010
4011 foreach my $format (qw(RSS Atom)) {
4012 my $type = lc($format);
4013 my %link_attr = (
4014 '-rel' => 'alternate',
4015 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
4016 '-type' => "application/$type+xml"
4017 );
4018
4019 $href_params{'extra_options'} = undef;
4020 $href_params{'action'} = $type;
4021 $link_attr{'-href'} = href(%href_params);
4022 print "<link ".
4023 "rel=\"$link_attr{'-rel'}\" ".
4024 "title=\"$link_attr{'-title'}\" ".
4025 "href=\"$link_attr{'-href'}\" ".
4026 "type=\"$link_attr{'-type'}\" ".
4027 "/>\n";
4028
4029 $href_params{'extra_options'} = '--no-merges';
4030 $link_attr{'-href'} = href(%href_params);
4031 $link_attr{'-title'} .= ' (no merges)';
4032 print "<link ".
4033 "rel=\"$link_attr{'-rel'}\" ".
4034 "title=\"$link_attr{'-title'}\" ".
4035 "href=\"$link_attr{'-href'}\" ".
4036 "type=\"$link_attr{'-type'}\" ".
4037 "/>\n";
4038 }
4039
4040 } else {
4041 printf('<link rel="alternate" title="%s projects list" '.
4042 'href="%s" type="text/plain; charset=utf-8" />'."\n",
4043 esc_attr($site_name), href(project=>undef, action=>"project_index"));
4044 printf('<link rel="alternate" title="%s projects feeds" '.
4045 'href="%s" type="text/x-opml" />'."\n",
4046 esc_attr($site_name), href(project=>undef, action=>"opml"));
4047 }
4048 }
4049
4050 sub print_header_links {
4051 my $status = shift;
4052
4053 # print out each stylesheet that exist, providing backwards capability
4054 # for those people who defined $stylesheet in a config file
4055 if (defined $stylesheet) {
4056 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4057 } else {
4058 foreach my $stylesheet (@stylesheets) {
4059 next unless $stylesheet;
4060 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4061 }
4062 }
4063 print_feed_meta()
4064 if ($status eq '200 OK');
4065 if (defined $favicon) {
4066 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
4067 }
4068 }
4069
4070 sub print_nav_breadcrumbs_path {
4071 my $dirprefix = undef;
4072 while (my $part = shift) {
4073 $dirprefix .= "/" if defined $dirprefix;
4074 $dirprefix .= $part;
4075 print $cgi->a({-href => href(project => undef,
4076 project_filter => $dirprefix,
4077 action => "project_list")},
4078 esc_html($part)) . " / ";
4079 }
4080 }
4081
4082 sub print_nav_breadcrumbs {
4083 my %opts = @_;
4084
4085 for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
4086 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
4087 }
4088 if (defined $project) {
4089 my @dirname = split '/', $project;
4090 my $projectbasename = pop @dirname;
4091 print_nav_breadcrumbs_path(@dirname);
4092 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
4093 if (defined $action) {
4094 my $action_print = $action ;
4095 if (defined $opts{-action_extra}) {
4096 $action_print = $cgi->a({-href => href(action=>$action)},
4097 $action);
4098 }
4099 print " / $action_print";
4100 }
4101 if (defined $opts{-action_extra}) {
4102 print " / $opts{-action_extra}";
4103 }
4104 print "\n";
4105 } elsif (defined $project_filter) {
4106 print_nav_breadcrumbs_path(split '/', $project_filter);
4107 }
4108 }
4109
4110 sub print_search_form {
4111 if (!defined $searchtext) {
4112 $searchtext = "";
4113 }
4114 my $search_hash;
4115 if (defined $hash_base) {
4116 $search_hash = $hash_base;
4117 } elsif (defined $hash) {
4118 $search_hash = $hash;
4119 } else {
4120 $search_hash = "HEAD";
4121 }
4122 my $action = $my_uri;
4123 my $use_pathinfo = gitweb_check_feature('pathinfo');
4124 if ($use_pathinfo) {
4125 $action .= "/".esc_url($project);
4126 }
4127 print $cgi->start_form(-method => "get", -action => $action) .
4128 "<div class=\"search\">\n" .
4129 (!$use_pathinfo &&
4130 $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
4131 $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
4132 $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
4133 $cgi->popup_menu(-name => 'st', -default => 'commit',
4134 -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
4135 " " . $cgi->a({-href => href(action=>"search_help"),
4136 -title => "search help" }, "?") . " search:\n",
4137 $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
4138 "<span title=\"Extended regular expression\">" .
4139 $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
4140 -checked => $search_use_regexp) .
4141 "</span>" .
4142 "</div>" .
4143 $cgi->end_form() . "\n";
4144 }
4145
4146 sub git_header_html {
4147 my $status = shift || "200 OK";
4148 my $expires = shift;
4149 my %opts = @_;
4150
4151 my $title = get_page_title();
4152 my $content_type = get_content_type_html();
4153 print $cgi->header(-type=>$content_type, -charset => 'utf-8',
4154 -status=> $status, -expires => $expires)
4155 unless ($opts{'-no_http_header'});
4156 my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
4157 print <<EOF;
4158 <?xml version="1.0" encoding="utf-8"?>
4159 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
4160 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
4161 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
4162 <!-- git core binaries version $git_version -->
4163 <head>
4164 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
4165 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
4166 <meta name="robots" content="index, nofollow"/>
4167 <title>$title</title>
4168 EOF
4169 # the stylesheet, favicon etc urls won't work correctly with path_info
4170 # unless we set the appropriate base URL
4171 if ($ENV{'PATH_INFO'}) {
4172 print "<base href=\"".esc_url($base_url)."\" />\n";
4173 }
4174 print_header_links($status);
4175
4176 if (defined $site_html_head_string) {
4177 print to_utf8($site_html_head_string);
4178 }
4179
4180 print "</head>\n" .
4181 "<body>\n";
4182
4183 if (defined $site_header && -f $site_header) {
4184 insert_file($site_header);
4185 }
4186
4187 print "<div class=\"page_header\">\n";
4188 if (defined $logo) {
4189 print $cgi->a({-href => esc_url($logo_url),
4190 -title => $logo_label},
4191 $cgi->img({-src => esc_url($logo),
4192 -width => 72, -height => 27,
4193 -alt => "git",
4194 -class => "logo"}));
4195 }
4196 print_nav_breadcrumbs(%opts);
4197 print "</div>\n";
4198
4199 my $have_search = gitweb_check_feature('search');
4200 if (defined $project && $have_search) {
4201 print_search_form();
4202 }
4203 }
4204
4205 sub git_footer_html {
4206 my $feed_class = 'rss_logo';
4207
4208 print "<div class=\"page_footer\">\n";
4209 if (defined $project) {
4210 my $descr = git_get_project_description($project);
4211 if (defined $descr) {
4212 print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
4213 }
4214
4215 my %href_params = get_feed_info();
4216 if (!%href_params) {
4217 $feed_class .= ' generic';
4218 }
4219 $href_params{'-title'} ||= 'log';
4220
4221 foreach my $format (qw(RSS Atom)) {
4222 $href_params{'action'} = lc($format);
4223 print $cgi->a({-href => href(%href_params),
4224 -title => "$href_params{'-title'} $format feed",
4225 -class => $feed_class}, $format)."\n";
4226 }
4227
4228 } else {
4229 print $cgi->a({-href => href(project=>undef, action=>"opml",
4230 project_filter => $project_filter),
4231 -class => $feed_class}, "OPML") . " ";
4232 print $cgi->a({-href => href(project=>undef, action=>"project_index",
4233 project_filter => $project_filter),
4234 -class => $feed_class}, "TXT") . "\n";
4235 }
4236 print "</div>\n"; # class="page_footer"
4237
4238 if (defined $t0 && gitweb_check_feature('timed')) {
4239 print "<div id=\"generating_info\">\n";
4240 print 'This page took '.
4241 '<span id="generating_time" class="time_span">'.
4242 tv_interval($t0, [ gettimeofday() ]).
4243 ' seconds </span>'.
4244 ' and '.
4245 '<span id="generating_cmd">'.
4246 $number_of_git_cmds.
4247 '</span> git commands '.
4248 " to generate.\n";
4249 print "</div>\n"; # class="page_footer"
4250 }
4251
4252 if (defined $site_footer && -f $site_footer) {
4253 insert_file($site_footer);
4254 }
4255
4256 print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
4257 if (defined $action &&
4258 $action eq 'blame_incremental') {
4259 print qq!<script type="text/javascript">\n!.
4260 qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
4261 qq! "!. href() .qq!");\n!.
4262 qq!</script>\n!;
4263 } else {
4264 my ($jstimezone, $tz_cookie, $datetime_class) =
4265 gitweb_get_feature('javascript-timezone');
4266
4267 print qq!<script type="text/javascript">\n!.
4268 qq!window.onload = function () {\n!;
4269 if (gitweb_check_feature('javascript-actions')) {
4270 print qq! fixLinks();\n!;
4271 }
4272 if ($jstimezone && $tz_cookie && $datetime_class) {
4273 print qq! var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
4274 qq! onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
4275 }
4276 print qq!};\n!.
4277 qq!</script>\n!;
4278 }
4279
4280 print "</body>\n" .
4281 "</html>";
4282 }
4283
4284 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
4285 # Example: die_error(404, 'Hash not found')
4286 # By convention, use the following status codes (as defined in RFC 2616):
4287 # 400: Invalid or missing CGI parameters, or
4288 # requested object exists but has wrong type.
4289 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
4290 # this server or project.
4291 # 404: Requested object/revision/project doesn't exist.
4292 # 500: The server isn't configured properly, or
4293 # an internal error occurred (e.g. failed assertions caused by bugs), or
4294 # an unknown error occurred (e.g. the git binary died unexpectedly).
4295 # 503: The server is currently unavailable (because it is overloaded,
4296 # or down for maintenance). Generally, this is a temporary state.
4297 sub die_error {
4298 my $status = shift || 500;
4299 my $error = esc_html(shift) || "Internal Server Error";
4300 my $extra = shift;
4301 my %opts = @_;
4302
4303 my %http_responses = (
4304 400 => '400 Bad Request',
4305 403 => '403 Forbidden',
4306 404 => '404 Not Found',
4307 500 => '500 Internal Server Error',
4308 503 => '503 Service Unavailable',
4309 );
4310 git_header_html($http_responses{$status}, undef, %opts);
4311 print <<EOF;
4312 <div class="page_body">
4313 <br /><br />
4314 $status - $error
4315 <br />
4316 EOF
4317 if (defined $extra) {
4318 print "<hr />\n" .
4319 "$extra\n";
4320 }
4321 print "</div>\n";
4322
4323 git_footer_html();
4324 goto DONE_GITWEB
4325 unless ($opts{'-error_handler'});
4326 }
4327
4328 ## ----------------------------------------------------------------------
4329 ## functions printing or outputting HTML: navigation
4330
4331 sub git_print_page_nav {
4332 my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
4333 $extra = '' if !defined $extra; # pager or formats
4334
4335 my @navs = qw(summary shortlog log commit commitdiff tree);
4336 if ($suppress) {
4337 @navs = grep { $_ ne $suppress } @navs;
4338 }
4339
4340 my %arg = map { $_ => {action=>$_} } @navs;
4341 if (defined $head) {
4342 for (qw(commit commitdiff)) {
4343 $arg{$_}{'hash'} = $head;
4344 }
4345 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
4346 for (qw(shortlog log)) {
4347 $arg{$_}{'hash'} = $head;
4348 }
4349 }
4350 }
4351
4352 $arg{'tree'}{'hash'} = $treehead if defined $treehead;
4353 $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
4354
4355 my @actions = gitweb_get_feature('actions');
4356 my %repl = (
4357 '%' => '%',
4358 'n' => $project, # project name
4359 'f' => $git_dir, # project path within filesystem
4360 'h' => $treehead || '', # current hash ('h' parameter)
4361 'b' => $treebase || '', # hash base ('hb' parameter)
4362 );
4363 while (@actions) {
4364 my ($label, $link, $pos) = splice(@actions,0,3);
4365 # insert
4366 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
4367 # munch munch
4368 $link =~ s/%([%nfhb])/$repl{$1}/g;
4369 $arg{$label}{'_href'} = $link;
4370 }
4371
4372 print "<div class=\"page_nav\">\n" .
4373 (join " | ",
4374 map { $_ eq $current ?
4375 $_ : $cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_")
4376 } @navs);
4377 print "<br/>\n$extra<br/>\n" .
4378 "</div>\n";
4379 }
4380
4381 # returns a submenu for the navigation of the refs views (tags, heads,
4382 # remotes) with the current view disabled and the remotes view only
4383 # available if the feature is enabled
4384 sub format_ref_views {
4385 my ($current) = @_;
4386 my @ref_views = qw{tags heads};
4387 push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
4388 return join " | ", map {
4389 $_ eq $current ? $_ :
4390 $cgi->a({-href => href(action=>$_)}, $_)
4391 } @ref_views
4392 }
4393
4394 sub format_paging_nav {
4395 my ($action, $page, $has_next_link) = @_;
4396 my $paging_nav;
4397
4398
4399 if ($page > 0) {
4400 $paging_nav .=
4401 $cgi->a({-href => href(-replay=>1, page=>undef)}, "first") .
4402 " &sdot; " .
4403 $cgi->a({-href => href(-replay=>1, page=>$page-1),
4404 -accesskey => "p", -title => "Alt-p"}, "prev");
4405 } else {
4406 $paging_nav .= "first &sdot; prev";
4407 }
4408
4409 if ($has_next_link) {
4410 $paging_nav .= " &sdot; " .
4411 $cgi->a({-href => href(-replay=>1, page=>$page+1),
4412 -accesskey => "n", -title => "Alt-n"}, "next");
4413 } else {
4414 $paging_nav .= " &sdot; next";
4415 }
4416
4417 return $paging_nav;
4418 }
4419
4420 ## ......................................................................
4421 ## functions printing or outputting HTML: div
4422
4423 sub git_print_header_div {
4424 my ($action, $title, $hash, $hash_base) = @_;
4425 my %args = ();
4426
4427 $args{'action'} = $action;
4428 $args{'hash'} = $hash if $hash;
4429 $args{'hash_base'} = $hash_base if $hash_base;
4430
4431 print "<div class=\"header\">\n" .
4432 $cgi->a({-href => href(%args), -class => "title"},
4433 $title ? $title : $action) .
4434 "\n</div>\n";
4435 }
4436
4437 sub format_repo_url {
4438 my ($name, $url) = @_;
4439 return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
4440 }
4441
4442 # Group output by placing it in a DIV element and adding a header.
4443 # Options for start_div() can be provided by passing a hash reference as the
4444 # first parameter to the function.
4445 # Options to git_print_header_div() can be provided by passing an array
4446 # reference. This must follow the options to start_div if they are present.
4447 # The content can be a scalar, which is output as-is, a scalar reference, which
4448 # is output after html escaping, an IO handle passed either as *handle or
4449 # *handle{IO}, or a function reference. In the latter case all following
4450 # parameters will be taken as argument to the content function call.
4451 sub git_print_section {
4452 my ($div_args, $header_args, $content);
4453 my $arg = shift;
4454 if (ref($arg) eq 'HASH') {
4455 $div_args = $arg;
4456 $arg = shift;
4457 }
4458 if (ref($arg) eq 'ARRAY') {
4459 $header_args = $arg;
4460 $arg = shift;
4461 }
4462 $content = $arg;
4463
4464 print $cgi->start_div($div_args);
4465 git_print_header_div(@$header_args);
4466
4467 if (ref($content) eq 'CODE') {
4468 $content->(@_);
4469 } elsif (ref($content) eq 'SCALAR') {
4470 print esc_html($$content);
4471 } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
4472 print <$content>;
4473 } elsif (!ref($content) && defined($content)) {
4474 print $content;
4475 }
4476
4477 print $cgi->end_div;
4478 }
4479
4480 sub format_timestamp_html {
4481 my $date = shift;
4482 my $strtime = $date->{'rfc2822'};
4483
4484 my (undef, undef, $datetime_class) =
4485 gitweb_get_feature('javascript-timezone');
4486 if ($datetime_class) {
4487 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
4488 }
4489
4490 my $localtime_format = '(%02d:%02d %s)';
4491 if ($date->{'hour_local'} < 6) {
4492 $localtime_format = '(<span class="atnight">%02d:%02d</span> %s)';
4493 }
4494 $strtime .= ' ' .
4495 sprintf($localtime_format,
4496 $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
4497
4498 return $strtime;
4499 }
4500
4501 # Outputs the author name and date in long form
4502 sub git_print_authorship {
4503 my $co = shift;
4504 my %opts = @_;
4505 my $tag = $opts{-tag} || 'div';
4506 my $author = $co->{'author_name'};
4507
4508 my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
4509 print "<$tag class=\"author_date\">" .
4510 format_search_author($author, "author", esc_html($author)) .
4511 " [".format_timestamp_html(\%ad)."]".
4512 git_get_avatar($co->{'author_email'}, -pad_before => 1) .
4513 "</$tag>\n";
4514 }
4515
4516 # Outputs table rows containing the full author or committer information,
4517 # in the format expected for 'commit' view (& similar).
4518 # Parameters are a commit hash reference, followed by the list of people
4519 # to output information for. If the list is empty it defaults to both
4520 # author and committer.
4521 sub git_print_authorship_rows {
4522 my $co = shift;
4523 # too bad we can't use @people = @_ || ('author', 'committer')
4524 my @people = @_;
4525 @people = ('author', 'committer') unless @people;
4526 foreach my $who (@people) {
4527 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
4528 print "<tr><td>$who</td><td>" .
4529 format_search_author($co->{"${who}_name"}, $who,
4530 esc_html($co->{"${who}_name"})) . " " .
4531 format_search_author($co->{"${who}_email"}, $who,
4532 esc_html("<" . $co->{"${who}_email"} . ">")) .
4533 "</td><td rowspan=\"2\">" .
4534 git_get_avatar($co->{"${who}_email"}, -size => 'double') .
4535 "</td></tr>\n" .
4536 "<tr>" .
4537 "<td></td><td>" .
4538 format_timestamp_html(\%wd) .
4539 "</td>" .
4540 "</tr>\n";
4541 }
4542 }
4543
4544 sub git_print_page_path {
4545 my $name = shift;
4546 my $type = shift;
4547 my $hb = shift;
4548
4549
4550 print "<div class=\"page_path\">";
4551 print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
4552 -title => 'tree root'}, to_utf8("[$project]"));
4553 print " / ";
4554 if (defined $name) {
4555 my @dirname = split '/', $name;
4556 my $basename = pop @dirname;
4557 my $fullname = '';
4558
4559 foreach my $dir (@dirname) {
4560 $fullname .= ($fullname ? '/' : '') . $dir;
4561 print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
4562 hash_base=>$hb),
4563 -title => $fullname}, esc_path($dir));
4564 print " / ";
4565 }
4566 if (defined $type && $type eq 'blob') {
4567 print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
4568 hash_base=>$hb),
4569 -title => $name}, esc_path($basename));
4570 } elsif (defined $type && $type eq 'tree') {
4571 print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
4572 hash_base=>$hb),
4573 -title => $name}, esc_path($basename));
4574 print " / ";
4575 } else {
4576 print esc_path($basename);
4577 }
4578 }
4579 print "<br/></div>\n";
4580 }
4581
4582 sub git_print_log {
4583 my $log = shift;
4584 my %opts = @_;
4585
4586 if ($opts{'-remove_title'}) {
4587 # remove title, i.e. first line of log
4588 shift @$log;
4589 }
4590 # remove leading empty lines
4591 while (defined $log->[0] && $log->[0] eq "") {
4592 shift @$log;
4593 }
4594
4595 # print log
4596 my $skip_blank_line = 0;
4597 foreach my $line (@$log) {
4598 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
4599 if (! $opts{'-remove_signoff'}) {
4600 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
4601 $skip_blank_line = 1;
4602 }
4603 next;
4604 }
4605
4606 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
4607 if (! $opts{'-remove_signoff'}) {
4608 print "<span class=\"signoff\">" . esc_html($1) . ": " .
4609 "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
4610 "</span><br/>\n";
4611 $skip_blank_line = 1;
4612 }
4613 next;
4614 }
4615
4616 # print only one empty line
4617 # do not print empty line after signoff
4618 if ($line eq "") {
4619 next if ($skip_blank_line);
4620 $skip_blank_line = 1;
4621 } else {
4622 $skip_blank_line = 0;
4623 }
4624
4625 print format_log_line_html($line) . "<br/>\n";
4626 }
4627
4628 if ($opts{'-final_empty_line'}) {
4629 # end with single empty line
4630 print "<br/>\n" unless $skip_blank_line;
4631 }
4632 }
4633
4634 # return link target (what link points to)
4635 sub git_get_link_target {
4636 my $hash = shift;
4637 my $link_target;
4638
4639 # read link
4640 open my $fd, "-|", git_cmd(), "cat-file", "blob", $hash
4641 or return;
4642 {
4643 local $/ = undef;
4644 $link_target = <$fd>;
4645 }
4646 close $fd
4647 or return;
4648
4649 return $link_target;
4650 }
4651
4652 # given link target, and the directory (basedir) the link is in,
4653 # return target of link relative to top directory (top tree);
4654 # return undef if it is not possible (including absolute links).
4655 sub normalize_link_target {
4656 my ($link_target, $basedir) = @_;
4657
4658 # absolute symlinks (beginning with '/') cannot be normalized
4659 return if (substr($link_target, 0, 1) eq '/');
4660
4661 # normalize link target to path from top (root) tree (dir)
4662 my $path;
4663 if ($basedir) {
4664 $path = $basedir . '/' . $link_target;
4665 } else {
4666 # we are in top (root) tree (dir)
4667 $path = $link_target;
4668 }
4669
4670 # remove //, /./, and /../
4671 my @path_parts;
4672 foreach my $part (split('/', $path)) {
4673 # discard '.' and ''
4674 next if (!$part || $part eq '.');
4675 # handle '..'
4676 if ($part eq '..') {
4677 if (@path_parts) {
4678 pop @path_parts;
4679 } else {
4680 # link leads outside repository (outside top dir)
4681 return;
4682 }
4683 } else {
4684 push @path_parts, $part;
4685 }
4686 }
4687 $path = join('/', @path_parts);
4688
4689 return $path;
4690 }
4691
4692 # print tree entry (row of git_tree), but without encompassing <tr> element
4693 sub git_print_tree_entry {
4694 my ($t, $basedir, $hash_base, $have_blame) = @_;
4695
4696 my %base_key = ();
4697 $base_key{'hash_base'} = $hash_base if defined $hash_base;
4698
4699 # The format of a table row is: mode list link. Where mode is
4700 # the mode of the entry, list is the name of the entry, an href,
4701 # and link is the action links of the entry.
4702
4703 print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
4704 if (exists $t->{'size'}) {
4705 print "<td class=\"size\">$t->{'size'}</td>\n";
4706 }
4707 if ($t->{'type'} eq "blob") {
4708 print "<td class=\"list\">" .
4709 $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
4710 file_name=>"$basedir$t->{'name'}", %base_key),
4711 -class => "list"}, esc_path($t->{'name'}));
4712 if (S_ISLNK(oct $t->{'mode'})) {
4713 my $link_target = git_get_link_target($t->{'hash'});
4714 if ($link_target) {
4715 my $norm_target = normalize_link_target($link_target, $basedir);
4716 if (defined $norm_target) {
4717 print " -> " .
4718 $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
4719 file_name=>$norm_target),
4720 -title => $norm_target}, esc_path($link_target));
4721 } else {
4722 print " -> " . esc_path($link_target);
4723 }
4724 }
4725 }
4726 print "</td>\n";
4727 print "<td class=\"link\">";
4728 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
4729 file_name=>"$basedir$t->{'name'}", %base_key)},
4730 "blob");
4731 if ($have_blame) {
4732 print " | " .
4733 $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
4734 file_name=>"$basedir$t->{'name'}", %base_key)},
4735 "blame");
4736 }
4737 if (defined $hash_base) {
4738 print " | " .
4739 $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
4740 hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
4741 "history");
4742 }
4743 print " | " .
4744 $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
4745 file_name=>"$basedir$t->{'name'}")},
4746 "raw");
4747 print "</td>\n";
4748
4749 } elsif ($t->{'type'} eq "tree") {
4750 print "<td class=\"list\">";
4751 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
4752 file_name=>"$basedir$t->{'name'}",
4753 %base_key)},
4754 esc_path($t->{'name'}));
4755 print "</td>\n";
4756 print "<td class=\"link\">";
4757 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
4758 file_name=>"$basedir$t->{'name'}",
4759 %base_key)},
4760 "tree");
4761 if (defined $hash_base) {
4762 print " | " .
4763 $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
4764 file_name=>"$basedir$t->{'name'}")},
4765 "history");
4766 }
4767 print "</td>\n";
4768 } else {
4769 # unknown object: we can only present history for it
4770 # (this includes 'commit' object, i.e. submodule support)
4771 print "<td class=\"list\">" .
4772 esc_path($t->{'name'}) .
4773 "</td>\n";
4774 print "<td class=\"link\">";
4775 if (defined $hash_base) {
4776 print $cgi->a({-href => href(action=>"history",
4777 hash_base=>$hash_base,
4778 file_name=>"$basedir$t->{'name'}")},
4779 "history");
4780 }
4781 print "</td>\n";
4782 }
4783 }
4784
4785 ## ......................................................................
4786 ## functions printing large fragments of HTML
4787
4788 # get pre-image filenames for merge (combined) diff
4789 sub fill_from_file_info {
4790 my ($diff, @parents) = @_;
4791
4792 $diff->{'from_file'} = [ ];
4793 $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
4794 for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
4795 if ($diff->{'status'}[$i] eq 'R' ||
4796 $diff->{'status'}[$i] eq 'C') {
4797 $diff->{'from_file'}[$i] =
4798 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
4799 }
4800 }
4801
4802 return $diff;
4803 }
4804
4805 # is current raw difftree line of file deletion
4806 sub is_deleted {
4807 my $diffinfo = shift;
4808
4809 return $diffinfo->{'to_id'} eq ('0' x 40);
4810 }
4811
4812 # does patch correspond to [previous] difftree raw line
4813 # $diffinfo - hashref of parsed raw diff format
4814 # $patchinfo - hashref of parsed patch diff format
4815 # (the same keys as in $diffinfo)
4816 sub is_patch_split {
4817 my ($diffinfo, $patchinfo) = @_;
4818
4819 return defined $diffinfo && defined $patchinfo
4820 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
4821 }
4822
4823
4824 sub git_difftree_body {
4825 my ($difftree, $hash, @parents) = @_;
4826 my ($parent) = $parents[0];
4827 my $have_blame = gitweb_check_feature('blame');
4828 print "<div class=\"list_head\">\n";
4829 if ($#{$difftree} > 10) {
4830 print(($#{$difftree} + 1) . " files changed:\n");
4831 }
4832 print "</div>\n";
4833
4834 print "<table class=\"" .
4835 (@parents > 1 ? "combined " : "") .
4836 "diff_tree\">\n";
4837
4838 # header only for combined diff in 'commitdiff' view
4839 my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
4840 if ($has_header) {
4841 # table header
4842 print "<thead><tr>\n" .
4843 "<th></th><th></th>\n"; # filename, patchN link
4844 for (my $i = 0; $i < @parents; $i++) {
4845 my $par = $parents[$i];
4846 print "<th>" .
4847 $cgi->a({-href => href(action=>"commitdiff",
4848 hash=>$hash, hash_parent=>$par),
4849 -title => 'commitdiff to parent number ' .
4850 ($i+1) . ': ' . substr($par,0,7)},
4851 $i+1) .
4852 "&nbsp;</th>\n";
4853 }
4854 print "</tr></thead>\n<tbody>\n";
4855 }
4856
4857 my $alternate = 1;
4858 my $patchno = 0;
4859 foreach my $line (@{$difftree}) {
4860 my $diff = parsed_difftree_line($line);
4861
4862 if ($alternate) {
4863 print "<tr class=\"dark\">\n";
4864 } else {
4865 print "<tr class=\"light\">\n";
4866 }
4867 $alternate ^= 1;
4868
4869 if (exists $diff->{'nparents'}) { # combined diff
4870
4871 fill_from_file_info($diff, @parents)
4872 unless exists $diff->{'from_file'};
4873
4874 if (!is_deleted($diff)) {
4875 # file exists in the result (child) commit
4876 print "<td>" .
4877 $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
4878 file_name=>$diff->{'to_file'},
4879 hash_base=>$hash),
4880 -class => "list"}, esc_path($diff->{'to_file'})) .
4881 "</td>\n";
4882 } else {
4883 print "<td>" .
4884 esc_path($diff->{'to_file'}) .
4885 "</td>\n";
4886 }
4887
4888 if ($action eq 'commitdiff') {
4889 # link to patch
4890 $patchno++;
4891 print "<td class=\"link\">" .
4892 $cgi->a({-href => href(-anchor=>"patch$patchno")},
4893 "patch") .
4894 " | " .
4895 "</td>\n";
4896 }
4897
4898 my $has_history = 0;
4899 my $not_deleted = 0;
4900 for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
4901 my $hash_parent = $parents[$i];
4902 my $from_hash = $diff->{'from_id'}[$i];
4903 my $from_path = $diff->{'from_file'}[$i];
4904 my $status = $diff->{'status'}[$i];
4905
4906 $has_history ||= ($status ne 'A');
4907 $not_deleted ||= ($status ne 'D');
4908
4909 if ($status eq 'A') {
4910 print "<td class=\"link\" align=\"right\"> | </td>\n";
4911 } elsif ($status eq 'D') {
4912 print "<td class=\"link\">" .
4913 $cgi->a({-href => href(action=>"blob",
4914 hash_base=>$hash,
4915 hash=>$from_hash,
4916 file_name=>$from_path)},
4917 "blob" . ($i+1)) .
4918 " | </td>\n";
4919 } else {
4920 if ($diff->{'to_id'} eq $from_hash) {
4921 print "<td class=\"link nochange\">";
4922 } else {
4923 print "<td class=\"link\">";
4924 }
4925 print $cgi->a({-href => href(action=>"blobdiff",
4926 hash=>$diff->{'to_id'},
4927 hash_parent=>$from_hash,
4928 hash_base=>$hash,
4929 hash_parent_base=>$hash_parent,
4930 file_name=>$diff->{'to_file'},
4931 file_parent=>$from_path)},
4932 "diff" . ($i+1)) .
4933 " | </td>\n";
4934 }
4935 }
4936
4937 print "<td class=\"link\">";
4938 if ($not_deleted) {
4939 print $cgi->a({-href => href(action=>"blob",
4940 hash=>$diff->{'to_id'},
4941 file_name=>$diff->{'to_file'},
4942 hash_base=>$hash)},
4943 "blob");
4944 print " | " if ($has_history);
4945 }
4946 if ($has_history) {
4947 print $cgi->a({-href => href(action=>"history",
4948 file_name=>$diff->{'to_file'},
4949 hash_base=>$hash)},
4950 "history");
4951 }
4952 print "</td>\n";
4953
4954 print "</tr>\n";
4955 next; # instead of 'else' clause, to avoid extra indent
4956 }
4957 # else ordinary diff
4958
4959 my ($to_mode_oct, $to_mode_str, $to_file_type);
4960 my ($from_mode_oct, $from_mode_str, $from_file_type);
4961 if ($diff->{'to_mode'} ne ('0' x 6)) {
4962 $to_mode_oct = oct $diff->{'to_mode'};
4963 if (S_ISREG($to_mode_oct)) { # only for regular file
4964 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
4965 }
4966 $to_file_type = file_type($diff->{'to_mode'});
4967 }
4968 if ($diff->{'from_mode'} ne ('0' x 6)) {
4969 $from_mode_oct = oct $diff->{'from_mode'};
4970 if (S_ISREG($from_mode_oct)) { # only for regular file
4971 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
4972 }
4973 $from_file_type = file_type($diff->{'from_mode'});
4974 }
4975
4976 if ($diff->{'status'} eq "A") { # created
4977 my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
4978 $mode_chng .= " with mode: $to_mode_str" if $to_mode_str;
4979 $mode_chng .= "]</span>";
4980 print "<td>";
4981 print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
4982 hash_base=>$hash, file_name=>$diff->{'file'}),
4983 -class => "list"}, esc_path($diff->{'file'}));
4984 print "</td>\n";
4985 print "<td>$mode_chng</td>\n";
4986 print "<td class=\"link\">";
4987 if ($action eq 'commitdiff') {
4988 # link to patch
4989 $patchno++;
4990 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
4991 "patch") .
4992 " | ";
4993 }
4994 print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
4995 hash_base=>$hash, file_name=>$diff->{'file'})},
4996 "blob");
4997 print "</td>\n";
4998
4999 } elsif ($diff->{'status'} eq "D") { # deleted
5000 my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
5001 print "<td>";
5002 print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5003 hash_base=>$parent, file_name=>$diff->{'file'}),
5004 -class => "list"}, esc_path($diff->{'file'}));
5005 print "</td>\n";
5006 print "<td>$mode_chng</td>\n";
5007 print "<td class=\"link\">";
5008 if ($action eq 'commitdiff') {
5009 # link to patch
5010 $patchno++;
5011 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5012 "patch") .
5013 " | ";
5014 }
5015 print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5016 hash_base=>$parent, file_name=>$diff->{'file'})},
5017 "blob") . " | ";
5018 if ($have_blame) {
5019 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
5020 file_name=>$diff->{'file'})},
5021 "blame") . " | ";
5022 }
5023 print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
5024 file_name=>$diff->{'file'})},
5025 "history");
5026 print "</td>\n";
5027
5028 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
5029 my $mode_chnge = "";
5030 if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5031 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
5032 if ($from_file_type ne $to_file_type) {
5033 $mode_chnge .= " from $from_file_type to $to_file_type";
5034 }
5035 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
5036 if ($from_mode_str && $to_mode_str) {
5037 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
5038 } elsif ($to_mode_str) {
5039 $mode_chnge .= " mode: $to_mode_str";
5040 }
5041 }
5042 $mode_chnge .= "]</span>\n";
5043 }
5044 print "<td>";
5045 print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5046 hash_base=>$hash, file_name=>$diff->{'file'}),
5047 -class => "list"}, esc_path($diff->{'file'}));
5048 print "</td>\n";
5049 print "<td>$mode_chnge</td>\n";
5050 print "<td class=\"link\">";
5051 if ($action eq 'commitdiff') {
5052 # link to patch
5053 $patchno++;
5054 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5055 "patch") .
5056 " | ";
5057 } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5058 # "commit" view and modified file (not onlu mode changed)
5059 print $cgi->a({-href => href(action=>"blobdiff",
5060 hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5061 hash_base=>$hash, hash_parent_base=>$parent,
5062 file_name=>$diff->{'file'})},
5063 "diff") .
5064 " | ";
5065 }
5066 print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5067 hash_base=>$hash, file_name=>$diff->{'file'})},
5068 "blob") . " | ";
5069 if ($have_blame) {
5070 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
5071 file_name=>$diff->{'file'})},
5072 "blame") . " | ";
5073 }
5074 print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
5075 file_name=>$diff->{'file'})},
5076 "history");
5077 print "</td>\n";
5078
5079 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
5080 my %status_name = ('R' => 'moved', 'C' => 'copied');
5081 my $nstatus = $status_name{$diff->{'status'}};
5082 my $mode_chng = "";
5083 if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5084 # mode also for directories, so we cannot use $to_mode_str
5085 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
5086 }
5087 print "<td>" .
5088 $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
5089 hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
5090 -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
5091 "<td><span class=\"file_status $nstatus\">[$nstatus from " .
5092 $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
5093 hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
5094 -class => "list"}, esc_path($diff->{'from_file'})) .
5095 " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
5096 "<td class=\"link\">";
5097 if ($action eq 'commitdiff') {
5098 # link to patch
5099 $patchno++;
5100 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5101 "patch") .
5102 " | ";
5103 } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5104 # "commit" view and modified file (not only pure rename or copy)
5105 print $cgi->a({-href => href(action=>"blobdiff",
5106 hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5107 hash_base=>$hash, hash_parent_base=>$parent,
5108 file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
5109 "diff") .
5110 " | ";
5111 }
5112 print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5113 hash_base=>$parent, file_name=>$diff->{'to_file'})},
5114 "blob") . " | ";
5115 if ($have_blame) {
5116 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
5117 file_name=>$diff->{'to_file'})},
5118 "blame") . " | ";
5119 }
5120 print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
5121 file_name=>$diff->{'to_file'})},
5122 "history");
5123 print "</td>\n";
5124
5125 } # we should not encounter Unmerged (U) or Unknown (X) status
5126 print "</tr>\n";
5127 }
5128 print "</tbody>" if $has_header;
5129 print "</table>\n";
5130 }
5131
5132 # Print context lines and then rem/add lines in a side-by-side manner.
5133 sub print_sidebyside_diff_lines {
5134 my ($ctx, $rem, $add) = @_;
5135
5136 # print context block before add/rem block
5137 if (@$ctx) {
5138 print join '',
5139 '<div class="chunk_block ctx">',
5140 '<div class="old">',
5141 @$ctx,
5142 '</div>',
5143 '<div class="new">',
5144 @$ctx,
5145 '</div>',
5146 '</div>';
5147 }
5148
5149 if (!@$add) {
5150 # pure removal
5151 print join '',
5152 '<div class="chunk_block rem">',
5153 '<div class="old">',
5154 @$rem,
5155 '</div>',
5156 '</div>';
5157 } elsif (!@$rem) {
5158 # pure addition
5159 print join '',
5160 '<div class="chunk_block add">',
5161 '<div class="new">',
5162 @$add,
5163 '</div>',
5164 '</div>';
5165 } else {
5166 print join '',
5167 '<div class="chunk_block chg">',
5168 '<div class="old">',
5169 @$rem,
5170 '</div>',
5171 '<div class="new">',
5172 @$add,
5173 '</div>',
5174 '</div>';
5175 }
5176 }
5177
5178 # Print context lines and then rem/add lines in inline manner.
5179 sub print_inline_diff_lines {
5180 my ($ctx, $rem, $add) = @_;
5181
5182 print @$ctx, @$rem, @$add;
5183 }
5184
5185 # Format removed and added line, mark changed part and HTML-format them.
5186 # Implementation is based on contrib/diff-highlight
5187 sub format_rem_add_lines_pair {
5188 my ($rem, $add, $num_parents) = @_;
5189
5190 # We need to untabify lines before split()'ing them;
5191 # otherwise offsets would be invalid.
5192 chomp $rem;
5193 chomp $add;
5194 $rem = untabify($rem);
5195 $add = untabify($add);
5196
5197 my @rem = split(//, $rem);
5198 my @add = split(//, $add);
5199 my ($esc_rem, $esc_add);
5200 # Ignore leading +/- characters for each parent.
5201 my ($prefix_len, $suffix_len) = ($num_parents, 0);
5202 my ($prefix_has_nonspace, $suffix_has_nonspace);
5203
5204 my $shorter = (@rem < @add) ? @rem : @add;
5205 while ($prefix_len < $shorter) {
5206 last if ($rem[$prefix_len] ne $add[$prefix_len]);
5207
5208 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
5209 $prefix_len++;
5210 }
5211
5212 while ($prefix_len + $suffix_len < $shorter) {
5213 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
5214
5215 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
5216 $suffix_len++;
5217 }
5218
5219 # Mark lines that are different from each other, but have some common
5220 # part that isn't whitespace. If lines are completely different, don't
5221 # mark them because that would make output unreadable, especially if
5222 # diff consists of multiple lines.
5223 if ($prefix_has_nonspace || $suffix_has_nonspace) {
5224 $esc_rem = esc_html_hl_regions($rem, 'marked',
5225 [$prefix_len, @rem - $suffix_len], -nbsp=>1);
5226 $esc_add = esc_html_hl_regions($add, 'marked',
5227 [$prefix_len, @add - $suffix_len], -nbsp=>1);
5228 } else {
5229 $esc_rem = esc_html($rem, -nbsp=>1);
5230 $esc_add = esc_html($add, -nbsp=>1);
5231 }
5232
5233 return format_diff_line(\$esc_rem, 'rem'),
5234 format_diff_line(\$esc_add, 'add');
5235 }
5236
5237 # HTML-format diff context, removed and added lines.
5238 sub format_ctx_rem_add_lines {
5239 my ($ctx, $rem, $add, $num_parents) = @_;
5240 my (@new_ctx, @new_rem, @new_add);
5241 my $can_highlight = 0;
5242 my $is_combined = ($num_parents > 1);
5243
5244 # Highlight if every removed line has a corresponding added line.
5245 if (@$add > 0 && @$add == @$rem) {
5246 $can_highlight = 1;
5247
5248 # Highlight lines in combined diff only if the chunk contains
5249 # diff between the same version, e.g.
5250 #
5251 # - a
5252 # - b
5253 # + c
5254 # + d
5255 #
5256 # Otherwise the highlightling would be confusing.
5257 if ($is_combined) {
5258 for (my $i = 0; $i < @$add; $i++) {
5259 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
5260 my $prefix_add = substr($add->[$i], 0, $num_parents);
5261
5262 $prefix_rem =~ s/-/+/g;
5263
5264 if ($prefix_rem ne $prefix_add) {
5265 $can_highlight = 0;
5266 last;
5267 }
5268 }
5269 }
5270 }
5271
5272 if ($can_highlight) {
5273 for (my $i = 0; $i < @$add; $i++) {
5274 my ($line_rem, $line_add) = format_rem_add_lines_pair(
5275 $rem->[$i], $add->[$i], $num_parents);
5276 push @new_rem, $line_rem;
5277 push @new_add, $line_add;
5278 }
5279 } else {
5280 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
5281 @new_add = map { format_diff_line($_, 'add') } @$add;
5282 }
5283
5284 @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
5285
5286 return (\@new_ctx, \@new_rem, \@new_add);
5287 }
5288
5289 # Print context lines and then rem/add lines.
5290 sub print_diff_lines {
5291 my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
5292 my $is_combined = $num_parents > 1;
5293
5294 ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
5295 $num_parents);
5296
5297 if ($diff_style eq 'sidebyside' && !$is_combined) {
5298 print_sidebyside_diff_lines($ctx, $rem, $add);
5299 } else {
5300 # default 'inline' style and unknown styles
5301 print_inline_diff_lines($ctx, $rem, $add);
5302 }
5303 }
5304
5305 sub print_diff_chunk {
5306 my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
5307 my (@ctx, @rem, @add);
5308
5309 # The class of the previous line.
5310 my $prev_class = '';
5311
5312 return unless @chunk;
5313
5314 # incomplete last line might be among removed or added lines,
5315 # or both, or among context lines: find which
5316 for (my $i = 1; $i < @chunk; $i++) {
5317 if ($chunk[$i][0] eq 'incomplete') {
5318 $chunk[$i][0] = $chunk[$i-1][0];
5319 }
5320 }
5321
5322 # guardian
5323 push @chunk, ["", ""];
5324
5325 foreach my $line_info (@chunk) {
5326 my ($class, $line) = @$line_info;
5327
5328 # print chunk headers
5329 if ($class && $class eq 'chunk_header') {
5330 print format_diff_line($line, $class, $from, $to);
5331 next;
5332 }
5333
5334 ## print from accumulator when have some add/rem lines or end
5335 # of chunk (flush context lines), or when have add and rem
5336 # lines and new block is reached (otherwise add/rem lines could
5337 # be reordered)
5338 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
5339 (@rem && @add && $class ne $prev_class)) {
5340 print_diff_lines(\@ctx, \@rem, \@add,
5341 $diff_style, $num_parents);
5342 @ctx = @rem = @add = ();
5343 }
5344
5345 ## adding lines to accumulator
5346 # guardian value
5347 last unless $line;
5348 # rem, add or change
5349 if ($class eq 'rem') {
5350 push @rem, $line;
5351 } elsif ($class eq 'add') {
5352 push @add, $line;
5353 }
5354 # context line
5355 if ($class eq 'ctx') {
5356 push @ctx, $line;
5357 }
5358
5359 $prev_class = $class;
5360 }
5361 }
5362
5363 sub git_patchset_body {
5364 my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
5365 my ($hash_parent) = $hash_parents[0];
5366
5367 my $is_combined = (@hash_parents > 1);
5368 my $patch_idx = 0;
5369 my $patch_number = 0;
5370 my $patch_line;
5371 my $diffinfo;
5372 my $to_name;
5373 my (%from, %to);
5374 my @chunk; # for side-by-side diff
5375
5376 print "<div class=\"patchset\">\n";
5377
5378 # skip to first patch
5379 while ($patch_line = <$fd>) {
5380 chomp $patch_line;
5381
5382 last if ($patch_line =~ m/^diff /);
5383 }
5384
5385 PATCH:
5386 while ($patch_line) {
5387
5388 # parse "git diff" header line
5389 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
5390 # $1 is from_name, which we do not use
5391 $to_name = unquote($2);
5392 $to_name =~ s!^b/!!;
5393 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
5394 # $1 is 'cc' or 'combined', which we do not use
5395 $to_name = unquote($2);
5396 } else {
5397 $to_name = undef;
5398 }
5399
5400 # check if current patch belong to current raw line
5401 # and parse raw git-diff line if needed
5402 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
5403 # this is continuation of a split patch
5404 print "<div class=\"patch cont\">\n";
5405 } else {
5406 # advance raw git-diff output if needed
5407 $patch_idx++ if defined $diffinfo;
5408
5409 # read and prepare patch information
5410 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
5411
5412 # compact combined diff output can have some patches skipped
5413 # find which patch (using pathname of result) we are at now;
5414 if ($is_combined) {
5415 while ($to_name ne $diffinfo->{'to_file'}) {
5416 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
5417 format_diff_cc_simplified($diffinfo, @hash_parents) .
5418 "</div>\n"; # class="patch"
5419
5420 $patch_idx++;
5421 $patch_number++;
5422
5423 last if $patch_idx > $#$difftree;
5424 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
5425 }
5426 }
5427
5428 # modifies %from, %to hashes
5429 parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
5430
5431 # this is first patch for raw difftree line with $patch_idx index
5432 # we index @$difftree array from 0, but number patches from 1
5433 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
5434 }
5435
5436 # git diff header
5437 #assert($patch_line =~ m/^diff /) if DEBUG;
5438 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
5439 $patch_number++;
5440 # print "git diff" header
5441 print format_git_diff_header_line($patch_line, $diffinfo,
5442 \%from, \%to);
5443
5444 # print extended diff header
5445 print "<div class=\"diff extended_header\">\n";
5446 EXTENDED_HEADER:
5447 while ($patch_line = <$fd>) {
5448 chomp $patch_line;
5449
5450 last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
5451
5452 print format_extended_diff_header_line($patch_line, $diffinfo,
5453 \%from, \%to);
5454 }
5455 print "</div>\n"; # class="diff extended_header"
5456
5457 # from-file/to-file diff header
5458 if (! $patch_line) {
5459 print "</div>\n"; # class="patch"
5460 last PATCH;
5461 }
5462 next PATCH if ($patch_line =~ m/^diff /);
5463 #assert($patch_line =~ m/^---/) if DEBUG;
5464
5465 my $last_patch_line = $patch_line;
5466 $patch_line = <$fd>;
5467 chomp $patch_line;
5468 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
5469
5470 print format_diff_from_to_header($last_patch_line, $patch_line,
5471 $diffinfo, \%from, \%to,
5472 @hash_parents);
5473
5474 # the patch itself
5475 LINE:
5476 while ($patch_line = <$fd>) {
5477 chomp $patch_line;
5478
5479 next PATCH if ($patch_line =~ m/^diff /);
5480
5481 my $class = diff_line_class($patch_line, \%from, \%to);
5482
5483 if ($class eq 'chunk_header') {
5484 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
5485 @chunk = ();
5486 }
5487
5488 push @chunk, [ $class, $patch_line ];
5489 }
5490
5491 } continue {
5492 if (@chunk) {
5493 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
5494 @chunk = ();
5495 }
5496 print "</div>\n"; # class="patch"
5497 }
5498
5499 # for compact combined (--cc) format, with chunk and patch simplification
5500 # the patchset might be empty, but there might be unprocessed raw lines
5501 for (++$patch_idx if $patch_number > 0;
5502 $patch_idx < @$difftree;
5503 ++$patch_idx) {
5504 # read and prepare patch information
5505 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
5506
5507 # generate anchor for "patch" links in difftree / whatchanged part
5508 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
5509 format_diff_cc_simplified($diffinfo, @hash_parents) .
5510 "</div>\n"; # class="patch"
5511
5512 $patch_number++;
5513 }
5514
5515 if ($patch_number == 0) {
5516 if (@hash_parents > 1) {
5517 print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
5518 } else {
5519 print "<div class=\"diff nodifferences\">No differences found</div>\n";
5520 }
5521 }
5522
5523 print "</div>\n"; # class="patchset"
5524 }
5525
5526 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
5527
5528 sub git_project_search_form {
5529 my ($searchtext, $search_use_regexp) = @_;
5530
5531 my $limit = '';
5532 if ($project_filter) {
5533 $limit = " in '$project_filter/'";
5534 }
5535
5536 print "<div class=\"projsearch\">\n";
5537 print $cgi->start_form(-method => 'get', -action => $my_uri) .
5538 $cgi->hidden(-name => 'a', -value => 'project_list') . "\n";
5539 print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
5540 if (defined $project_filter);
5541 print $cgi->textfield(-name => 's', -value => $searchtext,
5542 -title => "Search project by name and description$limit",
5543 -size => 60) . "\n" .
5544 "<span title=\"Extended regular expression\">" .
5545 $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5546 -checked => $search_use_regexp) .
5547 "</span>\n" .
5548 $cgi->submit(-name => 'btnS', -value => 'Search') .
5549 $cgi->end_form() . "\n" .
5550 $cgi->a({-href => href(project => undef, searchtext => undef,
5551 project_filter => $project_filter)},
5552 esc_html("List all projects$limit")) . "<br />\n";
5553 print "</div>\n";
5554 }
5555
5556 # entry for given @keys needs filling if at least one of keys in list
5557 # is not present in %$project_info
5558 sub project_info_needs_filling {
5559 my ($project_info, @keys) = @_;
5560
5561 # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
5562 foreach my $key (@keys) {
5563 if (!exists $project_info->{$key}) {
5564 return 1;
5565 }
5566 }
5567 return;
5568 }
5569
5570 # fills project list info (age, description, owner, category, forks, etc.)
5571 # for each project in the list, removing invalid projects from
5572 # returned list, or fill only specified info.
5573 #
5574 # Invalid projects are removed from the returned list if and only if you
5575 # ask 'age' or 'age_string' to be filled, because they are the only fields
5576 # that run unconditionally git command that requires repository, and
5577 # therefore do always check if project repository is invalid.
5578 #
5579 # USAGE:
5580 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
5581 # ensures that 'descr_long' and 'ctags' fields are filled
5582 # * @project_list = fill_project_list_info(\@project_list)
5583 # ensures that all fields are filled (and invalid projects removed)
5584 #
5585 # NOTE: modifies $projlist, but does not remove entries from it
5586 sub fill_project_list_info {
5587 my ($projlist, @wanted_keys) = @_;
5588 my @projects;
5589 my $filter_set = sub { return @_; };
5590 if (@wanted_keys) {
5591 my %wanted_keys = map { $_ => 1 } @wanted_keys;
5592 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
5593 }
5594
5595 my $show_ctags = gitweb_check_feature('ctags');
5596 PROJECT:
5597 foreach my $pr (@$projlist) {
5598 if (project_info_needs_filling($pr, $filter_set->('age', 'age_string'))) {
5599 my (@activity) = git_get_last_activity($pr->{'path'});
5600 unless (@activity) {
5601 next PROJECT;
5602 }
5603 ($pr->{'age'}, $pr->{'age_string'}) = @activity;
5604 }
5605 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
5606 my $descr = git_get_project_description($pr->{'path'}) || "";
5607 $descr = to_utf8($descr);
5608 $pr->{'descr_long'} = $descr;
5609 $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
5610 }
5611 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
5612 $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
5613 }
5614 if ($show_ctags &&
5615 project_info_needs_filling($pr, $filter_set->('ctags'))) {
5616 $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
5617 }
5618 if ($projects_list_group_categories &&
5619 project_info_needs_filling($pr, $filter_set->('category'))) {
5620 my $cat = git_get_project_category($pr->{'path'}) ||
5621 $project_list_default_category;
5622 $pr->{'category'} = to_utf8($cat);
5623 }
5624
5625 push @projects, $pr;
5626 }
5627
5628 return @projects;
5629 }
5630
5631 sub sort_projects_list {
5632 my ($projlist, $order) = @_;
5633
5634 sub order_str {
5635 my $key = shift;
5636 return sub { $a->{$key} cmp $b->{$key} };
5637 }
5638
5639 sub order_num_then_undef {
5640 my $key = shift;
5641 return sub {
5642 defined $a->{$key} ?
5643 (defined $b->{$key} ? $a->{$key} <=> $b->{$key} : -1) :
5644 (defined $b->{$key} ? 1 : 0)
5645 };
5646 }
5647
5648 my %orderings = (
5649 project => order_str('path'),
5650 descr => order_str('descr_long'),
5651 owner => order_str('owner'),
5652 age => order_num_then_undef('age'),
5653 );
5654
5655 my $ordering = $orderings{$order};
5656 return defined $ordering ? sort $ordering @$projlist : @$projlist;
5657 }
5658
5659 # returns a hash of categories, containing the list of project
5660 # belonging to each category
5661 sub build_projlist_by_category {
5662 my ($projlist, $from, $to) = @_;
5663 my %categories;
5664
5665 $from = 0 unless defined $from;
5666 $to = $#$projlist if (!defined $to || $#$projlist < $to);
5667
5668 for (my $i = $from; $i <= $to; $i++) {
5669 my $pr = $projlist->[$i];
5670 push @{$categories{ $pr->{'category'} }}, $pr;
5671 }
5672
5673 return wantarray ? %categories : \%categories;
5674 }
5675
5676 # print 'sort by' <th> element, generating 'sort by $name' replay link
5677 # if that order is not selected
5678 sub print_sort_th {
5679 print format_sort_th(@_);
5680 }
5681
5682 sub format_sort_th {
5683 my ($name, $order, $header) = @_;
5684 my $sort_th = "";
5685 $header ||= ucfirst($name);
5686
5687 if ($order eq $name) {
5688 $sort_th .= "<th>$header</th>\n";
5689 } else {
5690 $sort_th .= "<th>" .
5691 $cgi->a({-href => href(-replay=>1, order=>$name),
5692 -class => "header"}, $header) .
5693 "</th>\n";
5694 }
5695
5696 return $sort_th;
5697 }
5698
5699 sub git_project_list_rows {
5700 my ($projlist, $from, $to, $check_forks) = @_;
5701
5702 $from = 0 unless defined $from;
5703 $to = $#$projlist if (!defined $to || $#$projlist < $to);
5704
5705 my $alternate = 1;
5706 for (my $i = $from; $i <= $to; $i++) {
5707 my $pr = $projlist->[$i];
5708
5709 if ($alternate) {
5710 print "<tr class=\"dark\">\n";
5711 } else {
5712 print "<tr class=\"light\">\n";
5713 }
5714 $alternate ^= 1;
5715
5716 if ($check_forks) {
5717 print "<td>";
5718 if ($pr->{'forks'}) {
5719 my $nforks = scalar @{$pr->{'forks'}};
5720 if ($nforks > 0) {
5721 print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
5722 -title => "$nforks forks"}, "+");
5723 } else {
5724 print $cgi->span({-title => "$nforks forks"}, "+");
5725 }
5726 }
5727 print "</td>\n";
5728 }
5729 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
5730 -class => "list"},
5731 esc_html_match_hl($pr->{'path'}, $search_regexp)) .
5732 "</td>\n" .
5733 "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
5734 -class => "list",
5735 -title => $pr->{'descr_long'}},
5736 $search_regexp
5737 ? esc_html_match_hl_chopped($pr->{'descr_long'},
5738 $pr->{'descr'}, $search_regexp)
5739 : esc_html($pr->{'descr'})) .
5740 "</td>\n";
5741 unless ($omit_owner) {
5742 print "<td><i>" . chop_and_escape_str($pr->{'owner'}, 15) . "</i></td>\n";
5743 }
5744 unless ($omit_age_column) {
5745 print "<td class=\"". age_class($pr->{'age'}) . "\">" .
5746 (defined $pr->{'age_string'} ? $pr->{'age_string'} : "No commits") . "</td>\n";
5747 }
5748 print"<td class=\"link\">" .
5749 $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary") . " | " .
5750 $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "shortlog") . " | " .
5751 $cgi->a({-href => href(project=>$pr->{'path'}, action=>"log")}, "log") . " | " .
5752 $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
5753 ($pr->{'forks'} ? " | " . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
5754 "</td>\n" .
5755 "</tr>\n";
5756 }
5757 }
5758
5759 sub git_project_list_body {
5760 # actually uses global variable $project
5761 my ($projlist, $order, $from, $to, $extra, $no_header) = @_;
5762 my @projects = @$projlist;
5763
5764 my $check_forks = gitweb_check_feature('forks');
5765 my $show_ctags = gitweb_check_feature('ctags');
5766 my $tagfilter = $show_ctags ? $input_params{'ctag'} : undef;
5767 $check_forks = undef
5768 if ($tagfilter || $search_regexp);
5769
5770 # filtering out forks before filling info allows to do less work
5771 @projects = filter_forks_from_projects_list(\@projects)
5772 if ($check_forks);
5773 # search_projects_list pre-fills required info
5774 @projects = search_projects_list(\@projects,
5775 'search_regexp' => $search_regexp,
5776 'tagfilter' => $tagfilter)
5777 if ($tagfilter || $search_regexp);
5778 # fill the rest
5779 my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
5780 push @all_fields, ('age', 'age_string') unless($omit_age_column);
5781 push @all_fields, 'owner' unless($omit_owner);
5782 @projects = fill_project_list_info(\@projects, @all_fields);
5783
5784 $order ||= $default_projects_order;
5785 $from = 0 unless defined $from;
5786 $to = $#projects if (!defined $to || $#projects < $to);
5787
5788 # short circuit
5789 if ($from > $to) {
5790 print "<center>\n".
5791 "<b>No such projects found</b><br />\n".
5792 "Click ".$cgi->a({-href=>href(project=>undef)},"here")." to view all projects<br />\n".
5793 "</center>\n<br />\n";
5794 return;
5795 }
5796
5797 @projects = sort_projects_list(\@projects, $order);
5798
5799 if ($show_ctags) {
5800 my $ctags = git_gather_all_ctags(\@projects);
5801 my $cloud = git_populate_project_tagcloud($ctags);
5802 print git_show_project_tagcloud($cloud, 64);
5803 }
5804
5805 print "<table class=\"project_list\">\n";
5806 unless ($no_header) {
5807 print "<tr>\n";
5808 if ($check_forks) {
5809 print "<th></th>\n";
5810 }
5811 print_sort_th('project', $order, 'Project');
5812 print_sort_th('descr', $order, 'Description');
5813 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
5814 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
5815 print "<th></th>\n" . # for links
5816 "</tr>\n";
5817 }
5818
5819 if ($projects_list_group_categories) {
5820 # only display categories with projects in the $from-$to window
5821 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
5822 my %categories = build_projlist_by_category(\@projects, $from, $to);
5823 foreach my $cat (sort keys %categories) {
5824 unless ($cat eq "") {
5825 print "<tr>\n";
5826 if ($check_forks) {
5827 print "<td></td>\n";
5828 }
5829 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
5830 print "</tr>\n";
5831 }
5832
5833 git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
5834 }
5835 } else {
5836 git_project_list_rows(\@projects, $from, $to, $check_forks);
5837 }
5838
5839 if (defined $extra) {
5840 print "<tr>\n";
5841 if ($check_forks) {
5842 print "<td></td>\n";
5843 }
5844 print "<td colspan=\"5\">$extra</td>\n" .
5845 "</tr>\n";
5846 }
5847 print "</table>\n";
5848 }
5849
5850 sub git_log_body {
5851 # uses global variable $project
5852 my ($commitlist, $from, $to, $refs, $extra) = @_;
5853
5854 $from = 0 unless defined $from;
5855 $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
5856
5857 for (my $i = 0; $i <= $to; $i++) {
5858 my %co = %{$commitlist->[$i]};
5859 next if !%co;
5860 my $commit = $co{'id'};
5861 my $ref = format_ref_marker($refs, $commit);
5862 git_print_header_div('commit',
5863 "<span class=\"age\">$co{'age_string'}</span>" .
5864 esc_html($co{'title'}) . $ref,
5865 $commit);
5866 print "<div class=\"title_text\">\n" .
5867 "<div class=\"log_link\">\n" .
5868 $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
5869 " | " .
5870 $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
5871 " | " .
5872 $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
5873 "<br/>\n" .
5874 "</div>\n";
5875 git_print_authorship(\%co, -tag => 'span');
5876 print "<br/>\n</div>\n";
5877
5878 print "<div class=\"log_body\">\n";
5879 git_print_log($co{'comment'}, -final_empty_line=> 1);
5880 print "</div>\n";
5881 }
5882 if ($extra) {
5883 print "<div class=\"page_nav\">\n";
5884 print "$extra\n";
5885 print "</div>\n";
5886 }
5887 }
5888
5889 sub git_shortlog_body {
5890 # uses global variable $project
5891 my ($commitlist, $from, $to, $refs, $extra) = @_;
5892
5893 $from = 0 unless defined $from;
5894 $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
5895
5896 print "<table class=\"shortlog\">\n";
5897 my $alternate = 1;
5898 for (my $i = $from; $i <= $to; $i++) {
5899 my %co = %{$commitlist->[$i]};
5900 my $commit = $co{'id'};
5901 my $ref = format_ref_marker($refs, $commit);
5902 if ($alternate) {
5903 print "<tr class=\"dark\">\n";
5904 } else {
5905 print "<tr class=\"light\">\n";
5906 }
5907 $alternate ^= 1;
5908 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
5909 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
5910 format_author_html('td', \%co, 10) . "<td>";
5911 print format_subject_html($co{'title'}, $co{'title_short'},
5912 href(action=>"commit", hash=>$commit), $ref);
5913 print "</td>\n" .
5914 "<td class=\"link\">" .
5915 $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . " | " .
5916 $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . " | " .
5917 $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
5918 my $snapshot_links = format_snapshot_links($commit);
5919 if (defined $snapshot_links) {
5920 print " | " . $snapshot_links;
5921 }
5922 print "</td>\n" .
5923 "</tr>\n";
5924 }
5925 if (defined $extra) {
5926 print "<tr>\n" .
5927 "<td colspan=\"4\">$extra</td>\n" .
5928 "</tr>\n";
5929 }
5930 print "</table>\n";
5931 }
5932
5933 sub git_history_body {
5934 # Warning: assumes constant type (blob or tree) during history
5935 my ($commitlist, $from, $to, $refs, $extra,
5936 $file_name, $file_hash, $ftype) = @_;
5937
5938 $from = 0 unless defined $from;
5939 $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
5940
5941 print "<table class=\"history\">\n";
5942 my $alternate = 1;
5943 for (my $i = $from; $i <= $to; $i++) {
5944 my %co = %{$commitlist->[$i]};
5945 if (!%co) {
5946 next;
5947 }
5948 my $commit = $co{'id'};
5949
5950 my $ref = format_ref_marker($refs, $commit);
5951
5952 if ($alternate) {
5953 print "<tr class=\"dark\">\n";
5954 } else {
5955 print "<tr class=\"light\">\n";
5956 }
5957 $alternate ^= 1;
5958 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
5959 # shortlog: format_author_html('td', \%co, 10)
5960 format_author_html('td', \%co, 15, 3) . "<td>";
5961 # originally git_history used chop_str($co{'title'}, 50)
5962 print format_subject_html($co{'title'}, $co{'title_short'},
5963 href(action=>"commit", hash=>$commit), $ref);
5964 print "</td>\n" .
5965 "<td class=\"link\">" .
5966 $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . " | " .
5967 $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
5968
5969 if ($ftype eq 'blob') {
5970 my $blob_current = $file_hash;
5971 my $blob_parent = git_get_hash_by_path($commit, $file_name);
5972 if (defined $blob_current && defined $blob_parent &&
5973 $blob_current ne $blob_parent) {
5974 print " | " .
5975 $cgi->a({-href => href(action=>"blobdiff",
5976 hash=>$blob_current, hash_parent=>$blob_parent,
5977 hash_base=>$hash_base, hash_parent_base=>$commit,
5978 file_name=>$file_name)},
5979 "diff to current");
5980 }
5981 }
5982 print "</td>\n" .
5983 "</tr>\n";
5984 }
5985 if (defined $extra) {
5986 print "<tr>\n" .
5987 "<td colspan=\"4\">$extra</td>\n" .
5988 "</tr>\n";
5989 }
5990 print "</table>\n";
5991 }
5992
5993 sub git_tags_body {
5994 # uses global variable $project
5995 my ($taglist, $from, $to, $extra) = @_;
5996 $from = 0 unless defined $from;
5997 $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
5998
5999 print "<table class=\"tags\">\n";
6000 my $alternate = 1;
6001 for (my $i = $from; $i <= $to; $i++) {
6002 my $entry = $taglist->[$i];
6003 my %tag = %$entry;
6004 my $comment = $tag{'subject'};
6005 my $comment_short;
6006 if (defined $comment) {
6007 $comment_short = chop_str($comment, 30, 5);
6008 }
6009 if ($alternate) {
6010 print "<tr class=\"dark\">\n";
6011 } else {
6012 print "<tr class=\"light\">\n";
6013 }
6014 $alternate ^= 1;
6015 if (defined $tag{'age'}) {
6016 print "<td><i>$tag{'age'}</i></td>\n";
6017 } else {
6018 print "<td></td>\n";
6019 }
6020 print "<td>" .
6021 $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
6022 -class => "list name"}, esc_html($tag{'name'})) .
6023 "</td>\n" .
6024 "<td>";
6025 if (defined $comment) {
6026 print format_subject_html($comment, $comment_short,
6027 href(action=>"tag", hash=>$tag{'id'}));
6028 }
6029 print "</td>\n" .
6030 "<td class=\"selflink\">";
6031 if ($tag{'type'} eq "tag") {
6032 print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
6033 } else {
6034 print "&nbsp;";
6035 }
6036 print "</td>\n" .
6037 "<td class=\"link\">" . " | " .
6038 $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
6039 if ($tag{'reftype'} eq "commit") {
6040 print " | " . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "shortlog") .
6041 " | " . $cgi->a({-href => href(action=>"log", hash=>$tag{'fullname'})}, "log");
6042 } elsif ($tag{'reftype'} eq "blob") {
6043 print " | " . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
6044 }
6045 print "</td>\n" .
6046 "</tr>";
6047 }
6048 if (defined $extra) {
6049 print "<tr>\n" .
6050 "<td colspan=\"5\">$extra</td>\n" .
6051 "</tr>\n";
6052 }
6053 print "</table>\n";
6054 }
6055
6056 sub git_heads_body {
6057 # uses global variable $project
6058 my ($headlist, $head_at, $from, $to, $extra) = @_;
6059 $from = 0 unless defined $from;
6060 $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
6061
6062 print "<table class=\"heads\">\n";
6063 my $alternate = 1;
6064 for (my $i = $from; $i <= $to; $i++) {
6065 my $entry = $headlist->[$i];
6066 my %ref = %$entry;
6067 my $curr = defined $head_at && $ref{'id'} eq $head_at;
6068 if ($alternate) {
6069 print "<tr class=\"dark\">\n";
6070 } else {
6071 print "<tr class=\"light\">\n";
6072 }
6073 $alternate ^= 1;
6074 print "<td><i>$ref{'age'}</i></td>\n" .
6075 ($curr ? "<td class=\"current_head\">" : "<td>") .
6076 $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
6077 -class => "list name"},esc_html($ref{'name'})) .
6078 "</td>\n" .
6079 "<td class=\"link\">" .
6080 $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "shortlog") . " | " .
6081 $cgi->a({-href => href(action=>"log", hash=>$ref{'fullname'})}, "log") . " | " .
6082 $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
6083 "</td>\n" .
6084 "</tr>";
6085 }
6086 if (defined $extra) {
6087 print "<tr>\n" .
6088 "<td colspan=\"3\">$extra</td>\n" .
6089 "</tr>\n";
6090 }
6091 print "</table>\n";
6092 }
6093
6094 # Display a single remote block
6095 sub git_remote_block {
6096 my ($remote, $rdata, $limit, $head) = @_;
6097
6098 my $heads = $rdata->{'heads'};
6099 my $fetch = $rdata->{'fetch'};
6100 my $push = $rdata->{'push'};
6101
6102 my $urls_table = "<table class=\"projects_list\">\n" ;
6103
6104 if (defined $fetch) {
6105 if ($fetch eq $push) {
6106 $urls_table .= format_repo_url("URL", $fetch);
6107 } else {
6108 $urls_table .= format_repo_url("Fetch URL", $fetch);
6109 $urls_table .= format_repo_url("Push URL", $push) if defined $push;
6110 }
6111 } elsif (defined $push) {
6112 $urls_table .= format_repo_url("Push URL", $push);
6113 } else {
6114 $urls_table .= format_repo_url("", "No remote URL");
6115 }
6116
6117 $urls_table .= "</table>\n";
6118
6119 my $dots;
6120 if (defined $limit && $limit < @$heads) {
6121 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
6122 }
6123
6124 print $urls_table;
6125 git_heads_body($heads, $head, 0, $limit, $dots);
6126 }
6127
6128 # Display a list of remote names with the respective fetch and push URLs
6129 sub git_remotes_list {
6130 my ($remotedata, $limit) = @_;
6131 print "<table class=\"heads\">\n";
6132 my $alternate = 1;
6133 my @remotes = sort keys %$remotedata;
6134
6135 my $limited = $limit && $limit < @remotes;
6136
6137 $#remotes = $limit - 1 if $limited;
6138
6139 while (my $remote = shift @remotes) {
6140 my $rdata = $remotedata->{$remote};
6141 my $fetch = $rdata->{'fetch'};
6142 my $push = $rdata->{'push'};
6143 if ($alternate) {
6144 print "<tr class=\"dark\">\n";
6145 } else {
6146 print "<tr class=\"light\">\n";
6147 }
6148 $alternate ^= 1;
6149 print "<td>" .
6150 $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
6151 -class=> "list name"},esc_html($remote)) .
6152 "</td>";
6153 print "<td class=\"link\">" .
6154 (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
6155 " | " .
6156 (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
6157 "</td>";
6158
6159 print "</tr>\n";
6160 }
6161
6162 if ($limited) {
6163 print "<tr>\n" .
6164 "<td colspan=\"3\">" .
6165 $cgi->a({-href => href(action=>"remotes")}, "...") .
6166 "</td>\n" . "</tr>\n";
6167 }
6168
6169 print "</table>";
6170 }
6171
6172 # Display remote heads grouped by remote, unless there are too many
6173 # remotes, in which case we only display the remote names
6174 sub git_remotes_body {
6175 my ($remotedata, $limit, $head) = @_;
6176 if ($limit and $limit < keys %$remotedata) {
6177 git_remotes_list($remotedata, $limit);
6178 } else {
6179 fill_remote_heads($remotedata);
6180 while (my ($remote, $rdata) = each %$remotedata) {
6181 git_print_section({-class=>"remote", -id=>$remote},
6182 ["remotes", $remote, $remote], sub {
6183 git_remote_block($remote, $rdata, $limit, $head);
6184 });
6185 }
6186 }
6187 }
6188
6189 sub git_search_message {
6190 my %co = @_;
6191
6192 my $greptype;
6193 if ($searchtype eq 'commit') {
6194 $greptype = "--grep=";
6195 } elsif ($searchtype eq 'author') {
6196 $greptype = "--author=";
6197 } elsif ($searchtype eq 'committer') {
6198 $greptype = "--committer=";
6199 }
6200 $greptype .= $searchtext;
6201 my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
6202 $greptype, '--regexp-ignore-case',
6203 $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
6204
6205 my $paging_nav = '';
6206 if ($page > 0) {
6207 $paging_nav .=
6208 $cgi->a({-href => href(-replay=>1, page=>undef)},
6209 "first") .
6210 " &sdot; " .
6211 $cgi->a({-href => href(-replay=>1, page=>$page-1),
6212 -accesskey => "p", -title => "Alt-p"}, "prev");
6213 } else {
6214 $paging_nav .= "first &sdot; prev";
6215 }
6216 my $next_link = '';
6217 if ($#commitlist >= 100) {
6218 $next_link =
6219 $cgi->a({-href => href(-replay=>1, page=>$page+1),
6220 -accesskey => "n", -title => "Alt-n"}, "next");
6221 $paging_nav .= " &sdot; $next_link";
6222 } else {
6223 $paging_nav .= " &sdot; next";
6224 }
6225
6226 git_header_html();
6227
6228 git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav);
6229 git_print_header_div('commit', esc_html($co{'title'}), $hash);
6230 if ($page == 0 && !@commitlist) {
6231 print "<p>No match.</p>\n";
6232 } else {
6233 git_search_grep_body(\@commitlist, 0, 99, $next_link);
6234 }
6235
6236 git_footer_html();
6237 }
6238
6239 sub git_search_changes {
6240 my %co = @_;
6241
6242 local $/ = "\n";
6243 open my $fd, '-|', git_cmd(), '--no-pager', 'log', @diff_opts,
6244 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
6245 ($search_use_regexp ? '--pickaxe-regex' : ())
6246 or die_error(500, "Open git-log failed");
6247
6248 git_header_html();
6249
6250 git_print_page_nav('','', $hash,$co{'tree'},$hash);
6251 git_print_header_div('commit', esc_html($co{'title'}), $hash);
6252
6253 print "<table class=\"pickaxe search\">\n";
6254 my $alternate = 1;
6255 undef %co;
6256 my @files;
6257 while (my $line = <$fd>) {
6258 chomp $line;
6259 next unless $line;
6260
6261 my %set = parse_difftree_raw_line($line);
6262 if (defined $set{'commit'}) {
6263 # finish previous commit
6264 if (%co) {
6265 print "</td>\n" .
6266 "<td class=\"link\">" .
6267 $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
6268 "commit") .
6269 " | " .
6270 $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
6271 hash_base=>$co{'id'})},
6272 "tree") .
6273 "</td>\n" .
6274 "</tr>\n";
6275 }
6276
6277 if ($alternate) {
6278 print "<tr class=\"dark\">\n";
6279 } else {
6280 print "<tr class=\"light\">\n";
6281 }
6282 $alternate ^= 1;
6283 %co = parse_commit($set{'commit'});
6284 my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
6285 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6286 "<td><i>$author</i></td>\n" .
6287 "<td>" .
6288 $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
6289 -class => "list subject"},
6290 chop_and_escape_str($co{'title'}, 50) . "<br/>");
6291 } elsif (defined $set{'to_id'}) {
6292 next if ($set{'to_id'} =~ m/^0{40}$/);
6293
6294 print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
6295 hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
6296 -class => "list"},
6297 "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
6298 "<br/>\n";
6299 }
6300 }
6301 close $fd;
6302
6303 # finish last commit (warning: repetition!)
6304 if (%co) {
6305 print "</td>\n" .
6306 "<td class=\"link\">" .
6307 $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
6308 "commit") .
6309 " | " .
6310 $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
6311 hash_base=>$co{'id'})},
6312 "tree") .
6313 "</td>\n" .
6314 "</tr>\n";
6315 }
6316
6317 print "</table>\n";
6318
6319 git_footer_html();
6320 }
6321
6322 sub git_search_files {
6323 my %co = @_;
6324
6325 local $/ = "\n";
6326 open my $fd, "-|", git_cmd(), 'grep', '-n', '-z',
6327 $search_use_regexp ? ('-E', '-i') : '-F',
6328 $searchtext, $co{'tree'}
6329 or die_error(500, "Open git-grep failed");
6330
6331 git_header_html();
6332
6333 git_print_page_nav('','', $hash,$co{'tree'},$hash);
6334 git_print_header_div('commit', esc_html($co{'title'}), $hash);
6335
6336 print "<table class=\"grep_search\">\n";
6337 my $alternate = 1;
6338 my $matches = 0;
6339 my $lastfile = '';
6340 my $file_href;
6341 while (my $line = <$fd>) {
6342 chomp $line;
6343 my ($file, $lno, $ltext, $binary);
6344 last if ($matches++ > 1000);
6345 if ($line =~ /^Binary file (.+) matches$/) {
6346 $file = $1;
6347 $binary = 1;
6348 } else {
6349 ($file, $lno, $ltext) = split(/\0/, $line, 3);
6350 $file =~ s/^$co{'tree'}://;
6351 }
6352 if ($file ne $lastfile) {
6353 $lastfile and print "</td></tr>\n";
6354 if ($alternate++) {
6355 print "<tr class=\"dark\">\n";
6356 } else {
6357 print "<tr class=\"light\">\n";
6358 }
6359 $file_href = href(action=>"blob", hash_base=>$co{'id'},
6360 file_name=>$file);
6361 print "<td class=\"list\">".
6362 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
6363 print "</td><td>\n";
6364 $lastfile = $file;
6365 }
6366 if ($binary) {
6367 print "<div class=\"binary\">Binary file</div>\n";
6368 } else {
6369 $ltext = untabify($ltext);
6370 if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
6371 $ltext = esc_html($1, -nbsp=>1);
6372 $ltext .= '<span class="match">';
6373 $ltext .= esc_html($2, -nbsp=>1);
6374 $ltext .= '</span>';
6375 $ltext .= esc_html($3, -nbsp=>1);
6376 } else {
6377 $ltext = esc_html($ltext, -nbsp=>1);
6378 }
6379 print "<div class=\"pre\">" .
6380 $cgi->a({-href => $file_href.'#l'.$lno,
6381 -class => "linenr"}, sprintf('%4i', $lno)) .
6382 ' ' . $ltext . "</div>\n";
6383 }
6384 }
6385 if ($lastfile) {
6386 print "</td></tr>\n";
6387 if ($matches > 1000) {
6388 print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
6389 }
6390 } else {
6391 print "<div class=\"diff nodifferences\">No matches found</div>\n";
6392 }
6393 close $fd;
6394
6395 print "</table>\n";
6396
6397 git_footer_html();
6398 }
6399
6400 sub git_search_grep_body {
6401 my ($commitlist, $from, $to, $extra) = @_;
6402 $from = 0 unless defined $from;
6403 $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6404
6405 print "<table class=\"commit_search\">\n";
6406 my $alternate = 1;
6407 for (my $i = $from; $i <= $to; $i++) {
6408 my %co = %{$commitlist->[$i]};
6409 if (!%co) {
6410 next;
6411 }
6412 my $commit = $co{'id'};
6413 if ($alternate) {
6414 print "<tr class=\"dark\">\n";
6415 } else {
6416 print "<tr class=\"light\">\n";
6417 }
6418 $alternate ^= 1;
6419 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6420 format_author_html('td', \%co, 15, 5) .
6421 "<td>" .
6422 $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
6423 -class => "list subject"},
6424 chop_and_escape_str($co{'title'}, 50) . "<br/>");
6425 my $comment = $co{'comment'};
6426 foreach my $line (@$comment) {
6427 if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
6428 my ($lead, $match, $trail) = ($1, $2, $3);
6429 $match = chop_str($match, 70, 5, 'center');
6430 my $contextlen = int((80 - length($match))/2);
6431 $contextlen = 30 if ($contextlen > 30);
6432 $lead = chop_str($lead, $contextlen, 10, 'left');
6433 $trail = chop_str($trail, $contextlen, 10, 'right');
6434
6435 $lead = esc_html($lead);
6436 $match = esc_html($match);
6437 $trail = esc_html($trail);
6438
6439 print "$lead<span class=\"match\">$match</span>$trail<br />";
6440 }
6441 }
6442 print "</td>\n" .
6443 "<td class=\"link\">" .
6444 $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
6445 " | " .
6446 $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
6447 " | " .
6448 $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
6449 print "</td>\n" .
6450 "</tr>\n";
6451 }
6452 if (defined $extra) {
6453 print "<tr>\n" .
6454 "<td colspan=\"3\">$extra</td>\n" .
6455 "</tr>\n";
6456 }
6457 print "</table>\n";
6458 }
6459
6460 ## ======================================================================
6461 ## ======================================================================
6462 ## actions
6463
6464 sub git_project_list {
6465 my $order = $input_params{'order'};
6466 if (defined $order && $order !~ m/none|project|descr|owner|age/) {
6467 die_error(400, "Unknown order parameter");
6468 }
6469
6470 my @list = git_get_projects_list($project_filter, $strict_export);
6471 if (!@list) {
6472 die_error(404, "No projects found");
6473 }
6474
6475 git_header_html();
6476 if (defined $home_text && -f $home_text) {
6477 print "<div class=\"index_include\">\n";
6478 insert_file($home_text);
6479 print "</div>\n";
6480 }
6481
6482 git_project_search_form($searchtext, $search_use_regexp);
6483 git_project_list_body(\@list, $order);
6484 git_footer_html();
6485 }
6486
6487 sub git_forks {
6488 my $order = $input_params{'order'};
6489 if (defined $order && $order !~ m/none|project|descr|owner|age/) {
6490 die_error(400, "Unknown order parameter");
6491 }
6492
6493 my $filter = $project;
6494 $filter =~ s/\.git$//;
6495 my @list = git_get_projects_list($filter);
6496 if (!@list) {
6497 die_error(404, "No forks found");
6498 }
6499
6500 git_header_html();
6501 git_print_page_nav('','');
6502 git_print_header_div('summary', "$project forks");
6503 git_project_list_body(\@list, $order);
6504 git_footer_html();
6505 }
6506
6507 sub git_project_index {
6508 my @projects = git_get_projects_list($project_filter, $strict_export);
6509 if (!@projects) {
6510 die_error(404, "No projects found");
6511 }
6512
6513 print $cgi->header(
6514 -type => 'text/plain',
6515 -charset => 'utf-8',
6516 -content_disposition => 'inline; filename="index.aux"');
6517
6518 foreach my $pr (@projects) {
6519 if (!exists $pr->{'owner'}) {
6520 $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
6521 }
6522
6523 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
6524 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
6525 $path =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
6526 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
6527 $path =~ s/ /\+/g;
6528 $owner =~ s/ /\+/g;
6529
6530 print "$path $owner\n";
6531 }
6532 }
6533
6534 sub git_summary {
6535 my $descr = git_get_project_description($project) || "none";
6536 my %co = parse_commit("HEAD");
6537 my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
6538 my $head = $co{'id'};
6539 my $remote_heads = gitweb_check_feature('remote_heads');
6540
6541 my $owner = git_get_project_owner($project);
6542
6543 my $refs = git_get_references();
6544 # These get_*_list functions return one more to allow us to see if
6545 # there are more ...
6546 my @taglist = git_get_tags_list(16);
6547 my @headlist = git_get_heads_list(16);
6548 my %remotedata = $remote_heads ? git_get_remotes_list() : ();
6549 my @forklist;
6550 my $check_forks = gitweb_check_feature('forks');
6551
6552 if ($check_forks) {
6553 # find forks of a project
6554 my $filter = $project;
6555 $filter =~ s/\.git$//;
6556 @forklist = git_get_projects_list($filter);
6557 # filter out forks of forks
6558 @forklist = filter_forks_from_projects_list(\@forklist)
6559 if (@forklist);
6560 }
6561
6562 git_header_html();
6563 git_print_page_nav('summary','', $head);
6564
6565 print "<div class=\"title\">&nbsp;</div>\n";
6566 print "<table class=\"projects_list\">\n" .
6567 "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
6568 if ($owner and not $omit_owner) {
6569 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . esc_html($owner) . "</td></tr>\n";
6570 }
6571 if (defined $cd{'rfc2822'}) {
6572 print "<tr id=\"metadata_lchange\"><td>last change</td>" .
6573 "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
6574 }
6575
6576 # use per project git URL list in $projectroot/$project/cloneurl
6577 # or make project git URL from git base URL and project name
6578 my $url_tag = "URL";
6579 my @url_list = git_get_project_url_list($project);
6580 @url_list = map { "$_/$project" } @git_base_url_list unless @url_list;
6581 foreach my $git_url (@url_list) {
6582 next unless $git_url;
6583 print format_repo_url($url_tag, $git_url);
6584 $url_tag = "";
6585 }
6586
6587 # Tag cloud
6588 my $show_ctags = gitweb_check_feature('ctags');
6589 if ($show_ctags) {
6590 my $ctags = git_get_project_ctags($project);
6591 if (%$ctags) {
6592 # without ability to add tags, don't show if there are none
6593 my $cloud = git_populate_project_tagcloud($ctags);
6594 print "<tr id=\"metadata_ctags\">" .
6595 "<td>content tags</td>" .
6596 "<td>".git_show_project_tagcloud($cloud, 48)."</td>" .
6597 "</tr>\n";
6598 }
6599 }
6600
6601 print "</table>\n";
6602
6603 # If XSS prevention is on, we don't include README.html.
6604 # TODO: Allow a readme in some safe format.
6605 if (!$prevent_xss && -s "$projectroot/$project/README.html") {
6606 print "<div class=\"title\">readme</div>\n" .
6607 "<div class=\"readme\">\n";
6608 insert_file("$projectroot/$project/README.html");
6609 print "\n</div>\n"; # class="readme"
6610 }
6611
6612 # we need to request one more than 16 (0..15) to check if
6613 # those 16 are all
6614 my @commitlist = $head ? parse_commits($head, 17) : ();
6615 if (@commitlist) {
6616 git_print_header_div('shortlog');
6617 git_shortlog_body(\@commitlist, 0, 15, $refs,
6618 $#commitlist <= 15 ? undef :
6619 $cgi->a({-href => href(action=>"shortlog")}, "..."));
6620 }
6621
6622 if (@taglist) {
6623 git_print_header_div('tags');
6624 git_tags_body(\@taglist, 0, 15,
6625 $#taglist <= 15 ? undef :
6626 $cgi->a({-href => href(action=>"tags")}, "..."));
6627 }
6628
6629 if (@headlist) {
6630 git_print_header_div('heads');
6631 git_heads_body(\@headlist, $head, 0, 15,
6632 $#headlist <= 15 ? undef :
6633 $cgi->a({-href => href(action=>"heads")}, "..."));
6634 }
6635
6636 if (%remotedata) {
6637 git_print_header_div('remotes');
6638 git_remotes_body(\%remotedata, 15, $head);
6639 }
6640
6641 if (@forklist) {
6642 git_print_header_div('forks');
6643 git_project_list_body(\@forklist, 'age', 0, 15,
6644 $#forklist <= 15 ? undef :
6645 $cgi->a({-href => href(action=>"forks")}, "..."),
6646 'no_header');
6647 }
6648
6649 git_footer_html();
6650 }
6651
6652 sub git_tag {
6653 my %tag = parse_tag($hash);
6654
6655 if (! %tag) {
6656 die_error(404, "Unknown tag object");
6657 }
6658
6659 my $head = git_get_head_hash($project);
6660 git_header_html();
6661 git_print_page_nav('','', $head,undef,$head);
6662 git_print_header_div('commit', esc_html($tag{'name'}), $hash);
6663 print "<div class=\"title_text\">\n" .
6664 "<table class=\"object_header\">\n" .
6665 "<tr>\n" .
6666 "<td>object</td>\n" .
6667 "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
6668 $tag{'object'}) . "</td>\n" .
6669 "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
6670 $tag{'type'}) . "</td>\n" .
6671 "</tr>\n";
6672 if (defined($tag{'author'})) {
6673 git_print_authorship_rows(\%tag, 'author');
6674 }
6675 print "</table>\n\n" .
6676 "</div>\n";
6677 print "<div class=\"page_body\">";
6678 my $comment = $tag{'comment'};
6679 foreach my $line (@$comment) {
6680 chomp $line;
6681 print esc_html($line, -nbsp=>1) . "<br/>\n";
6682 }
6683 print "</div>\n";
6684 git_footer_html();
6685 }
6686
6687 sub git_blame_common {
6688 my $format = shift || 'porcelain';
6689 if ($format eq 'porcelain' && $input_params{'javascript'}) {
6690 $format = 'incremental';
6691 $action = 'blame_incremental'; # for page title etc
6692 }
6693
6694 # permissions
6695 gitweb_check_feature('blame')
6696 or die_error(403, "Blame view not allowed");
6697
6698 # error checking
6699 die_error(400, "No file name given") unless $file_name;
6700 $hash_base ||= git_get_head_hash($project);
6701 die_error(404, "Couldn't find base commit") unless $hash_base;
6702 my %co = parse_commit($hash_base)
6703 or die_error(404, "Commit not found");
6704 my $ftype = "blob";
6705 if (!defined $hash) {
6706 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
6707 or die_error(404, "Error looking up file");
6708 } else {
6709 $ftype = git_get_type($hash);
6710 if ($ftype !~ "blob") {
6711 die_error(400, "Object is not a blob");
6712 }
6713 }
6714
6715 my $fd;
6716 if ($format eq 'incremental') {
6717 # get file contents (as base)
6718 open $fd, "-|", git_cmd(), 'cat-file', 'blob', $hash
6719 or die_error(500, "Open git-cat-file failed");
6720 } elsif ($format eq 'data') {
6721 # run git-blame --incremental
6722 open $fd, "-|", git_cmd(), "blame", "--incremental",
6723 $hash_base, "--", $file_name
6724 or die_error(500, "Open git-blame --incremental failed");
6725 } else {
6726 # run git-blame --porcelain
6727 open $fd, "-|", git_cmd(), "blame", '-p',
6728 $hash_base, '--', $file_name
6729 or die_error(500, "Open git-blame --porcelain failed");
6730 }
6731 binmode $fd, ':utf8';
6732
6733 # incremental blame data returns early
6734 if ($format eq 'data') {
6735 print $cgi->header(
6736 -type=>"text/plain", -charset => "utf-8",
6737 -status=> "200 OK");
6738 local $| = 1; # output autoflush
6739 while (my $line = <$fd>) {
6740 print to_utf8($line);
6741 }
6742 close $fd
6743 or print "ERROR $!\n";
6744
6745 print 'END';
6746 if (defined $t0 && gitweb_check_feature('timed')) {
6747 print ' '.
6748 tv_interval($t0, [ gettimeofday() ]).
6749 ' '.$number_of_git_cmds;
6750 }
6751 print "\n";
6752
6753 return;
6754 }
6755
6756 # page header
6757 git_header_html();
6758 my $formats_nav =
6759 $cgi->a({-href => href(action=>"blob", -replay=>1)},
6760 "blob") .
6761 " | ";
6762 if ($format eq 'incremental') {
6763 $formats_nav .=
6764 $cgi->a({-href => href(action=>"blame", javascript=>0, -replay=>1)},
6765 "blame") . " (non-incremental)";
6766 } else {
6767 $formats_nav .=
6768 $cgi->a({-href => href(action=>"blame_incremental", -replay=>1)},
6769 "blame") . " (incremental)";
6770 }
6771 $formats_nav .=
6772 " | " .
6773 $cgi->a({-href => href(action=>"history", -replay=>1)},
6774 "history") .
6775 " | " .
6776 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
6777 "HEAD");
6778 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
6779 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
6780 git_print_page_path($file_name, $ftype, $hash_base);
6781
6782 # page body
6783 if ($format eq 'incremental') {
6784 print "<noscript>\n<div class=\"error\"><center><b>\n".
6785 "This page requires JavaScript to run.\n Use ".
6786 $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
6787 'this page').
6788 " instead.\n".
6789 "</b></center></div>\n</noscript>\n";
6790
6791 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
6792 }
6793
6794 print qq!<div class="page_body">\n!;
6795 print qq!<div id="progress_info">... / ...</div>\n!
6796 if ($format eq 'incremental');
6797 print qq!<table id="blame_table" class="blame" width="100%">\n!.
6798 #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
6799 qq!<thead>\n!.
6800 qq!<tr><th>Commit</th><th>Line</th><th>Data</th></tr>\n!.
6801 qq!</thead>\n!.
6802 qq!<tbody>\n!;
6803
6804 my @rev_color = qw(light dark);
6805 my $num_colors = scalar(@rev_color);
6806 my $current_color = 0;
6807
6808 if ($format eq 'incremental') {
6809 my $color_class = $rev_color[$current_color];
6810
6811 #contents of a file
6812 my $linenr = 0;
6813 LINE:
6814 while (my $line = <$fd>) {
6815 chomp $line;
6816 $linenr++;
6817
6818 print qq!<tr id="l$linenr" class="$color_class">!.
6819 qq!<td class="sha1"><a href=""> </a></td>!.
6820 qq!<td class="linenr">!.
6821 qq!<a class="linenr" href="">$linenr</a></td>!;
6822 print qq!<td class="pre">! . esc_html($line) . "</td>\n";
6823 print qq!</tr>\n!;
6824 }
6825
6826 } else { # porcelain, i.e. ordinary blame
6827 my %metainfo = (); # saves information about commits
6828
6829 # blame data
6830 LINE:
6831 while (my $line = <$fd>) {
6832 chomp $line;
6833 # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
6834 # no <lines in group> for subsequent lines in group of lines
6835 my ($full_rev, $orig_lineno, $lineno, $group_size) =
6836 ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
6837 if (!exists $metainfo{$full_rev}) {
6838 $metainfo{$full_rev} = { 'nprevious' => 0 };
6839 }
6840 my $meta = $metainfo{$full_rev};
6841 my $data;
6842 while ($data = <$fd>) {
6843 chomp $data;
6844 last if ($data =~ s/^\t//); # contents of line
6845 if ($data =~ /^(\S+)(?: (.*))?$/) {
6846 $meta->{$1} = $2 unless exists $meta->{$1};
6847 }
6848 if ($data =~ /^previous /) {
6849 $meta->{'nprevious'}++;
6850 }
6851 }
6852 my $short_rev = substr($full_rev, 0, 8);
6853 my $author = $meta->{'author'};
6854 my %date =
6855 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
6856 my $date = $date{'iso-tz'};
6857 if ($group_size) {
6858 $current_color = ($current_color + 1) % $num_colors;
6859 }
6860 my $tr_class = $rev_color[$current_color];
6861 $tr_class .= ' boundary' if (exists $meta->{'boundary'});
6862 $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
6863 $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
6864 print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
6865 if ($group_size) {
6866 print "<td class=\"sha1\"";
6867 print " title=\"". esc_html($author) . ", $date\"";
6868 print " rowspan=\"$group_size\"" if ($group_size > 1);
6869 print ">";
6870 print $cgi->a({-href => href(action=>"commit",
6871 hash=>$full_rev,
6872 file_name=>$file_name)},
6873 esc_html($short_rev));
6874 if ($group_size >= 2) {
6875 my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
6876 if (@author_initials) {
6877 print "<br />" .
6878 esc_html(join('', @author_initials));
6879 # or join('.', ...)
6880 }
6881 }
6882 print "</td>\n";
6883 }
6884 # 'previous' <sha1 of parent commit> <filename at commit>
6885 if (exists $meta->{'previous'} &&
6886 $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
6887 $meta->{'parent'} = $1;
6888 $meta->{'file_parent'} = unquote($2);
6889 }
6890 my $linenr_commit =
6891 exists($meta->{'parent'}) ?
6892 $meta->{'parent'} : $full_rev;
6893 my $linenr_filename =
6894 exists($meta->{'file_parent'}) ?
6895 $meta->{'file_parent'} : unquote($meta->{'filename'});
6896 my $blamed = href(action => 'blame',
6897 file_name => $linenr_filename,
6898 hash_base => $linenr_commit);
6899 print "<td class=\"linenr\">";
6900 print $cgi->a({ -href => "$blamed#l$orig_lineno",
6901 -class => "linenr" },
6902 esc_html($lineno));
6903 print "</td>";
6904 print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
6905 print "</tr>\n";
6906 } # end while
6907
6908 }
6909
6910 # footer
6911 print "</tbody>\n".
6912 "</table>\n"; # class="blame"
6913 print "</div>\n"; # class="blame_body"
6914 close $fd
6915 or print "Reading blob failed\n";
6916
6917 git_footer_html();
6918 }
6919
6920 sub git_blame {
6921 git_blame_common();
6922 }
6923
6924 sub git_blame_incremental {
6925 git_blame_common('incremental');
6926 }
6927
6928 sub git_blame_data {
6929 git_blame_common('data');
6930 }
6931
6932 sub git_tags {
6933 my $head = git_get_head_hash($project);
6934 git_header_html();
6935 git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
6936 git_print_header_div('summary', $project);
6937
6938 my @tagslist = git_get_tags_list();
6939 if (@tagslist) {
6940 git_tags_body(\@tagslist);
6941 }
6942 git_footer_html();
6943 }
6944
6945 sub git_heads {
6946 my $head = git_get_head_hash($project);
6947 git_header_html();
6948 git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
6949 git_print_header_div('summary', $project);
6950
6951 my @headslist = git_get_heads_list();
6952 if (@headslist) {
6953 git_heads_body(\@headslist, $head);
6954 }
6955 git_footer_html();
6956 }
6957
6958 # used both for single remote view and for list of all the remotes
6959 sub git_remotes {
6960 gitweb_check_feature('remote_heads')
6961 or die_error(403, "Remote heads view is disabled");
6962
6963 my $head = git_get_head_hash($project);
6964 my $remote = $input_params{'hash'};
6965
6966 my $remotedata = git_get_remotes_list($remote);
6967 die_error(500, "Unable to get remote information") unless defined $remotedata;
6968
6969 unless (%$remotedata) {
6970 die_error(404, defined $remote ?
6971 "Remote $remote not found" :
6972 "No remotes found");
6973 }
6974
6975 git_header_html(undef, undef, -action_extra => $remote);
6976 git_print_page_nav('', '', $head, undef, $head,
6977 format_ref_views($remote ? '' : 'remotes'));
6978
6979 fill_remote_heads($remotedata);
6980 if (defined $remote) {
6981 git_print_header_div('remotes', "$remote remote for $project");
6982 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
6983 } else {
6984 git_print_header_div('summary', "$project remotes");
6985 git_remotes_body($remotedata, undef, $head);
6986 }
6987
6988 git_footer_html();
6989 }
6990
6991 sub git_blob_plain {
6992 my $type = shift;
6993 my $expires;
6994
6995 if (!defined $hash) {
6996 if (defined $file_name) {
6997 my $base = $hash_base || git_get_head_hash($project);
6998 $hash = git_get_hash_by_path($base, $file_name, "blob")
6999 or die_error(404, "Cannot find file");
7000 } else {
7001 die_error(400, "No file name defined");
7002 }
7003 } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
7004 # blobs defined by non-textual hash id's can be cached
7005 $expires = "+1d";
7006 }
7007
7008 open my $fd, "-|", git_cmd(), "cat-file", "blob", $hash
7009 or die_error(500, "Open git-cat-file blob '$hash' failed");
7010
7011 # content-type (can include charset)
7012 $type = blob_contenttype($fd, $file_name, $type);
7013
7014 # "save as" filename, even when no $file_name is given
7015 my $save_as = "$hash";
7016 if (defined $file_name) {
7017 $save_as = $file_name;
7018 } elsif ($type =~ m/^text\//) {
7019 $save_as .= '.txt';
7020 }
7021
7022 # With XSS prevention on, blobs of all types except a few known safe
7023 # ones are served with "Content-Disposition: attachment" to make sure
7024 # they don't run in our security domain. For certain image types,
7025 # blob view writes an <img> tag referring to blob_plain view, and we
7026 # want to be sure not to break that by serving the image as an
7027 # attachment (though Firefox 3 doesn't seem to care).
7028 my $sandbox = $prevent_xss &&
7029 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
7030
7031 # serve text/* as text/plain
7032 if ($prevent_xss &&
7033 ($type =~ m!^text/[a-z]+\b(.*)$! ||
7034 ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
7035 my $rest = $1;
7036 $rest = defined $rest ? $rest : '';
7037 $type = "text/plain$rest";
7038 }
7039
7040 print $cgi->header(
7041 -type => $type,
7042 -expires => $expires,
7043 -content_disposition =>
7044 ($sandbox ? 'attachment' : 'inline')
7045 . '; filename="' . $save_as . '"');
7046 local $/ = undef;
7047 binmode STDOUT, ':raw';
7048 print <$fd>;
7049 binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
7050 close $fd;
7051 }
7052
7053 sub git_blob {
7054 my $expires;
7055
7056 if (!defined $hash) {
7057 if (defined $file_name) {
7058 my $base = $hash_base || git_get_head_hash($project);
7059 $hash = git_get_hash_by_path($base, $file_name, "blob")
7060 or die_error(404, "Cannot find file");
7061 } else {
7062 die_error(400, "No file name defined");
7063 }
7064 } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
7065 # blobs defined by non-textual hash id's can be cached
7066 $expires = "+1d";
7067 }
7068
7069 my $have_blame = gitweb_check_feature('blame');
7070 open my $fd, "-|", git_cmd(), "cat-file", "blob", $hash
7071 or die_error(500, "Couldn't cat $file_name, $hash");
7072 my $mimetype = blob_mimetype($fd, $file_name);
7073 # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
7074 if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
7075 close $fd;
7076 return git_blob_plain($mimetype);
7077 }
7078 # we can have blame only for text/* mimetype
7079 $have_blame &&= ($mimetype =~ m!^text/!);
7080
7081 my $highlight = gitweb_check_feature('highlight');
7082 my $syntax = guess_file_syntax($highlight, $file_name);
7083 $fd = run_highlighter($fd, $highlight, $syntax);
7084
7085 git_header_html(undef, $expires);
7086 my $formats_nav = '';
7087 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
7088 if (defined $file_name) {
7089 if ($have_blame) {
7090 $formats_nav .=
7091 $cgi->a({-href => href(action=>"blame", -replay=>1)},
7092 "blame") .
7093 " | ";
7094 }
7095 $formats_nav .=
7096 $cgi->a({-href => href(action=>"history", -replay=>1)},
7097 "history") .
7098 " | " .
7099 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
7100 "raw") .
7101 " | " .
7102 $cgi->a({-href => href(action=>"blob",
7103 hash_base=>"HEAD", file_name=>$file_name)},
7104 "HEAD");
7105 } else {
7106 $formats_nav .=
7107 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
7108 "raw");
7109 }
7110 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
7111 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
7112 } else {
7113 print "<div class=\"page_nav\">\n" .
7114 "<br/><br/></div>\n" .
7115 "<div class=\"title\">".esc_html($hash)."</div>\n";
7116 }
7117 git_print_page_path($file_name, "blob", $hash_base);
7118 print "<div class=\"page_body\">\n";
7119 if ($mimetype =~ m!^image/!) {
7120 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
7121 if ($file_name) {
7122 print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
7123 }
7124 print qq! src="! .
7125 href(action=>"blob_plain", hash=>$hash,
7126 hash_base=>$hash_base, file_name=>$file_name) .
7127 qq!" />\n!;
7128 } else {
7129 my $nr;
7130 while (my $line = <$fd>) {
7131 chomp $line;
7132 $nr++;
7133 $line = untabify($line);
7134 printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i</a> %s</div>\n!,
7135 $nr, esc_attr(href(-replay => 1)), $nr, $nr,
7136 $highlight ? sanitize($line) : esc_html($line, -nbsp=>1);
7137 }
7138 }
7139 close $fd
7140 or print "Reading blob failed.\n";
7141 print "</div>";
7142 git_footer_html();
7143 }
7144
7145 sub git_tree {
7146 if (!defined $hash_base) {
7147 $hash_base = "HEAD";
7148 }
7149 if (!defined $hash) {
7150 if (defined $file_name) {
7151 $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
7152 } else {
7153 $hash = $hash_base;
7154 }
7155 }
7156 die_error(404, "No such tree") unless defined($hash);
7157
7158 my $show_sizes = gitweb_check_feature('show-sizes');
7159 my $have_blame = gitweb_check_feature('blame');
7160
7161 my @entries = ();
7162 {
7163 local $/ = "\0";
7164 open my $fd, "-|", git_cmd(), "ls-tree", '-z',
7165 ($show_sizes ? '-l' : ()), @extra_options, $hash
7166 or die_error(500, "Open git-ls-tree failed");
7167 @entries = map { chomp; $_ } <$fd>;
7168 close $fd
7169 or die_error(404, "Reading tree failed");
7170 }
7171
7172 my $refs = git_get_references();
7173 my $ref = format_ref_marker($refs, $hash_base);
7174 git_header_html();
7175 my $basedir = '';
7176 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
7177 my @views_nav = ();
7178 if (defined $file_name) {
7179 push @views_nav,
7180 $cgi->a({-href => href(action=>"history", -replay=>1)},
7181 "history"),
7182 $cgi->a({-href => href(action=>"tree",
7183 hash_base=>"HEAD", file_name=>$file_name)},
7184 "HEAD"),
7185 }
7186 my $snapshot_links = format_snapshot_links($hash);
7187 if (defined $snapshot_links) {
7188 # FIXME: Should be available when we have no hash base as well.
7189 push @views_nav, $snapshot_links;
7190 }
7191 git_print_page_nav('tree','', $hash_base, undef, undef,
7192 join(' | ', @views_nav));
7193 git_print_header_div('commit', esc_html($co{'title'}) . $ref, $hash_base);
7194 } else {
7195 undef $hash_base;
7196 print "<div class=\"page_nav\">\n";
7197 print "<br/><br/></div>\n";
7198 print "<div class=\"title\">".esc_html($hash)."</div>\n";
7199 }
7200 if (defined $file_name) {
7201 $basedir = $file_name;
7202 if ($basedir ne '' && substr($basedir, -1) ne '/') {
7203 $basedir .= '/';
7204 }
7205 git_print_page_path($file_name, 'tree', $hash_base);
7206 }
7207 print "<div class=\"page_body\">\n";
7208 print "<table class=\"tree\">\n";
7209 my $alternate = 1;
7210 # '..' (top directory) link if possible
7211 if (defined $hash_base &&
7212 defined $file_name && $file_name =~ m![^/]+$!) {
7213 if ($alternate) {
7214 print "<tr class=\"dark\">\n";
7215 } else {
7216 print "<tr class=\"light\">\n";
7217 }
7218 $alternate ^= 1;
7219
7220 my $up = $file_name;
7221 $up =~ s!/?[^/]+$!!;
7222 undef $up unless $up;
7223 # based on git_print_tree_entry
7224 print '<td class="mode">' . mode_str('040000') . "</td>\n";
7225 print '<td class="size">&nbsp;</td>'."\n" if $show_sizes;
7226 print '<td class="list">';
7227 print $cgi->a({-href => href(action=>"tree",
7228 hash_base=>$hash_base,
7229 file_name=>$up)},
7230 "..");
7231 print "</td>\n";
7232 print "<td class=\"link\"></td>\n";
7233
7234 print "</tr>\n";
7235 }
7236 foreach my $line (@entries) {
7237 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
7238
7239 if ($alternate) {
7240 print "<tr class=\"dark\">\n";
7241 } else {
7242 print "<tr class=\"light\">\n";
7243 }
7244 $alternate ^= 1;
7245
7246 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
7247
7248 print "</tr>\n";
7249 }
7250 print "</table>\n" .
7251 "</div>";
7252 git_footer_html();
7253 }
7254
7255 sub sanitize_for_filename {
7256 my $name = shift;
7257
7258 $name =~ s!/!-!g;
7259 $name =~ s/[^[:alnum:]_.-]//g;
7260
7261 return $name;
7262 }
7263
7264 sub snapshot_name {
7265 my ($project, $hash) = @_;
7266
7267 # path/to/project.git -> project
7268 # path/to/project/.git -> project
7269 my $name = to_utf8($project);
7270 $name =~ s,([^/])/*\.git$,$1,;
7271 $name = sanitize_for_filename(basename($name));
7272
7273 my $ver = $hash;
7274 if ($hash =~ /^[0-9a-fA-F]+$/) {
7275 # shorten SHA-1 hash
7276 my $full_hash = git_get_full_hash($project, $hash);
7277 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
7278 $ver = git_get_short_hash($project, $hash);
7279 }
7280 } elsif ($hash =~ m!^refs/tags/(.*)$!) {
7281 # tags don't need shortened SHA-1 hash
7282 $ver = $1;
7283 } else {
7284 # branches and other need shortened SHA-1 hash
7285 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
7286 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
7287 my $ref_dir = (defined $1) ? $1 : '';
7288 $ver = $2;
7289
7290 $ref_dir = sanitize_for_filename($ref_dir);
7291 # for refs neither in heads nor remotes we want to
7292 # add a ref dir to archive name
7293 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
7294 $ver = $ref_dir . '-' . $ver;
7295 }
7296 }
7297 $ver .= '-' . git_get_short_hash($project, $hash);
7298 }
7299 # special case of sanitization for filename - we change
7300 # slashes to dots instead of dashes
7301 # in case of hierarchical branch names
7302 $ver =~ s!/!.!g;
7303 $ver =~ s/[^[:alnum:]_.-]//g;
7304
7305 # name = project-version_string
7306 $name = "$name-$ver";
7307
7308 return wantarray ? ($name, $name) : $name;
7309 }
7310
7311 sub exit_if_unmodified_since {
7312 my ($latest_epoch) = @_;
7313 our $cgi;
7314
7315 my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
7316 if (defined $if_modified) {
7317 my $since;
7318 if (eval { require HTTP::Date; 1; }) {
7319 $since = HTTP::Date::str2time($if_modified);
7320 } elsif (eval { require Time::ParseDate; 1; }) {
7321 $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
7322 }
7323 if (defined $since && $latest_epoch <= $since) {
7324 my %latest_date = parse_date($latest_epoch);
7325 print $cgi->header(
7326 -last_modified => $latest_date{'rfc2822'},
7327 -status => '304 Not Modified');
7328 goto DONE_GITWEB;
7329 }
7330 }
7331 }
7332
7333 sub git_snapshot {
7334 my $format = $input_params{'snapshot_format'};
7335 if (!@snapshot_fmts) {
7336 die_error(403, "Snapshots not allowed");
7337 }
7338 # default to first supported snapshot format
7339 $format ||= $snapshot_fmts[0];
7340 if ($format !~ m/^[a-z0-9]+$/) {
7341 die_error(400, "Invalid snapshot format parameter");
7342 } elsif (!exists($known_snapshot_formats{$format})) {
7343 die_error(400, "Unknown snapshot format");
7344 } elsif ($known_snapshot_formats{$format}{'disabled'}) {
7345 die_error(403, "Snapshot format not allowed");
7346 } elsif (!grep($_ eq $format, @snapshot_fmts)) {
7347 die_error(403, "Unsupported snapshot format");
7348 }
7349
7350 my $type = git_get_type("$hash^{}");
7351 if (!$type) {
7352 die_error(404, 'Object does not exist');
7353 } elsif ($type eq 'blob') {
7354 die_error(400, 'Object is not a tree-ish');
7355 }
7356
7357 my ($name, $prefix) = snapshot_name($project, $hash);
7358 my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
7359
7360 my %co = parse_commit($hash);
7361 exit_if_unmodified_since($co{'committer_epoch'}) if %co;
7362
7363 my $cmd = quote_command(
7364 git_cmd(), 'archive',
7365 "--format=$known_snapshot_formats{$format}{'format'}",
7366 "--prefix=$prefix/", $hash);
7367 if (exists $known_snapshot_formats{$format}{'compressor'}) {
7368 $cmd .= ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}});
7369 }
7370
7371 $filename =~ s/(["\\])/\\$1/g;
7372 my %latest_date;
7373 if (%co) {
7374 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
7375 }
7376
7377 print $cgi->header(
7378 -type => $known_snapshot_formats{$format}{'type'},
7379 -content_disposition => 'inline; filename="' . $filename . '"',
7380 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
7381 -status => '200 OK');
7382
7383 open my $fd, "-|", $cmd
7384 or die_error(500, "Execute git-archive failed");
7385 binmode STDOUT, ':raw';
7386 print <$fd>;
7387 binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
7388 close $fd;
7389 }
7390
7391 sub git_log_generic {
7392 my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
7393
7394 my $head = git_get_head_hash($project);
7395 if (!defined $base) {
7396 $base = $head;
7397 }
7398 if (!defined $page) {
7399 $page = 0;
7400 }
7401 my $refs = git_get_references();
7402
7403 my $commit_hash = $base;
7404 if (defined $parent) {
7405 $commit_hash = "$parent..$base";
7406 }
7407 my @commitlist =
7408 parse_commits($commit_hash, 101, (100 * $page),
7409 defined $file_name ? ($file_name, "--full-history") : ());
7410
7411 my $ftype;
7412 if (!defined $file_hash && defined $file_name) {
7413 # some commits could have deleted file in question,
7414 # and not have it in tree, but one of them has to have it
7415 for (my $i = 0; $i < @commitlist; $i++) {
7416 $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
7417 last if defined $file_hash;
7418 }
7419 }
7420 if (defined $file_hash) {
7421 $ftype = git_get_type($file_hash);
7422 }
7423 if (defined $file_name && !defined $ftype) {
7424 die_error(500, "Unknown type of object");
7425 }
7426 my %co;
7427 if (defined $file_name) {
7428 %co = parse_commit($base)
7429 or die_error(404, "Unknown commit object");
7430 }
7431
7432
7433 my $paging_nav = format_paging_nav($fmt_name, $page, $#commitlist >= 100);
7434 my $next_link = '';
7435 if ($#commitlist >= 100) {
7436 $next_link =
7437 $cgi->a({-href => href(-replay=>1, page=>$page+1),
7438 -accesskey => "n", -title => "Alt-n"}, "next");
7439 }
7440 my $patch_max = gitweb_get_feature('patches');
7441 if ($patch_max && !defined $file_name) {
7442 if ($patch_max < 0 || @commitlist <= $patch_max) {
7443 $paging_nav .= " &sdot; " .
7444 $cgi->a({-href => href(action=>"patches", -replay=>1)},
7445 "patches");
7446 }
7447 }
7448
7449 git_header_html();
7450 git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
7451 if (defined $file_name) {
7452 git_print_header_div('commit', esc_html($co{'title'}), $base);
7453 } else {
7454 git_print_header_div('summary', $project)
7455 }
7456 git_print_page_path($file_name, $ftype, $hash_base)
7457 if (defined $file_name);
7458
7459 $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
7460 $file_name, $file_hash, $ftype);
7461
7462 git_footer_html();
7463 }
7464
7465 sub git_log {
7466 git_log_generic('log', \&git_log_body,
7467 $hash, $hash_parent);
7468 }
7469
7470 sub git_commit {
7471 $hash ||= $hash_base || "HEAD";
7472 my %co = parse_commit($hash)
7473 or die_error(404, "Unknown commit object");
7474
7475 my $parent = $co{'parent'};
7476 my $parents = $co{'parents'}; # listref
7477
7478 # we need to prepare $formats_nav before any parameter munging
7479 my $formats_nav;
7480 if (!defined $parent) {
7481 # --root commitdiff
7482 $formats_nav .= '(initial)';
7483 } elsif (@$parents == 1) {
7484 # single parent commit
7485 $formats_nav .=
7486 '(parent: ' .
7487 $cgi->a({-href => href(action=>"commit",
7488 hash=>$parent)},
7489 esc_html(substr($parent, 0, 7))) .
7490 ')';
7491 } else {
7492 # merge commit
7493 $formats_nav .=
7494 '(merge: ' .
7495 join(' ', map {
7496 $cgi->a({-href => href(action=>"commit",
7497 hash=>$_)},
7498 esc_html(substr($_, 0, 7)));
7499 } @$parents ) .
7500 ')';
7501 }
7502 if (gitweb_check_feature('patches') && @$parents <= 1) {
7503 $formats_nav .= " | " .
7504 $cgi->a({-href => href(action=>"patch", -replay=>1)},
7505 "patch");
7506 }
7507
7508 if (!defined $parent) {
7509 $parent = "--root";
7510 }
7511 my @difftree;
7512 open my $fd, "-|", git_cmd(), "diff-tree", '-r', "--no-commit-id",
7513 @diff_opts,
7514 (@$parents <= 1 ? $parent : '-c'),
7515 $hash, "--"
7516 or die_error(500, "Open git-diff-tree failed");
7517 @difftree = map { chomp; $_ } <$fd>;
7518 close $fd or die_error(404, "Reading git-diff-tree failed");
7519
7520 # non-textual hash id's can be cached
7521 my $expires;
7522 if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
7523 $expires = "+1d";
7524 }
7525 my $refs = git_get_references();
7526 my $ref = format_ref_marker($refs, $co{'id'});
7527
7528 git_header_html(undef, $expires);
7529 git_print_page_nav('commit', '',
7530 $hash, $co{'tree'}, $hash,
7531 $formats_nav);
7532
7533 if (defined $co{'parent'}) {
7534 git_print_header_div('commitdiff', esc_html($co{'title'}) . $ref, $hash);
7535 } else {
7536 git_print_header_div('tree', esc_html($co{'title'}) . $ref, $co{'tree'}, $hash);
7537 }
7538 print "<div class=\"title_text\">\n" .
7539 "<table class=\"object_header\">\n";
7540 git_print_authorship_rows(\%co);
7541 print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
7542 print "<tr>" .
7543 "<td>tree</td>" .
7544 "<td class=\"sha1\">" .
7545 $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
7546 class => "list"}, $co{'tree'}) .
7547 "</td>" .
7548 "<td class=\"link\">" .
7549 $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
7550 "tree");
7551 my $snapshot_links = format_snapshot_links($hash);
7552 if (defined $snapshot_links) {
7553 print " | " . $snapshot_links;
7554 }
7555 print "</td>" .
7556 "</tr>\n";
7557
7558 foreach my $par (@$parents) {
7559 print "<tr>" .
7560 "<td>parent</td>" .
7561 "<td class=\"sha1\">" .
7562 $cgi->a({-href => href(action=>"commit", hash=>$par),
7563 class => "list"}, $par) .
7564 "</td>" .
7565 "<td class=\"link\">" .
7566 $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
7567 " | " .
7568 $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
7569 "</td>" .
7570 "</tr>\n";
7571 }
7572 print "</table>".
7573 "</div>\n";
7574
7575 print "<div class=\"page_body\">\n";
7576 git_print_log($co{'comment'});
7577 print "</div>\n";
7578
7579 git_difftree_body(\@difftree, $hash, @$parents);
7580
7581 git_footer_html();
7582 }
7583
7584 sub git_object {
7585 # object is defined by:
7586 # - hash or hash_base alone
7587 # - hash_base and file_name
7588 my $type;
7589
7590 # - hash or hash_base alone
7591 if ($hash || ($hash_base && !defined $file_name)) {
7592 my $object_id = $hash || $hash_base;
7593
7594 open my $fd, "-|", quote_command(
7595 git_cmd(), 'cat-file', '-t', $object_id) . ' 2> /dev/null'
7596 or die_error(404, "Object does not exist");
7597 $type = <$fd>;
7598 defined $type && chomp $type;
7599 close $fd
7600 or die_error(404, "Object does not exist");
7601
7602 # - hash_base and file_name
7603 } elsif ($hash_base && defined $file_name) {
7604 $file_name =~ s,/+$,,;
7605
7606 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
7607 or die_error(404, "Base object does not exist");
7608
7609 # here errors should not happen
7610 open my $fd, "-|", git_cmd(), "ls-tree", $hash_base, "--", $file_name
7611 or die_error(500, "Open git-ls-tree failed");
7612 my $line = <$fd>;
7613 close $fd;
7614
7615 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c'
7616 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
7617 die_error(404, "File or directory for given base does not exist");
7618 }
7619 $type = $2;
7620 $hash = $3;
7621 } else {
7622 die_error(400, "Not enough information to find object");
7623 }
7624
7625 print $cgi->redirect(-uri => href(action=>$type, -full=>1,
7626 hash=>$hash, hash_base=>$hash_base,
7627 file_name=>$file_name),
7628 -status => '302 Found');
7629 }
7630
7631 sub git_blobdiff {
7632 my $format = shift || 'html';
7633 my $diff_style = $input_params{'diff_style'} || 'inline';
7634
7635 my $fd;
7636 my @difftree;
7637 my %diffinfo;
7638 my $expires;
7639
7640 # preparing $fd and %diffinfo for git_patchset_body
7641 # new style URI
7642 if (defined $hash_base && defined $hash_parent_base) {
7643 if (defined $file_name) {
7644 # read raw output
7645 open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts,
7646 $hash_parent_base, $hash_base,
7647 "--", (defined $file_parent ? $file_parent : ()), $file_name
7648 or die_error(500, "Open git-diff-tree failed");
7649 @difftree = map { chomp; $_ } <$fd>;
7650 close $fd
7651 or die_error(404, "Reading git-diff-tree failed");
7652 @difftree
7653 or die_error(404, "Blob diff not found");
7654
7655 } elsif (defined $hash &&
7656 $hash =~ /[0-9a-fA-F]{40}/) {
7657 # try to find filename from $hash
7658
7659 # read filtered raw output
7660 open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts,
7661 $hash_parent_base, $hash_base, "--"
7662 or die_error(500, "Open git-diff-tree failed");
7663 @difftree =
7664 # ':100644 100644 03b21826... 3b93d5e7... M ls-files.c'
7665 # $hash == to_id
7666 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
7667 map { chomp; $_ } <$fd>;
7668 close $fd
7669 or die_error(404, "Reading git-diff-tree failed");
7670 @difftree
7671 or die_error(404, "Blob diff not found");
7672
7673 } else {
7674 die_error(400, "Missing one of the blob diff parameters");
7675 }
7676
7677 if (@difftree > 1) {
7678 die_error(400, "Ambiguous blob diff specification");
7679 }
7680
7681 %diffinfo = parse_difftree_raw_line($difftree[0]);
7682 $file_parent ||= $diffinfo{'from_file'} || $file_name;
7683 $file_name ||= $diffinfo{'to_file'};
7684
7685 $hash_parent ||= $diffinfo{'from_id'};
7686 $hash ||= $diffinfo{'to_id'};
7687
7688 # non-textual hash id's can be cached
7689 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
7690 $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
7691 $expires = '+1d';
7692 }
7693
7694 # open patch output
7695 open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts,
7696 '-p', ($format eq 'html' ? "--full-index" : ()),
7697 $hash_parent_base, $hash_base,
7698 "--", (defined $file_parent ? $file_parent : ()), $file_name
7699 or die_error(500, "Open git-diff-tree failed");
7700 }
7701
7702 # old/legacy style URI -- not generated anymore since 1.4.3.
7703 if (!%diffinfo) {
7704 die_error('404 Not Found', "Missing one of the blob diff parameters")
7705 }
7706
7707 # header
7708 if ($format eq 'html') {
7709 my $formats_nav =
7710 $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
7711 "raw");
7712 $formats_nav .= diff_style_nav($diff_style);
7713 git_header_html(undef, $expires);
7714 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
7715 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
7716 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
7717 } else {
7718 print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
7719 print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
7720 }
7721 if (defined $file_name) {
7722 git_print_page_path($file_name, "blob", $hash_base);
7723 } else {
7724 print "<div class=\"page_path\"></div>\n";
7725 }
7726
7727 } elsif ($format eq 'plain') {
7728 print $cgi->header(
7729 -type => 'text/plain',
7730 -charset => 'utf-8',
7731 -expires => $expires,
7732 -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
7733
7734 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
7735
7736 } else {
7737 die_error(400, "Unknown blobdiff format");
7738 }
7739
7740 # patch
7741 if ($format eq 'html') {
7742 print "<div class=\"page_body\">\n";
7743
7744 git_patchset_body($fd, $diff_style,
7745 [ \%diffinfo ], $hash_base, $hash_parent_base);
7746 close $fd;
7747
7748 print "</div>\n"; # class="page_body"
7749 git_footer_html();
7750
7751 } else {
7752 while (my $line = <$fd>) {
7753 $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
7754 $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
7755
7756 print $line;
7757
7758 last if $line =~ m!^\+\+\+!;
7759 }
7760 local $/ = undef;
7761 print <$fd>;
7762 close $fd;
7763 }
7764 }
7765
7766 sub git_blobdiff_plain {
7767 git_blobdiff('plain');
7768 }
7769
7770 # assumes that it is added as later part of already existing navigation,
7771 # so it returns "| foo | bar" rather than just "foo | bar"
7772 sub diff_style_nav {
7773 my ($diff_style, $is_combined) = @_;
7774 $diff_style ||= 'inline';
7775
7776 return "" if ($is_combined);
7777
7778 my @styles = (inline => 'inline', 'sidebyside' => 'side by side');
7779 my %styles = @styles;
7780 @styles =
7781 @styles[ map { $_ * 2 } 0..$#styles/2 ];
7782
7783 return join '',
7784 map { " | ".$_ }
7785 map {
7786 $_ eq $diff_style ? $styles{$_} :
7787 $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_})
7788 } @styles;
7789 }
7790
7791 sub git_commitdiff {
7792 my %params = @_;
7793 my $format = $params{-format} || 'html';
7794 my $diff_style = $input_params{'diff_style'} || 'inline';
7795
7796 my ($patch_max) = gitweb_get_feature('patches');
7797 if ($format eq 'patch') {
7798 die_error(403, "Patch view not allowed") unless $patch_max;
7799 }
7800
7801 $hash ||= $hash_base || "HEAD";
7802 my %co = parse_commit($hash)
7803 or die_error(404, "Unknown commit object");
7804
7805 # choose format for commitdiff for merge
7806 if (! defined $hash_parent && @{$co{'parents'}} > 1) {
7807 $hash_parent = '--cc';
7808 }
7809 # we need to prepare $formats_nav before almost any parameter munging
7810 my $formats_nav;
7811 if ($format eq 'html') {
7812 $formats_nav =
7813 $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
7814 "raw");
7815 if ($patch_max && @{$co{'parents'}} <= 1) {
7816 $formats_nav .= " | " .
7817 $cgi->a({-href => href(action=>"patch", -replay=>1)},
7818 "patch");
7819 }
7820 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
7821
7822 if (defined $hash_parent &&
7823 $hash_parent ne '-c' && $hash_parent ne '--cc') {
7824 # commitdiff with two commits given
7825 my $hash_parent_short = $hash_parent;
7826 if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
7827 $hash_parent_short = substr($hash_parent, 0, 7);
7828 }
7829 $formats_nav .=
7830 ' (from';
7831 for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
7832 if ($co{'parents'}[$i] eq $hash_parent) {
7833 $formats_nav .= ' parent ' . ($i+1);
7834 last;
7835 }
7836 }
7837 $formats_nav .= ': ' .
7838 $cgi->a({-href => href(-replay=>1,
7839 hash=>$hash_parent, hash_base=>undef)},
7840 esc_html($hash_parent_short)) .
7841 ')';
7842 } elsif (!$co{'parent'}) {
7843 # --root commitdiff
7844 $formats_nav .= ' (initial)';
7845 } elsif (scalar @{$co{'parents'}} == 1) {
7846 # single parent commit
7847 $formats_nav .=
7848 ' (parent: ' .
7849 $cgi->a({-href => href(-replay=>1,
7850 hash=>$co{'parent'}, hash_base=>undef)},
7851 esc_html(substr($co{'parent'}, 0, 7))) .
7852 ')';
7853 } else {
7854 # merge commit
7855 if ($hash_parent eq '--cc') {
7856 $formats_nav .= ' | ' .
7857 $cgi->a({-href => href(-replay=>1,
7858 hash=>$hash, hash_parent=>'-c')},
7859 'combined');
7860 } else { # $hash_parent eq '-c'
7861 $formats_nav .= ' | ' .
7862 $cgi->a({-href => href(-replay=>1,
7863 hash=>$hash, hash_parent=>'--cc')},
7864 'compact');
7865 }
7866 $formats_nav .=
7867 ' (merge: ' .
7868 join(' ', map {
7869 $cgi->a({-href => href(-replay=>1,
7870 hash=>$_, hash_base=>undef)},
7871 esc_html(substr($_, 0, 7)));
7872 } @{$co{'parents'}} ) .
7873 ')';
7874 }
7875 }
7876
7877 my $hash_parent_param = $hash_parent;
7878 if (!defined $hash_parent_param) {
7879 # --cc for multiple parents, --root for parentless
7880 $hash_parent_param =
7881 @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
7882 }
7883
7884 # read commitdiff
7885 my $fd;
7886 my @difftree;
7887 if ($format eq 'html') {
7888 open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts,
7889 "--no-commit-id", "--patch-with-raw", "--full-index",
7890 $hash_parent_param, $hash, "--"
7891 or die_error(500, "Open git-diff-tree failed");
7892
7893 while (my $line = <$fd>) {
7894 chomp $line;
7895 # empty line ends raw part of diff-tree output
7896 last unless $line;
7897 push @difftree, scalar parse_difftree_raw_line($line);
7898 }
7899
7900 } elsif ($format eq 'plain') {
7901 open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts,
7902 '-p', $hash_parent_param, $hash, "--"
7903 or die_error(500, "Open git-diff-tree failed");
7904 } elsif ($format eq 'patch') {
7905 # For commit ranges, we limit the output to the number of
7906 # patches specified in the 'patches' feature.
7907 # For single commits, we limit the output to a single patch,
7908 # diverging from the git-format-patch default.
7909 my @commit_spec = ();
7910 if ($hash_parent) {
7911 if ($patch_max > 0) {
7912 push @commit_spec, "-$patch_max";
7913 }
7914 push @commit_spec, '-n', "$hash_parent..$hash";
7915 } else {
7916 if ($params{-single}) {
7917 push @commit_spec, '-1';
7918 } else {
7919 if ($patch_max > 0) {
7920 push @commit_spec, "-$patch_max";
7921 }
7922 push @commit_spec, "-n";
7923 }
7924 push @commit_spec, '--root', $hash;
7925 }
7926 open $fd, "-|", git_cmd(), "format-patch", @diff_opts,
7927 '--encoding=utf8', '--stdout', @commit_spec
7928 or die_error(500, "Open git-format-patch failed");
7929 } else {
7930 die_error(400, "Unknown commitdiff format");
7931 }
7932
7933 # non-textual hash id's can be cached
7934 my $expires;
7935 if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
7936 $expires = "+1d";
7937 }
7938
7939 # write commit message
7940 if ($format eq 'html') {
7941 my $refs = git_get_references();
7942 my $ref = format_ref_marker($refs, $co{'id'});
7943
7944 git_header_html(undef, $expires);
7945 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
7946 git_print_header_div('commit', esc_html($co{'title'}) . $ref, $hash);
7947 print "<div class=\"title_text\">\n" .
7948 "<table class=\"object_header\">\n";
7949 git_print_authorship_rows(\%co);
7950 print "</table>".
7951 "</div>\n";
7952 print "<div class=\"page_body\">\n";
7953 if (@{$co{'comment'}} > 1) {
7954 print "<div class=\"log\">\n";
7955 git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
7956 print "</div>\n"; # class="log"
7957 }
7958
7959 } elsif ($format eq 'plain') {
7960 my $refs = git_get_references("tags");
7961 my $tagname = git_get_rev_name_tags($hash);
7962 my $filename = basename($project) . "-$hash.patch";
7963
7964 print $cgi->header(
7965 -type => 'text/plain',
7966 -charset => 'utf-8',
7967 -expires => $expires,
7968 -content_disposition => 'inline; filename="' . "$filename" . '"');
7969 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
7970 print "From: " . to_utf8($co{'author'}) . "\n";
7971 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
7972 print "Subject: " . to_utf8($co{'title'}) . "\n";
7973
7974 print "X-Git-Tag: $tagname\n" if $tagname;
7975 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
7976
7977 foreach my $line (@{$co{'comment'}}) {
7978 print to_utf8($line) . "\n";
7979 }
7980 print "---\n\n";
7981 } elsif ($format eq 'patch') {
7982 my $filename = basename($project) . "-$hash.patch";
7983
7984 print $cgi->header(
7985 -type => 'text/plain',
7986 -charset => 'utf-8',
7987 -expires => $expires,
7988 -content_disposition => 'inline; filename="' . "$filename" . '"');
7989 }
7990
7991 # write patch
7992 if ($format eq 'html') {
7993 my $use_parents = !defined $hash_parent ||
7994 $hash_parent eq '-c' || $hash_parent eq '--cc';
7995 git_difftree_body(\@difftree, $hash,
7996 $use_parents ? @{$co{'parents'}} : $hash_parent);
7997 print "<br/>\n";
7998
7999 git_patchset_body($fd, $diff_style,
8000 \@difftree, $hash,
8001 $use_parents ? @{$co{'parents'}} : $hash_parent);
8002 close $fd;
8003 print "</div>\n"; # class="page_body"
8004 git_footer_html();
8005
8006 } elsif ($format eq 'plain') {
8007 local $/ = undef;
8008 print <$fd>;
8009 close $fd
8010 or print "Reading git-diff-tree failed\n";
8011 } elsif ($format eq 'patch') {
8012 local $/ = undef;
8013 print <$fd>;
8014 close $fd
8015 or print "Reading git-format-patch failed\n";
8016 }
8017 }
8018
8019 sub git_commitdiff_plain {
8020 git_commitdiff(-format => 'plain');
8021 }
8022
8023 # format-patch-style patches
8024 sub git_patch {
8025 git_commitdiff(-format => 'patch', -single => 1);
8026 }
8027
8028 sub git_patches {
8029 git_commitdiff(-format => 'patch');
8030 }
8031
8032 sub git_history {
8033 git_log_generic('history', \&git_history_body,
8034 $hash_base, $hash_parent_base,
8035 $file_name, $hash);
8036 }
8037
8038 sub git_search {
8039 $searchtype ||= 'commit';
8040
8041 # check if appropriate features are enabled
8042 gitweb_check_feature('search')
8043 or die_error(403, "Search is disabled");
8044 if ($searchtype eq 'pickaxe') {
8045 # pickaxe may take all resources of your box and run for several minutes
8046 # with every query - so decide by yourself how public you make this feature
8047 gitweb_check_feature('pickaxe')
8048 or die_error(403, "Pickaxe search is disabled");
8049 }
8050 if ($searchtype eq 'grep') {
8051 # grep search might be potentially CPU-intensive, too
8052 gitweb_check_feature('grep')
8053 or die_error(403, "Grep search is disabled");
8054 }
8055
8056 if (!defined $searchtext) {
8057 die_error(400, "Text field is empty");
8058 }
8059 if (!defined $hash) {
8060 $hash = git_get_head_hash($project);
8061 }
8062 my %co = parse_commit($hash);
8063 if (!%co) {
8064 die_error(404, "Unknown commit object");
8065 }
8066 if (!defined $page) {
8067 $page = 0;
8068 }
8069
8070 if ($searchtype eq 'commit' ||
8071 $searchtype eq 'author' ||
8072 $searchtype eq 'committer') {
8073 git_search_message(%co);
8074 } elsif ($searchtype eq 'pickaxe') {
8075 git_search_changes(%co);
8076 } elsif ($searchtype eq 'grep') {
8077 git_search_files(%co);
8078 } else {
8079 die_error(400, "Unknown search type");
8080 }
8081 }
8082
8083 sub git_search_help {
8084 git_header_html();
8085 git_print_page_nav('','', $hash,$hash,$hash);
8086 print <<EOT;
8087 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
8088 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
8089 the pattern entered is recognized as the POSIX extended
8090 <a href="https://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
8091 insensitive).</p>
8092 <dl>
8093 <dt><b>commit</b></dt>
8094 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
8095 EOT
8096 my $have_grep = gitweb_check_feature('grep');
8097 if ($have_grep) {
8098 print <<EOT;
8099 <dt><b>grep</b></dt>
8100 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
8101 a different one) are searched for the given pattern. On large trees, this search can take
8102 a while and put some strain on the server, so please use it with some consideration. Note that
8103 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
8104 case-sensitive.</dd>
8105 EOT
8106 }
8107 print <<EOT;
8108 <dt><b>author</b></dt>
8109 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
8110 <dt><b>committer</b></dt>
8111 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
8112 EOT
8113 my $have_pickaxe = gitweb_check_feature('pickaxe');
8114 if ($have_pickaxe) {
8115 print <<EOT;
8116 <dt><b>pickaxe</b></dt>
8117 <dd>All commits that caused the string to appear or disappear from any file (changes that
8118 added, removed or "modified" the string) will be listed. This search can take a while and
8119 takes a lot of strain on the server, so please use it wisely. Note that since you may be
8120 interested even in changes just changing the case as well, this search is case sensitive.</dd>
8121 EOT
8122 }
8123 print "</dl>\n";
8124 git_footer_html();
8125 }
8126
8127 sub git_shortlog {
8128 git_log_generic('shortlog', \&git_shortlog_body,
8129 $hash, $hash_parent);
8130 }
8131
8132 ## ......................................................................
8133 ## feeds (RSS, Atom; OPML)
8134
8135 sub git_feed {
8136 my $format = shift || 'atom';
8137 my $have_blame = gitweb_check_feature('blame');
8138
8139 # Atom: http://www.atomenabled.org/developers/syndication/
8140 # RSS: http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
8141 if ($format ne 'rss' && $format ne 'atom') {
8142 die_error(400, "Unknown web feed format");
8143 }
8144
8145 # log/feed of current (HEAD) branch, log of given branch, history of file/directory
8146 my $head = $hash || 'HEAD';
8147 my @commitlist = parse_commits($head, 150, 0, $file_name);
8148
8149 my %latest_commit;
8150 my %latest_date;
8151 my $content_type = "application/$format+xml";
8152 if (defined $cgi->http('HTTP_ACCEPT') &&
8153 $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
8154 # browser (feed reader) prefers text/xml
8155 $content_type = 'text/xml';
8156 }
8157 if (defined($commitlist[0])) {
8158 %latest_commit = %{$commitlist[0]};
8159 my $latest_epoch = $latest_commit{'committer_epoch'};
8160 exit_if_unmodified_since($latest_epoch);
8161 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
8162 }
8163 print $cgi->header(
8164 -type => $content_type,
8165 -charset => 'utf-8',
8166 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
8167 -status => '200 OK');
8168
8169 # Optimization: skip generating the body if client asks only
8170 # for Last-Modified date.
8171 return if ($cgi->request_method() eq 'HEAD');
8172
8173 # header variables
8174 my $title = "$site_name - $project/$action";
8175 my $feed_type = 'log';
8176 if (defined $hash) {
8177 $title .= " - '$hash'";
8178 $feed_type = 'branch log';
8179 if (defined $file_name) {
8180 $title .= " :: $file_name";
8181 $feed_type = 'history';
8182 }
8183 } elsif (defined $file_name) {
8184 $title .= " - $file_name";
8185 $feed_type = 'history';
8186 }
8187 $title .= " $feed_type";
8188 $title = esc_html($title);
8189 my $descr = git_get_project_description($project);
8190 if (defined $descr) {
8191 $descr = esc_html($descr);
8192 } else {
8193 $descr = "$project " .
8194 ($format eq 'rss' ? 'RSS' : 'Atom') .
8195 " feed";
8196 }
8197 my $owner = git_get_project_owner($project);
8198 $owner = esc_html($owner);
8199
8200 #header
8201 my $alt_url;
8202 if (defined $file_name) {
8203 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
8204 } elsif (defined $hash) {
8205 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
8206 } else {
8207 $alt_url = href(-full=>1, action=>"summary");
8208 }
8209 print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
8210 if ($format eq 'rss') {
8211 print <<XML;
8212 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
8213 <channel>
8214 XML
8215 print "<title>$title</title>\n" .
8216 "<link>$alt_url</link>\n" .
8217 "<description>$descr</description>\n" .
8218 "<language>en</language>\n" .
8219 # project owner is responsible for 'editorial' content
8220 "<managingEditor>$owner</managingEditor>\n";
8221 if (defined $logo || defined $favicon) {
8222 # prefer the logo to the favicon, since RSS
8223 # doesn't allow both
8224 my $img = esc_url($logo || $favicon);
8225 print "<image>\n" .
8226 "<url>$img</url>\n" .
8227 "<title>$title</title>\n" .
8228 "<link>$alt_url</link>\n" .
8229 "</image>\n";
8230 }
8231 if (%latest_date) {
8232 print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
8233 print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
8234 }
8235 print "<generator>gitweb v.$version/$git_version</generator>\n";
8236 } elsif ($format eq 'atom') {
8237 print <<XML;
8238 <feed xmlns="http://www.w3.org/2005/Atom">
8239 XML
8240 print "<title>$title</title>\n" .
8241 "<subtitle>$descr</subtitle>\n" .
8242 '<link rel="alternate" type="text/html" href="' .
8243 $alt_url . '" />' . "\n" .
8244 '<link rel="self" type="' . $content_type . '" href="' .
8245 $cgi->self_url() . '" />' . "\n" .
8246 "<id>" . href(-full=>1) . "</id>\n" .
8247 # use project owner for feed author
8248 "<author><name>$owner</name></author>\n";
8249 if (defined $favicon) {
8250 print "<icon>" . esc_url($favicon) . "</icon>\n";
8251 }
8252 if (defined $logo) {
8253 # not twice as wide as tall: 72 x 27 pixels
8254 print "<logo>" . esc_url($logo) . "</logo>\n";
8255 }
8256 if (! %latest_date) {
8257 # dummy date to keep the feed valid until commits trickle in:
8258 print "<updated>1970-01-01T00:00:00Z</updated>\n";
8259 } else {
8260 print "<updated>$latest_date{'iso-8601'}</updated>\n";
8261 }
8262 print "<generator version='$version/$git_version'>gitweb</generator>\n";
8263 }
8264
8265 # contents
8266 for (my $i = 0; $i <= $#commitlist; $i++) {
8267 my %co = %{$commitlist[$i]};
8268 my $commit = $co{'id'};
8269 # we read 150, we always show 30 and the ones more recent than 48 hours
8270 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
8271 last;
8272 }
8273 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
8274
8275 # get list of changed files
8276 open my $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts,
8277 $co{'parent'} || "--root",
8278 $co{'id'}, "--", (defined $file_name ? $file_name : ())
8279 or next;
8280 my @difftree = map { chomp; $_ } <$fd>;
8281 close $fd
8282 or next;
8283
8284 # print element (entry, item)
8285 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
8286 if ($format eq 'rss') {
8287 print "<item>\n" .
8288 "<title>" . esc_html($co{'title'}) . "</title>\n" .
8289 "<author>" . esc_html($co{'author'}) . "</author>\n" .
8290 "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
8291 "<guid isPermaLink=\"true\">$co_url</guid>\n" .
8292 "<link>$co_url</link>\n" .
8293 "<description>" . esc_html($co{'title'}) . "</description>\n" .
8294 "<content:encoded>" .
8295 "<![CDATA[\n";
8296 } elsif ($format eq 'atom') {
8297 print "<entry>\n" .
8298 "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
8299 "<updated>$cd{'iso-8601'}</updated>\n" .
8300 "<author>\n" .
8301 " <name>" . esc_html($co{'author_name'}) . "</name>\n";
8302 if ($co{'author_email'}) {
8303 print " <email>" . esc_html($co{'author_email'}) . "</email>\n";
8304 }
8305 print "</author>\n" .
8306 # use committer for contributor
8307 "<contributor>\n" .
8308 " <name>" . esc_html($co{'committer_name'}) . "</name>\n";
8309 if ($co{'committer_email'}) {
8310 print " <email>" . esc_html($co{'committer_email'}) . "</email>\n";
8311 }
8312 print "</contributor>\n" .
8313 "<published>$cd{'iso-8601'}</published>\n" .
8314 "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
8315 "<id>$co_url</id>\n" .
8316 "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
8317 "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
8318 }
8319 my $comment = $co{'comment'};
8320 print "<pre>\n";
8321 foreach my $line (@$comment) {
8322 $line = esc_html($line);
8323 print "$line\n";
8324 }
8325 print "</pre><ul>\n";
8326 foreach my $difftree_line (@difftree) {
8327 my %difftree = parse_difftree_raw_line($difftree_line);
8328 next if !$difftree{'from_id'};
8329
8330 my $file = $difftree{'file'} || $difftree{'to_file'};
8331
8332 print "<li>" .
8333 "[" .
8334 $cgi->a({-href => href(-full=>1, action=>"blobdiff",
8335 hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
8336 hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
8337 file_name=>$file, file_parent=>$difftree{'from_file'}),
8338 -title => "diff"}, 'D');
8339 if ($have_blame) {
8340 print $cgi->a({-href => href(-full=>1, action=>"blame",
8341 file_name=>$file, hash_base=>$commit),
8342 -title => "blame"}, 'B');
8343 }
8344 # if this is not a feed of a file history
8345 if (!defined $file_name || $file_name ne $file) {
8346 print $cgi->a({-href => href(-full=>1, action=>"history",
8347 file_name=>$file, hash=>$commit),
8348 -title => "history"}, 'H');
8349 }
8350 $file = esc_path($file);
8351 print "] ".
8352 "$file</li>\n";
8353 }
8354 if ($format eq 'rss') {
8355 print "</ul>]]>\n" .
8356 "</content:encoded>\n" .
8357 "</item>\n";
8358 } elsif ($format eq 'atom') {
8359 print "</ul>\n</div>\n" .
8360 "</content>\n" .
8361 "</entry>\n";
8362 }
8363 }
8364
8365 # end of feed
8366 if ($format eq 'rss') {
8367 print "</channel>\n</rss>\n";
8368 } elsif ($format eq 'atom') {
8369 print "</feed>\n";
8370 }
8371 }
8372
8373 sub git_rss {
8374 git_feed('rss');
8375 }
8376
8377 sub git_atom {
8378 git_feed('atom');
8379 }
8380
8381 sub git_opml {
8382 my @list = git_get_projects_list($project_filter, $strict_export);
8383 if (!@list) {
8384 die_error(404, "No projects found");
8385 }
8386
8387 print $cgi->header(
8388 -type => 'text/xml',
8389 -charset => 'utf-8',
8390 -content_disposition => 'inline; filename="opml.xml"');
8391
8392 my $title = esc_html($site_name);
8393 my $filter = " within subdirectory ";
8394 if (defined $project_filter) {
8395 $filter .= esc_html($project_filter);
8396 } else {
8397 $filter = "";
8398 }
8399 print <<XML;
8400 <?xml version="1.0" encoding="utf-8"?>
8401 <opml version="1.0">
8402 <head>
8403 <title>$title OPML Export$filter</title>
8404 </head>
8405 <body>
8406 <outline text="git RSS feeds">
8407 XML
8408
8409 foreach my $pr (@list) {
8410 my %proj = %$pr;
8411 my $head = git_get_head_hash($proj{'path'});
8412 if (!defined $head) {
8413 next;
8414 }
8415 $git_dir = "$projectroot/$proj{'path'}";
8416 my %co = parse_commit($head);
8417 if (!%co) {
8418 next;
8419 }
8420
8421 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
8422 my $rss = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
8423 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
8424 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
8425 }
8426 print <<XML;
8427 </outline>
8428 </body>
8429 </opml>
8430 XML
8431 }