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