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