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