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