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