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