Andrew's git - gitweb.git/blob - gitweb/gitweb.perl

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