gitweb/gitweb.perl

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