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