gitweb/gitweb.perl

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