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