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