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