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