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