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

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