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&