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