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