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 overridden 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',   # carriage 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'} = esc_attr(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'} = esc_attr(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),
4074                        esc_attr(href(project=>undef, action=>"project_index")));
4075                 printf('<link rel="alternate" title="%s projects feeds" '.
4076                        'href="%s" type="text/x-opml" />'."\n",
4077                        esc_attr($site_name),
4078                        esc_attr(href(project=>undef, action=>"opml")));
4079         }
4080 }
4081
4082 sub print_header_links {
4083         my $status = shift;
4084
4085         # print out each stylesheet that exist, providing backwards capability
4086         # for those people who defined $stylesheet in a config file
4087         if (defined $stylesheet) {
4088                 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4089         } else {
4090                 foreach my $stylesheet (@stylesheets) {
4091                         next unless $stylesheet;
4092                         print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4093                 }
4094         }
4095         print_feed_meta()
4096                 if ($status eq '200 OK');
4097         if (defined $favicon) {
4098                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
4099         }
4100 }
4101
4102 sub print_nav_breadcrumbs_path {
4103         my $dirprefix = undef;
4104         while (my $part = shift) {
4105                 $dirprefix .= "/" if defined $dirprefix;
4106                 $dirprefix .= $part;
4107                 print $cgi->a({-href => href(project => undef,
4108                                              project_filter => $dirprefix,
4109                                              action => "project_list")},
4110                               esc_html($part)) . " / ";
4111         }
4112 }
4113
4114 sub print_nav_breadcrumbs {
4115         my %opts = @_;
4116
4117         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
4118                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
4119         }
4120         if (defined $project) {
4121                 my @dirname = split '/', $project;
4122                 my $projectbasename = pop @dirname;
4123                 print_nav_breadcrumbs_path(@dirname);
4124                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
4125                 if (defined $action) {
4126                         my $action_print = $action ;
4127                         if (defined $opts{-action_extra}) {
4128                                 $action_print = $cgi->a({-href => href(action=>$action)},
4129                                         $action);
4130                         }
4131                         print " / $action_print";
4132                 }
4133                 if (defined $opts{-action_extra}) {
4134                         print " / $opts{-action_extra}";
4135                 }
4136                 print "\n";
4137         } elsif (defined $project_filter) {
4138                 print_nav_breadcrumbs_path(split '/', $project_filter);
4139         }
4140 }
4141
4142 sub print_search_form {
4143         if (!defined $searchtext) {
4144                 $searchtext = "";
4145         }
4146         my $search_hash;
4147         if (defined $hash_base) {
4148                 $search_hash = $hash_base;
4149         } elsif (defined $hash) {
4150                 $search_hash = $hash;
4151         } else {
4152                 $search_hash = "HEAD";
4153         }
4154         my $action = $my_uri;
4155         my $use_pathinfo = gitweb_check_feature('pathinfo');
4156         if ($use_pathinfo) {
4157                 $action .= "/".esc_url($project);
4158         }
4159         print $cgi->start_form(-method => "get", -action => $action) .
4160               "<div class=\"search\">\n" .
4161               (!$use_pathinfo &&
4162               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
4163               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
4164               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
4165               $cgi->popup_menu(-name => 'st', -default => 'commit',
4166                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
4167               " " . $cgi->a({-href => href(action=>"search_help"),
4168                              -title => "search help" }, "?") . " search:\n",
4169               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
4170               "<span title=\"Extended regular expression\">" .
4171               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
4172                              -checked => $search_use_regexp) .
4173               "</span>" .
4174               "</div>" .
4175               $cgi->end_form() . "\n";
4176 }
4177
4178 sub git_header_html {
4179         my $status = shift || "200 OK";
4180         my $expires = shift;
4181         my %opts = @_;
4182
4183         my $title = get_page_title();
4184         my $content_type = get_content_type_html();
4185         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
4186                            -status=> $status, -expires => $expires)
4187                 unless ($opts{'-no_http_header'});
4188         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
4189         print <<EOF;
4190 <?xml version="1.0" encoding="utf-8"?>
4191 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
4192 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
4193 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
4194 <!-- git core binaries version $git_version -->
4195 <head>
4196 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
4197 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
4198 <meta name="robots" content="index, nofollow"/>
4199 <title>$title</title>
4200 EOF
4201         # the stylesheet, favicon etc urls won't work correctly with path_info
4202         # unless we set the appropriate base URL
4203         if ($ENV{'PATH_INFO'}) {
4204                 print "<base href=\"".esc_url($base_url)."\" />\n";
4205         }
4206         print_header_links($status);
4207
4208         if (defined $site_html_head_string) {
4209                 print to_utf8($site_html_head_string);
4210         }
4211
4212         print "</head>\n" .
4213               "<body>\n";
4214
4215         if (defined $site_header && -f $site_header) {
4216                 insert_file($site_header);
4217         }
4218
4219         print "<div class=\"page_header\">\n";
4220         if (defined $logo) {
4221                 print $cgi->a({-href => esc_url($logo_url),
4222                                -title => $logo_label},
4223                               $cgi->img({-src => esc_url($logo),
4224                                          -width => 72, -height => 27,
4225                                          -alt => "git",
4226                                          -class => "logo"}));
4227         }
4228         print_nav_breadcrumbs(%opts);
4229         print "</div>\n";
4230
4231         my $have_search = gitweb_check_feature('search');
4232         if (defined $project && $have_search) {
4233                 print_search_form();
4234         }
4235 }
4236
4237 sub git_footer_html {
4238         my $feed_class = 'rss_logo';
4239
4240         print "<div class=\"page_footer\">\n";
4241         if (defined $project) {
4242                 my $descr = git_get_project_description($project);
4243                 if (defined $descr) {
4244                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
4245                 }
4246
4247                 my %href_params = get_feed_info();
4248                 if (!%href_params) {
4249                         $feed_class .= ' generic';
4250                 }
4251                 $href_params{'-title'} ||= 'log';
4252
4253                 foreach my $format (qw(RSS Atom)) {
4254                         $href_params{'action'} = lc($format);
4255                         print $cgi->a({-href => href(%href_params),
4256                                       -title => "$href_params{'-title'} $format feed",
4257                                       -class => $feed_class}, $format)."\n";
4258                 }
4259
4260         } else {
4261                 print $cgi->a({-href => href(project=>undef, action=>"opml",
4262                                              project_filter => $project_filter),
4263                               -class => $feed_class}, "OPML") . " ";
4264                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
4265                                              project_filter => $project_filter),
4266                               -class => $feed_class}, "TXT") . "\n";
4267         }
4268         print "</div>\n"; # class="page_footer"
4269
4270         if (defined $t0 && gitweb_check_feature('timed')) {
4271                 print "<div id=\"generating_info\">\n";
4272                 print 'This page took '.
4273                       '<span id="generating_time" class="time_span">'.
4274                       tv_interval($t0, [ gettimeofday() ]).
4275                       ' seconds </span>'.
4276                       ' and '.
4277                       '<span id="generating_cmd">'.
4278                       $number_of_git_cmds.
4279                       '</span> git commands '.
4280                       " to generate.\n";
4281                 print "</div>\n"; # class="page_footer"
4282         }
4283
4284         if (defined $site_footer && -f $site_footer) {
4285                 insert_file($site_footer);
4286         }
4287
4288         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
4289         if (defined $action &&
4290             $action eq 'blame_incremental') {
4291                 print qq!<script type="text/javascript">\n!.
4292                       qq!startBlame("!. esc_attr(href(action=>"blame_data", -replay=>1)) .qq!",\n!.
4293                       qq!           "!. esc_attr(href()) .qq!");\n!.
4294                       qq!</script>\n!;
4295         } else {
4296                 my ($jstimezone, $tz_cookie, $datetime_class) =
4297                         gitweb_get_feature('javascript-timezone');
4298
4299                 print qq!<script type="text/javascript">\n!.
4300                       qq!window.onload = function () {\n!;
4301                 if (gitweb_check_feature('javascript-actions')) {
4302                         print qq!       fixLinks();\n!;
4303                 }
4304                 if ($jstimezone && $tz_cookie && $datetime_class) {
4305                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
4306                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
4307                 }
4308                 print qq!};\n!.
4309                       qq!</script>\n!;
4310         }
4311
4312         print "</body>\n" .
4313               "</html>";
4314 }
4315
4316 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
4317 # Example: die_error(404, 'Hash not found')
4318 # By convention, use the following status codes (as defined in RFC 2616):
4319 # 400: Invalid or missing CGI parameters, or
4320 #      requested object exists but has wrong type.
4321 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
4322 #      this server or project.
4323 # 404: Requested object/revision/project doesn't exist.
4324 # 500: The server isn't configured properly, or
4325 #      an internal error occurred (e.g. failed assertions caused by bugs), or
4326 #      an unknown error occurred (e.g. the git binary died unexpectedly).
4327 # 503: The server is currently unavailable (because it is overloaded,
4328 #      or down for maintenance).  Generally, this is a temporary state.
4329 sub die_error {
4330         my $status = shift || 500;
4331         my $error = esc_html(shift) || "Internal Server Error";
4332         my $extra = shift;
4333         my %opts = @_;
4334
4335         my %http_responses = (
4336                 400 => '400 Bad Request',
4337                 403 => '403 Forbidden',
4338                 404 => '404 Not Found',
4339                 500 => '500 Internal Server Error',
4340                 503 => '503 Service Unavailable',
4341         );
4342         git_header_html($http_responses{$status}, undef, %opts);
4343         print <<EOF;
4344 <div class="page_body">
4345 <br /><br />
4346 $status - $error
4347 <br />
4348 EOF
4349         if (defined $extra) {
4350                 print "<hr />\n" .
4351                       "$extra\n";
4352         }
4353         print "</div>\n";
4354
4355         git_footer_html();
4356         goto DONE_GITWEB
4357                 unless ($opts{'-error_handler'});
4358 }
4359
4360 ## ----------------------------------------------------------------------
4361 ## functions printing or outputting HTML: navigation
4362
4363 sub git_print_page_nav {
4364         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
4365         $extra = '' if !defined $extra; # pager or formats
4366
4367         my @navs = qw(summary shortlog log commit commitdiff tree);
4368         if ($suppress) {
4369                 @navs = grep { $_ ne $suppress } @navs;
4370         }
4371
4372         my %arg = map { $_ => {action=>$_} } @navs;
4373         if (defined $head) {
4374                 for (qw(commit commitdiff)) {
4375                         $arg{$_}{'hash'} = $head;
4376                 }
4377                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
4378                         for (qw(shortlog log)) {
4379                                 $arg{$_}{'hash'} = $head;
4380                         }
4381                 }
4382         }
4383
4384         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
4385         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
4386
4387         my @actions = gitweb_get_feature('actions');
4388         my %repl = (
4389                 '%' => '%',
4390                 'n' => $project,         # project name
4391                 'f' => $git_dir,         # project path within filesystem
4392                 'h' => $treehead || '',  # current hash ('h' parameter)
4393                 'b' => $treebase || '',  # hash base ('hb' parameter)
4394         );
4395         while (@actions) {
4396                 my ($label, $link, $pos) = splice(@actions,0,3);
4397                 # insert
4398                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
4399                 # munch munch
4400                 $link =~ s/%([%nfhb])/$repl{$1}/g;
4401                 $arg{$label}{'_href'} = $link;
4402         }
4403
4404         print "<div class=\"page_nav\">\n" .
4405                 (join " | ",
4406                  map { $_ eq $current ?
4407                        $_ : $cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_")
4408                  } @navs);
4409         print "<br/>\n$extra<br/>\n" .
4410               "</div>\n";
4411 }
4412
4413 # returns a submenu for the navigation of the refs views (tags, heads,
4414 # remotes) with the current view disabled and the remotes view only
4415 # available if the feature is enabled
4416 sub format_ref_views {
4417         my ($current) = @_;
4418         my @ref_views = qw{tags heads};
4419         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
4420         return join " | ", map {
4421                 $_ eq $current ? $_ :
4422                 $cgi->a({-href => href(action=>$_)}, $_)
4423         } @ref_views
4424 }
4425
4426 sub format_paging_nav {
4427         my ($action, $page, $has_next_link) = @_;
4428         my $paging_nav;
4429
4430
4431         if ($page > 0) {
4432                 $paging_nav .=
4433                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first") .
4434                         " &sdot; " .
4435                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
4436                                  -accesskey => "p", -title => "Alt-p"}, "prev");
4437         } else {
4438                 $paging_nav .= "first &sdot; prev";
4439         }
4440
4441         if ($has_next_link) {
4442                 $paging_nav .= " &sdot; " .
4443                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
4444                                  -accesskey => "n", -title => "Alt-n"}, "next");
4445         } else {
4446                 $paging_nav .= " &sdot; next";
4447         }
4448
4449         return $paging_nav;
4450 }
4451
4452 ## ......................................................................
4453 ## functions printing or outputting HTML: div
4454
4455 sub git_print_header_div {
4456         my ($action, $title, $hash, $hash_base) = @_;
4457         my %args = ();
4458
4459         $args{'action'} = $action;
4460         $args{'hash'} = $hash if $hash;
4461         $args{'hash_base'} = $hash_base if $hash_base;
4462
4463         print "<div class=\"header\">\n" .
4464               $cgi->a({-href => href(%args), -class => "title"},
4465               $title ? $title : $action) .
4466               "\n</div>\n";
4467 }
4468
4469 sub format_repo_url {
4470         my ($name, $url) = @_;
4471         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
4472 }
4473
4474 # Group output by placing it in a DIV element and adding a header.
4475 # Options for start_div() can be provided by passing a hash reference as the
4476 # first parameter to the function.
4477 # Options to git_print_header_div() can be provided by passing an array
4478 # reference. This must follow the options to start_div if they are present.
4479 # The content can be a scalar, which is output as-is, a scalar reference, which
4480 # is output after html escaping, an IO handle passed either as *handle or
4481 # *handle{IO}, or a function reference. In the latter case all following
4482 # parameters will be taken as argument to the content function call.
4483 sub git_print_section {
4484         my ($div_args, $header_args, $content);
4485         my $arg = shift;
4486         if (ref($arg) eq 'HASH') {
4487                 $div_args = $arg;
4488                 $arg = shift;
4489         }
4490         if (ref($arg) eq 'ARRAY') {
4491                 $header_args = $arg;
4492                 $arg = shift;
4493         }
4494         $content = $arg;
4495
4496         print $cgi->start_div($div_args);
4497         git_print_header_div(@$header_args);
4498
4499         if (ref($content) eq 'CODE') {
4500                 $content->(@_);
4501         } elsif (ref($content) eq 'SCALAR') {
4502                 print esc_html($$content);
4503         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
4504                 print <$content>;
4505         } elsif (!ref($content) && defined($content)) {
4506                 print $content;
4507         }
4508
4509         print $cgi->end_div;
4510 }
4511
4512 sub format_timestamp_html {
4513         my $date = shift;
4514         my $strtime = $date->{'rfc2822'};
4515
4516         my (undef, undef, $datetime_class) =
4517                 gitweb_get_feature('javascript-timezone');
4518         if ($datetime_class) {
4519                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
4520         }
4521
4522         my $localtime_format = '(%02d:%02d %s)';
4523         if ($date->{'hour_local'} < 6) {
4524                 $localtime_format = '(<span class="atnight">%02d:%02d</span> %s)';
4525         }
4526         $strtime .= ' ' .
4527                     sprintf($localtime_format,
4528                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
4529
4530         return $strtime;
4531 }
4532
4533 # Outputs the author name and date in long form
4534 sub git_print_authorship {
4535         my $co = shift;
4536         my %opts = @_;
4537         my $tag = $opts{-tag} || 'div';
4538         my $author = $co->{'author_name'};
4539
4540         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
4541         print "<$tag class=\"author_date\">" .
4542               format_search_author($author, "author", esc_html($author)) .
4543               " [".format_timestamp_html(\%ad)."]".
4544               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
4545               "</$tag>\n";
4546 }
4547
4548 # Outputs table rows containing the full author or committer information,
4549 # in the format expected for 'commit' view (& similar).
4550 # Parameters are a commit hash reference, followed by the list of people
4551 # to output information for. If the list is empty it defaults to both
4552 # author and committer.
4553 sub git_print_authorship_rows {
4554         my $co = shift;
4555         # too bad we can't use @people = @_ || ('author', 'committer')
4556         my @people = @_;
4557         @people = ('author', 'committer') unless @people;
4558         foreach my $who (@people) {
4559                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
4560                 print "<tr><td>$who</td><td>" .
4561                       format_search_author($co->{"${who}_name"}, $who,
4562                                            esc_html($co->{"${who}_name"})) . " " .
4563                       format_search_author($co->{"${who}_email"}, $who,
4564                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
4565                       "</td><td rowspan=\"2\">" .
4566                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
4567                       "</td></tr>\n" .
4568                       "<tr>" .
4569                       "<td></td><td>" .
4570                       format_timestamp_html(\%wd) .
4571                       "</td>" .
4572                       "</tr>\n";
4573         }
4574 }
4575
4576 sub git_print_page_path {
4577         my $name = shift;
4578         my $type = shift;
4579         my $hb = shift;
4580
4581
4582         print "<div class=\"page_path\">";
4583         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
4584                       -title => 'tree root'}, to_utf8("[$project]"));
4585         print " / ";
4586         if (defined $name) {
4587                 my @dirname = split '/', $name;
4588                 my $basename = pop @dirname;
4589                 my $fullname = '';
4590
4591                 foreach my $dir (@dirname) {
4592                         $fullname .= ($fullname ? '/' : '') . $dir;
4593                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
4594                                                      hash_base=>$hb),
4595                                       -title => $fullname}, esc_path($dir));
4596                         print " / ";
4597                 }
4598                 if (defined $type && $type eq 'blob') {
4599                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
4600                                                      hash_base=>$hb),
4601                                       -title => $name}, esc_path($basename));
4602                 } elsif (defined $type && $type eq 'tree') {
4603                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
4604                                                      hash_base=>$hb),
4605                                       -title => $name}, esc_path($basename));
4606                         print " / ";
4607                 } else {
4608                         print esc_path($basename);
4609                 }
4610         }
4611         print "<br/></div>\n";
4612 }
4613
4614 sub git_print_log {
4615         my $log = shift;
4616         my %opts = @_;
4617
4618         if ($opts{'-remove_title'}) {
4619                 # remove title, i.e. first line of log
4620                 shift @$log;
4621         }
4622         # remove leading empty lines
4623         while (defined $log->[0] && $log->[0] eq "") {
4624                 shift @$log;
4625         }
4626
4627         # print log
4628         my $skip_blank_line = 0;
4629         foreach my $line (@$log) {
4630                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
4631                         if (! $opts{'-remove_signoff'}) {
4632                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
4633                                 $skip_blank_line = 1;
4634                         }
4635                         next;
4636                 }
4637
4638                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
4639                         if (! $opts{'-remove_signoff'}) {
4640                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
4641                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
4642                                         "</span><br/>\n";
4643                                 $skip_blank_line = 1;
4644                         }
4645                         next;
4646                 }
4647
4648                 # print only one empty line
4649                 # do not print empty line after signoff
4650                 if ($line eq "") {
4651                         next if ($skip_blank_line);
4652                         $skip_blank_line = 1;
4653                 } else {
4654                         $skip_blank_line = 0;
4655                 }
4656
4657                 print format_log_line_html($line) . "<br/>\n";
4658         }
4659
4660         if ($opts{'-final_empty_line'}) {
4661                 # end with single empty line
4662                 print "<br/>\n" unless $skip_blank_line;
4663         }
4664 }
4665
4666 # return link target (what link points to)
4667 sub git_get_link_target {
4668         my $hash = shift;
4669         my $link_target;
4670
4671         # read link
4672         open my $fd, "-|", git_cmd(), "cat-file", "blob", $hash
4673                 or return;
4674         {
4675                 local $/ = undef;
4676                 $link_target = <$fd>;
4677         }
4678         close $fd
4679                 or return;
4680
4681         return $link_target;
4682 }
4683
4684 # given link target, and the directory (basedir) the link is in,
4685 # return target of link relative to top directory (top tree);
4686 # return undef if it is not possible (including absolute links).
4687 sub normalize_link_target {
4688         my ($link_target, $basedir) = @_;
4689
4690         # absolute symlinks (beginning with '/') cannot be normalized
4691         return if (substr($link_target, 0, 1) eq '/');
4692
4693         # normalize link target to path from top (root) tree (dir)
4694         my $path;
4695         if ($basedir) {
4696                 $path = $basedir . '/' . $link_target;
4697         } else {
4698                 # we are in top (root) tree (dir)
4699                 $path = $link_target;
4700         }
4701
4702         # remove //, /./, and /../
4703         my @path_parts;
4704         foreach my $part (split('/', $path)) {
4705                 # discard '.' and ''
4706                 next if (!$part || $part eq '.');
4707                 # handle '..'
4708                 if ($part eq '..') {
4709                         if (@path_parts) {
4710                                 pop @path_parts;
4711                         } else {
4712                                 # link leads outside repository (outside top dir)
4713                                 return;
4714                         }
4715                 } else {
4716                         push @path_parts, $part;
4717                 }
4718         }
4719         $path = join('/', @path_parts);
4720
4721         return $path;
4722 }
4723
4724 # print tree entry (row of git_tree), but without encompassing <tr> element
4725 sub git_print_tree_entry {
4726         my ($t, $basedir, $hash_base, $have_blame) = @_;
4727
4728         my %base_key = ();
4729         $base_key{'hash_base'} = $hash_base if defined $hash_base;
4730
4731         # The format of a table row is: mode list link.  Where mode is
4732         # the mode of the entry, list is the name of the entry, an href,
4733         # and link is the action links of the entry.
4734
4735         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
4736         if (exists $t->{'size'}) {
4737                 print "<td class=\"size\">$t->{'size'}</td>\n";
4738         }
4739         if ($t->{'type'} eq "blob") {
4740                 print "<td class=\"list\">" .
4741                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
4742                                                file_name=>"$basedir$t->{'name'}", %base_key),
4743                                 -class => "list"}, esc_path($t->{'name'}));
4744                 if (S_ISLNK(oct $t->{'mode'})) {
4745                         my $link_target = git_get_link_target($t->{'hash'});
4746                         if ($link_target) {
4747                                 my $norm_target = normalize_link_target($link_target, $basedir);
4748                                 if (defined $norm_target) {
4749                                         print " -> " .
4750                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
4751                                                                      file_name=>$norm_target),
4752                                                        -title => $norm_target}, esc_path($link_target));
4753                                 } else {
4754                                         print " -> " . esc_path($link_target);
4755                                 }
4756                         }
4757                 }
4758                 print "</td>\n";
4759                 print "<td class=\"link\">";
4760                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
4761                                              file_name=>"$basedir$t->{'name'}", %base_key)},
4762                               "blob");
4763                 if ($have_blame) {
4764                         print " | " .
4765                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
4766                                                      file_name=>"$basedir$t->{'name'}", %base_key)},
4767                                       "blame");
4768                 }
4769                 if (defined $hash_base) {
4770                         print " | " .
4771                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
4772                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
4773                                       "history");
4774                 }
4775                 print " | " .
4776                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
4777                                                file_name=>"$basedir$t->{'name'}")},
4778                                 "raw");
4779                 print "</td>\n";
4780
4781         } elsif ($t->{'type'} eq "tree") {
4782                 print "<td class=\"list\">";
4783                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
4784                                              file_name=>"$basedir$t->{'name'}",
4785                                              %base_key)},
4786                               esc_path($t->{'name'}));
4787                 print "</td>\n";
4788                 print "<td class=\"link\">";
4789                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
4790                                              file_name=>"$basedir$t->{'name'}",
4791                                              %base_key)},
4792                               "tree");
4793                 if (defined $hash_base) {
4794                         print " | " .
4795                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
4796                                                      file_name=>"$basedir$t->{'name'}")},
4797                                       "history");
4798                 }
4799                 print "</td>\n";
4800         } else {
4801                 # unknown object: we can only present history for it
4802                 # (this includes 'commit' object, i.e. submodule support)
4803                 print "<td class=\"list\">" .
4804                       esc_path($t->{'name'}) .
4805                       "</td>\n";
4806                 print "<td class=\"link\">";
4807                 if (defined $hash_base) {
4808                         print $cgi->a({-href => href(action=>"history",
4809                                                      hash_base=>$hash_base,
4810                                                      file_name=>"$basedir$t->{'name'}")},
4811                                       "history");
4812                 }
4813                 print "</td>\n";
4814         }
4815 }
4816
4817 ## ......................................................................
4818 ## functions printing large fragments of HTML
4819
4820 # get pre-image filenames for merge (combined) diff
4821 sub fill_from_file_info {
4822         my ($diff, @parents) = @_;
4823
4824         $diff->{'from_file'} = [ ];
4825         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
4826         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
4827                 if ($diff->{'status'}[$i] eq 'R' ||
4828                     $diff->{'status'}[$i] eq 'C') {
4829                         $diff->{'from_file'}[$i] =
4830                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
4831                 }
4832         }
4833
4834         return $diff;
4835 }
4836
4837 # is current raw difftree line of file deletion
4838 sub is_deleted {
4839         my $diffinfo = shift;
4840
4841         return $diffinfo->{'to_id'} eq ('0' x 40) || $diffinfo->{'to_id'} eq ('0' x 64);
4842 }
4843
4844 # does patch correspond to [previous] difftree raw line
4845 # $diffinfo  - hashref of parsed raw diff format
4846 # $patchinfo - hashref of parsed patch diff format
4847 #              (the same keys as in $diffinfo)
4848 sub is_patch_split {
4849         my ($diffinfo, $patchinfo) = @_;
4850
4851         return defined $diffinfo && defined $patchinfo
4852                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
4853 }
4854
4855
4856 sub git_difftree_body {
4857         my ($difftree, $hash, @parents) = @_;
4858         my ($parent) = $parents[0];
4859         my $have_blame = gitweb_check_feature('blame');
4860         print "<div class=\"list_head\">\n";
4861         if ($#{$difftree} > 10) {
4862                 print(($#{$difftree} + 1) . " files changed:\n");
4863         }
4864         print "</div>\n";
4865
4866         print "<table class=\"" .
4867               (@parents > 1 ? "combined " : "") .
4868               "diff_tree\">\n";
4869
4870         # header only for combined diff in 'commitdiff' view
4871         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
4872         if ($has_header) {
4873                 # table header
4874                 print "<thead><tr>\n" .
4875                        "<th></th><th></th>\n"; # filename, patchN link
4876                 for (my $i = 0; $i < @parents; $i++) {
4877                         my $par = $parents[$i];
4878                         print "<th>" .
4879                               $cgi->a({-href => href(action=>"commitdiff",
4880                                                      hash=>$hash, hash_parent=>$par),
4881                                        -title => 'commitdiff to parent number ' .
4882                                                   ($i+1) . ': ' . substr($par,0,7)},
4883                                       $i+1) .
4884                               "&nbsp;</th>\n";
4885                 }
4886                 print "</tr></thead>\n<tbody>\n";
4887         }
4888
4889         my $alternate = 1;
4890         my $patchno = 0;
4891         foreach my $line (@{$difftree}) {
4892                 my $diff = parsed_difftree_line($line);
4893
4894                 if ($alternate) {
4895                         print "<tr class=\"dark\">\n";
4896                 } else {
4897                         print "<tr class=\"light\">\n";
4898                 }
4899                 $alternate ^= 1;
4900
4901                 if (exists $diff->{'nparents'}) { # combined diff
4902
4903                         fill_from_file_info($diff, @parents)
4904                                 unless exists $diff->{'from_file'};
4905
4906                         if (!is_deleted($diff)) {
4907                                 # file exists in the result (child) commit
4908                                 print "<td>" .
4909                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
4910                                                              file_name=>$diff->{'to_file'},
4911                                                              hash_base=>$hash),
4912                                               -class => "list"}, esc_path($diff->{'to_file'})) .
4913                                       "</td>\n";
4914                         } else {
4915                                 print "<td>" .
4916                                       esc_path($diff->{'to_file'}) .
4917                                       "</td>\n";
4918                         }
4919
4920                         if ($action eq 'commitdiff') {
4921                                 # link to patch
4922                                 $patchno++;
4923                                 print "<td class=\"link\">" .
4924                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
4925                                               "patch") .
4926                                       " | " .
4927                                       "</td>\n";
4928                         }
4929
4930                         my $has_history = 0;
4931                         my $not_deleted = 0;
4932                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
4933                                 my $hash_parent = $parents[$i];
4934                                 my $from_hash = $diff->{'from_id'}[$i];
4935                                 my $from_path = $diff->{'from_file'}[$i];
4936                                 my $status = $diff->{'status'}[$i];
4937
4938                                 $has_history ||= ($status ne 'A');
4939                                 $not_deleted ||= ($status ne 'D');
4940
4941                                 if ($status eq 'A') {
4942                                         print "<td  class=\"link\" align=\"right\"> | </td>\n";
4943                                 } elsif ($status eq 'D') {
4944                                         print "<td class=\"link\">" .
4945                                               $cgi->a({-href => href(action=>"blob",
4946                                                                      hash_base=>$hash,
4947                                                                      hash=>$from_hash,
4948                                                                      file_name=>$from_path)},
4949                                                       "blob" . ($i+1)) .
4950                                               " | </td>\n";
4951                                 } else {
4952                                         if ($diff->{'to_id'} eq $from_hash) {
4953                                                 print "<td class=\"link nochange\">";
4954                                         } else {
4955                                                 print "<td class=\"link\">";
4956                                         }
4957                                         print $cgi->a({-href => href(action=>"blobdiff",
4958                                                                      hash=>$diff->{'to_id'},
4959                                                                      hash_parent=>$from_hash,
4960                                                                      hash_base=>$hash,
4961                                                                      hash_parent_base=>$hash_parent,
4962                                                                      file_name=>$diff->{'to_file'},
4963                                                                      file_parent=>$from_path)},
4964                                                       "diff" . ($i+1)) .
4965                                               " | </td>\n";
4966                                 }
4967                         }
4968
4969                         print "<td class=\"link\">";
4970                         if ($not_deleted) {
4971                                 print $cgi->a({-href => href(action=>"blob",
4972                                                              hash=>$diff->{'to_id'},
4973                                                              file_name=>$diff->{'to_file'},
4974                                                              hash_base=>$hash)},
4975                                               "blob");
4976                                 print " | " if ($has_history);
4977                         }
4978                         if ($has_history) {
4979                                 print $cgi->a({-href => href(action=>"history",
4980                                                              file_name=>$diff->{'to_file'},
4981                                                              hash_base=>$hash)},
4982                                               "history");
4983                         }
4984                         print "</td>\n";
4985
4986                         print "</tr>\n";
4987                         next; # instead of 'else' clause, to avoid extra indent
4988                 }
4989                 # else ordinary diff
4990
4991                 my ($to_mode_oct, $to_mode_str, $to_file_type);
4992                 my ($from_mode_oct, $from_mode_str, $from_file_type);
4993                 if ($diff->{'to_mode'} ne ('0' x 6)) {
4994                         $to_mode_oct = oct $diff->{'to_mode'};
4995                         if (S_ISREG($to_mode_oct)) { # only for regular file
4996                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
4997                         }
4998                         $to_file_type = file_type($diff->{'to_mode'});
4999                 }
5000                 if ($diff->{'from_mode'} ne ('0' x 6)) {
5001                         $from_mode_oct = oct $diff->{'from_mode'};
5002                         if (S_ISREG($from_mode_oct)) { # only for regular file
5003                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
5004                         }
5005                         $from_file_type = file_type($diff->{'from_mode'});
5006                 }
5007
5008                 if ($diff->{'status'} eq "A") { # created
5009                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
5010                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
5011                         $mode_chng   .= "]</span>";
5012                         print "<td>";
5013                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5014                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5015                                       -class => "list"}, esc_path($diff->{'file'}));
5016                         print "</td>\n";
5017                         print "<td>$mode_chng</td>\n";
5018                         print "<td class=\"link\">";
5019                         if ($action eq 'commitdiff') {
5020                                 # link to patch
5021                                 $patchno++;
5022                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5023                                               "patch") .
5024                                       " | ";
5025                         }
5026                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5027                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5028                                       "blob");
5029                         print "</td>\n";
5030
5031                 } elsif ($diff->{'status'} eq "D") { # deleted
5032                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
5033                         print "<td>";
5034                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5035                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
5036                                        -class => "list"}, esc_path($diff->{'file'}));
5037                         print "</td>\n";
5038                         print "<td>$mode_chng</td>\n";
5039                         print "<td class=\"link\">";
5040                         if ($action eq 'commitdiff') {
5041                                 # link to patch
5042                                 $patchno++;
5043                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5044                                               "patch") .
5045                                       " | ";
5046                         }
5047                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5048                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
5049                                       "blob") . " | ";
5050                         if ($have_blame) {
5051                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
5052                                                              file_name=>$diff->{'file'})},
5053                                               "blame") . " | ";
5054                         }
5055                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
5056                                                      file_name=>$diff->{'file'})},
5057                                       "history");
5058                         print "</td>\n";
5059
5060                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
5061                         my $mode_chnge = "";
5062                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5063                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
5064                                 if ($from_file_type ne $to_file_type) {
5065                                         $mode_chnge .= " from $from_file_type to $to_file_type";
5066                                 }
5067                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
5068                                         if ($from_mode_str && $to_mode_str) {
5069                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
5070                                         } elsif ($to_mode_str) {
5071                                                 $mode_chnge .= " mode: $to_mode_str";
5072                                         }
5073                                 }
5074                                 $mode_chnge .= "]</span>\n";
5075                         }
5076                         print "<td>";
5077                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5078                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5079                                       -class => "list"}, esc_path($diff->{'file'}));
5080                         print "</td>\n";
5081                         print "<td>$mode_chnge</td>\n";
5082                         print "<td class=\"link\">";
5083                         if ($action eq 'commitdiff') {
5084                                 # link to patch
5085                                 $patchno++;
5086                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5087                                               "patch") .
5088                                       " | ";
5089                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5090                                 # "commit" view and modified file (not onlu mode changed)
5091                                 print $cgi->a({-href => href(action=>"blobdiff",
5092                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5093                                                              hash_base=>$hash, hash_parent_base=>$parent,
5094                                                              file_name=>$diff->{'file'})},
5095                                               "diff") .
5096                                       " | ";
5097                         }
5098                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5099                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5100                                        "blob") . " | ";
5101                         if ($have_blame) {
5102                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
5103                                                              file_name=>$diff->{'file'})},
5104                                               "blame") . " | ";
5105                         }
5106                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
5107                                                      file_name=>$diff->{'file'})},
5108                                       "history");
5109                         print "</td>\n";
5110
5111                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
5112                         my %status_name = ('R' => 'moved', 'C' => 'copied');
5113                         my $nstatus = $status_name{$diff->{'status'}};
5114                         my $mode_chng = "";
5115                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5116                                 # mode also for directories, so we cannot use $to_mode_str
5117                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
5118                         }
5119                         print "<td>" .
5120                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
5121                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
5122                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
5123                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
5124                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
5125                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
5126                                       -class => "list"}, esc_path($diff->{'from_file'})) .
5127                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
5128                               "<td class=\"link\">";
5129                         if ($action eq 'commitdiff') {
5130                                 # link to patch
5131                                 $patchno++;
5132                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5133                                               "patch") .
5134                                       " | ";
5135                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5136                                 # "commit" view and modified file (not only pure rename or copy)
5137                                 print $cgi->a({-href => href(action=>"blobdiff",
5138                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5139                                                              hash_base=>$hash, hash_parent_base=>$parent,
5140                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
5141                                               "diff") .
5142                                       " | ";
5143                         }
5144                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5145                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
5146                                       "blob") . " | ";
5147                         if ($have_blame) {
5148                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
5149                                                              file_name=>$diff->{'to_file'})},
5150                                               "blame") . " | ";
5151                         }
5152                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
5153                                                     file_name=>$diff->{'to_file'})},
5154                                       "history");
5155                         print "</td>\n";
5156
5157                 } # we should not encounter Unmerged (U) or Unknown (X) status
5158                 print "</tr>\n";
5159         }
5160         print "</tbody>" if $has_header;
5161         print "</table>\n";
5162 }
5163
5164 # Print context lines and then rem/add lines in a side-by-side manner.
5165 sub print_sidebyside_diff_lines {
5166         my ($ctx, $rem, $add) = @_;
5167
5168         # print context block before add/rem block
5169         if (@$ctx) {
5170                 print join '',
5171                         '<div class="chunk_block ctx">',
5172                                 '<div class="old">',
5173                                 @$ctx,
5174                                 '</div>',
5175                                 '<div class="new">',
5176                                 @$ctx,
5177                                 '</div>',
5178                         '</div>';
5179         }
5180
5181         if (!@$add) {
5182                 # pure removal
5183                 print join '',
5184                         '<div class="chunk_block rem">',
5185                                 '<div class="old">',
5186                                 @$rem,
5187                                 '</div>',
5188                         '</div>';
5189         } elsif (!@$rem) {
5190                 # pure addition
5191                 print join '',
5192                         '<div class="chunk_block add">',
5193                                 '<div class="new">',
5194                                 @$add,
5195                                 '</div>',
5196                         '</div>';
5197         } else {
5198                 print join '',
5199                         '<div class="chunk_block chg">',
5200                                 '<div class="old">',
5201                                 @$rem,
5202                                 '</div>',
5203                                 '<div class="new">',
5204                                 @$add,
5205                                 '</div>',
5206                         '</div>';
5207         }
5208 }
5209
5210 # Print context lines and then rem/add lines in inline manner.
5211 sub print_inline_diff_lines {
5212         my ($ctx, $rem, $add) = @_;
5213
5214         print @$ctx, @$rem, @$add;
5215 }
5216
5217 # Format removed and added line, mark changed part and HTML-format them.
5218 # Implementation is based on contrib/diff-highlight
5219 sub format_rem_add_lines_pair {
5220         my ($rem, $add, $num_parents) = @_;
5221
5222         # We need to untabify lines before split()'ing them;
5223         # otherwise offsets would be invalid.
5224         chomp $rem;
5225         chomp $add;
5226         $rem = untabify($rem);
5227         $add = untabify($add);
5228
5229         my @rem = split(//, $rem);
5230         my @add = split(//, $add);
5231         my ($esc_rem, $esc_add);
5232         # Ignore leading +/- characters for each parent.
5233         my ($prefix_len, $suffix_len) = ($num_parents, 0);
5234         my ($prefix_has_nonspace, $suffix_has_nonspace);
5235
5236         my $shorter = (@rem < @add) ? @rem : @add;
5237         while ($prefix_len < $shorter) {
5238                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
5239
5240                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
5241                 $prefix_len++;
5242         }
5243
5244         while ($prefix_len + $suffix_len < $shorter) {
5245                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
5246
5247                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
5248                 $suffix_len++;
5249         }
5250
5251         # Mark lines that are different from each other, but have some common
5252         # part that isn't whitespace.  If lines are completely different, don't
5253         # mark them because that would make output unreadable, especially if
5254         # diff consists of multiple lines.
5255         if ($prefix_has_nonspace || $suffix_has_nonspace) {
5256                 $esc_rem = esc_html_hl_regions($rem, 'marked',
5257                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
5258                 $esc_add = esc_html_hl_regions($add, 'marked',
5259                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
5260         } else {
5261                 $esc_rem = esc_html($rem, -nbsp=>1);
5262                 $esc_add = esc_html($add, -nbsp=>1);
5263         }
5264
5265         return format_diff_line(\$esc_rem, 'rem'),
5266                format_diff_line(\$esc_add, 'add');
5267 }
5268
5269 # HTML-format diff context, removed and added lines.
5270 sub format_ctx_rem_add_lines {
5271         my ($ctx, $rem, $add, $num_parents) = @_;
5272         my (@new_ctx, @new_rem, @new_add);
5273         my $can_highlight = 0;
5274         my $is_combined = ($num_parents > 1);
5275
5276         # Highlight if every removed line has a corresponding added line.
5277         if (@$add > 0 && @$add == @$rem) {
5278                 $can_highlight = 1;
5279
5280                 # Highlight lines in combined diff only if the chunk contains
5281                 # diff between the same version, e.g.
5282                 #
5283                 #    - a
5284                 #   -  b
5285                 #    + c
5286                 #   +  d
5287                 #
5288                 # Otherwise the highlighting would be confusing.
5289                 if ($is_combined) {
5290                         for (my $i = 0; $i < @$add; $i++) {
5291                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
5292                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
5293
5294                                 $prefix_rem =~ s/-/+/g;
5295
5296                                 if ($prefix_rem ne $prefix_add) {
5297                                         $can_highlight = 0;
5298                                         last;
5299                                 }
5300                         }
5301                 }
5302         }
5303
5304         if ($can_highlight) {
5305                 for (my $i = 0; $i < @$add; $i++) {
5306                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
5307                                 $rem->[$i], $add->[$i], $num_parents);
5308                         push @new_rem, $line_rem;
5309                         push @new_add, $line_add;
5310                 }
5311         } else {
5312                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
5313                 @new_add = map { format_diff_line($_, 'add') } @$add;
5314         }
5315
5316         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
5317
5318         return (\@new_ctx, \@new_rem, \@new_add);
5319 }
5320
5321 # Print context lines and then rem/add lines.
5322 sub print_diff_lines {
5323         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
5324         my $is_combined = $num_parents > 1;
5325
5326         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
5327                 $num_parents);
5328
5329         if ($diff_style eq 'sidebyside' && !$is_combined) {
5330                 print_sidebyside_diff_lines($ctx, $rem, $add);
5331         } else {
5332                 # default 'inline' style and unknown styles
5333                 print_inline_diff_lines($ctx, $rem, $add);
5334         }
5335 }
5336
5337 sub print_diff_chunk {
5338         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
5339         my (@ctx, @rem, @add);
5340
5341         # The class of the previous line.
5342         my $prev_class = '';
5343
5344         return unless @chunk;
5345
5346         # incomplete last line might be among removed or added lines,
5347         # or both, or among context lines: find which
5348         for (my $i = 1; $i < @chunk; $i++) {
5349                 if ($chunk[$i][0] eq 'incomplete') {
5350                         $chunk[$i][0] = $chunk[$i-1][0];
5351                 }
5352         }
5353
5354         # guardian
5355         push @chunk, ["", ""];
5356
5357         foreach my $line_info (@chunk) {
5358                 my ($class, $line) = @$line_info;
5359
5360                 # print chunk headers
5361                 if ($class && $class eq 'chunk_header') {
5362                         print format_diff_line($line, $class, $from, $to);
5363                         next;
5364                 }
5365
5366                 ## print from accumulator when have some add/rem lines or end
5367                 # of chunk (flush context lines), or when have add and rem
5368                 # lines and new block is reached (otherwise add/rem lines could
5369                 # be reordered)
5370                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
5371                     (@rem && @add && $class ne $prev_class)) {
5372                         print_diff_lines(\@ctx, \@rem, \@add,
5373                                          $diff_style, $num_parents);
5374                         @ctx = @rem = @add = ();
5375                 }
5376
5377                 ## adding lines to accumulator
5378                 # guardian value
5379                 last unless $line;
5380                 # rem, add or change
5381                 if ($class eq 'rem') {
5382                         push @rem, $line;
5383                 } elsif ($class eq 'add') {
5384                         push @add, $line;
5385                 }
5386                 # context line
5387                 if ($class eq 'ctx') {
5388                         push @ctx, $line;
5389                 }
5390
5391                 $prev_class = $class;
5392         }
5393 }
5394
5395 sub git_patchset_body {
5396         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
5397         my ($hash_parent) = $hash_parents[0];
5398
5399         my $is_combined = (@hash_parents > 1);
5400         my $patch_idx = 0;
5401         my $patch_number = 0;
5402         my $patch_line;
5403         my $diffinfo;
5404         my $to_name;
5405         my (%from, %to);
5406         my @chunk; # for side-by-side diff
5407
5408         print "<div class=\"patchset\">\n";
5409
5410         # skip to first patch
5411         while ($patch_line = <$fd>) {
5412                 chomp $patch_line;
5413
5414                 last if ($patch_line =~ m/^diff /);
5415         }
5416
5417  PATCH:
5418         while ($patch_line) {
5419
5420                 # parse "git diff" header line
5421                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
5422                         # $1 is from_name, which we do not use
5423                         $to_name = unquote($2);
5424                         $to_name =~ s!^b/!!;
5425                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
5426                         # $1 is 'cc' or 'combined', which we do not use
5427                         $to_name = unquote($2);
5428                 } else {
5429                         $to_name = undef;
5430                 }
5431
5432                 # check if current patch belong to current raw line
5433                 # and parse raw git-diff line if needed
5434                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
5435                         # this is continuation of a split patch
5436                         print "<div class=\"patch cont\">\n";
5437                 } else {
5438                         # advance raw git-diff output if needed
5439                         $patch_idx++ if defined $diffinfo;
5440
5441                         # read and prepare patch information
5442                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
5443
5444                         # compact combined diff output can have some patches skipped
5445                         # find which patch (using pathname of result) we are at now;
5446                         if ($is_combined) {
5447                                 while ($to_name ne $diffinfo->{'to_file'}) {
5448                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
5449                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
5450                                               "</div>\n";  # class="patch"
5451
5452                                         $patch_idx++;
5453                                         $patch_number++;
5454
5455                                         last if $patch_idx > $#$difftree;
5456                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
5457                                 }
5458                         }
5459
5460                         # modifies %from, %to hashes
5461                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
5462
5463                         # this is first patch for raw difftree line with $patch_idx index
5464                         # we index @$difftree array from 0, but number patches from 1
5465                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
5466                 }
5467
5468                 # git diff header
5469                 #assert($patch_line =~ m/^diff /) if DEBUG;
5470                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
5471                 $patch_number++;
5472                 # print "git diff" header
5473                 print format_git_diff_header_line($patch_line, $diffinfo,
5474                                                   \%from, \%to);
5475
5476                 # print extended diff header
5477                 print "<div class=\"diff extended_header\">\n";
5478         EXTENDED_HEADER:
5479                 while ($patch_line = <$fd>) {
5480                         chomp $patch_line;
5481
5482                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
5483
5484                         print format_extended_diff_header_line($patch_line, $diffinfo,
5485                                                                \%from, \%to);
5486                 }
5487                 print "</div>\n"; # class="diff extended_header"
5488
5489                 # from-file/to-file diff header
5490                 if (! $patch_line) {
5491                         print "</div>\n"; # class="patch"
5492                         last PATCH;
5493                 }
5494                 next PATCH if ($patch_line =~ m/^diff /);
5495                 #assert($patch_line =~ m/^---/) if DEBUG;
5496
5497                 my $last_patch_line = $patch_line;
5498                 $patch_line = <$fd>;
5499                 chomp $patch_line;
5500                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
5501
5502                 print format_diff_from_to_header($last_patch_line, $patch_line,
5503                                                  $diffinfo, \%from, \%to,
5504                                                  @hash_parents);
5505
5506                 # the patch itself
5507         LINE:
5508                 while ($patch_line = <$fd>) {
5509                         chomp $patch_line;
5510
5511                         next PATCH if ($patch_line =~ m/^diff /);
5512
5513                         my $class = diff_line_class($patch_line, \%from, \%to);
5514
5515                         if ($class eq 'chunk_header') {
5516                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
5517                                 @chunk = ();
5518                         }
5519
5520                         push @chunk, [ $class, $patch_line ];
5521                 }
5522
5523         } continue {
5524                 if (@chunk) {
5525                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
5526                         @chunk = ();
5527                 }
5528                 print "</div>\n"; # class="patch"
5529         }
5530
5531         # for compact combined (--cc) format, with chunk and patch simplification
5532         # the patchset might be empty, but there might be unprocessed raw lines
5533         for (++$patch_idx if $patch_number > 0;
5534              $patch_idx < @$difftree;
5535              ++$patch_idx) {
5536                 # read and prepare patch information
5537                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
5538
5539                 # generate anchor for "patch" links in difftree / whatchanged part
5540                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
5541                       format_diff_cc_simplified($diffinfo, @hash_parents) .
5542                       "</div>\n";  # class="patch"
5543
5544                 $patch_number++;
5545         }
5546
5547         if ($patch_number == 0) {
5548                 if (@hash_parents > 1) {
5549                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
5550                 } else {
5551                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
5552                 }
5553         }
5554
5555         print "</div>\n"; # class="patchset"
5556 }
5557
5558 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
5559
5560 sub git_project_search_form {
5561         my ($searchtext, $search_use_regexp) = @_;
5562
5563         my $limit = '';
5564         if ($project_filter) {
5565                 $limit = " in '$project_filter/'";
5566         }
5567
5568         print "<div class=\"projsearch\">\n";
5569         print $cgi->start_form(-method => 'get', -action => $my_uri) .
5570               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
5571         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
5572                 if (defined $project_filter);
5573         print $cgi->textfield(-name => 's', -value => $searchtext,
5574                               -title => "Search project by name and description$limit",
5575                               -size => 60) . "\n" .
5576               "<span title=\"Extended regular expression\">" .
5577               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5578                              -checked => $search_use_regexp) .
5579               "</span>\n" .
5580               $cgi->submit(-name => 'btnS', -value => 'Search') .
5581               $cgi->end_form() . "\n" .
5582               $cgi->a({-href => href(project => undef, searchtext => undef,
5583                                      project_filter => $project_filter)},
5584                       esc_html("List all projects$limit")) . "<br />\n";
5585         print "</div>\n";
5586 }
5587
5588 # entry for given @keys needs filling if at least one of keys in list
5589 # is not present in %$project_info
5590 sub project_info_needs_filling {
5591         my ($project_info, @keys) = @_;
5592
5593         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
5594         foreach my $key (@keys) {
5595                 if (!exists $project_info->{$key}) {
5596                         return 1;
5597                 }
5598         }
5599         return;
5600 }
5601
5602 # fills project list info (age, description, owner, category, forks, etc.)
5603 # for each project in the list, removing invalid projects from
5604 # returned list, or fill only specified info.
5605 #
5606 # Invalid projects are removed from the returned list if and only if you
5607 # ask 'age' or 'age_string' to be filled, because they are the only fields
5608 # that run unconditionally git command that requires repository, and
5609 # therefore do always check if project repository is invalid.
5610 #
5611 # USAGE:
5612 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
5613 #   ensures that 'descr_long' and 'ctags' fields are filled
5614 # * @project_list = fill_project_list_info(\@project_list)
5615 #   ensures that all fields are filled (and invalid projects removed)
5616 #
5617 # NOTE: modifies $projlist, but does not remove entries from it
5618 sub fill_project_list_info {
5619         my ($projlist, @wanted_keys) = @_;
5620         my @projects;
5621         my $filter_set = sub { return @_; };
5622         if (@wanted_keys) {
5623                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
5624                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
5625         }
5626
5627         my $show_ctags = gitweb_check_feature('ctags');
5628  PROJECT:
5629         foreach my $pr (@$projlist) {
5630                 if (project_info_needs_filling($pr, $filter_set->('age', 'age_string'))) {
5631                         my (@activity) = git_get_last_activity($pr->{'path'});
5632                         unless (@activity) {
5633                                 next PROJECT;
5634                         }
5635                         ($pr->{'age'}, $pr->{'age_string'}) = @activity;
5636                 }
5637                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
5638                         my $descr = git_get_project_description($pr->{'path'}) || "";
5639                         $descr = to_utf8($descr);
5640                         $pr->{'descr_long'} = $descr;
5641                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
5642                 }
5643                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
5644                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
5645                 }
5646                 if ($show_ctags &&
5647                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
5648                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
5649                 }
5650                 if ($projects_list_group_categories &&
5651                     project_info_needs_filling($pr, $filter_set->('category'))) {
5652                         my $cat = git_get_project_category($pr->{'path'}) ||
5653                                                            $project_list_default_category;
5654                         $pr->{'category'} = to_utf8($cat);
5655                 }
5656
5657                 push @projects, $pr;
5658         }
5659
5660         return @projects;
5661 }
5662
5663 sub sort_projects_list {
5664         my ($projlist, $order) = @_;
5665
5666         sub order_str {
5667                 my $key = shift;
5668                 return sub { $a->{$key} cmp $b->{$key} };
5669         }
5670
5671         sub order_num_then_undef {
5672                 my $key = shift;
5673                 return sub {
5674                         defined $a->{$key} ?
5675                                 (defined $b->{$key} ? $a->{$key} <=> $b->{$key} : -1) :
5676                                 (defined $b->{$key} ? 1 : 0)
5677                 };
5678         }
5679
5680         my %orderings = (
5681                 project => order_str('path'),
5682                 descr => order_str('descr_long'),
5683                 owner => order_str('owner'),
5684                 age => order_num_then_undef('age'),
5685         );
5686
5687         my $ordering = $orderings{$order};
5688         return defined $ordering ? sort $ordering @$projlist : @$projlist;
5689 }
5690
5691 # returns a hash of categories, containing the list of project
5692 # belonging to each category
5693 sub build_projlist_by_category {
5694         my ($projlist, $from, $to) = @_;
5695         my %categories;
5696
5697         $from = 0 unless defined $from;
5698         $to = $#$projlist if (!defined $to || $#$projlist < $to);
5699
5700         for (my $i = $from; $i <= $to; $i++) {
5701                 my $pr = $projlist->[$i];
5702                 push @{$categories{ $pr->{'category'} }}, $pr;
5703         }
5704
5705         return wantarray ? %categories : \%categories;
5706 }
5707
5708 # print 'sort by' <th> element, generating 'sort by $name' replay link
5709 # if that order is not selected
5710 sub print_sort_th {
5711         print format_sort_th(@_);
5712 }
5713
5714 sub format_sort_th {
5715         my ($name, $order, $header) = @_;
5716         my $sort_th = "";
5717         $header ||= ucfirst($name);
5718
5719         if ($order eq $name) {
5720                 $sort_th .= "<th>$header</th>\n";
5721         } else {
5722                 $sort_th .= "<th>" .
5723                             $cgi->a({-href => href(-replay=>1, order=>$name),
5724                                      -class => "header"}, $header) .
5725                             "</th>\n";
5726         }
5727
5728         return $sort_th;
5729 }
5730
5731 sub git_project_list_rows {
5732         my ($projlist, $from, $to, $check_forks) = @_;
5733
5734         $from = 0 unless defined $from;
5735         $to = $#$projlist if (!defined $to || $#$projlist < $to);
5736
5737         my $alternate = 1;
5738         for (my $i = $from; $i <= $to; $i++) {
5739                 my $pr = $projlist->[$i];
5740
5741                 if ($alternate) {
5742                         print "<tr class=\"dark\">\n";
5743                 } else {
5744                         print "<tr class=\"light\">\n";
5745                 }
5746                 $alternate ^= 1;
5747
5748                 if ($check_forks) {
5749                         print "<td>";
5750                         if ($pr->{'forks'}) {
5751                                 my $nforks = scalar @{$pr->{'forks'}};
5752                                 if ($nforks > 0) {
5753                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
5754                                                        -title => "$nforks forks"}, "+");
5755                                 } else {
5756                                         print $cgi->span({-title => "$nforks forks"}, "+");
5757                                 }
5758                         }
5759                         print "</td>\n";
5760                 }
5761                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
5762                                         -class => "list"},
5763                                        esc_html_match_hl($pr->{'path'}, $search_regexp)) .
5764                       "</td>\n" .
5765                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
5766                                         -class => "list",
5767                                         -title => $pr->{'descr_long'}},
5768                                         $search_regexp
5769                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
5770                                                                     $pr->{'descr'}, $search_regexp)
5771                                         : esc_html($pr->{'descr'})) .
5772                       "</td>\n";
5773                 unless ($omit_owner) {
5774                         print "<td><i>" . chop_and_escape_str($pr->{'owner'}, 15) . "</i></td>\n";
5775                 }
5776                 unless ($omit_age_column) {
5777                         print "<td class=\"". age_class($pr->{'age'}) . "\">" .
5778                             (defined $pr->{'age_string'} ? $pr->{'age_string'} : "No commits") . "</td>\n";
5779                 }
5780                 print"<td class=\"link\">" .
5781                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . " | " .
5782                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "shortlog") . " | " .
5783                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"log")}, "log") . " | " .
5784                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
5785                       ($pr->{'forks'} ? " | " . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
5786                       "</td>\n" .
5787                       "</tr>\n";
5788         }
5789 }
5790
5791 sub git_project_list_body {
5792         # actually uses global variable $project
5793         my ($projlist, $order, $from, $to, $extra, $no_header) = @_;
5794         my @projects = @$projlist;
5795
5796         my $check_forks = gitweb_check_feature('forks');
5797         my $show_ctags  = gitweb_check_feature('ctags');
5798         my $tagfilter = $show_ctags ? $input_params{'ctag'} : undef;
5799         $check_forks = undef
5800                 if ($tagfilter || $search_regexp);
5801
5802         # filtering out forks before filling info allows to do less work
5803         @projects = filter_forks_from_projects_list(\@projects)
5804                 if ($check_forks);
5805         # search_projects_list pre-fills required info
5806         @projects = search_projects_list(\@projects,
5807                                          'search_regexp' => $search_regexp,
5808                                          'tagfilter'  => $tagfilter)
5809                 if ($tagfilter || $search_regexp);
5810         # fill the rest
5811         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
5812         push @all_fields, ('age', 'age_string') unless($omit_age_column);
5813         push @all_fields, 'owner' unless($omit_owner);
5814         @projects = fill_project_list_info(\@projects, @all_fields);
5815
5816         $order ||= $default_projects_order;
5817         $from = 0 unless defined $from;
5818         $to = $#projects if (!defined $to || $#projects < $to);
5819
5820         # short circuit
5821         if ($from > $to) {
5822                 print "<center>\n".
5823                       "<b>No such projects found</b><br />\n".
5824                       "Click ".$cgi->a({-href=>href(project=>undef)},"here")." to view all projects<br />\n".
5825                       "</center>\n<br />\n";
5826                 return;
5827         }
5828
5829         @projects = sort_projects_list(\@projects, $order);
5830
5831         if ($show_ctags) {
5832                 my $ctags = git_gather_all_ctags(\@projects);
5833                 my $cloud = git_populate_project_tagcloud($ctags);
5834                 print git_show_project_tagcloud($cloud, 64);
5835         }
5836
5837         print "<table class=\"project_list\">\n";
5838         unless ($no_header) {
5839                 print "<tr>\n";
5840                 if ($check_forks) {
5841                         print "<th></th>\n";
5842                 }
5843                 print_sort_th('project', $order, 'Project');
5844                 print_sort_th('descr', $order, 'Description');
5845                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
5846                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
5847                 print "<th></th>\n" . # for links
5848                       "</tr>\n";
5849         }
5850
5851         if ($projects_list_group_categories) {
5852                 # only display categories with projects in the $from-$to window
5853                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
5854                 my %categories = build_projlist_by_category(\@projects, $from, $to);
5855                 foreach my $cat (sort keys %categories) {
5856                         unless ($cat eq "") {
5857                                 print "<tr>\n";
5858                                 if ($check_forks) {
5859                                         print "<td></td>\n";
5860                                 }
5861                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
5862                                 print "</tr>\n";
5863                         }
5864
5865                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
5866                 }
5867         } else {
5868                 git_project_list_rows(\@projects, $from, $to, $check_forks);
5869         }
5870
5871         if (defined $extra) {
5872                 print "<tr>\n";
5873                 if ($check_forks) {
5874                         print "<td></td>\n";
5875                 }
5876                 print "<td colspan=\"5\">$extra</td>\n" .
5877                       "</tr>\n";
5878         }
5879         print "</table>\n";
5880 }
5881
5882 sub git_log_body {
5883         # uses global variable $project
5884         my ($commitlist, $from, $to, $refs, $extra) = @_;
5885
5886         $from = 0 unless defined $from;
5887         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
5888
5889         for (my $i = 0; $i <= $to; $i++) {
5890                 my %co = %{$commitlist->[$i]};
5891                 next if !%co;
5892                 my $commit = $co{'id'};
5893                 my $ref = format_ref_marker($refs, $commit);
5894                 git_print_header_div('commit',
5895                                "<span class=\"age\">$co{'age_string'}</span>" .
5896                                esc_html($co{'title'}) . $ref,
5897                                $commit);
5898                 print "<div class=\"title_text\">\n" .
5899                       "<div class=\"log_link\">\n" .
5900                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
5901                       " | " .
5902                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
5903                       " | " .
5904                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
5905                       "<br/>\n" .
5906                       "</div>\n";
5907                       git_print_authorship(\%co, -tag => 'span');
5908                       print "<br/>\n</div>\n";
5909
5910                 print "<div class=\"log_body\">\n";
5911                 git_print_log($co{'comment'}, -final_empty_line=> 1);
5912                 print "</div>\n";
5913         }
5914         if ($extra) {
5915                 print "<div class=\"page_nav\">\n";
5916                 print "$extra\n";
5917                 print "</div>\n";
5918         }
5919 }
5920
5921 sub git_shortlog_body {
5922         # uses global variable $project
5923         my ($commitlist, $from, $to, $refs, $extra) = @_;
5924
5925         $from = 0 unless defined $from;
5926         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
5927
5928         print "<table class=\"shortlog\">\n";
5929         my $alternate = 1;
5930         for (my $i = $from; $i <= $to; $i++) {
5931                 my %co = %{$commitlist->[$i]};
5932                 my $commit = $co{'id'};
5933                 my $ref = format_ref_marker($refs, $commit);
5934                 if ($alternate) {
5935                         print "<tr class=\"dark\">\n";
5936                 } else {
5937                         print "<tr class=\"light\">\n";
5938                 }
5939                 $alternate ^= 1;
5940                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
5941                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
5942                       format_author_html('td', \%co, 10) . "<td>";
5943                 print format_subject_html($co{'title'}, $co{'title_short'},
5944                                           href(action=>"commit", hash=>$commit), $ref);
5945                 print "</td>\n" .
5946                       "<td class=\"link\">" .
5947                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . " | " .
5948                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . " | " .
5949                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
5950                 my $snapshot_links = format_snapshot_links($commit);
5951                 if (defined $snapshot_links) {
5952                         print " | " . $snapshot_links;
5953                 }
5954                 print "</td>\n" .
5955                       "</tr>\n";
5956         }
5957         if (defined $extra) {
5958                 print "<tr>\n" .
5959                       "<td colspan=\"4\">$extra</td>\n" .
5960                       "</tr>\n";
5961         }
5962         print "</table>\n";
5963 }
5964
5965 sub git_history_body {
5966         # Warning: assumes constant type (blob or tree) during history
5967         my ($commitlist, $from, $to, $refs, $extra,
5968             $file_name, $file_hash, $ftype) = @_;
5969
5970         $from = 0 unless defined $from;
5971         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
5972
5973         print "<table class=\"history\">\n";
5974         my $alternate = 1;
5975         for (my $i = $from; $i <= $to; $i++) {
5976                 my %co = %{$commitlist->[$i]};
5977                 if (!%co) {
5978                         next;
5979                 }
5980                 my $commit = $co{'id'};
5981
5982                 my $ref = format_ref_marker($refs, $commit);
5983
5984                 if ($alternate) {
5985                         print "<tr class=\"dark\">\n";
5986                 } else {
5987                         print "<tr class=\"light\">\n";
5988                 }
5989                 $alternate ^= 1;
5990                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
5991         # shortlog:   format_author_html('td', \%co, 10)
5992                       format_author_html('td', \%co, 15, 3) . "<td>";
5993                 # originally git_history used chop_str($co{'title'}, 50)
5994                 print format_subject_html($co{'title'}, $co{'title_short'},
5995                                           href(action=>"commit", hash=>$commit), $ref);
5996                 print "</td>\n" .
5997                       "<td class=\"link\">" .
5998                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . " | " .
5999                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
6000
6001                 if ($ftype eq 'blob') {
6002                         print " | " .
6003                               $cgi->a({-href => href(action=>"blob_plain", hash_base=>$commit, file_name=>$file_name)}, "raw");
6004
6005                         my $blob_current = $file_hash;
6006                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
6007                         if (defined $blob_current && defined $blob_parent &&
6008                                         $blob_current ne $blob_parent) {
6009                                 print " | " .
6010                                         $cgi->a({-href => href(action=>"blobdiff",
6011                                                                hash=>$blob_current, hash_parent=>$blob_parent,
6012                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
6013                                                                file_name=>$file_name)},
6014                                                 "diff to current");
6015                         }
6016                 }
6017                 print "</td>\n" .
6018                       "</tr>\n";
6019         }
6020         if (defined $extra) {
6021                 print "<tr>\n" .
6022                       "<td colspan=\"4\">$extra</td>\n" .
6023                       "</tr>\n";
6024         }
6025         print "</table>\n";
6026 }
6027
6028 sub git_tags_body {
6029         # uses global variable $project
6030         my ($taglist, $from, $to, $extra) = @_;
6031         $from = 0 unless defined $from;
6032         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
6033
6034         print "<table class=\"tags\">\n";
6035         my $alternate = 1;
6036         for (my $i = $from; $i <= $to; $i++) {
6037                 my $entry = $taglist->[$i];
6038                 my %tag = %$entry;
6039                 my $comment = $tag{'subject'};
6040                 my $comment_short;
6041                 if (defined $comment) {
6042                         $comment_short = chop_str($comment, 30, 5);
6043                 }
6044                 if ($alternate) {
6045                         print "<tr class=\"dark\">\n";
6046                 } else {
6047                         print "<tr class=\"light\">\n";
6048                 }
6049                 $alternate ^= 1;
6050                 if (defined $tag{'age'}) {
6051                         print "<td><i>$tag{'age'}</i></td>\n";
6052                 } else {
6053                         print "<td></td>\n";
6054                 }
6055                 print "<td>" .
6056                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
6057                                -class => "list name"}, esc_html($tag{'name'})) .
6058                       "</td>\n" .
6059                       "<td>";
6060                 if (defined $comment) {
6061                         print format_subject_html($comment, $comment_short,
6062                                                   href(action=>"tag", hash=>$tag{'id'}));
6063                 }
6064                 print "</td>\n" .
6065                       "<td class=\"selflink\">";
6066                 if ($tag{'type'} eq "tag") {
6067                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
6068                 } else {
6069                         print "&nbsp;";
6070                 }
6071                 print "</td>\n" .
6072                       "<td class=\"link\">" . " | " .
6073                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
6074                 if ($tag{'reftype'} eq "commit") {
6075                         print " | " . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "shortlog") .
6076                               " | " . $cgi->a({-href => href(action=>"log", hash=>$tag{'fullname'})}, "log");
6077                 } elsif ($tag{'reftype'} eq "blob") {
6078                         print " | " . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
6079                 }
6080                 print "</td>\n" .
6081                       "</tr>";
6082         }
6083         if (defined $extra) {
6084                 print "<tr>\n" .
6085                       "<td colspan=\"5\">$extra</td>\n" .
6086                       "</tr>\n";
6087         }
6088         print "</table>\n";
6089 }
6090
6091 sub git_heads_body {
6092         # uses global variable $project
6093         my ($headlist, $head_at, $from, $to, $extra) = @_;
6094         $from = 0 unless defined $from;
6095         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
6096
6097         print "<table class=\"heads\">\n";
6098         my $alternate = 1;
6099         for (my $i = $from; $i <= $to; $i++) {
6100                 my $entry = $headlist->[$i];
6101                 my %ref = %$entry;
6102                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
6103                 if ($alternate) {
6104                         print "<tr class=\"dark\">\n";
6105                 } else {
6106                         print "<tr class=\"light\">\n";
6107                 }
6108                 $alternate ^= 1;
6109                 print "<td><i>$ref{'age'}</i></td>\n" .
6110                       ($curr ? "<td class=\"current_head\">" : "<td>") .
6111                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
6112                                -class => "list name"},esc_html($ref{'name'})) .
6113                       "</td>\n" .
6114                       "<td class=\"link\">" .
6115                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "shortlog") . " | " .
6116                       $cgi->a({-href => href(action=>"log", hash=>$ref{'fullname'})}, "log") . " | " .
6117                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
6118                       "</td>\n" .
6119                       "</tr>";
6120         }
6121         if (defined $extra) {
6122                 print "<tr>\n" .
6123                       "<td colspan=\"3\">$extra</td>\n" .
6124                       "</tr>\n";
6125         }
6126         print "</table>\n";
6127 }
6128
6129 # Display a single remote block
6130 sub git_remote_block {
6131         my ($remote, $rdata, $limit, $head) = @_;
6132
6133         my $heads = $rdata->{'heads'};
6134         my $fetch = $rdata->{'fetch'};
6135         my $push = $rdata->{'push'};
6136
6137         my $urls_table = "<table class=\"projects_list\">\n" ;
6138
6139         if (defined $fetch) {
6140                 if ($fetch eq $push) {
6141                         $urls_table .= format_repo_url("URL", $fetch);
6142                 } else {
6143                         $urls_table .= format_repo_url("Fetch URL", $fetch);
6144                         $urls_table .= format_repo_url("Push URL", $push) if defined $push;
6145                 }
6146         } elsif (defined $push) {
6147                 $urls_table .= format_repo_url("Push URL", $push);
6148         } else {
6149                 $urls_table .= format_repo_url("", "No remote URL");
6150         }
6151
6152         $urls_table .= "</table>\n";
6153
6154         my $dots;
6155         if (defined $limit && $limit < @$heads) {
6156                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
6157         }
6158
6159         print $urls_table;
6160         git_heads_body($heads, $head, 0, $limit, $dots);
6161 }
6162
6163 # Display a list of remote names with the respective fetch and push URLs
6164 sub git_remotes_list {
6165         my ($remotedata, $limit) = @_;
6166         print "<table class=\"heads\">\n";
6167         my $alternate = 1;
6168         my @remotes = sort keys %$remotedata;
6169
6170         my $limited = $limit && $limit < @remotes;
6171
6172         $#remotes = $limit - 1 if $limited;
6173
6174         while (my $remote = shift @remotes) {
6175                 my $rdata = $remotedata->{$remote};
6176                 my $fetch = $rdata->{'fetch'};
6177                 my $push = $rdata->{'push'};
6178                 if ($alternate) {
6179                         print "<tr class=\"dark\">\n";
6180                 } else {
6181                         print "<tr class=\"light\">\n";
6182                 }
6183                 $alternate ^= 1;
6184                 print "<td>" .
6185                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
6186                                -class=> "list name"},esc_html($remote)) .
6187                       "</td>";
6188                 print "<td class=\"link\">" .
6189                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
6190                       " | " .
6191                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
6192                       "</td>";
6193
6194                 print "</tr>\n";
6195         }
6196
6197         if ($limited) {
6198                 print "<tr>\n" .
6199                       "<td colspan=\"3\">" .
6200                       $cgi->a({-href => href(action=>"remotes")}, "...") .
6201                       "</td>\n" . "</tr>\n";
6202         }
6203
6204         print "</table>";
6205 }
6206
6207 # Display remote heads grouped by remote, unless there are too many
6208 # remotes, in which case we only display the remote names
6209 sub git_remotes_body {
6210         my ($remotedata, $limit, $head) = @_;
6211         if ($limit and $limit < keys %$remotedata) {
6212                 git_remotes_list($remotedata, $limit);
6213         } else {
6214                 fill_remote_heads($remotedata);
6215                 while (my ($remote, $rdata) = each %$remotedata) {
6216                         git_print_section({-class=>"remote", -id=>$remote},
6217                                 ["remotes", $remote, $remote], sub {
6218                                         git_remote_block($remote, $rdata, $limit, $head);
6219                                 });
6220                 }
6221         }
6222 }
6223
6224 sub git_search_message {
6225         my %co = @_;
6226
6227         my $greptype;
6228         if ($searchtype eq 'commit') {
6229                 $greptype = "--grep=";
6230         } elsif ($searchtype eq 'author') {
6231                 $greptype = "--author=";
6232         } elsif ($searchtype eq 'committer') {
6233                 $greptype = "--committer=";
6234         }
6235         $greptype .= $searchtext;
6236         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
6237                                        $greptype, '--regexp-ignore-case',
6238                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
6239
6240         my $paging_nav = '';
6241         if ($page > 0) {
6242                 $paging_nav .=
6243                         $cgi->a({-href => href(-replay=>1, page=>undef)},
6244                                 "first") .
6245                         " &sdot; " .
6246                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
6247                                  -accesskey => "p", -title => "Alt-p"}, "prev");
6248         } else {
6249                 $paging_nav .= "first &sdot; prev";
6250         }
6251         my $next_link = '';
6252         if ($#commitlist >= 100) {
6253                 $next_link =
6254                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
6255                                  -accesskey => "n", -title => "Alt-n"}, "next");
6256                 $paging_nav .= " &sdot; $next_link";
6257         } else {
6258                 $paging_nav .= " &sdot; next";
6259         }
6260
6261         git_header_html();
6262
6263         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav);
6264         git_print_header_div('commit', esc_html($co{'title'}), $hash);
6265         if ($page == 0 && !@commitlist) {
6266                 print "<p>No match.</p>\n";
6267         } else {
6268                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
6269         }
6270
6271         git_footer_html();
6272 }
6273
6274 sub git_search_changes {
6275         my %co = @_;
6276
6277         local $/ = "\n";
6278         open my $fd, '-|', git_cmd(), '--no-pager', 'log', @diff_opts,
6279                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
6280                 ($search_use_regexp ? '--pickaxe-regex' : ())
6281                         or die_error(500, "Open git-log failed");
6282
6283         git_header_html();
6284
6285         git_print_page_nav('','', $hash,$co{'tree'},$hash);
6286         git_print_header_div('commit', esc_html($co{'title'}), $hash);
6287
6288         print "<table class=\"pickaxe search\">\n";
6289         my $alternate = 1;
6290         undef %co;
6291         my @files;
6292         while (my $line = <$fd>) {
6293                 chomp $line;
6294                 next unless $line;
6295
6296                 my %set = parse_difftree_raw_line($line);
6297                 if (defined $set{'commit'}) {
6298                         # finish previous commit
6299                         if (%co) {
6300                                 print "</td>\n" .
6301                                       "<td class=\"link\">" .
6302                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
6303                                               "commit") .
6304                                       " | " .
6305                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
6306                                                              hash_base=>$co{'id'})},
6307                                               "tree") .
6308                                       "</td>\n" .
6309                                       "</tr>\n";
6310                         }
6311
6312                         if ($alternate) {
6313                                 print "<tr class=\"dark\">\n";
6314                         } else {
6315                                 print "<tr class=\"light\">\n";
6316                         }
6317                         $alternate ^= 1;
6318                         %co = parse_commit($set{'commit'});
6319                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
6320                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6321                               "<td><i>$author</i></td>\n" .
6322                               "<td>" .
6323                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
6324                                       -class => "list subject"},
6325                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
6326                 } elsif (defined $set{'to_id'}) {
6327                         next if is_deleted(\%set);
6328
6329                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
6330                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
6331                                       -class => "list"},
6332                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
6333                               "<br/>\n";
6334                 }
6335         }
6336         close $fd;
6337
6338         # finish last commit (warning: repetition!)
6339         if (%co) {
6340                 print "</td>\n" .
6341                       "<td class=\"link\">" .
6342                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
6343                               "commit") .
6344                       " | " .
6345                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
6346                                              hash_base=>$co{'id'})},
6347                               "tree") .
6348                       "</td>\n" .
6349                       "</tr>\n";
6350         }
6351
6352         print "</table>\n";
6353
6354         git_footer_html();
6355 }
6356
6357 sub git_search_files {
6358         my %co = @_;
6359
6360         local $/ = "\n";
6361         open my $fd, "-|", git_cmd(), 'grep', '-n', '-z',
6362                 $search_use_regexp ? ('-E', '-i') : '-F',
6363                 $searchtext, $co{'tree'}
6364                         or die_error(500, "Open git-grep failed");
6365
6366         git_header_html();
6367
6368         git_print_page_nav('','', $hash,$co{'tree'},$hash);
6369         git_print_header_div('commit', esc_html($co{'title'}), $hash);
6370
6371         print "<table class=\"grep_search\">\n";
6372         my $alternate = 1;
6373         my $matches = 0;
6374         my $lastfile = '';
6375         my $file_href;
6376         while (my $line = <$fd>) {
6377                 chomp $line;
6378                 my ($file, $lno, $ltext, $binary);
6379                 last if ($matches++ > 1000);
6380                 if ($line =~ /^Binary file (.+) matches$/) {
6381                         $file = $1;
6382                         $binary = 1;
6383                 } else {
6384                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
6385                         $file =~ s/^$co{'tree'}://;
6386                 }
6387                 if ($file ne $lastfile) {
6388                         $lastfile and print "</td></tr>\n";
6389                         if ($alternate++) {
6390                                 print "<tr class=\"dark\">\n";
6391                         } else {
6392                                 print "<tr class=\"light\">\n";
6393                         }
6394                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
6395                                           file_name=>$file);
6396                         print "<td class=\"list\">".
6397                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
6398                         print "</td><td>\n";
6399                         $lastfile = $file;
6400                 }
6401                 if ($binary) {
6402                         print "<div class=\"binary\">Binary file</div>\n";
6403                 } else {
6404                         $ltext = untabify($ltext);
6405                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
6406                                 $ltext = esc_html($1, -nbsp=>1);
6407                                 $ltext .= '<span class="match">';
6408                                 $ltext .= esc_html($2, -nbsp=>1);
6409                                 $ltext .= '</span>';
6410                                 $ltext .= esc_html($3, -nbsp=>1);
6411                         } else {
6412                                 $ltext = esc_html($ltext, -nbsp=>1);
6413                         }
6414                         print "<div class=\"pre\">" .
6415                                 $cgi->a({-href => $file_href.'#l'.$lno,
6416                                         -class => "linenr"}, sprintf('%4i', $lno)) .
6417                                 ' ' .  $ltext . "</div>\n";
6418                 }
6419         }
6420         if ($lastfile) {
6421                 print "</td></tr>\n";
6422                 if ($matches > 1000) {
6423                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
6424                 }
6425         } else {
6426                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
6427         }
6428         close $fd;
6429
6430         print "</table>\n";
6431
6432         git_footer_html();
6433 }
6434
6435 sub git_search_grep_body {
6436         my ($commitlist, $from, $to, $extra) = @_;
6437         $from = 0 unless defined $from;
6438         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6439
6440         print "<table class=\"commit_search\">\n";
6441         my $alternate = 1;
6442         for (my $i = $from; $i <= $to; $i++) {
6443                 my %co = %{$commitlist->[$i]};
6444                 if (!%co) {
6445                         next;
6446                 }
6447                 my $commit = $co{'id'};
6448                 if ($alternate) {
6449                         print "<tr class=\"dark\">\n";
6450                 } else {
6451                         print "<tr class=\"light\">\n";
6452                 }
6453                 $alternate ^= 1;
6454                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6455                       format_author_html('td', \%co, 15, 5) .
6456                       "<td>" .
6457                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
6458                                -class => "list subject"},
6459                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
6460                 my $comment = $co{'comment'};
6461                 foreach my $line (@$comment) {
6462                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
6463                                 my ($lead, $match, $trail) = ($1, $2, $3);
6464                                 $match = chop_str($match, 70, 5, 'center');
6465                                 my $contextlen = int((80 - length($match))/2);
6466                                 $contextlen = 30 if ($contextlen > 30);
6467                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
6468                                 $trail = chop_str($trail, $contextlen, 10, 'right');
6469
6470                                 $lead  = esc_html($lead);
6471                                 $match = esc_html($match);
6472                                 $trail = esc_html($trail);
6473
6474                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
6475                         }
6476                 }
6477                 print "</td>\n" .
6478                       "<td class=\"link\">" .
6479                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
6480                       " | " .
6481                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
6482                       " | " .
6483                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
6484                 print "</td>\n" .
6485                       "</tr>\n";
6486         }
6487         if (defined $extra) {
6488                 print "<tr>\n" .
6489                       "<td colspan=\"3\">$extra</td>\n" .
6490                       "</tr>\n";
6491         }
6492         print "</table>\n";
6493 }
6494
6495 ## ======================================================================
6496 ## ======================================================================
6497 ## actions
6498
6499 sub git_project_list {
6500         my $order = $input_params{'order'};
6501         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
6502                 die_error(400, "Unknown order parameter");
6503         }
6504
6505         my @list = git_get_projects_list($project_filter, $strict_export);
6506         if (!@list) {
6507                 die_error(404, "No projects found");
6508         }
6509
6510         git_header_html();
6511         if (defined $home_text && -f $home_text) {
6512                 print "<div class=\"index_include\">\n";
6513                 insert_file($home_text);
6514                 print "</div>\n";
6515         }
6516
6517         git_project_search_form($searchtext, $search_use_regexp);
6518         git_project_list_body(\@list, $order);
6519         git_footer_html();
6520 }
6521
6522 sub git_forks {
6523         my $order = $input_params{'order'};
6524         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
6525                 die_error(400, "Unknown order parameter");
6526         }
6527
6528         my $filter = $project;
6529         $filter =~ s/\.git$//;
6530         my @list = git_get_projects_list($filter);
6531         if (!@list) {
6532                 die_error(404, "No forks found");
6533         }
6534
6535         git_header_html();
6536         git_print_page_nav('','');
6537         git_print_header_div('summary', "$project forks");
6538         git_project_list_body(\@list, $order);
6539         git_footer_html();
6540 }
6541
6542 sub git_project_index {
6543         my @projects = git_get_projects_list($project_filter, $strict_export);
6544         if (!@projects) {
6545                 die_error(404, "No projects found");
6546         }
6547
6548         print $cgi->header(
6549                 -type => 'text/plain',
6550                 -charset => 'utf-8',
6551                 -content_disposition => 'inline; filename="index.aux"');
6552
6553         foreach my $pr (@projects) {
6554                 if (!exists $pr->{'owner'}) {
6555                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
6556                 }
6557
6558                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
6559                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
6560                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
6561                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
6562                 $path  =~ s/ /\+/g;
6563                 $owner =~ s/ /\+/g;
6564
6565                 print "$path $owner\n";
6566         }
6567 }
6568
6569 sub git_summary {
6570         my $descr = git_get_project_description($project) || "none";
6571         my %co = parse_commit("HEAD");
6572         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
6573         my $head = $co{'id'};
6574         my $remote_heads = gitweb_check_feature('remote_heads');
6575
6576         my $owner = git_get_project_owner($project);
6577
6578         my $refs = git_get_references();
6579         # These get_*_list functions return one more to allow us to see if
6580         # there are more ...
6581         my @taglist  = git_get_tags_list(16);
6582         my @headlist = git_get_heads_list(16);
6583         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
6584         my @forklist;
6585         my $check_forks = gitweb_check_feature('forks');
6586
6587         if ($check_forks) {
6588                 # find forks of a project
6589                 my $filter = $project;
6590                 $filter =~ s/\.git$//;
6591                 @forklist = git_get_projects_list($filter);
6592                 # filter out forks of forks
6593                 @forklist = filter_forks_from_projects_list(\@forklist)
6594                         if (@forklist);
6595         }
6596
6597         git_header_html();
6598         git_print_page_nav('summary','', $head);
6599
6600         print "<div class=\"title\">&nbsp;</div>\n";
6601         print "<table class=\"projects_list\">\n" .
6602               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
6603         if ($owner and not $omit_owner) {
6604                 print  "<tr id=\"metadata_owner\"><td>owner</td><td>" . esc_html($owner) . "</td></tr>\n";
6605         }
6606         if (defined $cd{'rfc2822'}) {
6607                 print "<tr id=\"metadata_lchange\"><td>last change</td>" .
6608                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
6609         }
6610
6611         # use per project git URL list in $projectroot/$project/cloneurl
6612         # or make project git URL from git base URL and project name
6613         my $url_tag = "URL";
6614         my @url_list = git_get_project_url_list($project);
6615         @url_list = map { "$_/$project" } @git_base_url_list unless @url_list;
6616         foreach my $git_url (@url_list) {
6617                 next unless $git_url;
6618                 print format_repo_url($url_tag, $git_url);
6619                 $url_tag = "";
6620         }
6621
6622         # Tag cloud
6623         my $show_ctags = gitweb_check_feature('ctags');
6624         if ($show_ctags) {
6625                 my $ctags = git_get_project_ctags($project);
6626                 if (%$ctags) {
6627                         # without ability to add tags, don't show if there are none
6628                         my $cloud = git_populate_project_tagcloud($ctags);
6629                         print "<tr id=\"metadata_ctags\">" .
6630                               "<td>content tags</td>" .
6631                               "<td>".git_show_project_tagcloud($cloud, 48)."</td>" .
6632                               "</tr>\n";
6633                 }
6634         }
6635
6636         print "</table>\n";
6637
6638         # If XSS prevention is on, we don't include README.html.
6639         # TODO: Allow a readme in some safe format.
6640         if (!$prevent_xss && -s "$projectroot/$project/README.html") {
6641                 print "<div class=\"title\">readme</div>\n" .
6642                       "<div class=\"readme\">\n";
6643                 insert_file("$projectroot/$project/README.html");
6644                 print "\n</div>\n"; # class="readme"
6645         }
6646
6647         # we need to request one more than 16 (0..15) to check if
6648         # those 16 are all
6649         my @commitlist = $head ? parse_commits($head, 17) : ();
6650         if (@commitlist) {
6651                 git_print_header_div('shortlog');
6652                 git_shortlog_body(\@commitlist, 0, 15, $refs,
6653                                   $#commitlist <=  15 ? undef :
6654                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
6655         }
6656
6657         if (@taglist) {
6658                 git_print_header_div('tags');
6659                 git_tags_body(\@taglist, 0, 15,
6660                               $#taglist <=  15 ? undef :
6661                               $cgi->a({-href => href(action=>"tags")}, "..."));
6662         }
6663
6664         if (@headlist) {
6665                 git_print_header_div('heads');
6666                 git_heads_body(\@headlist, $head, 0, 15,
6667                                $#headlist <= 15 ? undef :
6668                                $cgi->a({-href => href(action=>"heads")}, "..."));
6669         }
6670
6671         if (%remotedata) {
6672                 git_print_header_div('remotes');
6673                 git_remotes_body(\%remotedata, 15, $head);
6674         }
6675
6676         if (@forklist) {
6677                 git_print_header_div('forks');
6678                 git_project_list_body(\@forklist, 'age', 0, 15,
6679                                       $#forklist <= 15 ? undef :
6680                                       $cgi->a({-href => href(action=>"forks")}, "..."),
6681                                       'no_header');
6682         }
6683
6684         git_footer_html();
6685 }
6686
6687 sub git_tag {
6688         my %tag = parse_tag($hash);
6689
6690         if (! %tag) {
6691                 die_error(404, "Unknown tag object");
6692         }
6693
6694         my $head = git_get_head_hash($project);
6695         git_header_html();
6696         git_print_page_nav('','', $head,undef,$head);
6697         git_print_header_div('commit', esc_html($tag{'name'}), $hash);
6698         print "<div class=\"title_text\">\n" .
6699               "<table class=\"object_header\">\n" .
6700               "<tr>\n" .
6701               "<td>object</td>\n" .
6702               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
6703                                $tag{'object'}) . "</td>\n" .
6704               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
6705                                               $tag{'type'}) . "</td>\n" .
6706               "</tr>\n";
6707         if (defined($tag{'author'})) {
6708                 git_print_authorship_rows(\%tag, 'author');
6709         }
6710         print "</table>\n\n" .
6711               "</div>\n";
6712         print "<div class=\"page_body\">";
6713         my $comment = $tag{'comment'};
6714         foreach my $line (@$comment) {
6715                 chomp $line;
6716                 print esc_html($line, -nbsp=>1) . "<br/>\n";
6717         }
6718         print "</div>\n";
6719         git_footer_html();
6720 }
6721
6722 sub git_blame_common {
6723         my $format = shift || 'porcelain';
6724         if ($format eq 'porcelain' && $input_params{'javascript'}) {
6725                 $format = 'incremental';
6726                 $action = 'blame_incremental'; # for page title etc
6727         }
6728
6729         # permissions
6730         gitweb_check_feature('blame')
6731                 or die_error(403, "Blame view not allowed");
6732
6733         # error checking
6734         die_error(400, "No file name given") unless $file_name;
6735         $hash_base ||= git_get_head_hash($project);
6736         die_error(404, "Couldn't find base commit") unless $hash_base;
6737         my %co = parse_commit($hash_base)
6738                 or die_error(404, "Commit not found");
6739         my $ftype = "blob";
6740         if (!defined $hash) {
6741                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
6742                         or die_error(404, "Error looking up file");
6743         } else {
6744                 $ftype = git_get_type($hash);
6745                 if ($ftype !~ "blob") {
6746                         die_error(400, "Object is not a blob");
6747                 }
6748         }
6749
6750         my $fd;
6751         if ($format eq 'incremental') {
6752                 # get file contents (as base)
6753                 open $fd, "-|", git_cmd(), 'cat-file', 'blob', $hash
6754                         or die_error(500, "Open git-cat-file failed");
6755         } elsif ($format eq 'data') {
6756                 # run git-blame --incremental
6757                 open $fd, "-|", git_cmd(), "blame", "--incremental",
6758                         $hash_base, "--", $file_name
6759                         or die_error(500, "Open git-blame --incremental failed");
6760         } else {
6761                 # run git-blame --porcelain
6762                 open $fd, "-|", git_cmd(), "blame", '-p',
6763                         $hash_base, '--', $file_name
6764                         or die_error(500, "Open git-blame --porcelain failed");
6765         }
6766         binmode $fd, ':utf8';
6767
6768         # incremental blame data returns early
6769         if ($format eq 'data') {
6770                 print $cgi->header(
6771                         -type=>"text/plain", -charset => "utf-8",
6772                         -status=> "200 OK");
6773                 local $| = 1; # output autoflush
6774                 while (my $line = <$fd>) {
6775                         print to_utf8($line);
6776                 }
6777                 close $fd
6778                         or print "ERROR $!\n";
6779
6780                 print 'END';
6781                 if (defined $t0 && gitweb_check_feature('timed')) {
6782                         print ' '.
6783                               tv_interval($t0, [ gettimeofday() ]).
6784                               ' '.$number_of_git_cmds;
6785                 }
6786                 print "\n";
6787
6788                 return;
6789         }
6790
6791         # page header
6792         git_header_html();
6793         my $formats_nav =
6794                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
6795                         "blob") .
6796                 " | ";
6797         if ($format eq 'incremental') {
6798                 $formats_nav .=
6799                         $cgi->a({-href => href(action=>"blame", javascript=>0, -replay=>1)},
6800                                 "blame") . " (non-incremental)";
6801         } else {
6802                 $formats_nav .=
6803                         $cgi->a({-href => href(action=>"blame_incremental", -replay=>1)},
6804                                 "blame") . " (incremental)";
6805         }
6806         $formats_nav .=
6807                 " | " .
6808                 $cgi->a({-href => href(action=>"history", -replay=>1)},
6809                         "history") .
6810                 " | " .
6811                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
6812                         "HEAD");
6813         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
6814         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
6815         git_print_page_path($file_name, $ftype, $hash_base);
6816
6817         # page body
6818         if ($format eq 'incremental') {
6819                 print "<noscript>\n<div class=\"error\"><center><b>\n".
6820                       "This page requires JavaScript to run.\n Use ".
6821                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
6822                               'this page').
6823                       " instead.\n".
6824                       "</b></center></div>\n</noscript>\n";
6825
6826                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
6827         }
6828
6829         print qq!<div class="page_body">\n!;
6830         print qq!<div id="progress_info">... / ...</div>\n!
6831                 if ($format eq 'incremental');
6832         print qq!<table id="blame_table" class="blame" width="100%">\n!.
6833               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
6834               qq!<thead>\n!.
6835               qq!<tr><th>Commit</th><th>Line</th><th>Data</th></tr>\n!.
6836               qq!</thead>\n!.
6837               qq!<tbody>\n!;
6838
6839         my @rev_color = qw(light dark);
6840         my $num_colors = scalar(@rev_color);
6841         my $current_color = 0;
6842
6843         if ($format eq 'incremental') {
6844                 my $color_class = $rev_color[$current_color];
6845
6846                 #contents of a file
6847                 my $linenr = 0;
6848         LINE:
6849                 while (my $line = <$fd>) {
6850                         chomp $line;
6851                         $linenr++;
6852
6853                         print qq!<tr id="l$linenr" class="$color_class">!.
6854                               qq!<td class="sha1"><a href=""> </a></td>!.
6855                               qq!<td class="linenr">!.
6856                               qq!<a class="linenr" href="">$linenr</a></td>!;
6857                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
6858                         print qq!</tr>\n!;
6859                 }
6860
6861         } else { # porcelain, i.e. ordinary blame
6862                 my %metainfo = (); # saves information about commits
6863
6864                 # blame data
6865         LINE:
6866                 while (my $line = <$fd>) {
6867                         chomp $line;
6868                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
6869                         # no <lines in group> for subsequent lines in group of lines
6870                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
6871                            ($line =~ /^($oid_regex) (\d+) (\d+)(?: (\d+))?$/);
6872                         if (!exists $metainfo{$full_rev}) {
6873                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
6874                         }
6875                         my $meta = $metainfo{$full_rev};
6876                         my $data;
6877                         while ($data = <$fd>) {
6878                                 chomp $data;
6879                                 last if ($data =~ s/^\t//); # contents of line
6880                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
6881                                         $meta->{$1} = $2 unless exists $meta->{$1};
6882                                 }
6883                                 if ($data =~ /^previous /) {
6884                                         $meta->{'nprevious'}++;
6885                                 }
6886                         }
6887                         my $short_rev = substr($full_rev, 0, 8);
6888                         my $author = $meta->{'author'};
6889                         my %date =
6890                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
6891                         my $date = $date{'iso-tz'};
6892                         if ($group_size) {
6893                                 $current_color = ($current_color + 1) % $num_colors;
6894                         }
6895                         my $tr_class = $rev_color[$current_color];
6896                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
6897                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
6898                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
6899                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
6900                         if ($group_size) {
6901                                 print "<td class=\"sha1\"";
6902                                 print " title=\"". esc_html($author) . ", $date\"";
6903                                 print " rowspan=\"$group_size\"" if ($group_size > 1);
6904                                 print ">";
6905                                 print $cgi->a({-href => href(action=>"commit",
6906                                                              hash=>$full_rev,
6907                                                              file_name=>$file_name)},
6908                                               esc_html($short_rev));
6909                                 if ($group_size >= 2) {
6910                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
6911                                         if (@author_initials) {
6912                                                 print "<br />" .
6913                                                       esc_html(join('', @author_initials));
6914                                                 #           or join('.', ...)
6915                                         }
6916                                 }
6917                                 print "</td>\n";
6918                         }
6919                         # 'previous' <sha1 of parent commit> <filename at commit>
6920                         if (exists $meta->{'previous'} &&
6921                             $meta->{'previous'} =~ /^($oid_regex) (.*)$/) {
6922                                 $meta->{'parent'} = $1;
6923                                 $meta->{'file_parent'} = unquote($2);
6924                         }
6925                         my $linenr_commit =
6926                                 exists($meta->{'parent'}) ?
6927                                 $meta->{'parent'} : $full_rev;
6928                         my $linenr_filename =
6929                                 exists($meta->{'file_parent'}) ?
6930                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
6931                         my $blamed = href(action => 'blame',
6932                                           file_name => $linenr_filename,
6933                                           hash_base => $linenr_commit);
6934                         print "<td class=\"linenr\">";
6935                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
6936                                         -class => "linenr" },
6937                                       esc_html($lineno));
6938                         print "</td>";
6939                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
6940                         print "</tr>\n";
6941                 } # end while
6942
6943         }
6944
6945         # footer
6946         print "</tbody>\n".
6947               "</table>\n"; # class="blame"
6948         print "</div>\n";   # class="blame_body"
6949         close $fd
6950                 or print "Reading blob failed\n";
6951
6952         git_footer_html();
6953 }
6954
6955 sub git_blame {
6956         git_blame_common();
6957 }
6958
6959 sub git_blame_incremental {
6960         git_blame_common('incremental');
6961 }
6962
6963 sub git_blame_data {
6964         git_blame_common('data');
6965 }
6966
6967 sub git_tags {
6968         my $head = git_get_head_hash($project);
6969         git_header_html();
6970         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
6971         git_print_header_div('summary', $project);
6972
6973         my @tagslist = git_get_tags_list();
6974         if (@tagslist) {
6975                 git_tags_body(\@tagslist);
6976         }
6977         git_footer_html();
6978 }
6979
6980 sub git_heads {
6981         my $head = git_get_head_hash($project);
6982         git_header_html();
6983         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
6984         git_print_header_div('summary', $project);
6985
6986         my @headslist = git_get_heads_list();
6987         if (@headslist) {
6988                 git_heads_body(\@headslist, $head);
6989         }
6990         git_footer_html();
6991 }
6992
6993 # used both for single remote view and for list of all the remotes
6994 sub git_remotes {
6995         gitweb_check_feature('remote_heads')
6996                 or die_error(403, "Remote heads view is disabled");
6997
6998         my $head = git_get_head_hash($project);
6999         my $remote = $input_params{'hash'};
7000
7001         my $remotedata = git_get_remotes_list($remote);
7002         die_error(500, "Unable to get remote information") unless defined $remotedata;
7003
7004         unless (%$remotedata) {
7005                 die_error(404, defined $remote ?
7006                         "Remote $remote not found" :
7007                         "No remotes found");
7008         }
7009
7010         git_header_html(undef, undef, -action_extra => $remote);
7011         git_print_page_nav('', '',  $head, undef, $head,
7012                 format_ref_views($remote ? '' : 'remotes'));
7013
7014         fill_remote_heads($remotedata);
7015         if (defined $remote) {
7016                 git_print_header_div('remotes', "$remote remote for $project");
7017                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
7018         } else {
7019                 git_print_header_div('summary', "$project remotes");
7020                 git_remotes_body($remotedata, undef, $head);
7021         }
7022
7023         git_footer_html();
7024 }
7025
7026 sub git_blob_plain {
7027         my $type = shift;
7028         my $expires;
7029
7030         if (!defined $hash) {
7031                 if (defined $file_name) {
7032                         my $base = $hash_base || git_get_head_hash($project);
7033                         $hash = git_get_hash_by_path($base, $file_name, "blob")
7034                                 or die_error(404, "Cannot find file");
7035                 } else {
7036                         die_error(400, "No file name defined");
7037                 }
7038         } elsif ($hash =~ m/^$oid_regex$/) {
7039                 # blobs defined by non-textual hash id's can be cached
7040                 $expires = "+1d";
7041         }
7042
7043         open my $fd, "-|", git_cmd(), "cat-file", "blob", $hash
7044                 or die_error(500, "Open git-cat-file blob '$hash' failed");
7045
7046         # content-type (can include charset)
7047         $type = blob_contenttype($fd, $file_name, $type);
7048
7049         # "save as" filename, even when no $file_name is given
7050         my $save_as = "$hash";
7051         if (defined $file_name) {
7052                 $save_as = $file_name;
7053         } elsif ($type =~ m/^text\//) {
7054                 $save_as .= '.txt';
7055         }
7056
7057         # With XSS prevention on, blobs of all types except a few known safe
7058         # ones are served with "Content-Disposition: attachment" to make sure
7059         # they don't run in our security domain.  For certain image types,
7060         # blob view writes an <img> tag referring to blob_plain view, and we
7061         # want to be sure not to break that by serving the image as an
7062         # attachment (though Firefox 3 doesn't seem to care).
7063         my $sandbox = $prevent_xss &&
7064                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
7065
7066         # serve text/* as text/plain
7067         if ($prevent_xss &&
7068             ($type =~ m!^text/[a-z]+\b(.*)$! ||
7069              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
7070                 my $rest = $1;
7071                 $rest = defined $rest ? $rest : '';
7072                 $type = "text/plain$rest";
7073         }
7074
7075         print $cgi->header(
7076                 -type => $type,
7077                 -expires => $expires,
7078                 -content_disposition =>
7079                         ($sandbox ? 'attachment' : 'inline')
7080                         . '; filename="' . $save_as . '"');
7081         local $/ = undef;
7082         binmode STDOUT, ':raw';
7083         print <$fd>;
7084         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
7085         close $fd;
7086 }
7087
7088 sub git_blob {
7089         my $expires;
7090
7091         if (!defined $hash) {
7092                 if (defined $file_name) {
7093                         my $base = $hash_base || git_get_head_hash($project);
7094                         $hash = git_get_hash_by_path($base, $file_name, "blob")
7095                                 or die_error(404, "Cannot find file");
7096                 } else {
7097                         die_error(400, "No file name defined");
7098                 }
7099         } elsif ($hash =~ m/^$oid_regex$/) {
7100                 # blobs defined by non-textual hash id's can be cached
7101                 $expires = "+1d";
7102         }
7103
7104         my $have_blame = gitweb_check_feature('blame');
7105         open my $fd, "-|", git_cmd(), "cat-file", "blob", $hash
7106                 or die_error(500, "Couldn't cat $file_name, $hash");
7107         my $mimetype = blob_mimetype($fd, $file_name);
7108         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
7109         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
7110                 close $fd;
7111                 return git_blob_plain($mimetype);
7112         }
7113         # we can have blame only for text/* mimetype
7114         $have_blame &&= ($mimetype =~ m!^text/!);
7115
7116         my $highlight = gitweb_check_feature('highlight');
7117         my $syntax = guess_file_syntax($highlight, $file_name);
7118         $fd = run_highlighter($fd, $highlight, $syntax);
7119
7120         git_header_html(undef, $expires);
7121         my $formats_nav = '';
7122         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
7123                 if (defined $file_name) {
7124                         if ($have_blame) {
7125                                 $formats_nav .=
7126                                         $cgi->a({-href => href(action=>"blame", -replay=>1)},
7127                                                 "blame") .
7128                                         " | ";
7129                         }
7130                         $formats_nav .=
7131                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7132                                         "history") .
7133                                 " | " .
7134                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
7135                                         "raw") .
7136                                 " | " .
7137                                 $cgi->a({-href => href(action=>"blob",
7138                                                        hash_base=>"HEAD", file_name=>$file_name)},
7139                                         "HEAD");
7140                 } else {
7141                         $formats_nav .=
7142                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
7143                                         "raw");
7144                 }
7145                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
7146                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
7147         } else {
7148                 print "<div class=\"page_nav\">\n" .
7149                       "<br/><br/></div>\n" .
7150                       "<div class=\"title\">".esc_html($hash)."</div>\n";
7151         }
7152         git_print_page_path($file_name, "blob", $hash_base);
7153         print "<div class=\"page_body\">\n";
7154         if ($mimetype =~ m!^image/!) {
7155                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
7156                 if ($file_name) {
7157                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
7158                 }
7159                 print qq! src="! .
7160                       esc_attr(href(action=>"blob_plain", hash=>$hash,
7161                            hash_base=>$hash_base, file_name=>$file_name)) .
7162                       qq!" />\n!;
7163         } else {
7164                 my $nr;
7165                 while (my $line = <$fd>) {
7166                         chomp $line;
7167                         $nr++;
7168                         $line = untabify($line);
7169                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i</a> %s</div>\n!,
7170                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
7171                                $highlight ? sanitize($line) : esc_html($line, -nbsp=>1);
7172                 }
7173         }
7174         close $fd
7175                 or print "Reading blob failed.\n";
7176         print "</div>";
7177         git_footer_html();
7178 }
7179
7180 sub git_tree {
7181         if (!defined $hash_base) {
7182                 $hash_base = "HEAD";
7183         }
7184         if (!defined $hash) {
7185                 if (defined $file_name) {
7186                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
7187                 } else {
7188                         $hash = $hash_base;
7189                 }
7190         }
7191         die_error(404, "No such tree") unless defined($hash);
7192
7193         my $show_sizes = gitweb_check_feature('show-sizes');
7194         my $have_blame = gitweb_check_feature('blame');
7195
7196         my @entries = ();
7197         {
7198                 local $/ = "\0";
7199                 open my $fd, "-|", git_cmd(), "ls-tree", '-z',
7200                         ($show_sizes ? '-l' : ()), @extra_options, $hash
7201                         or die_error(500, "Open git-ls-tree failed");
7202                 @entries = map { chomp; $_ } <$fd>;
7203                 close $fd
7204                         or die_error(404, "Reading tree failed");
7205         }
7206
7207         my $refs = git_get_references();
7208         my $ref = format_ref_marker($refs, $hash_base);
7209         git_header_html();
7210         my $basedir = '';
7211         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
7212                 my @views_nav = ();
7213                 if (defined $file_name) {
7214                         push @views_nav,
7215                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7216                                         "history"),
7217                                 $cgi->a({-href => href(action=>"tree",
7218                                                        hash_base=>"HEAD", file_name=>$file_name)},
7219                                         "HEAD"),
7220                 }
7221                 my $snapshot_links = format_snapshot_links($hash);
7222                 if (defined $snapshot_links) {
7223                         # FIXME: Should be available when we have no hash base as well.
7224                         push @views_nav, $snapshot_links;
7225                 }
7226                 git_print_page_nav('tree','', $hash_base, undef, undef,
7227                                    join(' | ', @views_nav));
7228                 git_print_header_div('commit', esc_html($co{'title'}) . $ref, $hash_base);
7229         } else {
7230                 undef $hash_base;
7231                 print "<div class=\"page_nav\">\n";
7232                 print "<br/><br/></div>\n";
7233                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
7234         }
7235         if (defined $file_name) {
7236                 $basedir = $file_name;
7237                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
7238                         $basedir .= '/';
7239                 }
7240                 git_print_page_path($file_name, 'tree', $hash_base);
7241         }
7242         print "<div class=\"page_body\">\n";
7243         print "<table class=\"tree\">\n";
7244         my $alternate = 1;
7245         # '..' (top directory) link if possible
7246         if (defined $hash_base &&
7247             defined $file_name && $file_name =~ m![^/]+$!) {
7248                 if ($alternate) {
7249                         print "<tr class=\"dark\">\n";
7250                 } else {
7251                         print "<tr class=\"light\">\n";
7252                 }
7253                 $alternate ^= 1;
7254
7255                 my $up = $file_name;
7256                 $up =~ s!/?[^/]+$!!;
7257                 undef $up unless $up;
7258                 # based on git_print_tree_entry
7259                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
7260                 print '<td class="size">&nbsp;</td>'."\n" if $show_sizes;
7261                 print '<td class="list">';
7262                 print $cgi->a({-href => href(action=>"tree",
7263                                              hash_base=>$hash_base,
7264                                              file_name=>$up)},
7265                               "..");
7266                 print "</td>\n";
7267                 print "<td class=\"link\"></td>\n";
7268
7269                 print "</tr>\n";
7270         }
7271         foreach my $line (@entries) {
7272                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
7273
7274                 if ($alternate) {
7275                         print "<tr class=\"dark\">\n";
7276                 } else {
7277                         print "<tr class=\"light\">\n";
7278                 }
7279                 $alternate ^= 1;
7280
7281                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
7282
7283                 print "</tr>\n";
7284         }
7285         print "</table>\n" .
7286               "</div>";
7287         git_footer_html();
7288 }
7289
7290 sub sanitize_for_filename {
7291     my $name = shift;
7292
7293     $name =~ s!/!-!g;
7294     $name =~ s/[^[:alnum:]_.-]//g;
7295
7296     return $name;
7297 }
7298
7299 sub snapshot_name {
7300         my ($project, $hash) = @_;
7301
7302         # path/to/project.git  -> project
7303         # path/to/project/.git -> project
7304         my $name = to_utf8($project);
7305         $name =~ s,([^/])/*\.git$,$1,;
7306         $name = sanitize_for_filename(basename($name));
7307
7308         my $ver = $hash;
7309         if ($hash =~ /^[0-9a-fA-F]+$/) {
7310                 # shorten SHA-1 hash
7311                 my $full_hash = git_get_full_hash($project, $hash);
7312                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
7313                         $ver = git_get_short_hash($project, $hash);
7314                 }
7315         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
7316                 # tags don't need shortened SHA-1 hash
7317                 $ver = $1;
7318         } else {
7319                 # branches and other need shortened SHA-1 hash
7320                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
7321                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
7322                         my $ref_dir = (defined $1) ? $1 : '';
7323                         $ver = $2;
7324
7325                         $ref_dir = sanitize_for_filename($ref_dir);
7326                         # for refs neither in heads nor remotes we want to
7327                         # add a ref dir to archive name
7328                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
7329                                 $ver = $ref_dir . '-' . $ver;
7330                         }
7331                 }
7332                 $ver .= '-' . git_get_short_hash($project, $hash);
7333         }
7334         # special case of sanitization for filename - we change
7335         # slashes to dots instead of dashes
7336         # in case of hierarchical branch names
7337         $ver =~ s!/!.!g;
7338         $ver =~ s/[^[:alnum:]_.-]//g;
7339
7340         # name = project-version_string
7341         $name = "$name-$ver";
7342
7343         return wantarray ? ($name, $name) : $name;
7344 }
7345
7346 sub exit_if_unmodified_since {
7347         my ($latest_epoch) = @_;
7348         our $cgi;
7349
7350         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
7351         if (defined $if_modified) {
7352                 my $since;
7353                 if (eval { require HTTP::Date; 1; }) {
7354                         $since = HTTP::Date::str2time($if_modified);
7355                 } elsif (eval { require Time::ParseDate; 1; }) {
7356                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
7357                 }
7358                 if (defined $since && $latest_epoch <= $since) {
7359                         my %latest_date = parse_date($latest_epoch);
7360                         print $cgi->header(
7361                                 -last_modified => $latest_date{'rfc2822'},
7362                                 -status => '304 Not Modified');
7363                         goto DONE_GITWEB;
7364                 }
7365         }
7366 }
7367
7368 sub git_snapshot {
7369         my $format = $input_params{'snapshot_format'};
7370         if (!@snapshot_fmts) {
7371                 die_error(403, "Snapshots not allowed");
7372         }
7373         # default to first supported snapshot format
7374         $format ||= $snapshot_fmts[0];
7375         if ($format !~ m/^[a-z0-9]+$/) {
7376                 die_error(400, "Invalid snapshot format parameter");
7377         } elsif (!exists($known_snapshot_formats{$format})) {
7378                 die_error(400, "Unknown snapshot format");
7379         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
7380                 die_error(403, "Snapshot format not allowed");
7381         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
7382                 die_error(403, "Unsupported snapshot format");
7383         }
7384
7385         my $type = git_get_type("$hash^{}");
7386         if (!$type) {
7387                 die_error(404, 'Object does not exist');
7388         }  elsif ($type eq 'blob') {
7389                 die_error(400, 'Object is not a tree-ish');
7390         }
7391
7392         my ($name, $prefix) = snapshot_name($project, $hash);
7393         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
7394
7395         my %co = parse_commit($hash);
7396         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
7397
7398         my $cmd = quote_command(
7399                 git_cmd(), 'archive',
7400                 "--format=$known_snapshot_formats{$format}{'format'}",
7401                 "--prefix=$prefix/", $hash);
7402         if (exists $known_snapshot_formats{$format}{'compressor'}) {
7403                 $cmd .= ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}});
7404         }
7405
7406         $filename =~ s/(["\\])/\\$1/g;
7407         my %latest_date;
7408         if (%co) {
7409                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
7410         }
7411
7412         print $cgi->header(
7413                 -type => $known_snapshot_formats{$format}{'type'},
7414                 -content_disposition => 'inline; filename="' . $filename . '"',
7415                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
7416                 -status => '200 OK');
7417
7418         open my $fd, "-|", $cmd
7419                 or die_error(500, "Execute git-archive failed");
7420         binmode STDOUT, ':raw';
7421         print <$fd>;
7422         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
7423         close $fd;
7424 }
7425
7426 sub git_log_generic {
7427         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
7428
7429         my $head = git_get_head_hash($project);
7430         if (!defined $base) {
7431                 $base = $head;
7432         }
7433         if (!defined $page) {
7434                 $page = 0;
7435         }
7436         my $refs = git_get_references();
7437
7438         my $commit_hash = $base;
7439         if (defined $parent) {
7440                 $commit_hash = "$parent..$base";
7441         }
7442         my @commitlist =
7443                 parse_commits($commit_hash, 101, (100 * $page),
7444                               defined $file_name ? ($file_name, "--full-history") : ());
7445
7446         my $ftype;
7447         if (!defined $file_hash && defined $file_name) {
7448                 # some commits could have deleted file in question,
7449                 # and not have it in tree, but one of them has to have it
7450                 for (my $i = 0; $i < @commitlist; $i++) {
7451                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
7452                         last if defined $file_hash;
7453                 }
7454         }
7455         if (defined $file_hash) {
7456                 $ftype = git_get_type($file_hash);
7457         }
7458         if (defined $file_name && !defined $ftype) {
7459                 die_error(500, "Unknown type of object");
7460         }
7461         my %co;
7462         if (defined $file_name) {
7463                 %co = parse_commit($base)
7464                         or die_error(404, "Unknown commit object");
7465         }
7466
7467
7468         my $paging_nav = format_paging_nav($fmt_name, $page, $#commitlist >= 100);
7469         my $next_link = '';
7470         if ($#commitlist >= 100) {
7471                 $next_link =
7472                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7473                                  -accesskey => "n", -title => "Alt-n"}, "next");
7474         }
7475         my $patch_max = gitweb_get_feature('patches');
7476         if ($patch_max && !defined $file_name) {
7477                 if ($patch_max < 0 || @commitlist <= $patch_max) {
7478                         $paging_nav .= " &sdot; " .
7479                                 $cgi->a({-href => href(action=>"patches", -replay=>1)},
7480                                         "patches");
7481                 }
7482         }
7483
7484         git_header_html();
7485         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
7486         if (defined $file_name) {
7487                 git_print_header_div('commit', esc_html($co{'title'}), $base);
7488         } else {
7489                 git_print_header_div('summary', $project)
7490         }
7491         git_print_page_path($file_name, $ftype, $hash_base)
7492                 if (defined $file_name);
7493
7494         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
7495                      $file_name, $file_hash, $ftype);
7496
7497         git_footer_html();
7498 }
7499
7500 sub git_log {
7501         git_log_generic('log', \&git_log_body,
7502                         $hash, $hash_parent);
7503 }
7504
7505 sub git_commit {
7506         $hash ||= $hash_base || "HEAD";
7507         my %co = parse_commit($hash)
7508             or die_error(404, "Unknown commit object");
7509
7510         my $parent  = $co{'parent'};
7511         my $parents = $co{'parents'}; # listref
7512
7513         # we need to prepare $formats_nav before any parameter munging
7514         my $formats_nav;
7515         if (!defined $parent) {
7516                 # --root commitdiff
7517                 $formats_nav .= '(initial)';
7518         } elsif (@$parents == 1) {
7519                 # single parent commit
7520                 $formats_nav .=
7521                         '(parent: ' .
7522                         $cgi->a({-href => href(action=>"commit",
7523                                                hash=>$parent)},
7524                                 esc_html(substr($parent, 0, 7))) .
7525                         ')';
7526         } else {
7527                 # merge commit
7528                 $formats_nav .=
7529                         '(merge: ' .
7530                         join(' ', map {
7531                                 $cgi->a({-href => href(action=>"commit",
7532                                                        hash=>$_)},
7533                                         esc_html(substr($_, 0, 7)));
7534                         } @$parents ) .
7535                         ')';
7536         }
7537         if (gitweb_check_feature('patches') && @$parents <= 1) {
7538                 $formats_nav .= " | " .
7539                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
7540                                 "patch");
7541         }
7542
7543         if (!defined $parent) {
7544                 $parent = "--root";
7545         }
7546         my @difftree;
7547         open my $fd, "-|", git_cmd(), "diff-tree", '-r', "--no-commit-id",
7548                 @diff_opts,
7549                 (@$parents <= 1 ? $parent : '-c'),
7550                 $hash, "--"
7551                 or die_error(500, "Open git-diff-tree failed");
7552         @difftree = map { chomp; $_ } <$fd>;
7553         close $fd or die_error(404, "Reading git-diff-tree failed");
7554
7555         # non-textual hash id's can be cached
7556         my $expires;
7557         if ($hash =~ m/^$oid_regex$/) {
7558                 $expires = "+1d";
7559         }
7560         my $refs = git_get_references();
7561         my $ref = format_ref_marker($refs, $co{'id'});
7562
7563         git_header_html(undef, $expires);
7564         git_print_page_nav('commit', '',
7565                            $hash, $co{'tree'}, $hash,
7566                            $formats_nav);
7567
7568         if (defined $co{'parent'}) {
7569                 git_print_header_div('commitdiff', esc_html($co{'title'}) . $ref, $hash);
7570         } else {
7571                 git_print_header_div('tree', esc_html($co{'title'}) . $ref, $co{'tree'}, $hash);
7572         }
7573         print "<div class=\"title_text\">\n" .
7574               "<table class=\"object_header\">\n";
7575         git_print_authorship_rows(\%co);
7576         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
7577         print "<tr>" .
7578               "<td>tree</td>" .
7579               "<td class=\"sha1\">" .
7580               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
7581                        class => "list"}, $co{'tree'}) .
7582               "</td>" .
7583               "<td class=\"link\">" .
7584               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
7585                       "tree");
7586         my $snapshot_links = format_snapshot_links($hash);
7587         if (defined $snapshot_links) {
7588                 print " | " . $snapshot_links;
7589         }
7590         print "</td>" .
7591               "</tr>\n";
7592
7593         foreach my $par (@$parents) {
7594                 print "<tr>" .
7595                       "<td>parent</td>" .
7596                       "<td class=\"sha1\">" .
7597                       $cgi->a({-href => href(action=>"commit", hash=>$par),
7598                                class => "list"}, $par) .
7599                       "</td>" .
7600                       "<td class=\"link\">" .
7601                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
7602                       " | " .
7603                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
7604                       "</td>" .
7605                       "</tr>\n";
7606         }
7607         print "</table>".
7608               "</div>\n";
7609
7610         print "<div class=\"page_body\">\n";
7611         git_print_log($co{'comment'});
7612         print "</div>\n";
7613
7614         git_difftree_body(\@difftree, $hash, @$parents);
7615
7616         git_footer_html();
7617 }
7618
7619 sub git_object {
7620         # object is defined by:
7621         # - hash or hash_base alone
7622         # - hash_base and file_name
7623         my $type;
7624
7625         # - hash or hash_base alone
7626         if ($hash || ($hash_base && !defined $file_name)) {
7627                 my $object_id = $hash || $hash_base;
7628
7629                 open my $fd, "-|", quote_command(
7630                         git_cmd(), 'cat-file', '-t', $object_id) . ' 2> /dev/null'
7631                         or die_error(404, "Object does not exist");
7632                 $type = <$fd>;
7633                 defined $type && chomp $type;
7634                 close $fd
7635                         or die_error(404, "Object does not exist");
7636
7637         # - hash_base and file_name
7638         } elsif ($hash_base && defined $file_name) {
7639                 $file_name =~ s,/+$,,;
7640
7641                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
7642                         or die_error(404, "Base object does not exist");
7643
7644                 # here errors should not happen
7645                 open my $fd, "-|", git_cmd(), "ls-tree", $hash_base, "--", $file_name
7646                         or die_error(500, "Open git-ls-tree failed");
7647                 my $line = <$fd>;
7648                 close $fd;
7649
7650                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
7651                 unless ($line && $line =~ m/^([0-9]+) (.+) ($oid_regex)\t/) {
7652                         die_error(404, "File or directory for given base does not exist");
7653                 }
7654                 $type = $2;
7655                 $hash = $3;
7656         } else {
7657                 die_error(400, "Not enough information to find object");
7658         }
7659
7660         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
7661                                           hash=>$hash, hash_base=>$hash_base,
7662                                           file_name=>$file_name),
7663                              -status => '302 Found');
7664 }
7665
7666 sub git_blobdiff {
7667         my $format = shift || 'html';
7668         my $diff_style = $input_params{'diff_style'} || 'inline';
7669
7670         my $fd;
7671         my @difftree;
7672         my %diffinfo;
7673         my $expires;
7674
7675         # preparing $fd and %diffinfo for git_patchset_body
7676         # new style URI
7677         if (defined $hash_base && defined $hash_parent_base) {
7678                 if (defined $file_name) {
7679                         # read raw output
7680                         open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts,
7681                                 $hash_parent_base, $hash_base,
7682                                 "--", (defined $file_parent ? $file_parent : ()), $file_name
7683                                 or die_error(500, "Open git-diff-tree failed");
7684                         @difftree = map { chomp; $_ } <$fd>;
7685                         close $fd
7686                                 or die_error(404, "Reading git-diff-tree failed");
7687                         @difftree
7688                                 or die_error(404, "Blob diff not found");
7689
7690                 } elsif (defined $hash &&
7691                          $hash =~ $oid_regex) {
7692                         # try to find filename from $hash
7693
7694                         # read filtered raw output
7695                         open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts,
7696                                 $hash_parent_base, $hash_base, "--"
7697                                 or die_error(500, "Open git-diff-tree failed");
7698                         @difftree =
7699                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
7700                                 # $hash == to_id
7701                                 grep { /^:[0-7]{6} [0-7]{6} $oid_regex $hash/ }
7702                                 map { chomp; $_ } <$fd>;
7703                         close $fd
7704                                 or die_error(404, "Reading git-diff-tree failed");
7705                         @difftree
7706                                 or die_error(404, "Blob diff not found");
7707
7708                 } else {
7709                         die_error(400, "Missing one of the blob diff parameters");
7710                 }
7711
7712                 if (@difftree > 1) {
7713                         die_error(400, "Ambiguous blob diff specification");
7714                 }
7715
7716                 %diffinfo = parse_difftree_raw_line($difftree[0]);
7717                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
7718                 $file_name   ||= $diffinfo{'to_file'};
7719
7720                 $hash_parent ||= $diffinfo{'from_id'};
7721                 $hash        ||= $diffinfo{'to_id'};
7722
7723                 # non-textual hash id's can be cached
7724                 if ($hash_base =~ m/^$oid_regex$/ &&
7725                     $hash_parent_base =~ m/^$oid_regex$/) {
7726                         $expires = '+1d';
7727                 }
7728
7729                 # open patch output
7730                 open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts,
7731                         '-p', ($format eq 'html' ? "--full-index" : ()),
7732                         $hash_parent_base, $hash_base,
7733                         "--", (defined $file_parent ? $file_parent : ()), $file_name
7734                         or die_error(500, "Open git-diff-tree failed");
7735         }
7736
7737         # old/legacy style URI -- not generated anymore since 1.4.3.
7738         if (!%diffinfo) {
7739                 die_error('404 Not Found', "Missing one of the blob diff parameters")
7740         }
7741
7742         # header
7743         if ($format eq 'html') {
7744                 my $formats_nav =
7745                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
7746                                 "raw");
7747                 $formats_nav .= diff_style_nav($diff_style);
7748                 git_header_html(undef, $expires);
7749                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
7750                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
7751                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
7752                 } else {
7753                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
7754                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
7755                 }
7756                 if (defined $file_name) {
7757                         git_print_page_path($file_name, "blob", $hash_base);
7758                 } else {
7759                         print "<div class=\"page_path\"></div>\n";
7760                 }
7761
7762         } elsif ($format eq 'plain') {
7763                 print $cgi->header(
7764                         -type => 'text/plain',
7765                         -charset => 'utf-8',
7766                         -expires => $expires,
7767                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
7768
7769                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
7770
7771         } else {
7772                 die_error(400, "Unknown blobdiff format");
7773         }
7774
7775         # patch
7776         if ($format eq 'html') {
7777                 print "<div class=\"page_body\">\n";
7778
7779                 git_patchset_body($fd, $diff_style,
7780                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
7781                 close $fd;
7782
7783                 print "</div>\n"; # class="page_body"
7784                 git_footer_html();
7785
7786         } else {
7787                 while (my $line = <$fd>) {
7788                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
7789                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
7790
7791                         print $line;
7792
7793                         last if $line =~ m!^\+\+\+!;
7794                 }
7795                 local $/ = undef;
7796                 print <$fd>;
7797                 close $fd;
7798         }
7799 }
7800
7801 sub git_blobdiff_plain {
7802         git_blobdiff('plain');
7803 }
7804
7805 # assumes that it is added as later part of already existing navigation,
7806 # so it returns "| foo | bar" rather than just "foo | bar"
7807 sub diff_style_nav {
7808         my ($diff_style, $is_combined) = @_;
7809         $diff_style ||= 'inline';
7810
7811         return "" if ($is_combined);
7812
7813         my @styles = (inline => 'inline', 'sidebyside' => 'side by side');
7814         my %styles = @styles;
7815         @styles =
7816                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
7817
7818         return join '',
7819                 map { " | ".$_ }
7820                 map {
7821                         $_ eq $diff_style ? $styles{$_} :
7822                         $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_})
7823                 } @styles;
7824 }
7825
7826 sub git_commitdiff {
7827         my %params = @_;
7828         my $format = $params{-format} || 'html';
7829         my $diff_style = $input_params{'diff_style'} || 'inline';
7830
7831         my ($patch_max) = gitweb_get_feature('patches');
7832         if ($format eq 'patch') {
7833                 die_error(403, "Patch view not allowed") unless $patch_max;
7834         }
7835
7836         $hash ||= $hash_base || "HEAD";
7837         my %co = parse_commit($hash)
7838             or die_error(404, "Unknown commit object");
7839
7840         # choose format for commitdiff for merge
7841         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
7842                 $hash_parent = '--cc';
7843         }
7844         # we need to prepare $formats_nav before almost any parameter munging
7845         my $formats_nav;
7846         if ($format eq 'html') {
7847                 $formats_nav =
7848                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
7849                                 "raw");
7850                 if ($patch_max && @{$co{'parents'}} <= 1) {
7851                         $formats_nav .= " | " .
7852                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
7853                                         "patch");
7854                 }
7855                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
7856
7857                 if (defined $hash_parent &&
7858                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
7859                         # commitdiff with two commits given
7860                         my $hash_parent_short = $hash_parent;
7861                         if ($hash_parent =~ m/^$oid_regex$/) {
7862                                 $hash_parent_short = substr($hash_parent, 0, 7);
7863                         }
7864                         $formats_nav .=
7865                                 ' (from';
7866                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
7867                                 if ($co{'parents'}[$i] eq $hash_parent) {
7868                                         $formats_nav .= ' parent ' . ($i+1);
7869                                         last;
7870                                 }
7871                         }
7872                         $formats_nav .= ': ' .
7873                                 $cgi->a({-href => href(-replay=>1,
7874                                                        hash=>$hash_parent, hash_base=>undef)},
7875                                         esc_html($hash_parent_short)) .
7876                                 ')';
7877                 } elsif (!$co{'parent'}) {
7878                         # --root commitdiff
7879                         $formats_nav .= ' (initial)';
7880                 } elsif (scalar @{$co{'parents'}} == 1) {
7881                         # single parent commit
7882                         $formats_nav .=
7883                                 ' (parent: ' .
7884                                 $cgi->a({-href => href(-replay=>1,
7885                                                        hash=>$co{'parent'}, hash_base=>undef)},
7886                                         esc_html(substr($co{'parent'}, 0, 7))) .
7887                                 ')';
7888                 } else {
7889                         # merge commit
7890                         if ($hash_parent eq '--cc') {
7891                                 $formats_nav .= ' | ' .
7892                                         $cgi->a({-href => href(-replay=>1,
7893                                                                hash=>$hash, hash_parent=>'-c')},
7894                                                 'combined');
7895                         } else { # $hash_parent eq '-c'
7896                                 $formats_nav .= ' | ' .
7897                                         $cgi->a({-href => href(-replay=>1,
7898                                                                hash=>$hash, hash_parent=>'--cc')},
7899                                                 'compact');
7900                         }
7901                         $formats_nav .=
7902                                 ' (merge: ' .
7903                                 join(' ', map {
7904                                         $cgi->a({-href => href(-replay=>1,
7905                                                                hash=>$_, hash_base=>undef)},
7906                                                 esc_html(substr($_, 0, 7)));
7907                                 } @{$co{'parents'}} ) .
7908                                 ')';
7909                 }
7910         }
7911
7912         my $hash_parent_param = $hash_parent;
7913         if (!defined $hash_parent_param) {
7914                 # --cc for multiple parents, --root for parentless
7915                 $hash_parent_param =
7916                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
7917         }
7918
7919         # read commitdiff
7920         my $fd;
7921         my @difftree;
7922         if ($format eq 'html') {
7923                 open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts,
7924                         "--no-commit-id", "--patch-with-raw", "--full-index",
7925                         $hash_parent_param, $hash, "--"
7926                         or die_error(500, "Open git-diff-tree failed");
7927
7928                 while (my $line = <$fd>) {
7929                         chomp $line;
7930                         # empty line ends raw part of diff-tree output
7931                         last unless $line;
7932                         push @difftree, scalar parse_difftree_raw_line($line);
7933                 }
7934
7935         } elsif ($format eq 'plain') {
7936                 open $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts,
7937                         '-p', $hash_parent_param, $hash, "--"
7938                         or die_error(500, "Open git-diff-tree failed");
7939         } elsif ($format eq 'patch') {
7940                 # For commit ranges, we limit the output to the number of
7941                 # patches specified in the 'patches' feature.
7942                 # For single commits, we limit the output to a single patch,
7943                 # diverging from the git-format-patch default.
7944                 my @commit_spec = ();
7945                 if ($hash_parent) {
7946                         if ($patch_max > 0) {
7947                                 push @commit_spec, "-$patch_max";
7948                         }
7949                         push @commit_spec, '-n', "$hash_parent..$hash";
7950                 } else {
7951                         if ($params{-single}) {
7952                                 push @commit_spec, '-1';
7953                         } else {
7954                                 if ($patch_max > 0) {
7955                                         push @commit_spec, "-$patch_max";
7956                                 }
7957                                 push @commit_spec, "-n";
7958                         }
7959                         push @commit_spec, '--root', $hash;
7960                 }
7961                 open $fd, "-|", git_cmd(), "format-patch", @diff_opts,
7962                         '--encoding=utf8', '--stdout', @commit_spec
7963                         or die_error(500, "Open git-format-patch failed");
7964         } else {
7965                 die_error(400, "Unknown commitdiff format");
7966         }
7967
7968         # non-textual hash id's can be cached
7969         my $expires;
7970         if ($hash =~ m/^$oid_regex$/) {
7971                 $expires = "+1d";
7972         }
7973
7974         # write commit message
7975         if ($format eq 'html') {
7976                 my $refs = git_get_references();
7977                 my $ref = format_ref_marker($refs, $co{'id'});
7978
7979                 git_header_html(undef, $expires);
7980                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
7981                 git_print_header_div('commit', esc_html($co{'title'}) . $ref, $hash);
7982                 print "<div class=\"title_text\">\n" .
7983                       "<table class=\"object_header\">\n";
7984                 git_print_authorship_rows(\%co);
7985                 print "</table>".
7986                       "</div>\n";
7987                 print "<div class=\"page_body\">\n";
7988                 if (@{$co{'comment'}} > 1) {
7989                         print "<div class=\"log\">\n";
7990                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
7991                         print "</div>\n"; # class="log"
7992                 }
7993
7994         } elsif ($format eq 'plain') {
7995                 my $refs = git_get_references("tags");
7996                 my $tagname = git_get_rev_name_tags($hash);
7997                 my $filename = basename($project) . "-$hash.patch";
7998
7999                 print $cgi->header(
8000                         -type => 'text/plain',
8001                         -charset => 'utf-8',
8002                         -expires => $expires,
8003                         -content_disposition => 'inline; filename="' . "$filename" . '"');
8004                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
8005                 print "From: " . to_utf8($co{'author'}) . "\n";
8006                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
8007                 print "Subject: " . to_utf8($co{'title'}) . "\n";
8008
8009                 print "X-Git-Tag: $tagname\n" if $tagname;
8010                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
8011
8012                 foreach my $line (@{$co{'comment'}}) {
8013                         print to_utf8($line) . "\n";
8014                 }
8015                 print "---\n\n";
8016         } elsif ($format eq 'patch') {
8017                 my $filename = basename($project) . "-$hash.patch";
8018
8019                 print $cgi->header(
8020                         -type => 'text/plain',
8021                         -charset => 'utf-8',
8022                         -expires => $expires,
8023                         -content_disposition => 'inline; filename="' . "$filename" . '"');
8024         }
8025
8026         # write patch
8027         if ($format eq 'html') {
8028                 my $use_parents = !defined $hash_parent ||
8029                         $hash_parent eq '-c' || $hash_parent eq '--cc';
8030                 git_difftree_body(\@difftree, $hash,
8031                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
8032                 print "<br/>\n";
8033
8034                 git_patchset_body($fd, $diff_style,
8035                                   \@difftree, $hash,
8036                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
8037                 close $fd;
8038                 print "</div>\n"; # class="page_body"
8039                 git_footer_html();
8040
8041         } elsif ($format eq 'plain') {
8042                 local $/ = undef;
8043                 print <$fd>;
8044                 close $fd
8045                         or print "Reading git-diff-tree failed\n";
8046         } elsif ($format eq 'patch') {
8047                 local $/ = undef;
8048                 print <$fd>;
8049                 close $fd
8050                         or print "Reading git-format-patch failed\n";
8051         }
8052 }
8053
8054 sub git_commitdiff_plain {
8055         git_commitdiff(-format => 'plain');
8056 }
8057
8058 # format-patch-style patches
8059 sub git_patch {
8060         git_commitdiff(-format => 'patch', -single => 1);
8061 }
8062
8063 sub git_patches {
8064         git_commitdiff(-format => 'patch');
8065 }
8066
8067 sub git_history {
8068         git_log_generic('history', \&git_history_body,
8069                         $hash_base, $hash_parent_base,
8070                         $file_name, $hash);
8071 }
8072
8073 sub git_search {
8074         $searchtype ||= 'commit';
8075
8076         # check if appropriate features are enabled
8077         gitweb_check_feature('search')
8078                 or die_error(403, "Search is disabled");
8079         if ($searchtype eq 'pickaxe') {
8080                 # pickaxe may take all resources of your box and run for several minutes
8081                 # with every query - so decide by yourself how public you make this feature
8082                 gitweb_check_feature('pickaxe')
8083                         or die_error(403, "Pickaxe search is disabled");
8084         }
8085         if ($searchtype eq 'grep') {
8086                 # grep search might be potentially CPU-intensive, too
8087                 gitweb_check_feature('grep')
8088                         or die_error(403, "Grep search is disabled");
8089         }
8090
8091         if (!defined $searchtext) {
8092                 die_error(400, "Text field is empty");
8093         }
8094         if (!defined $hash) {
8095                 $hash = git_get_head_hash($project);
8096         }
8097         my %co = parse_commit($hash);
8098         if (!%co) {
8099                 die_error(404, "Unknown commit object");
8100         }
8101         if (!defined $page) {
8102                 $page = 0;
8103         }
8104
8105         if ($searchtype eq 'commit' ||
8106             $searchtype eq 'author' ||
8107             $searchtype eq 'committer') {
8108                 git_search_message(%co);
8109         } elsif ($searchtype eq 'pickaxe') {
8110                 git_search_changes(%co);
8111         } elsif ($searchtype eq 'grep') {
8112                 git_search_files(%co);
8113         } else {
8114                 die_error(400, "Unknown search type");
8115         }
8116 }
8117
8118 sub git_search_help {
8119         git_header_html();
8120         git_print_page_nav('','', $hash,$hash,$hash);
8121         print <<EOT;
8122 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
8123 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
8124 the pattern entered is recognized as the POSIX extended
8125 <a href="https://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
8126 insensitive).</p>
8127 <dl>
8128 <dt><b>commit</b></dt>
8129 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
8130 EOT
8131         my $have_grep = gitweb_check_feature('grep');
8132         if ($have_grep) {
8133                 print <<EOT;
8134 <dt><b>grep</b></dt>
8135 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
8136     a different one) are searched for the given pattern. On large trees, this search can take
8137 a while and put some strain on the server, so please use it with some consideration. Note that
8138 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
8139 case-sensitive.</dd>
8140 EOT
8141         }
8142         print <<EOT;
8143 <dt><b>author</b></dt>
8144 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
8145 <dt><b>committer</b></dt>
8146 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
8147 EOT
8148         my $have_pickaxe = gitweb_check_feature('pickaxe');
8149         if ($have_pickaxe) {
8150                 print <<EOT;
8151 <dt><b>pickaxe</b></dt>
8152 <dd>All commits that caused the string to appear or disappear from any file (changes that
8153 added, removed or "modified" the string) will be listed. This search can take a while and
8154 takes a lot of strain on the server, so please use it wisely. Note that since you may be
8155 interested even in changes just changing the case as well, this search is case sensitive.</dd>
8156 EOT
8157         }
8158         print "</dl>\n";
8159         git_footer_html();
8160 }
8161
8162 sub git_shortlog {
8163         git_log_generic('shortlog', \&git_shortlog_body,
8164                         $hash, $hash_parent);
8165 }
8166
8167 ## ......................................................................
8168 ## feeds (RSS, Atom; OPML)
8169
8170 sub git_feed {
8171         my $format = shift || 'atom';
8172         my $have_blame = gitweb_check_feature('blame');
8173
8174         # Atom: http://www.atomenabled.org/developers/syndication/
8175         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
8176         if ($format ne 'rss' && $format ne 'atom') {
8177                 die_error(400, "Unknown web feed format");
8178         }
8179
8180         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
8181         my $head = $hash || 'HEAD';
8182         my @commitlist = parse_commits($head, 150, 0, $file_name);
8183
8184         my %latest_commit;
8185         my %latest_date;
8186         my $content_type = "application/$format+xml";
8187         if (defined $cgi->http('HTTP_ACCEPT') &&
8188                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
8189                 # browser (feed reader) prefers text/xml
8190                 $content_type = 'text/xml';
8191         }
8192         if (defined($commitlist[0])) {
8193                 %latest_commit = %{$commitlist[0]};
8194                 my $latest_epoch = $latest_commit{'committer_epoch'};
8195                 exit_if_unmodified_since($latest_epoch);
8196                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
8197         }
8198         print $cgi->header(
8199                 -type => $content_type,
8200                 -charset => 'utf-8',
8201                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
8202                 -status => '200 OK');
8203
8204         # Optimization: skip generating the body if client asks only
8205         # for Last-Modified date.
8206         return if ($cgi->request_method() eq 'HEAD');
8207
8208         # header variables
8209         my $title = "$site_name - $project/$action";
8210         my $feed_type = 'log';
8211         if (defined $hash) {
8212                 $title .= " - '$hash'";
8213                 $feed_type = 'branch log';
8214                 if (defined $file_name) {
8215                         $title .= " :: $file_name";
8216                         $feed_type = 'history';
8217                 }
8218         } elsif (defined $file_name) {
8219                 $title .= " - $file_name";
8220                 $feed_type = 'history';
8221         }
8222         $title .= " $feed_type";
8223         $title = esc_html($title);
8224         my $descr = git_get_project_description($project);
8225         if (defined $descr) {
8226                 $descr = esc_html($descr);
8227         } else {
8228                 $descr = "$project " .
8229                          ($format eq 'rss' ? 'RSS' : 'Atom') .
8230                          " feed";
8231         }
8232         my $owner = git_get_project_owner($project);
8233         $owner = esc_html($owner);
8234
8235         #header
8236         my $alt_url;
8237         if (defined $file_name) {
8238                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
8239         } elsif (defined $hash) {
8240                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
8241         } else {
8242                 $alt_url = href(-full=>1, action=>"summary");
8243         }
8244         $alt_url = esc_attr($alt_url);
8245         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
8246         if ($format eq 'rss') {
8247                 print <<XML;
8248 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
8249 <channel>
8250 XML
8251                 print "<title>$title</title>\n" .
8252                       "<link>$alt_url</link>\n" .
8253                       "<description>$descr</description>\n" .
8254                       "<language>en</language>\n" .
8255                       # project owner is responsible for 'editorial' content
8256                       "<managingEditor>$owner</managingEditor>\n";
8257                 if (defined $logo || defined $favicon) {
8258                         # prefer the logo to the favicon, since RSS
8259                         # doesn't allow both
8260                         my $img = esc_url($logo || $favicon);
8261                         print "<image>\n" .
8262                               "<url>$img</url>\n" .
8263                               "<title>$title</title>\n" .
8264                               "<link>$alt_url</link>\n" .
8265                               "</image>\n";
8266                 }
8267                 if (%latest_date) {
8268                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
8269                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
8270                 }
8271                 print "<generator>gitweb v.$version/$git_version</generator>\n";
8272         } elsif ($format eq 'atom') {
8273                 print <<XML;
8274 <feed xmlns="http://www.w3.org/2005/Atom">
8275 XML
8276                 print "<title>$title</title>\n" .
8277                       "<subtitle>$descr</subtitle>\n" .
8278                       '<link rel="alternate" type="text/html" href="' .
8279                       $alt_url . '" />' . "\n" .
8280                       '<link rel="self" type="' . $content_type . '" href="' .
8281                       $cgi->self_url() . '" />' . "\n" .
8282                       "<id>" . esc_url(href(-full=>1)) . "</id>\n" .
8283                       # use project owner for feed author
8284                       "<author><name>$owner</name></author>\n";
8285                 if (defined $favicon) {
8286                         print "<icon>" . esc_url($favicon) . "</icon>\n";
8287                 }
8288                 if (defined $logo) {
8289                         # not twice as wide as tall: 72 x 27 pixels
8290                         print "<logo>" . esc_url($logo) . "</logo>\n";
8291                 }
8292                 if (! %latest_date) {
8293                         # dummy date to keep the feed valid until commits trickle in:
8294                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
8295                 } else {
8296                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
8297                 }
8298                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
8299         }
8300
8301         # contents
8302         for (my $i = 0; $i <= $#commitlist; $i++) {
8303                 my %co = %{$commitlist[$i]};
8304                 my $commit = $co{'id'};
8305                 # we read 150, we always show 30 and the ones more recent than 48 hours
8306                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
8307                         last;
8308                 }
8309                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
8310
8311                 # get list of changed files
8312                 open my $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts,
8313                         $co{'parent'} || "--root",
8314                         $co{'id'}, "--", (defined $file_name ? $file_name : ())
8315                         or next;
8316                 my @difftree = map { chomp; $_ } <$fd>;
8317                 close $fd
8318                         or next;
8319
8320                 # print element (entry, item)
8321                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
8322                 if ($format eq 'rss') {
8323                         print "<item>\n" .
8324                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
8325                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
8326                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
8327                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
8328                               "<link>" . esc_html($co_url) . "</link>\n" .
8329                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
8330                               "<content:encoded>" .
8331                               "<![CDATA[\n";
8332                 } elsif ($format eq 'atom') {
8333                         print "<entry>\n" .
8334                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
8335                               "<updated>$cd{'iso-8601'}</updated>\n" .
8336                               "<author>\n" .
8337                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
8338                         if ($co{'author_email'}) {
8339                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
8340                         }
8341                         print "</author>\n" .
8342                               # use committer for contributor
8343                               "<contributor>\n" .
8344                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
8345                         if ($co{'committer_email'}) {
8346                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
8347                         }
8348                         print "</contributor>\n" .
8349                               "<published>$cd{'iso-8601'}</published>\n" .
8350                               "<link rel=\"alternate\" type=\"text/html\" href=\"" . esc_attr($co_url) . "\" />\n" .
8351                               "<id>" . esc_html($co_url) . "</id>\n" .
8352                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
8353                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
8354                 }
8355                 my $comment = $co{'comment'};
8356                 print "<pre>\n";
8357                 foreach my $line (@$comment) {
8358                         $line = esc_html($line);
8359                         print "$line\n";
8360                 }
8361                 print "</pre><ul>\n";
8362                 foreach my $difftree_line (@difftree) {
8363                         my %difftree = parse_difftree_raw_line($difftree_line);
8364                         next if !$difftree{'from_id'};
8365
8366                         my $file = $difftree{'file'} || $difftree{'to_file'};
8367
8368                         print "<li>" .
8369                               "[" .
8370                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
8371                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
8372                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
8373                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
8374                                       -title => "diff"}, 'D');
8375                         if ($have_blame) {
8376                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
8377                                                              file_name=>$file, hash_base=>$commit),
8378                                               -title => "blame"}, 'B');
8379                         }
8380                         # if this is not a feed of a file history
8381                         if (!defined $file_name || $file_name ne $file) {
8382                                 print $cgi->a({-href => href(-full=>1, action=>"history",
8383                                                              file_name=>$file, hash=>$commit),
8384                                               -title => "history"}, 'H');
8385                         }
8386                         $file = esc_path($file);
8387                         print "] ".
8388                               "$file</li>\n";
8389                 }
8390                 if ($format eq 'rss') {
8391                         print "</ul>]]>\n" .
8392                               "</content:encoded>\n" .
8393                               "</item>\n";
8394                 } elsif ($format eq 'atom') {
8395                         print "</ul>\n</div>\n" .
8396                               "</content>\n" .
8397                               "</entry>\n";
8398                 }
8399         }
8400
8401         # end of feed
8402         if ($format eq 'rss') {
8403                 print "</channel>\n</rss>\n";
8404         } elsif ($format eq 'atom') {
8405                 print "</feed>\n";
8406         }
8407 }
8408
8409 sub git_rss {
8410         git_feed('rss');
8411 }
8412
8413 sub git_atom {
8414         git_feed('atom');
8415 }
8416
8417 sub git_opml {
8418         my @list = git_get_projects_list($project_filter, $strict_export);
8419         if (!@list) {
8420                 die_error(404, "No projects found");
8421         }
8422
8423         print $cgi->header(
8424                 -type => 'text/xml',
8425                 -charset => 'utf-8',
8426                 -content_disposition => 'inline; filename="opml.xml"');
8427
8428         my $title = esc_html($site_name);
8429         my $filter = " within subdirectory ";
8430         if (defined $project_filter) {
8431                 $filter .= esc_html($project_filter);
8432         } else {
8433                 $filter = "";
8434         }
8435         print <<XML;
8436 <?xml version="1.0" encoding="utf-8"?>
8437 <opml version="1.0">
8438 <head>
8439   <title>$title OPML Export$filter</title>
8440 </head>
8441 <body>
8442 <outline text="git RSS feeds">
8443 XML
8444
8445         foreach my $pr (@list) {
8446                 my %proj = %$pr;
8447                 my $head = git_get_head_hash($proj{'path'});
8448                 if (!defined $head) {
8449                         next;
8450                 }
8451                 $git_dir = "$projectroot/$proj{'path'}";
8452                 my %co = parse_commit($head);
8453                 if (!%co) {
8454                         next;
8455                 }
8456
8457                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
8458                 my $rss  = esc_attr(href('project' => $proj{'path'}, 'action' => 'rss', -full => 1));
8459                 my $html = esc_attr(href('project' => $proj{'path'}, 'action' => 'summary', -full => 1));
8460                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
8461         }
8462         print <<XML;
8463 </outline>
8464 </body>
8465 </opml>
8466 XML
8467 }