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