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