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