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