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