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