gitweb/gitweb.perl

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