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