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