Remove debugging statement.
[hcoop/zz_old/gitweb.git] / gitweb.cgi
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 strict;
11 use warnings;
12 use CGI qw(:standard :escapeHTML -nosticky);
13 use CGI::Util qw(unescape);
14 use CGI::Carp qw(fatalsToBrowser);
15 use Encode;
16 use Fcntl ':mode';
17 use File::Find qw();
18 use File::Basename qw(basename);
19 binmode STDOUT, ':utf8';
20
21 BEGIN {
22 CGI->compile() if $ENV{'MOD_PERL'};
23 }
24
25 our $cgi = new CGI;
26 our $version = "debian.1.5.6.1.19.ge6b2";
27 our $my_url = $cgi->url();
28 our $my_uri = $cgi->url(-absolute => 1);
29
30 # core git executable to use
31 # this can just be "git" if your webserver has a sensible PATH
32 our $GIT = "/usr/bin/git";
33
34 # absolute fs-path which will be prepended to the project path
35 #our $projectroot = "/pub/scm";
36 our $projectroot = "/pub/git";
37
38 # fs traversing limit for getting project list
39 # the number is relative to the projectroot
40 our $project_maxdepth = 2007;
41
42 # target of the home link on top of all pages
43 our $home_link = $my_uri || "/";
44
45 # string of the home link on top of all pages
46 # hcoop-change: Customize.
47 our $home_link_str = "HCoop";
48
49 # name of your site or organization to appear in page titles
50 # replace this with something more descriptive for clearer bookmarks
51 # hcoop-change: Customize.
52 our $site_name = "HCoop Git"
53 || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
54
55 # filename of html text to include at top of each page
56 our $site_header = "";
57 # html text to include at home page
58 our $home_text = "indextext.html";
59 # filename of html text to include at bottom of each page
60 our $site_footer = "";
61 # filename of cached version of front page
62 our $cached_front_page = "/var/local/lib/gitweb/indexcache.html";
63
64 # URI of stylesheets
65 our @stylesheets = ("gitweb.css");
66 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
67 our $stylesheet = undef;
68 # URI of GIT logo (72x27 size)
69 our $logo = "git-logo.png";
70 # URI of GIT favicon, assumed to be image/png type
71 our $favicon = "git-favicon.png";
72
73 # URI and label (title) of GIT logo link
74 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
75 #our $logo_label = "git documentation";
76 our $logo_url = "http://git.or.cz/";
77 our $logo_label = "git homepage";
78
79 # source of projects list
80 our $projects_list = "";
81
82 # the width (in characters) of the projects list "Description" column
83 our $projects_list_description_width = 25;
84
85 # default order of projects list
86 # valid values are none, project, descr, owner, and age
87 our $default_projects_order = "project";
88
89 # show repository only if this file exists
90 # (only effective if this variable evaluates to true)
91 our $export_ok = "";
92
93 # only allow viewing of repositories also shown on the overview page
94 our $strict_export = "";
95
96 # list of git base URLs used for URL to where fetch project from,
97 # i.e. full URL is "$git_base_url/$project"
98 # hcoop-change: We like several URLs.
99 #our @git_base_url_list = grep { $_ ne '' } ("");
100 our @git_base_url_list = ('git://git.hcoop.net/git',
101 'http://git.hcoop.net/git');
102
103 # default blob_plain mimetype and default charset for text/plain blob
104 our $default_blob_plain_mimetype = 'text/plain';
105 our $default_text_plain_charset = undef;
106
107 # file to use for guessing MIME types before trying /etc/mime.types
108 # (relative to the current git repository)
109 our $mimetypes_file = undef;
110
111 # assume this charset if line contains non-UTF-8 characters;
112 # it should be valid encoding (see Encoding::Supported(3pm) for list),
113 # for which encoding all byte sequences are valid, for example
114 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
115 # could be even 'utf-8' for the old behavior)
116 our $fallback_encoding = 'latin1';
117
118 # rename detection options for git-diff and git-diff-tree
119 # - default is '-M', with the cost proportional to
120 # (number of removed files) * (number of new files).
121 # - more costly is '-C' (which implies '-M'), with the cost proportional to
122 # (number of changed files + number of removed files) * (number of new files)
123 # - even more costly is '-C', '--find-copies-harder' with cost
124 # (number of files in the original tree) * (number of new files)
125 # - one might want to include '-B' option, e.g. '-B', '-M'
126 our @diff_opts = ('-M'); # taken from git_commit
127
128 # information about snapshot formats that gitweb is capable of serving
129 our %known_snapshot_formats = (
130 # name => {
131 # 'display' => display name,
132 # 'type' => mime type,
133 # 'suffix' => filename suffix,
134 # 'format' => --format for git-archive,
135 # 'compressor' => [compressor command and arguments]
136 # (array reference, optional)}
137 #
138 'tgz' => {
139 'display' => 'tar.gz',
140 'type' => 'application/x-gzip',
141 'suffix' => '.tar.gz',
142 'format' => 'tar',
143 'compressor' => ['gzip']},
144
145 'tbz2' => {
146 'display' => 'tar.bz2',
147 'type' => 'application/x-bzip2',
148 'suffix' => '.tar.bz2',
149 'format' => 'tar',
150 'compressor' => ['bzip2']},
151
152 'zip' => {
153 'display' => 'zip',
154 'type' => 'application/x-zip',
155 'suffix' => '.zip',
156 'format' => 'zip'},
157 );
158
159 # Aliases so we understand old gitweb.snapshot values in repository
160 # configuration.
161 our %known_snapshot_format_aliases = (
162 'gzip' => 'tgz',
163 'bzip2' => 'tbz2',
164
165 # backward compatibility: legacy gitweb config support
166 'x-gzip' => undef, 'gz' => undef,
167 'x-bzip2' => undef, 'bz2' => undef,
168 'x-zip' => undef, '' => undef,
169 );
170
171 # You define site-wide feature defaults here; override them with
172 # $GITWEB_CONFIG as necessary.
173 our %feature = (
174 # feature => {
175 # 'sub' => feature-sub (subroutine),
176 # 'override' => allow-override (boolean),
177 # 'default' => [ default options...] (array reference)}
178 #
179 # if feature is overridable (it means that allow-override has true value),
180 # then feature-sub will be called with default options as parameters;
181 # return value of feature-sub indicates if to enable specified feature
182 #
183 # if there is no 'sub' key (no feature-sub), then feature cannot be
184 # overriden
185 #
186 # use gitweb_check_feature(<feature>) to check if <feature> is enabled
187
188 # Enable the 'blame' blob view, showing the last commit that modified
189 # each line in the file. This can be very CPU-intensive.
190
191 # To enable system wide have in $GITWEB_CONFIG
192 # $feature{'blame'}{'default'} = [1];
193 # To have project specific config enable override in $GITWEB_CONFIG
194 # $feature{'blame'}{'override'} = 1;
195 # and in project config gitweb.blame = 0|1;
196 'blame' => {
197 'sub' => \&feature_blame,
198 'override' => 0,
199 'default' => [0]},
200
201 # Enable the 'snapshot' link, providing a compressed archive of any
202 # tree. This can potentially generate high traffic if you have large
203 # project.
204
205 # Value is a list of formats defined in %known_snapshot_formats that
206 # you wish to offer.
207 # To disable system wide have in $GITWEB_CONFIG
208 # $feature{'snapshot'}{'default'} = [];
209 # To have project specific config enable override in $GITWEB_CONFIG
210 # $feature{'snapshot'}{'override'} = 1;
211 # and in project config, a comma-separated list of formats or "none"
212 # to disable. Example: gitweb.snapshot = tbz2,zip;
213 'snapshot' => {
214 'sub' => \&feature_snapshot,
215 'override' => 0,
216 'default' => ['tgz']},
217
218 # Enable text search, which will list the commits which match author,
219 # committer or commit text to a given string. Enabled by default.
220 # Project specific override is not supported.
221 'search' => {
222 'override' => 0,
223 'default' => [1]},
224
225 # Enable grep search, which will list the files in currently selected
226 # tree containing the given string. Enabled by default. This can be
227 # potentially CPU-intensive, of course.
228
229 # To enable system wide have in $GITWEB_CONFIG
230 # $feature{'grep'}{'default'} = [1];
231 # To have project specific config enable override in $GITWEB_CONFIG
232 # $feature{'grep'}{'override'} = 1;
233 # and in project config gitweb.grep = 0|1;
234 'grep' => {
235 'override' => 0,
236 'default' => [1]},
237
238 # Enable the pickaxe search, which will list the commits that modified
239 # a given string in a file. This can be practical and quite faster
240 # alternative to 'blame', but still potentially CPU-intensive.
241
242 # To enable system wide have in $GITWEB_CONFIG
243 # $feature{'pickaxe'}{'default'} = [1];
244 # To have project specific config enable override in $GITWEB_CONFIG
245 # $feature{'pickaxe'}{'override'} = 1;
246 # and in project config gitweb.pickaxe = 0|1;
247 'pickaxe' => {
248 'sub' => \&feature_pickaxe,
249 'override' => 0,
250 'default' => [1]},
251
252 # Make gitweb use an alternative format of the URLs which can be
253 # more readable and natural-looking: project name is embedded
254 # directly in the path and the query string contains other
255 # auxiliary information. All gitweb installations recognize
256 # URL in either format; this configures in which formats gitweb
257 # generates links.
258
259 # To enable system wide have in $GITWEB_CONFIG
260 # $feature{'pathinfo'}{'default'} = [1];
261 # Project specific override is not supported.
262
263 # Note that you will need to change the default location of CSS,
264 # favicon, logo and possibly other files to an absolute URL. Also,
265 # if gitweb.cgi serves as your indexfile, you will need to force
266 # $my_uri to contain the script name in your $GITWEB_CONFIG.
267 'pathinfo' => {
268 'override' => 0,
269 'default' => [0]},
270
271 # Make gitweb consider projects in project root subdirectories
272 # to be forks of existing projects. Given project $projname.git,
273 # projects matching $projname/*.git will not be shown in the main
274 # projects list, instead a '+' mark will be added to $projname
275 # there and a 'forks' view will be enabled for the project, listing
276 # all the forks. If project list is taken from a file, forks have
277 # to be listed after the main project.
278
279 # To enable system wide have in $GITWEB_CONFIG
280 # $feature{'forks'}{'default'} = [1];
281 # Project specific override is not supported.
282 'forks' => {
283 'override' => 0,
284 'default' => [0]},
285 );
286
287 sub gitweb_check_feature {
288 my ($name) = @_;
289 return unless exists $feature{$name};
290 my ($sub, $override, @defaults) = (
291 $feature{$name}{'sub'},
292 $feature{$name}{'override'},
293 @{$feature{$name}{'default'}});
294 if (!$override) { return @defaults; }
295 if (!defined $sub) {
296 warn "feature $name is not overrideable";
297 return @defaults;
298 }
299 return $sub->(@defaults);
300 }
301
302 sub feature_blame {
303 my ($val) = git_get_project_config('blame', '--bool');
304
305 if ($val eq 'true') {
306 return 1;
307 } elsif ($val eq 'false') {
308 return 0;
309 }
310
311 return $_[0];
312 }
313
314 sub feature_snapshot {
315 my (@fmts) = @_;
316
317 my ($val) = git_get_project_config('snapshot');
318
319 if ($val) {
320 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
321 }
322
323 return @fmts;
324 }
325
326 sub feature_grep {
327 my ($val) = git_get_project_config('grep', '--bool');
328
329 if ($val eq 'true') {
330 return (1);
331 } elsif ($val eq 'false') {
332 return (0);
333 }
334
335 return ($_[0]);
336 }
337
338 sub feature_pickaxe {
339 my ($val) = git_get_project_config('pickaxe', '--bool');
340
341 if ($val eq 'true') {
342 return (1);
343 } elsif ($val eq 'false') {
344 return (0);
345 }
346
347 return ($_[0]);
348 }
349
350 # checking HEAD file with -e is fragile if the repository was
351 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
352 # and then pruned.
353 sub check_head_link {
354 my ($dir) = @_;
355 my $headfile = "$dir/HEAD";
356 return ((-e $headfile) ||
357 (-l $headfile && readlink($headfile) =~ /^refs\/heads\//));
358 }
359
360 sub check_export_ok {
361 my ($dir) = @_;
362 return (check_head_link($dir) &&
363 (!$export_ok || -e "$dir/$export_ok"));
364 }
365
366 # process alternate names for backward compatibility
367 # filter out unsupported (unknown) snapshot formats
368 sub filter_snapshot_fmts {
369 my @fmts = @_;
370
371 @fmts = map {
372 exists $known_snapshot_format_aliases{$_} ?
373 $known_snapshot_format_aliases{$_} : $_} @fmts;
374 @fmts = grep(exists $known_snapshot_formats{$_}, @fmts);
375
376 }
377
378 our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "gitweb_config.perl";
379 if (-e $GITWEB_CONFIG) {
380 do $GITWEB_CONFIG;
381 } else {
382 our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "/etc/gitweb.conf";
383 do $GITWEB_CONFIG_SYSTEM if -e $GITWEB_CONFIG_SYSTEM;
384 }
385
386 # version of the core git binary
387 our $git_version = qx("$GIT" --version) =~ m/git version (.*)$/ ? $1 : "unknown";
388
389 $projects_list ||= $projectroot;
390
391 # ======================================================================
392 # input validation and dispatch
393 our $action = $cgi->param('a');
394 if (defined $action) {
395 if ($action =~ m/[^0-9a-zA-Z\.\-_]/) {
396 die_error(undef, "Invalid action parameter");
397 }
398 }
399
400 # parameters which are pathnames
401 our $project = $cgi->param('p');
402 if (defined $project) {
403 if (!validate_pathname($project) ||
404 !(-d "$projectroot/$project") ||
405 !check_head_link("$projectroot/$project") ||
406 ($export_ok && !(-e "$projectroot/$project/$export_ok")) ||
407 ($strict_export && !project_in_list($project))) {
408 undef $project;
409 die_error(undef, "No such project");
410 }
411 }
412
413 our $file_name = $cgi->param('f');
414 if (defined $file_name) {
415 if (!validate_pathname($file_name)) {
416 die_error(undef, "Invalid file parameter");
417 }
418 }
419
420 our $file_parent = $cgi->param('fp');
421 if (defined $file_parent) {
422 if (!validate_pathname($file_parent)) {
423 die_error(undef, "Invalid file parent parameter");
424 }
425 }
426
427 sub git_send_cached_front_page {
428 my $status = shift || "200 OK";
429 my $expires = shift;
430 my $content_type;
431 # require explicit support from the UA if we are to send the page as
432 # 'application/xhtml+xml', otherwise send it as plain old 'text/html'.
433 # we have to do this because MSIE sometimes globs '*/*', pretending to
434 # support xhtml+xml but choking when it gets what it asked for.
435 if (defined $cgi->http('HTTP_ACCEPT') &&
436 $cgi->http('HTTP_ACCEPT') =~ m/(,|;|\s|^)application\/xhtml\+xml(,|;|\s|$)/ &&
437 $cgi->Accept('application/xhtml+xml') != 0) {
438 $content_type = 'application/xhtml+xml';
439 } else {
440 $content_type = 'text/html';
441 }
442 print $cgi->header(-type=>$content_type, -charset => 'utf-8',
443 -status=> $status, -expires => $expires);
444 open (my $fd, $cached_front_page);
445 print <$fd>;
446 close $fd;
447 exit;
448 }
449
450 # Display a cached page if no parameters were provided and the
451 # "nocache" parameter was not passed.
452 our $nocache = $cgi->param('nocache');
453 our @params = $cgi->Vars;
454 if ($cached_front_page && ! defined $nocache && scalar @params == 0
455 && -f $cached_front_page && -r $cached_front_page) {
456 git_send_cached_front_page();
457 }
458
459 # parameters which are refnames
460 our $hash = $cgi->param('h');
461 if (defined $hash) {
462 if (!validate_refname($hash)) {
463 die_error(undef, "Invalid hash parameter");
464 }
465 }
466
467 our $hash_parent = $cgi->param('hp');
468 if (defined $hash_parent) {
469 if (!validate_refname($hash_parent)) {
470 die_error(undef, "Invalid hash parent parameter");
471 }
472 }
473
474 our $hash_base = $cgi->param('hb');
475 if (defined $hash_base) {
476 if (!validate_refname($hash_base)) {
477 die_error(undef, "Invalid hash base parameter");
478 }
479 }
480
481 my %allowed_options = (
482 "--no-merges" => [ qw(rss atom log shortlog history) ],
483 );
484
485 our @extra_options = $cgi->param('opt');
486 if (defined @extra_options) {
487 foreach my $opt (@extra_options) {
488 if (not exists $allowed_options{$opt}) {
489 die_error(undef, "Invalid option parameter");
490 }
491 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
492 die_error(undef, "Invalid option parameter for this action");
493 }
494 }
495 }
496
497 our $hash_parent_base = $cgi->param('hpb');
498 if (defined $hash_parent_base) {
499 if (!validate_refname($hash_parent_base)) {
500 die_error(undef, "Invalid hash parent base parameter");
501 }
502 }
503
504 # other parameters
505 our $page = $cgi->param('pg');
506 if (defined $page) {
507 if ($page =~ m/[^0-9]/) {
508 die_error(undef, "Invalid page parameter");
509 }
510 }
511
512 our $searchtype = $cgi->param('st');
513 if (defined $searchtype) {
514 if ($searchtype =~ m/[^a-z]/) {
515 die_error(undef, "Invalid searchtype parameter");
516 }
517 }
518
519 our $search_use_regexp = $cgi->param('sr');
520
521 our $searchtext = $cgi->param('s');
522 our $search_regexp;
523 if (defined $searchtext) {
524 if (length($searchtext) < 2) {
525 die_error(undef, "At least two characters are required for search parameter");
526 }
527 $search_regexp = $search_use_regexp ? $searchtext : quotemeta $searchtext;
528 }
529
530 # now read PATH_INFO and use it as alternative to parameters
531 sub evaluate_path_info {
532 return if defined $project;
533 my $path_info = $ENV{"PATH_INFO"};
534 return if !$path_info;
535 $path_info =~ s,^/+,,;
536 return if !$path_info;
537 # find which part of PATH_INFO is project
538 $project = $path_info;
539 $project =~ s,/+$,,;
540 while ($project && !check_head_link("$projectroot/$project")) {
541 $project =~ s,/*[^/]*$,,;
542 }
543 # validate project
544 $project = validate_pathname($project);
545 if (!$project ||
546 ($export_ok && !-e "$projectroot/$project/$export_ok") ||
547 ($strict_export && !project_in_list($project))) {
548 undef $project;
549 return;
550 }
551 # do not change any parameters if an action is given using the query string
552 return if $action;
553 $path_info =~ s,^\Q$project\E/*,,;
554 my ($refname, $pathname) = split(/:/, $path_info, 2);
555 if (defined $pathname) {
556 # we got "project.git/branch:filename" or "project.git/branch:dir/"
557 # we could use git_get_type(branch:pathname), but it needs $git_dir
558 $pathname =~ s,^/+,,;
559 if (!$pathname || substr($pathname, -1) eq "/") {
560 $action ||= "tree";
561 $pathname =~ s,/$,,;
562 } else {
563 $action ||= "blob_plain";
564 }
565 $hash_base ||= validate_refname($refname);
566 $file_name ||= validate_pathname($pathname);
567 } elsif (defined $refname) {
568 # we got "project.git/branch"
569 $action ||= "shortlog";
570 $hash ||= validate_refname($refname);
571 }
572 }
573 evaluate_path_info();
574
575 # path to the current git repository
576 our $git_dir;
577 $git_dir = "$projectroot/$project" if $project;
578
579 # dispatch
580 my %actions = (
581 "blame" => \&git_blame2,
582 "blobdiff" => \&git_blobdiff,
583 "blobdiff_plain" => \&git_blobdiff_plain,
584 "blob" => \&git_blob,
585 "blob_plain" => \&git_blob_plain,
586 "commitdiff" => \&git_commitdiff,
587 "commitdiff_plain" => \&git_commitdiff_plain,
588 "commit" => \&git_commit,
589 "forks" => \&git_forks,
590 "heads" => \&git_heads,
591 "history" => \&git_history,
592 "log" => \&git_log,
593 "rss" => \&git_rss,
594 "atom" => \&git_atom,
595 "search" => \&git_search,
596 "search_help" => \&git_search_help,
597 "shortlog" => \&git_shortlog,
598 "summary" => \&git_summary,
599 "tag" => \&git_tag,
600 "tags" => \&git_tags,
601 "tree" => \&git_tree,
602 "snapshot" => \&git_snapshot,
603 "object" => \&git_object,
604 # those below don't need $project
605 "opml" => \&git_opml,
606 "project_list" => \&git_project_list,
607 "project_index" => \&git_project_index,
608 );
609
610 if (!defined $action) {
611 if (defined $hash) {
612 $action = git_get_type($hash);
613 } elsif (defined $hash_base && defined $file_name) {
614 $action = git_get_type("$hash_base:$file_name");
615 } elsif (defined $project) {
616 $action = 'summary';
617 } else {
618 $action = 'project_list';
619 }
620 }
621 if (!defined($actions{$action})) {
622 die_error(undef, "Unknown action");
623 }
624 if ($action !~ m/^(opml|project_list|project_index)$/ &&
625 !$project) {
626 die_error(undef, "Project needed");
627 }
628 $actions{$action}->();
629 exit;
630
631 ## ======================================================================
632 ## action links
633
634 sub href (%) {
635 my %params = @_;
636 # default is to use -absolute url() i.e. $my_uri
637 my $href = $params{-full} ? $my_url : $my_uri;
638
639 # XXX: Warning: If you touch this, check the search form for updating,
640 # too.
641
642 my @mapping = (
643 project => "p",
644 action => "a",
645 file_name => "f",
646 file_parent => "fp",
647 hash => "h",
648 hash_parent => "hp",
649 hash_base => "hb",
650 hash_parent_base => "hpb",
651 page => "pg",
652 order => "o",
653 searchtext => "s",
654 searchtype => "st",
655 snapshot_format => "sf",
656 extra_options => "opt",
657 search_use_regexp => "sr",
658 );
659 my %mapping = @mapping;
660
661 $params{'project'} = $project unless exists $params{'project'};
662
663 if ($params{-replay}) {
664 while (my ($name, $symbol) = each %mapping) {
665 if (!exists $params{$name}) {
666 # to allow for multivalued params we use arrayref form
667 $params{$name} = [ $cgi->param($symbol) ];
668 }
669 }
670 }
671
672 my ($use_pathinfo) = gitweb_check_feature('pathinfo');
673 if ($use_pathinfo) {
674 # use PATH_INFO for project name
675 $href .= "/".esc_url($params{'project'}) if defined $params{'project'};
676 delete $params{'project'};
677
678 # Summary just uses the project path URL
679 if (defined $params{'action'} && $params{'action'} eq 'summary') {
680 delete $params{'action'};
681 }
682 }
683
684 # now encode the parameters explicitly
685 my @result = ();
686 for (my $i = 0; $i < @mapping; $i += 2) {
687 my ($name, $symbol) = ($mapping[$i], $mapping[$i+1]);
688 if (defined $params{$name}) {
689 if (ref($params{$name}) eq "ARRAY") {
690 foreach my $par (@{$params{$name}}) {
691 push @result, $symbol . "=" . esc_param($par);
692 }
693 } else {
694 push @result, $symbol . "=" . esc_param($params{$name});
695 }
696 }
697 }
698 $href .= "?" . join(';', @result) if scalar @result;
699
700 return $href;
701 }
702
703
704 ## ======================================================================
705 ## validation, quoting/unquoting and escaping
706
707 sub validate_pathname {
708 my $input = shift || return undef;
709
710 # no '.' or '..' as elements of path, i.e. no '.' nor '..'
711 # at the beginning, at the end, and between slashes.
712 # also this catches doubled slashes
713 if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
714 return undef;
715 }
716 # no null characters
717 if ($input =~ m!\0!) {
718 return undef;
719 }
720 return $input;
721 }
722
723 sub validate_refname {
724 my $input = shift || return undef;
725
726 # textual hashes are O.K.
727 if ($input =~ m/^[0-9a-fA-F]{40}$/) {
728 return $input;
729 }
730 # it must be correct pathname
731 $input = validate_pathname($input)
732 or return undef;
733 # restrictions on ref name according to git-check-ref-format
734 if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
735 return undef;
736 }
737 return $input;
738 }
739
740 # decode sequences of octets in utf8 into Perl's internal form,
741 # which is utf-8 with utf8 flag set if needed. gitweb writes out
742 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
743 sub to_utf8 {
744 my $str = shift;
745 if (utf8::valid($str)) {
746 utf8::decode($str);
747 return $str;
748 } else {
749 return decode($fallback_encoding, $str, Encode::FB_DEFAULT);
750 }
751 }
752
753 # quote unsafe chars, but keep the slash, even when it's not
754 # correct, but quoted slashes look too horrible in bookmarks
755 sub esc_param {
756 my $str = shift;
757 $str =~ s/([^A-Za-z0-9\-_.~()\/:@])/sprintf("%%%02X", ord($1))/eg;
758 $str =~ s/\+/%2B/g;
759 $str =~ s/ /\+/g;
760 return $str;
761 }
762
763 # quote unsafe chars in whole URL, so some charactrs cannot be quoted
764 sub esc_url {
765 my $str = shift;
766 $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&=])/sprintf("%%%02X", ord($1))/eg;
767 $str =~ s/\+/%2B/g;
768 $str =~ s/ /\+/g;
769 return $str;
770 }
771
772 # replace invalid utf8 character with SUBSTITUTION sequence
773 sub esc_html ($;%) {
774 my $str = shift;
775 my %opts = @_;
776
777 $str = to_utf8($str);
778 $str = $cgi->escapeHTML($str);
779 if ($opts{'-nbsp'}) {
780 $str =~ s/ /&nbsp;/g;
781 }
782 $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
783 return $str;
784 }
785
786 # quote control characters and escape filename to HTML
787 sub esc_path {
788 my $str = shift;
789 my %opts = @_;
790
791 $str = to_utf8($str);
792 $str = $cgi->escapeHTML($str);
793 if ($opts{'-nbsp'}) {
794 $str =~ s/ /&nbsp;/g;
795 }
796 $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
797 return $str;
798 }
799
800 # Make control characters "printable", using character escape codes (CEC)
801 sub quot_cec {
802 my $cntrl = shift;
803 my %opts = @_;
804 my %es = ( # character escape codes, aka escape sequences
805 "\t" => '\t', # tab (HT)
806 "\n" => '\n', # line feed (LF)
807 "\r" => '\r', # carrige return (CR)
808 "\f" => '\f', # form feed (FF)
809 "\b" => '\b', # backspace (BS)
810 "\a" => '\a', # alarm (bell) (BEL)
811 "\e" => '\e', # escape (ESC)
812 "\013" => '\v', # vertical tab (VT)
813 "\000" => '\0', # nul character (NUL)
814 );
815 my $chr = ( (exists $es{$cntrl})
816 ? $es{$cntrl}
817 : sprintf('\%03o', ord($cntrl)) );
818 if ($opts{-nohtml}) {
819 return $chr;
820 } else {
821 return "<span class=\"cntrl\">$chr</span>";
822 }
823 }
824
825 # Alternatively use unicode control pictures codepoints,
826 # Unicode "printable representation" (PR)
827 sub quot_upr {
828 my $cntrl = shift;
829 my %opts = @_;
830
831 my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
832 if ($opts{-nohtml}) {
833 return $chr;
834 } else {
835 return "<span class=\"cntrl\">$chr</span>";
836 }
837 }
838
839 # git may return quoted and escaped filenames
840 sub unquote {
841 my $str = shift;
842
843 sub unq {
844 my $seq = shift;
845 my %es = ( # character escape codes, aka escape sequences
846 't' => "\t", # tab (HT, TAB)
847 'n' => "\n", # newline (NL)
848 'r' => "\r", # return (CR)
849 'f' => "\f", # form feed (FF)
850 'b' => "\b", # backspace (BS)
851 'a' => "\a", # alarm (bell) (BEL)
852 'e' => "\e", # escape (ESC)
853 'v' => "\013", # vertical tab (VT)
854 );
855
856 if ($seq =~ m/^[0-7]{1,3}$/) {
857 # octal char sequence
858 return chr(oct($seq));
859 } elsif (exists $es{$seq}) {
860 # C escape sequence, aka character escape code
861 return $es{$seq};
862 }
863 # quoted ordinary character
864 return $seq;
865 }
866
867 if ($str =~ m/^"(.*)"$/) {
868 # needs unquoting
869 $str = $1;
870 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
871 }
872 return $str;
873 }
874
875 # escape tabs (convert tabs to spaces)
876 sub untabify {
877 my $line = shift;
878
879 while ((my $pos = index($line, "\t")) != -1) {
880 if (my $count = (8 - ($pos % 8))) {
881 my $spaces = ' ' x $count;
882 $line =~ s/\t/$spaces/;
883 }
884 }
885
886 return $line;
887 }
888
889 sub project_in_list {
890 my $project = shift;
891 my @list = git_get_projects_list();
892 return @list && scalar(grep { $_->{'path'} eq $project } @list);
893 }
894
895 ## ----------------------------------------------------------------------
896 ## HTML aware string manipulation
897
898 # Try to chop given string on a word boundary between position
899 # $len and $len+$add_len. If there is no word boundary there,
900 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
901 # (marking chopped part) would be longer than given string.
902 sub chop_str {
903 my $str = shift;
904 my $len = shift;
905 my $add_len = shift || 10;
906 my $where = shift || 'right'; # 'left' | 'center' | 'right'
907
908 # Make sure perl knows it is utf8 encoded so we don't
909 # cut in the middle of a utf8 multibyte char.
910 $str = to_utf8($str);
911
912 # allow only $len chars, but don't cut a word if it would fit in $add_len
913 # if it doesn't fit, cut it if it's still longer than the dots we would add
914 # remove chopped character entities entirely
915
916 # when chopping in the middle, distribute $len into left and right part
917 # return early if chopping wouldn't make string shorter
918 if ($where eq 'center') {
919 return $str if ($len + 5 >= length($str)); # filler is length 5
920 $len = int($len/2);
921 } else {
922 return $str if ($len + 4 >= length($str)); # filler is length 4
923 }
924
925 # regexps: ending and beginning with word part up to $add_len
926 my $endre = qr/.{$len}\w{0,$add_len}/;
927 my $begre = qr/\w{0,$add_len}.{$len}/;
928
929 if ($where eq 'left') {
930 $str =~ m/^(.*?)($begre)$/;
931 my ($lead, $body) = ($1, $2);
932 if (length($lead) > 4) {
933 $body =~ s/^[^;]*;// if ($lead =~ m/&[^;]*$/);
934 $lead = " ...";
935 }
936 return "$lead$body";
937
938 } elsif ($where eq 'center') {
939 $str =~ m/^($endre)(.*)$/;
940 my ($left, $str) = ($1, $2);
941 $str =~ m/^(.*?)($begre)$/;
942 my ($mid, $right) = ($1, $2);
943 if (length($mid) > 5) {
944 $left =~ s/&[^;]*$//;
945 $right =~ s/^[^;]*;// if ($mid =~ m/&[^;]*$/);
946 $mid = " ... ";
947 }
948 return "$left$mid$right";
949
950 } else {
951 $str =~ m/^($endre)(.*)$/;
952 my $body = $1;
953 my $tail = $2;
954 if (length($tail) > 4) {
955 $body =~ s/&[^;]*$//;
956 $tail = "... ";
957 }
958 return "$body$tail";
959 }
960 }
961
962 # takes the same arguments as chop_str, but also wraps a <span> around the
963 # result with a title attribute if it does get chopped. Additionally, the
964 # string is HTML-escaped.
965 sub chop_and_escape_str {
966 my ($str) = @_;
967
968 my $chopped = chop_str(@_);
969 if ($chopped eq $str) {
970 return esc_html($chopped);
971 } else {
972 $str =~ s/([[:cntrl:]])/?/g;
973 return $cgi->span({-title=>$str}, esc_html($chopped));
974 }
975 }
976
977 ## ----------------------------------------------------------------------
978 ## functions returning short strings
979
980 # CSS class for given age value (in seconds)
981 sub age_class {
982 my $age = shift;
983
984 if (!defined $age) {
985 return "noage";
986 } elsif ($age < 60*60*2) {
987 return "age0";
988 } elsif ($age < 60*60*24*2) {
989 return "age1";
990 } else {
991 return "age2";
992 }
993 }
994
995 # convert age in seconds to "nn units ago" string
996 sub age_string {
997 my $age = shift;
998 my $age_str;
999
1000 if ($age > 60*60*24*365*2) {
1001 $age_str = (int $age/60/60/24/365);
1002 $age_str .= " years ago";
1003 } elsif ($age > 60*60*24*(365/12)*2) {
1004 $age_str = int $age/60/60/24/(365/12);
1005 $age_str .= " months ago";
1006 } elsif ($age > 60*60*24*7*2) {
1007 $age_str = int $age/60/60/24/7;
1008 $age_str .= " weeks ago";
1009 } elsif ($age > 60*60*24*2) {
1010 $age_str = int $age/60/60/24;
1011 $age_str .= " days ago";
1012 } elsif ($age > 60*60*2) {
1013 $age_str = int $age/60/60;
1014 $age_str .= " hours ago";
1015 } elsif ($age > 60*2) {
1016 $age_str = int $age/60;
1017 $age_str .= " min ago";
1018 } elsif ($age > 2) {
1019 $age_str = int $age;
1020 $age_str .= " sec ago";
1021 } else {
1022 $age_str .= " right now";
1023 }
1024 return $age_str;
1025 }
1026
1027 use constant {
1028 S_IFINVALID => 0030000,
1029 S_IFGITLINK => 0160000,
1030 };
1031
1032 # submodule/subproject, a commit object reference
1033 sub S_ISGITLINK($) {
1034 my $mode = shift;
1035
1036 return (($mode & S_IFMT) == S_IFGITLINK)
1037 }
1038
1039 # convert file mode in octal to symbolic file mode string
1040 sub mode_str {
1041 my $mode = oct shift;
1042
1043 if (S_ISGITLINK($mode)) {
1044 return 'm---------';
1045 } elsif (S_ISDIR($mode & S_IFMT)) {
1046 return 'drwxr-xr-x';
1047 } elsif (S_ISLNK($mode)) {
1048 return 'lrwxrwxrwx';
1049 } elsif (S_ISREG($mode)) {
1050 # git cares only about the executable bit
1051 if ($mode & S_IXUSR) {
1052 return '-rwxr-xr-x';
1053 } else {
1054 return '-rw-r--r--';
1055 };
1056 } else {
1057 return '----------';
1058 }
1059 }
1060
1061 # convert file mode in octal to file type string
1062 sub file_type {
1063 my $mode = shift;
1064
1065 if ($mode !~ m/^[0-7]+$/) {
1066 return $mode;
1067 } else {
1068 $mode = oct $mode;
1069 }
1070
1071 if (S_ISGITLINK($mode)) {
1072 return "submodule";
1073 } elsif (S_ISDIR($mode & S_IFMT)) {
1074 return "directory";
1075 } elsif (S_ISLNK($mode)) {
1076 return "symlink";
1077 } elsif (S_ISREG($mode)) {
1078 return "file";
1079 } else {
1080 return "unknown";
1081 }
1082 }
1083
1084 # convert file mode in octal to file type description string
1085 sub file_type_long {
1086 my $mode = shift;
1087
1088 if ($mode !~ m/^[0-7]+$/) {
1089 return $mode;
1090 } else {
1091 $mode = oct $mode;
1092 }
1093
1094 if (S_ISGITLINK($mode)) {
1095 return "submodule";
1096 } elsif (S_ISDIR($mode & S_IFMT)) {
1097 return "directory";
1098 } elsif (S_ISLNK($mode)) {
1099 return "symlink";
1100 } elsif (S_ISREG($mode)) {
1101 if ($mode & S_IXUSR) {
1102 return "executable";
1103 } else {
1104 return "file";
1105 };
1106 } else {
1107 return "unknown";
1108 }
1109 }
1110
1111
1112 ## ----------------------------------------------------------------------
1113 ## functions returning short HTML fragments, or transforming HTML fragments
1114 ## which don't belong to other sections
1115
1116 # format line of commit message.
1117 sub format_log_line_html {
1118 my $line = shift;
1119
1120 $line = esc_html($line, -nbsp=>1);
1121 if ($line =~ m/([0-9a-fA-F]{8,40})/) {
1122 my $hash_text = $1;
1123 my $link =
1124 $cgi->a({-href => href(action=>"object", hash=>$hash_text),
1125 -class => "text"}, $hash_text);
1126 $line =~ s/$hash_text/$link/;
1127 }
1128 return $line;
1129 }
1130
1131 # format marker of refs pointing to given object
1132 sub format_ref_marker {
1133 my ($refs, $id) = @_;
1134 my $markers = '';
1135
1136 if (defined $refs->{$id}) {
1137 foreach my $ref (@{$refs->{$id}}) {
1138 my ($type, $name) = qw();
1139 # e.g. tags/v2.6.11 or heads/next
1140 if ($ref =~ m!^(.*?)s?/(.*)$!) {
1141 $type = $1;
1142 $name = $2;
1143 } else {
1144 $type = "ref";
1145 $name = $ref;
1146 }
1147
1148 $markers .= " <span class=\"$type\" title=\"$ref\">" .
1149 esc_html($name) . "</span>";
1150 }
1151 }
1152
1153 if ($markers) {
1154 return ' <span class="refs">'. $markers . '</span>';
1155 } else {
1156 return "";
1157 }
1158 }
1159
1160 # format, perhaps shortened and with markers, title line
1161 sub format_subject_html {
1162 my ($long, $short, $href, $extra) = @_;
1163 $extra = '' unless defined($extra);
1164
1165 if (length($short) < length($long)) {
1166 return $cgi->a({-href => $href, -class => "list subject",
1167 -title => to_utf8($long)},
1168 esc_html($short) . $extra);
1169 } else {
1170 return $cgi->a({-href => $href, -class => "list subject"},
1171 esc_html($long) . $extra);
1172 }
1173 }
1174
1175 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
1176 sub format_git_diff_header_line {
1177 my $line = shift;
1178 my $diffinfo = shift;
1179 my ($from, $to) = @_;
1180
1181 if ($diffinfo->{'nparents'}) {
1182 # combined diff
1183 $line =~ s!^(diff (.*?) )"?.*$!$1!;
1184 if ($to->{'href'}) {
1185 $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
1186 esc_path($to->{'file'}));
1187 } else { # file was deleted (no href)
1188 $line .= esc_path($to->{'file'});
1189 }
1190 } else {
1191 # "ordinary" diff
1192 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
1193 if ($from->{'href'}) {
1194 $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
1195 'a/' . esc_path($from->{'file'}));
1196 } else { # file was added (no href)
1197 $line .= 'a/' . esc_path($from->{'file'});
1198 }
1199 $line .= ' ';
1200 if ($to->{'href'}) {
1201 $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
1202 'b/' . esc_path($to->{'file'}));
1203 } else { # file was deleted
1204 $line .= 'b/' . esc_path($to->{'file'});
1205 }
1206 }
1207
1208 return "<div class=\"diff header\">$line</div>\n";
1209 }
1210
1211 # format extended diff header line, before patch itself
1212 sub format_extended_diff_header_line {
1213 my $line = shift;
1214 my $diffinfo = shift;
1215 my ($from, $to) = @_;
1216
1217 # match <path>
1218 if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
1219 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
1220 esc_path($from->{'file'}));
1221 }
1222 if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
1223 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
1224 esc_path($to->{'file'}));
1225 }
1226 # match single <mode>
1227 if ($line =~ m/\s(\d{6})$/) {
1228 $line .= '<span class="info"> (' .
1229 file_type_long($1) .
1230 ')</span>';
1231 }
1232 # match <hash>
1233 if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
1234 # can match only for combined diff
1235 $line = 'index ';
1236 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
1237 if ($from->{'href'}[$i]) {
1238 $line .= $cgi->a({-href=>$from->{'href'}[$i],
1239 -class=>"hash"},
1240 substr($diffinfo->{'from_id'}[$i],0,7));
1241 } else {
1242 $line .= '0' x 7;
1243 }
1244 # separator
1245 $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
1246 }
1247 $line .= '..';
1248 if ($to->{'href'}) {
1249 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
1250 substr($diffinfo->{'to_id'},0,7));
1251 } else {
1252 $line .= '0' x 7;
1253 }
1254
1255 } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
1256 # can match only for ordinary diff
1257 my ($from_link, $to_link);
1258 if ($from->{'href'}) {
1259 $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
1260 substr($diffinfo->{'from_id'},0,7));
1261 } else {
1262 $from_link = '0' x 7;
1263 }
1264 if ($to->{'href'}) {
1265 $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
1266 substr($diffinfo->{'to_id'},0,7));
1267 } else {
1268 $to_link = '0' x 7;
1269 }
1270 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
1271 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
1272 }
1273
1274 return $line . "<br/>\n";
1275 }
1276
1277 # format from-file/to-file diff header
1278 sub format_diff_from_to_header {
1279 my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
1280 my $line;
1281 my $result = '';
1282
1283 $line = $from_line;
1284 #assert($line =~ m/^---/) if DEBUG;
1285 # no extra formatting for "^--- /dev/null"
1286 if (! $diffinfo->{'nparents'}) {
1287 # ordinary (single parent) diff
1288 if ($line =~ m!^--- "?a/!) {
1289 if ($from->{'href'}) {
1290 $line = '--- a/' .
1291 $cgi->a({-href=>$from->{'href'}, -class=>"path"},
1292 esc_path($from->{'file'}));
1293 } else {
1294 $line = '--- a/' .
1295 esc_path($from->{'file'});
1296 }
1297 }
1298 $result .= qq!<div class="diff from_file">$line</div>\n!;
1299
1300 } else {
1301 # combined diff (merge commit)
1302 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
1303 if ($from->{'href'}[$i]) {
1304 $line = '--- ' .
1305 $cgi->a({-href=>href(action=>"blobdiff",
1306 hash_parent=>$diffinfo->{'from_id'}[$i],
1307 hash_parent_base=>$parents[$i],
1308 file_parent=>$from->{'file'}[$i],
1309 hash=>$diffinfo->{'to_id'},
1310 hash_base=>$hash,
1311 file_name=>$to->{'file'}),
1312 -class=>"path",
1313 -title=>"diff" . ($i+1)},
1314 $i+1) .
1315 '/' .
1316 $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
1317 esc_path($from->{'file'}[$i]));
1318 } else {
1319 $line = '--- /dev/null';
1320 }
1321 $result .= qq!<div class="diff from_file">$line</div>\n!;
1322 }
1323 }
1324
1325 $line = $to_line;
1326 #assert($line =~ m/^\+\+\+/) if DEBUG;
1327 # no extra formatting for "^+++ /dev/null"
1328 if ($line =~ m!^\+\+\+ "?b/!) {
1329 if ($to->{'href'}) {
1330 $line = '+++ b/' .
1331 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
1332 esc_path($to->{'file'}));
1333 } else {
1334 $line = '+++ b/' .
1335 esc_path($to->{'file'});
1336 }
1337 }
1338 $result .= qq!<div class="diff to_file">$line</div>\n!;
1339
1340 return $result;
1341 }
1342
1343 # create note for patch simplified by combined diff
1344 sub format_diff_cc_simplified {
1345 my ($diffinfo, @parents) = @_;
1346 my $result = '';
1347
1348 $result .= "<div class=\"diff header\">" .
1349 "diff --cc ";
1350 if (!is_deleted($diffinfo)) {
1351 $result .= $cgi->a({-href => href(action=>"blob",
1352 hash_base=>$hash,
1353 hash=>$diffinfo->{'to_id'},
1354 file_name=>$diffinfo->{'to_file'}),
1355 -class => "path"},
1356 esc_path($diffinfo->{'to_file'}));
1357 } else {
1358 $result .= esc_path($diffinfo->{'to_file'});
1359 }
1360 $result .= "</div>\n" . # class="diff header"
1361 "<div class=\"diff nodifferences\">" .
1362 "Simple merge" .
1363 "</div>\n"; # class="diff nodifferences"
1364
1365 return $result;
1366 }
1367
1368 # format patch (diff) line (not to be used for diff headers)
1369 sub format_diff_line {
1370 my $line = shift;
1371 my ($from, $to) = @_;
1372 my $diff_class = "";
1373
1374 chomp $line;
1375
1376 if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
1377 # combined diff
1378 my $prefix = substr($line, 0, scalar @{$from->{'href'}});
1379 if ($line =~ m/^\@{3}/) {
1380 $diff_class = " chunk_header";
1381 } elsif ($line =~ m/^\\/) {
1382 $diff_class = " incomplete";
1383 } elsif ($prefix =~ tr/+/+/) {
1384 $diff_class = " add";
1385 } elsif ($prefix =~ tr/-/-/) {
1386 $diff_class = " rem";
1387 }
1388 } else {
1389 # assume ordinary diff
1390 my $char = substr($line, 0, 1);
1391 if ($char eq '+') {
1392 $diff_class = " add";
1393 } elsif ($char eq '-') {
1394 $diff_class = " rem";
1395 } elsif ($char eq '@') {
1396 $diff_class = " chunk_header";
1397 } elsif ($char eq "\\") {
1398 $diff_class = " incomplete";
1399 }
1400 }
1401 $line = untabify($line);
1402 if ($from && $to && $line =~ m/^\@{2} /) {
1403 my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
1404 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
1405
1406 $from_lines = 0 unless defined $from_lines;
1407 $to_lines = 0 unless defined $to_lines;
1408
1409 if ($from->{'href'}) {
1410 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
1411 -class=>"list"}, $from_text);
1412 }
1413 if ($to->{'href'}) {
1414 $to_text = $cgi->a({-href=>"$to->{'href'}#l$to_start",
1415 -class=>"list"}, $to_text);
1416 }
1417 $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
1418 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
1419 return "<div class=\"diff$diff_class\">$line</div>\n";
1420 } elsif ($from && $to && $line =~ m/^\@{3}/) {
1421 my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
1422 my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
1423
1424 @from_text = split(' ', $ranges);
1425 for (my $i = 0; $i < @from_text; ++$i) {
1426 ($from_start[$i], $from_nlines[$i]) =
1427 (split(',', substr($from_text[$i], 1)), 0);
1428 }
1429
1430 $to_text = pop @from_text;
1431 $to_start = pop @from_start;
1432 $to_nlines = pop @from_nlines;
1433
1434 $line = "<span class=\"chunk_info\">$prefix ";
1435 for (my $i = 0; $i < @from_text; ++$i) {
1436 if ($from->{'href'}[$i]) {
1437 $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
1438 -class=>"list"}, $from_text[$i]);
1439 } else {
1440 $line .= $from_text[$i];
1441 }
1442 $line .= " ";
1443 }
1444 if ($to->{'href'}) {
1445 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
1446 -class=>"list"}, $to_text);
1447 } else {
1448 $line .= $to_text;
1449 }
1450 $line .= " $prefix</span>" .
1451 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
1452 return "<div class=\"diff$diff_class\">$line</div>\n";
1453 }
1454 return "<div class=\"diff$diff_class\">" . esc_html($line, -nbsp=>1) . "</div>\n";
1455 }
1456
1457 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
1458 # linked. Pass the hash of the tree/commit to snapshot.
1459 sub format_snapshot_links {
1460 my ($hash) = @_;
1461 my @snapshot_fmts = gitweb_check_feature('snapshot');
1462 @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1463 my $num_fmts = @snapshot_fmts;
1464 if ($num_fmts > 1) {
1465 # A parenthesized list of links bearing format names.
1466 # e.g. "snapshot (_tar.gz_ _zip_)"
1467 return "snapshot (" . join(' ', map
1468 $cgi->a({
1469 -href => href(
1470 action=>"snapshot",
1471 hash=>$hash,
1472 snapshot_format=>$_
1473 )
1474 }, $known_snapshot_formats{$_}{'display'})
1475 , @snapshot_fmts) . ")";
1476 } elsif ($num_fmts == 1) {
1477 # A single "snapshot" link whose tooltip bears the format name.
1478 # i.e. "_snapshot_"
1479 my ($fmt) = @snapshot_fmts;
1480 return
1481 $cgi->a({
1482 -href => href(
1483 action=>"snapshot",
1484 hash=>$hash,
1485 snapshot_format=>$fmt
1486 ),
1487 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
1488 }, "snapshot");
1489 } else { # $num_fmts == 0
1490 return undef;
1491 }
1492 }
1493
1494 ## ......................................................................
1495 ## functions returning values to be passed, perhaps after some
1496 ## transformation, to other functions; e.g. returning arguments to href()
1497
1498 # returns hash to be passed to href to generate gitweb URL
1499 # in -title key it returns description of link
1500 sub get_feed_info {
1501 my $format = shift || 'Atom';
1502 my %res = (action => lc($format));
1503
1504 # feed links are possible only for project views
1505 return unless (defined $project);
1506 # some views should link to OPML, or to generic project feed,
1507 # or don't have specific feed yet (so they should use generic)
1508 return if ($action =~ /^(?:tags|heads|forks|tag|search)$/x);
1509
1510 my $branch;
1511 # branches refs uses 'refs/heads/' prefix (fullname) to differentiate
1512 # from tag links; this also makes possible to detect branch links
1513 if ((defined $hash_base && $hash_base =~ m!^refs/heads/(.*)$!) ||
1514 (defined $hash && $hash =~ m!^refs/heads/(.*)$!)) {
1515 $branch = $1;
1516 }
1517 # find log type for feed description (title)
1518 my $type = 'log';
1519 if (defined $file_name) {
1520 $type = "history of $file_name";
1521 $type .= "/" if ($action eq 'tree');
1522 $type .= " on '$branch'" if (defined $branch);
1523 } else {
1524 $type = "log of $branch" if (defined $branch);
1525 }
1526
1527 $res{-title} = $type;
1528 $res{'hash'} = (defined $branch ? "refs/heads/$branch" : undef);
1529 $res{'file_name'} = $file_name;
1530
1531 return %res;
1532 }
1533
1534 ## ----------------------------------------------------------------------
1535 ## git utility subroutines, invoking git commands
1536
1537 # returns path to the core git executable and the --git-dir parameter as list
1538 sub git_cmd {
1539 return $GIT, '--git-dir='.$git_dir;
1540 }
1541
1542 # quote the given arguments for passing them to the shell
1543 # quote_command("command", "arg 1", "arg with ' and ! characters")
1544 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
1545 # Try to avoid using this function wherever possible.
1546 sub quote_command {
1547 return join(' ',
1548 map( { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ ));
1549 }
1550
1551 # get HEAD ref of given project as hash
1552 sub git_get_head_hash {
1553 my $project = shift;
1554 my $o_git_dir = $git_dir;
1555 my $retval = undef;
1556 $git_dir = "$projectroot/$project";
1557 if (open my $fd, "-|", git_cmd(), "rev-parse", "--verify", "HEAD") {
1558 my $head = <$fd>;
1559 close $fd;
1560 if (defined $head && $head =~ /^([0-9a-fA-F]{40})$/) {
1561 $retval = $1;
1562 }
1563 }
1564 if (defined $o_git_dir) {
1565 $git_dir = $o_git_dir;
1566 }
1567 return $retval;
1568 }
1569
1570 # get type of given object
1571 sub git_get_type {
1572 my $hash = shift;
1573
1574 open my $fd, "-|", git_cmd(), "cat-file", '-t', $hash or return;
1575 my $type = <$fd>;
1576 close $fd or return;
1577 chomp $type;
1578 return $type;
1579 }
1580
1581 # repository configuration
1582 our $config_file = '';
1583 our %config;
1584
1585 # store multiple values for single key as anonymous array reference
1586 # single values stored directly in the hash, not as [ <value> ]
1587 sub hash_set_multi {
1588 my ($hash, $key, $value) = @_;
1589
1590 if (!exists $hash->{$key}) {
1591 $hash->{$key} = $value;
1592 } elsif (!ref $hash->{$key}) {
1593 $hash->{$key} = [ $hash->{$key}, $value ];
1594 } else {
1595 push @{$hash->{$key}}, $value;
1596 }
1597 }
1598
1599 # return hash of git project configuration
1600 # optionally limited to some section, e.g. 'gitweb'
1601 sub git_parse_project_config {
1602 my $section_regexp = shift;
1603 my %config;
1604
1605 local $/ = "\0";
1606
1607 open my $fh, "-|", git_cmd(), "config", '-z', '-l',
1608 or return;
1609
1610 while (my $keyval = <$fh>) {
1611 chomp $keyval;
1612 my ($key, $value) = split(/\n/, $keyval, 2);
1613
1614 hash_set_multi(\%config, $key, $value)
1615 if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
1616 }
1617 close $fh;
1618
1619 return %config;
1620 }
1621
1622 # convert config value to boolean, 'true' or 'false'
1623 # no value, number > 0, 'true' and 'yes' values are true
1624 # rest of values are treated as false (never as error)
1625 sub config_to_bool {
1626 my $val = shift;
1627
1628 # strip leading and trailing whitespace
1629 $val =~ s/^\s+//;
1630 $val =~ s/\s+$//;
1631
1632 return (!defined $val || # section.key
1633 ($val =~ /^\d+$/ && $val) || # section.key = 1
1634 ($val =~ /^(?:true|yes)$/i)); # section.key = true
1635 }
1636
1637 # convert config value to simple decimal number
1638 # an optional value suffix of 'k', 'm', or 'g' will cause the value
1639 # to be multiplied by 1024, 1048576, or 1073741824
1640 sub config_to_int {
1641 my $val = shift;
1642
1643 # strip leading and trailing whitespace
1644 $val =~ s/^\s+//;
1645 $val =~ s/\s+$//;
1646
1647 if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
1648 $unit = lc($unit);
1649 # unknown unit is treated as 1
1650 return $num * ($unit eq 'g' ? 1073741824 :
1651 $unit eq 'm' ? 1048576 :
1652 $unit eq 'k' ? 1024 : 1);
1653 }
1654 return $val;
1655 }
1656
1657 # convert config value to array reference, if needed
1658 sub config_to_multi {
1659 my $val = shift;
1660
1661 return ref($val) ? $val : (defined($val) ? [ $val ] : []);
1662 }
1663
1664 sub git_get_project_config {
1665 my ($key, $type) = @_;
1666
1667 # key sanity check
1668 return unless ($key);
1669 $key =~ s/^gitweb\.//;
1670 return if ($key =~ m/\W/);
1671
1672 # type sanity check
1673 if (defined $type) {
1674 $type =~ s/^--//;
1675 $type = undef
1676 unless ($type eq 'bool' || $type eq 'int');
1677 }
1678
1679 # get config
1680 if (!defined $config_file ||
1681 $config_file ne "$git_dir/config") {
1682 %config = git_parse_project_config('gitweb');
1683 $config_file = "$git_dir/config";
1684 }
1685
1686 # ensure given type
1687 if (!defined $type) {
1688 return $config{"gitweb.$key"};
1689 } elsif ($type eq 'bool') {
1690 # backward compatibility: 'git config --bool' returns true/false
1691 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
1692 } elsif ($type eq 'int') {
1693 return config_to_int($config{"gitweb.$key"});
1694 }
1695 return $config{"gitweb.$key"};
1696 }
1697
1698 # get hash of given path at given ref
1699 sub git_get_hash_by_path {
1700 my $base = shift;
1701 my $path = shift || return undef;
1702 my $type = shift;
1703
1704 $path =~ s,/+$,,;
1705
1706 open my $fd, "-|", git_cmd(), "ls-tree", $base, "--", $path
1707 or die_error(undef, "Open git-ls-tree failed");
1708 my $line = <$fd>;
1709 close $fd or return undef;
1710
1711 if (!defined $line) {
1712 # there is no tree or hash given by $path at $base
1713 return undef;
1714 }
1715
1716 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c'
1717 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
1718 if (defined $type && $type ne $2) {
1719 # type doesn't match
1720 return undef;
1721 }
1722 return $3;
1723 }
1724
1725 # get path of entry with given hash at given tree-ish (ref)
1726 # used to get 'from' filename for combined diff (merge commit) for renames
1727 sub git_get_path_by_hash {
1728 my $base = shift || return;
1729 my $hash = shift || return;
1730
1731 local $/ = "\0";
1732
1733 open my $fd, "-|", git_cmd(), "ls-tree", '-r', '-t', '-z', $base
1734 or return undef;
1735 while (my $line = <$fd>) {
1736 chomp $line;
1737
1738 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423 gitweb'
1739 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f gitweb/README'
1740 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
1741 close $fd;
1742 return $1;
1743 }
1744 }
1745 close $fd;
1746 return undef;
1747 }
1748
1749 ## ......................................................................
1750 ## git utility functions, directly accessing git repository
1751
1752 sub git_get_project_description {
1753 my $path = shift;
1754
1755 $git_dir = "$projectroot/$path";
1756 open my $fd, "$git_dir/description"
1757 or return git_get_project_config('description');
1758 my $descr = <$fd>;
1759 close $fd;
1760 if (defined $descr) {
1761 chomp $descr;
1762 }
1763 return $descr;
1764 }
1765
1766 sub git_get_project_url_list {
1767 my $path = shift;
1768
1769 $git_dir = "$projectroot/$path";
1770 open my $fd, "$git_dir/cloneurl"
1771 or return wantarray ?
1772 @{ config_to_multi(git_get_project_config('url')) } :
1773 config_to_multi(git_get_project_config('url'));
1774 my @git_project_url_list = map { chomp; $_ } <$fd>;
1775 close $fd;
1776
1777 return wantarray ? @git_project_url_list : \@git_project_url_list;
1778 }
1779
1780 sub git_get_projects_list {
1781 my ($filter) = @_;
1782 my @list;
1783
1784 $filter ||= '';
1785 $filter =~ s/\.git$//;
1786
1787 my ($check_forks) = gitweb_check_feature('forks');
1788
1789 if (-d $projects_list) {
1790 # search in directory
1791 my $dir = $projects_list . ($filter ? "/$filter" : '');
1792 # remove the trailing "/"
1793 $dir =~ s!/+$!!;
1794 my $pfxlen = length("$dir");
1795 my $pfxdepth = ($dir =~ tr!/!!);
1796
1797 File::Find::find({
1798 follow_fast => 1, # follow symbolic links
1799 follow_skip => 2, # ignore duplicates
1800 dangling_symlinks => 0, # ignore dangling symlinks, silently
1801 wanted => sub {
1802 # skip project-list toplevel, if we get it.
1803 return if (m!^[/.]$!);
1804 # only directories can be git repositories
1805 return unless (-d $_);
1806 # don't traverse too deep (Find is super slow on os x)
1807 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
1808 $File::Find::prune = 1;
1809 return;
1810 }
1811
1812 my $subdir = substr($File::Find::name, $pfxlen + 1);
1813 # we check related file in $projectroot
1814 if ($check_forks and $subdir =~ m#/.#) {
1815 $File::Find::prune = 1;
1816 } elsif (check_export_ok("$projectroot/$filter/$subdir")) {
1817 push @list, { path => ($filter ? "$filter/" : '') . $subdir };
1818 $File::Find::prune = 1;
1819 }
1820 },
1821 }, "$dir");
1822
1823 } elsif (-f $projects_list) {
1824 # read from file(url-encoded):
1825 # 'git%2Fgit.git Linus+Torvalds'
1826 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
1827 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
1828 my %paths;
1829 open my ($fd), $projects_list or return;
1830 PROJECT:
1831 while (my $line = <$fd>) {
1832 chomp $line;
1833 my ($path, $owner) = split ' ', $line;
1834 $path = unescape($path);
1835 $owner = unescape($owner);
1836 if (!defined $path) {
1837 next;
1838 }
1839 if ($filter ne '') {
1840 # looking for forks;
1841 my $pfx = substr($path, 0, length($filter));
1842 if ($pfx ne $filter) {
1843 next PROJECT;
1844 }
1845 my $sfx = substr($path, length($filter));
1846 if ($sfx !~ /^\/.*\.git$/) {
1847 next PROJECT;
1848 }
1849 } elsif ($check_forks) {
1850 PATH:
1851 foreach my $filter (keys %paths) {
1852 # looking for forks;
1853 my $pfx = substr($path, 0, length($filter));
1854 if ($pfx ne $filter) {
1855 next PATH;
1856 }
1857 my $sfx = substr($path, length($filter));
1858 if ($sfx !~ /^\/.*\.git$/) {
1859 next PATH;
1860 }
1861 # is a fork, don't include it in
1862 # the list
1863 next PROJECT;
1864 }
1865 }
1866 if (check_export_ok("$projectroot/$path")) {
1867 my $pr = {
1868 path => $path,
1869 owner => to_utf8($owner),
1870 };
1871 push @list, $pr;
1872 (my $forks_path = $path) =~ s/\.git$//;
1873 $paths{$forks_path}++;
1874 }
1875 }
1876 close $fd;
1877 }
1878 return @list;
1879 }
1880
1881 our $gitweb_project_owner = undef;
1882 sub git_get_project_list_from_file {
1883
1884 return if (defined $gitweb_project_owner);
1885
1886 $gitweb_project_owner = {};
1887 # read from file (url-encoded):
1888 # 'git%2Fgit.git Linus+Torvalds'
1889 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
1890 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
1891 if (-f $projects_list) {
1892 open (my $fd , $projects_list);
1893 while (my $line = <$fd>) {
1894 chomp $line;
1895 my ($pr, $ow) = split ' ', $line;
1896 $pr = unescape($pr);
1897 $ow = unescape($ow);
1898 $gitweb_project_owner->{$pr} = to_utf8($ow);
1899 }
1900 close $fd;
1901 }
1902 }
1903
1904 sub git_get_project_owner {
1905 my $project = shift;
1906 my $owner;
1907
1908 return undef unless $project;
1909 $git_dir = "$projectroot/$project";
1910
1911 if (!defined $gitweb_project_owner) {
1912 git_get_project_list_from_file();
1913 }
1914
1915 if (exists $gitweb_project_owner->{$project}) {
1916 $owner = $gitweb_project_owner->{$project};
1917 }
1918 if (!defined $owner){
1919 $owner = git_get_project_config('owner');
1920 }
1921 if (!defined $owner) {
1922 $owner = get_file_owner("$git_dir");
1923 }
1924
1925 return $owner;
1926 }
1927
1928 sub git_get_last_activity {
1929 my ($path) = @_;
1930 my $fd;
1931
1932 $git_dir = "$projectroot/$path";
1933 open($fd, "-|", git_cmd(), 'for-each-ref',
1934 '--format=%(committer)',
1935 '--sort=-committerdate',
1936 '--count=1',
1937 'refs/heads') or return;
1938 my $most_recent = <$fd>;
1939 close $fd or return;
1940 if (defined $most_recent &&
1941 $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
1942 my $timestamp = $1;
1943 my $age = time - $timestamp;
1944 return ($age, age_string($age));
1945 }
1946 return (undef, undef);
1947 }
1948
1949 sub git_get_references {
1950 my $type = shift || "";
1951 my %refs;
1952 # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
1953 # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
1954 open my $fd, "-|", git_cmd(), "show-ref", "--dereference",
1955 ($type ? ("--", "refs/$type") : ()) # use -- <pattern> if $type
1956 or return;
1957
1958 while (my $line = <$fd>) {
1959 chomp $line;
1960 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type/?[^^]+)!) {
1961 if (defined $refs{$1}) {
1962 push @{$refs{$1}}, $2;
1963 } else {
1964 $refs{$1} = [ $2 ];
1965 }
1966 }
1967 }
1968 close $fd or return;
1969 return \%refs;
1970 }
1971
1972 sub git_get_rev_name_tags {
1973 my $hash = shift || return undef;
1974
1975 open my $fd, "-|", git_cmd(), "name-rev", "--tags", $hash
1976 or return;
1977 my $name_rev = <$fd>;
1978 close $fd;
1979
1980 if ($name_rev =~ m|^$hash tags/(.*)$|) {
1981 return $1;
1982 } else {
1983 # catches also '$hash undefined' output
1984 return undef;
1985 }
1986 }
1987
1988 ## ----------------------------------------------------------------------
1989 ## parse to hash functions
1990
1991 sub parse_date {
1992 my $epoch = shift;
1993 my $tz = shift || "-0000";
1994
1995 my %date;
1996 my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
1997 my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
1998 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
1999 $date{'hour'} = $hour;
2000 $date{'minute'} = $min;
2001 $date{'mday'} = $mday;
2002 $date{'day'} = $days[$wday];
2003 $date{'month'} = $months[$mon];
2004 $date{'rfc2822'} = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
2005 $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
2006 $date{'mday-time'} = sprintf "%d %s %02d:%02d",
2007 $mday, $months[$mon], $hour ,$min;
2008 $date{'iso-8601'} = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
2009 1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
2010
2011 $tz =~ m/^([+\-][0-9][0-9])([0-9][0-9])$/;
2012 my $local = $epoch + ((int $1 + ($2/60)) * 3600);
2013 ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
2014 $date{'hour_local'} = $hour;
2015 $date{'minute_local'} = $min;
2016 $date{'tz_local'} = $tz;
2017 $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
2018 1900+$year, $mon+1, $mday,
2019 $hour, $min, $sec, $tz);
2020 return %date;
2021 }
2022
2023 sub parse_tag {
2024 my $tag_id = shift;
2025 my %tag;
2026 my @comment;
2027
2028 open my $fd, "-|", git_cmd(), "cat-file", "tag", $tag_id or return;
2029 $tag{'id'} = $tag_id;
2030 while (my $line = <$fd>) {
2031 chomp $line;
2032 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
2033 $tag{'object'} = $1;
2034 } elsif ($line =~ m/^type (.+)$/) {
2035 $tag{'type'} = $1;
2036 } elsif ($line =~ m/^tag (.+)$/) {
2037 $tag{'name'} = $1;
2038 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
2039 $tag{'author'} = $1;
2040 $tag{'epoch'} = $2;
2041 $tag{'tz'} = $3;
2042 } elsif ($line =~ m/--BEGIN/) {
2043 push @comment, $line;
2044 last;
2045 } elsif ($line eq "") {
2046 last;
2047 }
2048 }
2049 push @comment, <$fd>;
2050 $tag{'comment'} = \@comment;
2051 close $fd or return;
2052 if (!defined $tag{'name'}) {
2053 return
2054 };
2055 return %tag
2056 }
2057
2058 sub parse_commit_text {
2059 my ($commit_text, $withparents) = @_;
2060 my @commit_lines = split '\n', $commit_text;
2061 my %co;
2062
2063 pop @commit_lines; # Remove '\0'
2064
2065 if (! @commit_lines) {
2066 return;
2067 }
2068
2069 my $header = shift @commit_lines;
2070 if ($header !~ m/^[0-9a-fA-F]{40}/) {
2071 return;
2072 }
2073 ($co{'id'}, my @parents) = split ' ', $header;
2074 while (my $line = shift @commit_lines) {
2075 last if $line eq "\n";
2076 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
2077 $co{'tree'} = $1;
2078 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
2079 push @parents, $1;
2080 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
2081 $co{'author'} = $1;
2082 $co{'author_epoch'} = $2;
2083 $co{'author_tz'} = $3;
2084 if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
2085 $co{'author_name'} = $1;
2086 $co{'author_email'} = $2;
2087 } else {
2088 $co{'author_name'} = $co{'author'};
2089 }
2090 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
2091 $co{'committer'} = $1;
2092 $co{'committer_epoch'} = $2;
2093 $co{'committer_tz'} = $3;
2094 $co{'committer_name'} = $co{'committer'};
2095 if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
2096 $co{'committer_name'} = $1;
2097 $co{'committer_email'} = $2;
2098 } else {
2099 $co{'committer_name'} = $co{'committer'};
2100 }
2101 }
2102 }
2103 if (!defined $co{'tree'}) {
2104 return;
2105 };
2106 $co{'parents'} = \@parents;
2107 $co{'parent'} = $parents[0];
2108
2109 foreach my $title (@commit_lines) {
2110 $title =~ s/^ //;
2111 if ($title ne "") {
2112 $co{'title'} = chop_str($title, 80, 5);
2113 # remove leading stuff of merges to make the interesting part visible
2114 if (length($title) > 50) {
2115 $title =~ s/^Automatic //;
2116 $title =~ s/^merge (of|with) /Merge ... /i;
2117 if (length($title) > 50) {
2118 $title =~ s/(http|rsync):\/\///;
2119 }
2120 if (length($title) > 50) {
2121 $title =~ s/(master|www|rsync)\.//;
2122 }
2123 if (length($title) > 50) {
2124 $title =~ s/kernel.org:?//;
2125 }
2126 if (length($title) > 50) {
2127 $title =~ s/\/pub\/scm//;
2128 }
2129 }
2130 $co{'title_short'} = chop_str($title, 50, 5);
2131 last;
2132 }
2133 }
2134 if ($co{'title'} eq "") {
2135 $co{'title'} = $co{'title_short'} = '(no commit message)';
2136 }
2137 # remove added spaces
2138 foreach my $line (@commit_lines) {
2139 $line =~ s/^ //;
2140 }
2141 $co{'comment'} = \@commit_lines;
2142
2143 my $age = time - $co{'committer_epoch'};
2144 $co{'age'} = $age;
2145 $co{'age_string'} = age_string($age);
2146 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($co{'committer_epoch'});
2147 if ($age > 60*60*24*7*2) {
2148 $co{'age_string_date'} = sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2149 $co{'age_string_age'} = $co{'age_string'};
2150 } else {
2151 $co{'age_string_date'} = $co{'age_string'};
2152 $co{'age_string_age'} = sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2153 }
2154 return %co;
2155 }
2156
2157 sub parse_commit {
2158 my ($commit_id) = @_;
2159 my %co;
2160
2161 local $/ = "\0";
2162
2163 open my $fd, "-|", git_cmd(), "rev-list",
2164 "--parents",
2165 "--header",
2166 "--max-count=1",
2167 $commit_id,
2168 "--",
2169 or die_error(undef, "Open git-rev-list failed");
2170 %co = parse_commit_text(<$fd>, 1);
2171 close $fd;
2172
2173 return %co;
2174 }
2175
2176 sub parse_commits {
2177 my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
2178 my @cos;
2179
2180 $maxcount ||= 1;
2181 $skip ||= 0;
2182
2183 local $/ = "\0";
2184
2185 open my $fd, "-|", git_cmd(), "rev-list",
2186 "--header",
2187 @args,
2188 ("--max-count=" . $maxcount),
2189 ("--skip=" . $skip),
2190 @extra_options,
2191 $commit_id,
2192 "--",
2193 ($filename ? ($filename) : ())
2194 or die_error(undef, "Open git-rev-list failed");
2195 while (my $line = <$fd>) {
2196 my %co = parse_commit_text($line);
2197 push @cos, \%co;
2198 }
2199 close $fd;
2200
2201 return wantarray ? @cos : \@cos;
2202 }
2203
2204 # parse line of git-diff-tree "raw" output
2205 sub parse_difftree_raw_line {
2206 my $line = shift;
2207 my %res;
2208
2209 # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M ls-files.c'
2210 # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M rev-tree.c'
2211 if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
2212 $res{'from_mode'} = $1;
2213 $res{'to_mode'} = $2;
2214 $res{'from_id'} = $3;
2215 $res{'to_id'} = $4;
2216 $res{'status'} = $5;
2217 $res{'similarity'} = $6;
2218 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
2219 ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
2220 } else {
2221 $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
2222 }
2223 }
2224 # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
2225 # combined diff (for merge commit)
2226 elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
2227 $res{'nparents'} = length($1);
2228 $res{'from_mode'} = [ split(' ', $2) ];
2229 $res{'to_mode'} = pop @{$res{'from_mode'}};
2230 $res{'from_id'} = [ split(' ', $3) ];
2231 $res{'to_id'} = pop @{$res{'from_id'}};
2232 $res{'status'} = [ split('', $4) ];
2233 $res{'to_file'} = unquote($5);
2234 }
2235 # 'c512b523472485aef4fff9e57b229d9d243c967f'
2236 elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
2237 $res{'commit'} = $1;
2238 }
2239
2240 return wantarray ? %res : \%res;
2241 }
2242
2243 # wrapper: return parsed line of git-diff-tree "raw" output
2244 # (the argument might be raw line, or parsed info)
2245 sub parsed_difftree_line {
2246 my $line_or_ref = shift;
2247
2248 if (ref($line_or_ref) eq "HASH") {
2249 # pre-parsed (or generated by hand)
2250 return $line_or_ref;
2251 } else {
2252 return parse_difftree_raw_line($line_or_ref);
2253 }
2254 }
2255
2256 # parse line of git-ls-tree output
2257 sub parse_ls_tree_line ($;%) {
2258 my $line = shift;
2259 my %opts = @_;
2260 my %res;
2261
2262 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c'
2263 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
2264
2265 $res{'mode'} = $1;
2266 $res{'type'} = $2;
2267 $res{'hash'} = $3;
2268 if ($opts{'-z'}) {
2269 $res{'name'} = $4;
2270 } else {
2271 $res{'name'} = unquote($4);
2272 }
2273
2274 return wantarray ? %res : \%res;
2275 }
2276
2277 # generates _two_ hashes, references to which are passed as 2 and 3 argument
2278 sub parse_from_to_diffinfo {
2279 my ($diffinfo, $from, $to, @parents) = @_;
2280
2281 if ($diffinfo->{'nparents'}) {
2282 # combined diff
2283 $from->{'file'} = [];
2284 $from->{'href'} = [];
2285 fill_from_file_info($diffinfo, @parents)
2286 unless exists $diffinfo->{'from_file'};
2287 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2288 $from->{'file'}[$i] =
2289 defined $diffinfo->{'from_file'}[$i] ?
2290 $diffinfo->{'from_file'}[$i] :
2291 $diffinfo->{'to_file'};
2292 if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
2293 $from->{'href'}[$i] = href(action=>"blob",
2294 hash_base=>$parents[$i],
2295 hash=>$diffinfo->{'from_id'}[$i],
2296 file_name=>$from->{'file'}[$i]);
2297 } else {
2298 $from->{'href'}[$i] = undef;
2299 }
2300 }
2301 } else {
2302 # ordinary (not combined) diff
2303 $from->{'file'} = $diffinfo->{'from_file'};
2304 if ($diffinfo->{'status'} ne "A") { # not new (added) file
2305 $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
2306 hash=>$diffinfo->{'from_id'},
2307 file_name=>$from->{'file'});
2308 } else {
2309 delete $from->{'href'};
2310 }
2311 }
2312
2313 $to->{'file'} = $diffinfo->{'to_file'};
2314 if (!is_deleted($diffinfo)) { # file exists in result
2315 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
2316 hash=>$diffinfo->{'to_id'},
2317 file_name=>$to->{'file'});
2318 } else {
2319 delete $to->{'href'};
2320 }
2321 }
2322
2323 ## ......................................................................
2324 ## parse to array of hashes functions
2325
2326 sub git_get_heads_list {
2327 my $limit = shift;
2328 my @headslist;
2329
2330 open my $fd, '-|', git_cmd(), 'for-each-ref',
2331 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
2332 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
2333 'refs/heads'
2334 or return;
2335 while (my $line = <$fd>) {
2336 my %ref_item;
2337
2338 chomp $line;
2339 my ($refinfo, $committerinfo) = split(/\0/, $line);
2340 my ($hash, $name, $title) = split(' ', $refinfo, 3);
2341 my ($committer, $epoch, $tz) =
2342 ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
2343 $ref_item{'fullname'} = $name;
2344 $name =~ s!^refs/heads/!!;
2345
2346 $ref_item{'name'} = $name;
2347 $ref_item{'id'} = $hash;
2348 $ref_item{'title'} = $title || '(no commit message)';
2349 $ref_item{'epoch'} = $epoch;
2350 if ($epoch) {
2351 $ref_item{'age'} = age_string(time - $ref_item{'epoch'});
2352 } else {
2353 $ref_item{'age'} = "unknown";
2354 }
2355
2356 push @headslist, \%ref_item;
2357 }
2358 close $fd;
2359
2360 return wantarray ? @headslist : \@headslist;
2361 }
2362
2363 sub git_get_tags_list {
2364 my $limit = shift;
2365 my @tagslist;
2366
2367 open my $fd, '-|', git_cmd(), 'for-each-ref',
2368 ($limit ? '--count='.($limit+1) : ()), '--sort=-creatordate',
2369 '--format=%(objectname) %(objecttype) %(refname) '.
2370 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
2371 'refs/tags'
2372 or return;
2373 while (my $line = <$fd>) {
2374 my %ref_item;
2375
2376 chomp $line;
2377 my ($refinfo, $creatorinfo) = split(/\0/, $line);
2378 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
2379 my ($creator, $epoch, $tz) =
2380 ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
2381 $ref_item{'fullname'} = $name;
2382 $name =~ s!^refs/tags/!!;
2383
2384 $ref_item{'type'} = $type;
2385 $ref_item{'id'} = $id;
2386 $ref_item{'name'} = $name;
2387 if ($type eq "tag") {
2388 $ref_item{'subject'} = $title;
2389 $ref_item{'reftype'} = $reftype;
2390 $ref_item{'refid'} = $refid;
2391 } else {
2392 $ref_item{'reftype'} = $type;
2393 $ref_item{'refid'} = $id;
2394 }
2395
2396 if ($type eq "tag" || $type eq "commit") {
2397 $ref_item{'epoch'} = $epoch;
2398 if ($epoch) {
2399 $ref_item{'age'} = age_string(time - $ref_item{'epoch'});
2400 } else {
2401 $ref_item{'age'} = "unknown";
2402 }
2403 }
2404
2405 push @tagslist, \%ref_item;
2406 }
2407 close $fd;
2408
2409 return wantarray ? @tagslist : \@tagslist;
2410 }
2411
2412 ## ----------------------------------------------------------------------
2413 ## filesystem-related functions
2414
2415 sub get_file_owner {
2416 my $path = shift;
2417
2418 my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
2419 my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
2420 if (!defined $gcos) {
2421 return undef;
2422 }
2423 my $owner = $gcos;
2424 $owner =~ s/[,;].*$//;
2425 return to_utf8($owner);
2426 }
2427
2428 ## ......................................................................
2429 ## mimetype related functions
2430
2431 sub mimetype_guess_file {
2432 my $filename = shift;
2433 my $mimemap = shift;
2434 -r $mimemap or return undef;
2435
2436 my %mimemap;
2437 open(MIME, $mimemap) or return undef;
2438 while (<MIME>) {
2439 next if m/^#/; # skip comments
2440 my ($mime, $exts) = split(/\t+/);
2441 if (defined $exts) {
2442 my @exts = split(/\s+/, $exts);
2443 foreach my $ext (@exts) {
2444 $mimemap{$ext} = $mime;
2445 }
2446 }
2447 }
2448 close(MIME);
2449
2450 $filename =~ /\.([^.]*)$/;
2451 return $mimemap{$1};
2452 }
2453
2454 sub mimetype_guess {
2455 my $filename = shift;
2456 my $mime;
2457 $filename =~ /\./ or return undef;
2458
2459 if ($mimetypes_file) {
2460 my $file = $mimetypes_file;
2461 if ($file !~ m!^/!) { # if it is relative path
2462 # it is relative to project
2463 $file = "$projectroot/$project/$file";
2464 }
2465 $mime = mimetype_guess_file($filename, $file);
2466 }
2467 $mime ||= mimetype_guess_file($filename, '/etc/mime.types');
2468 return $mime;
2469 }
2470
2471 sub blob_mimetype {
2472 my $fd = shift;
2473 my $filename = shift;
2474
2475 if ($filename) {
2476 my $mime = mimetype_guess($filename);
2477 $mime and return $mime;
2478 }
2479
2480 # just in case
2481 return $default_blob_plain_mimetype unless $fd;
2482
2483 if (-T $fd) {
2484 return 'text/plain';
2485 } elsif (! $filename) {
2486 return 'application/octet-stream';
2487 } elsif ($filename =~ m/\.png$/i) {
2488 return 'image/png';
2489 } elsif ($filename =~ m/\.gif$/i) {
2490 return 'image/gif';
2491 } elsif ($filename =~ m/\.jpe?g$/i) {
2492 return 'image/jpeg';
2493 } else {
2494 return 'application/octet-stream';
2495 }
2496 }
2497
2498 sub blob_contenttype {
2499 my ($fd, $file_name, $type) = @_;
2500
2501 $type ||= blob_mimetype($fd, $file_name);
2502 if ($type eq 'text/plain' && defined $default_text_plain_charset) {
2503 $type .= "; charset=$default_text_plain_charset";
2504 }
2505
2506 return $type;
2507 }
2508
2509 ## ======================================================================
2510 ## functions printing HTML: header, footer, error page
2511
2512 sub git_header_html {
2513 my $status = shift || "200 OK";
2514 my $expires = shift;
2515
2516 my $title = "$site_name";
2517 if (defined $project) {
2518 $title .= " - " . to_utf8($project);
2519 if (defined $action) {
2520 $title .= "/$action";
2521 if (defined $file_name) {
2522 $title .= " - " . esc_path($file_name);
2523 if ($action eq "tree" && $file_name !~ m|/$|) {
2524 $title .= "/";
2525 }
2526 }
2527 }
2528 }
2529 my $content_type;
2530 # require explicit support from the UA if we are to send the page as
2531 # 'application/xhtml+xml', otherwise send it as plain old 'text/html'.
2532 # we have to do this because MSIE sometimes globs '*/*', pretending to
2533 # support xhtml+xml but choking when it gets what it asked for.
2534 if (defined $cgi->http('HTTP_ACCEPT') &&
2535 $cgi->http('HTTP_ACCEPT') =~ m/(,|;|\s|^)application\/xhtml\+xml(,|;|\s|$)/ &&
2536 $cgi->Accept('application/xhtml+xml') != 0) {
2537 $content_type = 'application/xhtml+xml';
2538 } else {
2539 $content_type = 'text/html';
2540 }
2541 print $cgi->header(-type=>$content_type, -charset => 'utf-8',
2542 -status=> $status, -expires => $expires);
2543 my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
2544 print <<EOF;
2545 <?xml version="1.0" encoding="utf-8"?>
2546 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
2547 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
2548 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
2549 <!-- git core binaries version $git_version -->
2550 <head>
2551 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
2552 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
2553 <meta name="robots" content="index, nofollow"/>
2554 <title>$title</title>
2555 EOF
2556 # print out each stylesheet that exist
2557 if (defined $stylesheet) {
2558 #provides backwards capability for those people who define style sheet in a config file
2559 print '<link rel="stylesheet" type="text/css" href="'.$stylesheet.'"/>'."\n";
2560 } else {
2561 foreach my $stylesheet (@stylesheets) {
2562 next unless $stylesheet;
2563 print '<link rel="stylesheet" type="text/css" href="'.$stylesheet.'"/>'."\n";
2564 }
2565 }
2566 if (defined $project) {
2567 my %href_params = get_feed_info();
2568 if (!exists $href_params{'-title'}) {
2569 $href_params{'-title'} = 'log';
2570 }
2571
2572 foreach my $format qw(RSS Atom) {
2573 my $type = lc($format);
2574 my %link_attr = (
2575 '-rel' => 'alternate',
2576 '-title' => "$project - $href_params{'-title'} - $format feed",
2577 '-type' => "application/$type+xml"
2578 );
2579
2580 $href_params{'action'} = $type;
2581 $link_attr{'-href'} = href(%href_params);
2582 print "<link ".
2583 "rel=\"$link_attr{'-rel'}\" ".
2584 "title=\"$link_attr{'-title'}\" ".
2585 "href=\"$link_attr{'-href'}\" ".
2586 "type=\"$link_attr{'-type'}\" ".
2587 "/>\n";
2588
2589 $href_params{'extra_options'} = '--no-merges';
2590 $link_attr{'-href'} = href(%href_params);
2591 $link_attr{'-title'} .= ' (no merges)';
2592 print "<link ".
2593 "rel=\"$link_attr{'-rel'}\" ".
2594 "title=\"$link_attr{'-title'}\" ".
2595 "href=\"$link_attr{'-href'}\" ".
2596 "type=\"$link_attr{'-type'}\" ".
2597 "/>\n";
2598 }
2599
2600 } else {
2601 printf('<link rel="alternate" title="%s projects list" '.
2602 'href="%s" type="text/plain; charset=utf-8" />'."\n",
2603 $site_name, href(project=>undef, action=>"project_index"));
2604 printf('<link rel="alternate" title="%s projects feeds" '.
2605 'href="%s" type="text/x-opml" />'."\n",
2606 $site_name, href(project=>undef, action=>"opml"));
2607 }
2608 if (defined $favicon) {
2609 print qq(<link rel="shortcut icon" href="$favicon" type="image/png" />\n);
2610 }
2611
2612 print "</head>\n" .
2613 "<body>\n";
2614
2615 if (-f $site_header) {
2616 open (my $fd, $site_header);
2617 print <$fd>;
2618 close $fd;
2619 }
2620
2621 print "<div class=\"page_header\">\n" .
2622 $cgi->a({-href => esc_url($logo_url),
2623 -title => $logo_label},
2624 qq(<img src="$logo" width="72" height="27" alt="git" class="logo"/>));
2625 print $cgi->a({-href => esc_url($home_link)}, $home_link_str) . " / ";
2626 if (defined $project) {
2627 print $cgi->a({-href => href(action=>"summary")}, esc_html($project));
2628 if (defined $action) {
2629 print " / $action";
2630 }
2631 print "\n";
2632 }
2633 print "</div>\n";
2634
2635 my ($have_search) = gitweb_check_feature('search');
2636 if (defined $project && $have_search) {
2637 if (!defined $searchtext) {
2638 $searchtext = "";
2639 }
2640 my $search_hash;
2641 if (defined $hash_base) {
2642 $search_hash = $hash_base;
2643 } elsif (defined $hash) {
2644 $search_hash = $hash;
2645 } else {
2646 $search_hash = "HEAD";
2647 }
2648 my $action = $my_uri;
2649 my ($use_pathinfo) = gitweb_check_feature('pathinfo');
2650 if ($use_pathinfo) {
2651 $action .= "/".esc_url($project);
2652 }
2653 print $cgi->startform(-method => "get", -action => $action) .
2654 "<div class=\"search\">\n" .
2655 (!$use_pathinfo &&
2656 $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
2657 $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
2658 $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
2659 $cgi->popup_menu(-name => 'st', -default => 'commit',
2660 -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
2661 $cgi->sup($cgi->a({-href => href(action=>"search_help")}, "?")) .
2662 " search:\n",
2663 $cgi->textfield(-name => "s", -value => $searchtext) . "\n" .
2664 "<span title=\"Extended regular expression\">" .
2665 $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
2666 -checked => $search_use_regexp) .
2667 "</span>" .
2668 "</div>" .
2669 $cgi->end_form() . "\n";
2670 }
2671 }
2672
2673 sub git_footer_html {
2674 my $feed_class = 'rss_logo';
2675
2676 print "<div class=\"page_footer\">\n";
2677 if (defined $project) {
2678 my $descr = git_get_project_description($project);
2679 if (defined $descr) {
2680 print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
2681 }
2682
2683 my %href_params = get_feed_info();
2684 if (!%href_params) {
2685 $feed_class .= ' generic';
2686 }
2687 $href_params{'-title'} ||= 'log';
2688
2689 foreach my $format qw(RSS Atom) {
2690 $href_params{'action'} = lc($format);
2691 print $cgi->a({-href => href(%href_params),
2692 -title => "$href_params{'-title'} $format feed",
2693 -class => $feed_class}, $format)."\n";
2694 }
2695
2696 } else {
2697 print $cgi->a({-href => href(project=>undef, action=>"opml"),
2698 -class => $feed_class}, "OPML") . " ";
2699 print $cgi->a({-href => href(project=>undef, action=>"project_index"),
2700 -class => $feed_class}, "TXT") . "\n";
2701 }
2702 print "</div>\n"; # class="page_footer"
2703
2704 if (-f $site_footer) {
2705 open (my $fd, $site_footer);
2706 print <$fd>;
2707 close $fd;
2708 }
2709
2710 print "</body>\n" .
2711 "</html>";
2712 }
2713
2714 sub die_error {
2715 my $status = shift || "403 Forbidden";
2716 my $error = shift || "Malformed query, file missing or permission denied";
2717
2718 git_header_html($status);
2719 print <<EOF;
2720 <div class="page_body">
2721 <br /><br />
2722 $status - $error
2723 <br />
2724 </div>
2725 EOF
2726 git_footer_html();
2727 exit;
2728 }
2729
2730 ## ----------------------------------------------------------------------
2731 ## functions printing or outputting HTML: navigation
2732
2733 sub git_print_page_nav {
2734 my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
2735 $extra = '' if !defined $extra; # pager or formats
2736
2737 my @navs = qw(summary shortlog log commit commitdiff tree);
2738 if ($suppress) {
2739 @navs = grep { $_ ne $suppress } @navs;
2740 }
2741
2742 my %arg = map { $_ => {action=>$_} } @navs;
2743 if (defined $head) {
2744 for (qw(commit commitdiff)) {
2745 $arg{$_}{'hash'} = $head;
2746 }
2747 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
2748 for (qw(shortlog log)) {
2749 $arg{$_}{'hash'} = $head;
2750 }
2751 }
2752 }
2753 $arg{'tree'}{'hash'} = $treehead if defined $treehead;
2754 $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
2755
2756 print "<div class=\"page_nav\">\n" .
2757 (join " | ",
2758 map { $_ eq $current ?
2759 $_ : $cgi->a({-href => href(%{$arg{$_}})}, "$_")
2760 } @navs);
2761 print "<br/>\n$extra<br/>\n" .
2762 "</div>\n";
2763 }
2764
2765 sub format_paging_nav {
2766 my ($action, $hash, $head, $page, $has_next_link) = @_;
2767 my $paging_nav;
2768
2769
2770 if ($hash ne $head || $page) {
2771 $paging_nav .= $cgi->a({-href => href(action=>$action)}, "HEAD");
2772 } else {
2773 $paging_nav .= "HEAD";
2774 }
2775
2776 if ($page > 0) {
2777 $paging_nav .= " &sdot; " .
2778 $cgi->a({-href => href(-replay=>1, page=>$page-1),
2779 -accesskey => "p", -title => "Alt-p"}, "prev");
2780 } else {
2781 $paging_nav .= " &sdot; prev";
2782 }
2783
2784 if ($has_next_link) {
2785 $paging_nav .= " &sdot; " .
2786 $cgi->a({-href => href(-replay=>1, page=>$page+1),
2787 -accesskey => "n", -title => "Alt-n"}, "next");
2788 } else {
2789 $paging_nav .= " &sdot; next";
2790 }
2791
2792 return $paging_nav;
2793 }
2794
2795 ## ......................................................................
2796 ## functions printing or outputting HTML: div
2797
2798 sub git_print_header_div {
2799 my ($action, $title, $hash, $hash_base) = @_;
2800 my %args = ();
2801
2802 $args{'action'} = $action;
2803 $args{'hash'} = $hash if $hash;
2804 $args{'hash_base'} = $hash_base if $hash_base;
2805
2806 print "<div class=\"header\">\n" .
2807 $cgi->a({-href => href(%args), -class => "title"},
2808 $title ? $title : $action) .
2809 "\n</div>\n";
2810 }
2811
2812 #sub git_print_authorship (\%) {
2813 sub git_print_authorship {
2814 my $co = shift;
2815
2816 my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
2817 print "<div class=\"author_date\">" .
2818 esc_html($co->{'author_name'}) .
2819 " [$ad{'rfc2822'}";
2820 if ($ad{'hour_local'} < 6) {
2821 printf(" (<span class=\"atnight\">%02d:%02d</span> %s)",
2822 $ad{'hour_local'}, $ad{'minute_local'}, $ad{'tz_local'});
2823 } else {
2824 printf(" (%02d:%02d %s)",
2825 $ad{'hour_local'}, $ad{'minute_local'}, $ad{'tz_local'});
2826 }
2827 print "]</div>\n";
2828 }
2829
2830 sub git_print_page_path {
2831 my $name = shift;
2832 my $type = shift;
2833 my $hb = shift;
2834
2835
2836 print "<div class=\"page_path\">";
2837 print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
2838 -title => 'tree root'}, to_utf8("[$project]"));
2839 print " / ";
2840 if (defined $name) {
2841 my @dirname = split '/', $name;
2842 my $basename = pop @dirname;
2843 my $fullname = '';
2844
2845 foreach my $dir (@dirname) {
2846 $fullname .= ($fullname ? '/' : '') . $dir;
2847 print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
2848 hash_base=>$hb),
2849 -title => $fullname}, esc_path($dir));
2850 print " / ";
2851 }
2852 if (defined $type && $type eq 'blob') {
2853 print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
2854 hash_base=>$hb),
2855 -title => $name}, esc_path($basename));
2856 } elsif (defined $type && $type eq 'tree') {
2857 print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
2858 hash_base=>$hb),
2859 -title => $name}, esc_path($basename));
2860 print " / ";
2861 } else {
2862 print esc_path($basename);
2863 }
2864 }
2865 print "<br/></div>\n";
2866 }
2867
2868 # sub git_print_log (\@;%) {
2869 sub git_print_log ($;%) {
2870 my $log = shift;
2871 my %opts = @_;
2872
2873 if ($opts{'-remove_title'}) {
2874 # remove title, i.e. first line of log
2875 shift @$log;
2876 }
2877 # remove leading empty lines
2878 while (defined $log->[0] && $log->[0] eq "") {
2879 shift @$log;
2880 }
2881
2882 # print log
2883 my $signoff = 0;
2884 my $empty = 0;
2885 foreach my $line (@$log) {
2886 if ($line =~ m/^ *(signed[ \-]off[ \-]by[ :]|acked[ \-]by[ :]|cc[ :])/i) {
2887 $signoff = 1;
2888 $empty = 0;
2889 if (! $opts{'-remove_signoff'}) {
2890 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
2891 next;
2892 } else {
2893 # remove signoff lines
2894 next;
2895 }
2896 } else {
2897 $signoff = 0;
2898 }
2899
2900 # print only one empty line
2901 # do not print empty line after signoff
2902 if ($line eq "") {
2903 next if ($empty || $signoff);
2904 $empty = 1;
2905 } else {
2906 $empty = 0;
2907 }
2908
2909 print format_log_line_html($line) . "<br/>\n";
2910 }
2911
2912 if ($opts{'-final_empty_line'}) {
2913 # end with single empty line
2914 print "<br/>\n" unless $empty;
2915 }
2916 }
2917
2918 # return link target (what link points to)
2919 sub git_get_link_target {
2920 my $hash = shift;
2921 my $link_target;
2922
2923 # read link
2924 open my $fd, "-|", git_cmd(), "cat-file", "blob", $hash
2925 or return;
2926 {
2927 local $/;
2928 $link_target = <$fd>;
2929 }
2930 close $fd
2931 or return;
2932
2933 return $link_target;
2934 }
2935
2936 # given link target, and the directory (basedir) the link is in,
2937 # return target of link relative to top directory (top tree);
2938 # return undef if it is not possible (including absolute links).
2939 sub normalize_link_target {
2940 my ($link_target, $basedir, $hash_base) = @_;
2941
2942 # we can normalize symlink target only if $hash_base is provided
2943 return unless $hash_base;
2944
2945 # absolute symlinks (beginning with '/') cannot be normalized
2946 return if (substr($link_target, 0, 1) eq '/');
2947
2948 # normalize link target to path from top (root) tree (dir)
2949 my $path;
2950 if ($basedir) {
2951 $path = $basedir . '/' . $link_target;
2952 } else {
2953 # we are in top (root) tree (dir)
2954 $path = $link_target;
2955 }
2956
2957 # remove //, /./, and /../
2958 my @path_parts;
2959 foreach my $part (split('/', $path)) {
2960 # discard '.' and ''
2961 next if (!$part || $part eq '.');
2962 # handle '..'
2963 if ($part eq '..') {
2964 if (@path_parts) {
2965 pop @path_parts;
2966 } else {
2967 # link leads outside repository (outside top dir)
2968 return;
2969 }
2970 } else {
2971 push @path_parts, $part;
2972 }
2973 }
2974 $path = join('/', @path_parts);
2975
2976 return $path;
2977 }
2978
2979 # print tree entry (row of git_tree), but without encompassing <tr> element
2980 sub git_print_tree_entry {
2981 my ($t, $basedir, $hash_base, $have_blame) = @_;
2982
2983 my %base_key = ();
2984 $base_key{'hash_base'} = $hash_base if defined $hash_base;
2985
2986 # The format of a table row is: mode list link. Where mode is
2987 # the mode of the entry, list is the name of the entry, an href,
2988 # and link is the action links of the entry.
2989
2990 print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
2991 if ($t->{'type'} eq "blob") {
2992 print "<td class=\"list\">" .
2993 $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
2994 file_name=>"$basedir$t->{'name'}", %base_key),
2995 -class => "list"}, esc_path($t->{'name'}));
2996 if (S_ISLNK(oct $t->{'mode'})) {
2997 my $link_target = git_get_link_target($t->{'hash'});
2998 if ($link_target) {
2999 my $norm_target = normalize_link_target($link_target, $basedir, $hash_base);
3000 if (defined $norm_target) {
3001 print " -> " .
3002 $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
3003 file_name=>$norm_target),
3004 -title => $norm_target}, esc_path($link_target));
3005 } else {
3006 print " -> " . esc_path($link_target);
3007 }
3008 }
3009 }
3010 print "</td>\n";
3011 print "<td class=\"link\">";
3012 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
3013 file_name=>"$basedir$t->{'name'}", %base_key)},
3014 "blob");
3015 if ($have_blame) {
3016 print " | " .
3017 $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
3018 file_name=>"$basedir$t->{'name'}", %base_key)},
3019 "blame");
3020 }
3021 if (defined $hash_base) {
3022 print " | " .
3023 $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
3024 hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
3025 "history");
3026 }
3027 print " | " .
3028 $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
3029 file_name=>"$basedir$t->{'name'}")},
3030 "raw");
3031 print "</td>\n";
3032
3033 } elsif ($t->{'type'} eq "tree") {
3034 print "<td class=\"list\">";
3035 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
3036 file_name=>"$basedir$t->{'name'}", %base_key)},
3037 esc_path($t->{'name'}));
3038 print "</td>\n";
3039 print "<td class=\"link\">";
3040 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
3041 file_name=>"$basedir$t->{'name'}", %base_key)},
3042 "tree");
3043 if (defined $hash_base) {
3044 print " | " .
3045 $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
3046 file_name=>"$basedir$t->{'name'}")},
3047 "history");
3048 }
3049 print "</td>\n";
3050 } else {
3051 # unknown object: we can only present history for it
3052 # (this includes 'commit' object, i.e. submodule support)
3053 print "<td class=\"list\">" .
3054 esc_path($t->{'name'}) .
3055 "</td>\n";
3056 print "<td class=\"link\">";
3057 if (defined $hash_base) {
3058 print $cgi->a({-href => href(action=>"history",
3059 hash_base=>$hash_base,
3060 file_name=>"$basedir$t->{'name'}")},
3061 "history");
3062 }
3063 print "</td>\n";
3064 }
3065 }
3066
3067 ## ......................................................................
3068 ## functions printing large fragments of HTML
3069
3070 # get pre-image filenames for merge (combined) diff
3071 sub fill_from_file_info {
3072 my ($diff, @parents) = @_;
3073
3074 $diff->{'from_file'} = [ ];
3075 $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
3076 for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
3077 if ($diff->{'status'}[$i] eq 'R' ||
3078 $diff->{'status'}[$i] eq 'C') {
3079 $diff->{'from_file'}[$i] =
3080 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
3081 }
3082 }
3083
3084 return $diff;
3085 }
3086
3087 # is current raw difftree line of file deletion
3088 sub is_deleted {
3089 my $diffinfo = shift;
3090
3091 return $diffinfo->{'to_id'} eq ('0' x 40);
3092 }
3093
3094 # does patch correspond to [previous] difftree raw line
3095 # $diffinfo - hashref of parsed raw diff format
3096 # $patchinfo - hashref of parsed patch diff format
3097 # (the same keys as in $diffinfo)
3098 sub is_patch_split {
3099 my ($diffinfo, $patchinfo) = @_;
3100
3101 return defined $diffinfo && defined $patchinfo
3102 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
3103 }
3104
3105
3106 sub git_difftree_body {
3107 my ($difftree, $hash, @parents) = @_;
3108 my ($parent) = $parents[0];
3109 my ($have_blame) = gitweb_check_feature('blame');
3110 print "<div class=\"list_head\">\n";
3111 if ($#{$difftree} > 10) {
3112 print(($#{$difftree} + 1) . " files changed:\n");
3113 }
3114 print "</div>\n";
3115
3116 print "<table class=\"" .
3117 (@parents > 1 ? "combined " : "") .
3118 "diff_tree\">\n";
3119
3120 # header only for combined diff in 'commitdiff' view
3121 my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
3122 if ($has_header) {
3123 # table header
3124 print "<thead><tr>\n" .
3125 "<th></th><th></th>\n"; # filename, patchN link
3126 for (my $i = 0; $i < @parents; $i++) {
3127 my $par = $parents[$i];
3128 print "<th>" .
3129 $cgi->a({-href => href(action=>"commitdiff",
3130 hash=>$hash, hash_parent=>$par),
3131 -title => 'commitdiff to parent number ' .
3132 ($i+1) . ': ' . substr($par,0,7)},
3133 $i+1) .
3134 "&nbsp;</th>\n";
3135 }
3136 print "</tr></thead>\n<tbody>\n";
3137 }
3138
3139 my $alternate = 1;
3140 my $patchno = 0;
3141 foreach my $line (@{$difftree}) {
3142 my $diff = parsed_difftree_line($line);
3143
3144 if ($alternate) {
3145 print "<tr class=\"dark\">\n";
3146 } else {
3147 print "<tr class=\"light\">\n";
3148 }
3149 $alternate ^= 1;
3150
3151 if (exists $diff->{'nparents'}) { # combined diff
3152
3153 fill_from_file_info($diff, @parents)
3154 unless exists $diff->{'from_file'};
3155
3156 if (!is_deleted($diff)) {
3157 # file exists in the result (child) commit
3158 print "<td>" .
3159 $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
3160 file_name=>$diff->{'to_file'},
3161 hash_base=>$hash),
3162 -class => "list"}, esc_path($diff->{'to_file'})) .
3163 "</td>\n";
3164 } else {
3165 print "<td>" .
3166 esc_path($diff->{'to_file'}) .
3167 "</td>\n";
3168 }
3169
3170 if ($action eq 'commitdiff') {
3171 # link to patch
3172 $patchno++;
3173 print "<td class=\"link\">" .
3174 $cgi->a({-href => "#patch$patchno"}, "patch") .
3175 " | " .
3176 "</td>\n";
3177 }
3178
3179 my $has_history = 0;
3180 my $not_deleted = 0;
3181 for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
3182 my $hash_parent = $parents[$i];
3183 my $from_hash = $diff->{'from_id'}[$i];
3184 my $from_path = $diff->{'from_file'}[$i];
3185 my $status = $diff->{'status'}[$i];
3186
3187 $has_history ||= ($status ne 'A');
3188 $not_deleted ||= ($status ne 'D');
3189
3190 if ($status eq 'A') {
3191 print "<td class=\"link\" align=\"right\"> | </td>\n";
3192 } elsif ($status eq 'D') {
3193 print "<td class=\"link\">" .
3194 $cgi->a({-href => href(action=>"blob",
3195 hash_base=>$hash,
3196 hash=>$from_hash,
3197 file_name=>$from_path)},
3198 "blob" . ($i+1)) .
3199 " | </td>\n";
3200 } else {
3201 if ($diff->{'to_id'} eq $from_hash) {
3202 print "<td class=\"link nochange\">";
3203 } else {
3204 print "<td class=\"link\">";
3205 }
3206 print $cgi->a({-href => href(action=>"blobdiff",
3207 hash=>$diff->{'to_id'},
3208 hash_parent=>$from_hash,
3209 hash_base=>$hash,
3210 hash_parent_base=>$hash_parent,
3211 file_name=>$diff->{'to_file'},
3212 file_parent=>$from_path)},
3213 "diff" . ($i+1)) .
3214 " | </td>\n";
3215 }
3216 }
3217
3218 print "<td class=\"link\">";
3219 if ($not_deleted) {
3220 print $cgi->a({-href => href(action=>"blob",
3221 hash=>$diff->{'to_id'},
3222 file_name=>$diff->{'to_file'},
3223 hash_base=>$hash)},
3224 "blob");
3225 print " | " if ($has_history);
3226 }
3227 if ($has_history) {
3228 print $cgi->a({-href => href(action=>"history",
3229 file_name=>$diff->{'to_file'},
3230 hash_base=>$hash)},
3231 "history");
3232 }
3233 print "</td>\n";
3234
3235 print "</tr>\n";
3236 next; # instead of 'else' clause, to avoid extra indent
3237 }
3238 # else ordinary diff
3239
3240 my ($to_mode_oct, $to_mode_str, $to_file_type);
3241 my ($from_mode_oct, $from_mode_str, $from_file_type);
3242 if ($diff->{'to_mode'} ne ('0' x 6)) {
3243 $to_mode_oct = oct $diff->{'to_mode'};
3244 if (S_ISREG($to_mode_oct)) { # only for regular file
3245 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
3246 }
3247 $to_file_type = file_type($diff->{'to_mode'});
3248 }
3249 if ($diff->{'from_mode'} ne ('0' x 6)) {
3250 $from_mode_oct = oct $diff->{'from_mode'};
3251 if (S_ISREG($to_mode_oct)) { # only for regular file
3252 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
3253 }
3254 $from_file_type = file_type($diff->{'from_mode'});
3255 }
3256
3257 if ($diff->{'status'} eq "A") { # created
3258 my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
3259 $mode_chng .= " with mode: $to_mode_str" if $to_mode_str;
3260 $mode_chng .= "]</span>";
3261 print "<td>";
3262 print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
3263 hash_base=>$hash, file_name=>$diff->{'file'}),
3264 -class => "list"}, esc_path($diff->{'file'}));
3265 print "</td>\n";
3266 print "<td>$mode_chng</td>\n";
3267 print "<td class=\"link\">";
3268 if ($action eq 'commitdiff') {
3269 # link to patch
3270 $patchno++;
3271 print $cgi->a({-href => "#patch$patchno"}, "patch");
3272 print " | ";
3273 }
3274 print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
3275 hash_base=>$hash, file_name=>$diff->{'file'})},
3276 "blob");
3277 print "</td>\n";
3278
3279 } elsif ($diff->{'status'} eq "D") { # deleted
3280 my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
3281 print "<td>";
3282 print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
3283 hash_base=>$parent, file_name=>$diff->{'file'}),
3284 -class => "list"}, esc_path($diff->{'file'}));
3285 print "</td>\n";
3286 print "<td>$mode_chng</td>\n";
3287 print "<td class=\"link\">";
3288 if ($action eq 'commitdiff') {
3289 # link to patch
3290 $patchno++;
3291 print $cgi->a({-href => "#patch$patchno"}, "patch");
3292 print " | ";
3293 }
3294 print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
3295 hash_base=>$parent, file_name=>$diff->{'file'})},
3296 "blob") . " | ";
3297 if ($have_blame) {
3298 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
3299 file_name=>$diff->{'file'})},
3300 "blame") . " | ";
3301 }
3302 print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
3303 file_name=>$diff->{'file'})},
3304 "history");
3305 print "</td>\n";
3306
3307 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
3308 my $mode_chnge = "";
3309 if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
3310 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
3311 if ($from_file_type ne $to_file_type) {
3312 $mode_chnge .= " from $from_file_type to $to_file_type";
3313 }
3314 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
3315 if ($from_mode_str && $to_mode_str) {
3316 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
3317 } elsif ($to_mode_str) {
3318 $mode_chnge .= " mode: $to_mode_str";
3319 }
3320 }
3321 $mode_chnge .= "]</span>\n";
3322 }
3323 print "<td&