git.oblomov.eu Git - git/blob - gitweb/gitweb.perl

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