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