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