gitweb/gitweb.perl

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