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