gitweb/gitweb.perl

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