Lady’s Gitweb - Gitweb/blob - gitweb.perl

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