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