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