gitweb/gitweb.perl

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