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