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 File::Spec;
  21 use Time::HiRes qw(gettimeofday tv_interval);
  22 use Time::Local;
  23 use constant GITWEB_CACHE_FORMAT => "Gitweb Cache Format 3";
  24 binmode STDOUT, ':utf8';
  25
  26 if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
  27         eval 'sub CGI::multi_param { CGI::param(@_) }'
  28 }
  29
  30 our $t0 = [ gettimeofday() ];
  31 our $number_of_git_cmds = 0;
  32 our ($mdotsep, $barsep, $slssep, $spcsep, $spctxt);
  33
  34 BEGIN {
  35         *mdotsep = \'<span class="mdotsep">&#160;&#183;&#160;</span>';
  36         *barsep = \'<span class="barsep">&#160;|&#160;</span>';
  37         *slssep = \'<span class="slssep">&#160;/&#160;</span>';
  38         *spcsep = \'<span class="spcsep">&#160;</span>';
  39         *spctxt = \'<span style="display:none">&#160;</span>';
  40         CGI->compile() if $ENV{'MOD_PERL'};
  41 }
  42
  43 our $version = "++GIT_VERSION++";
  44
  45 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
  46 sub evaluate_uri {
  47         our $cgi;
  48
  49         our $my_url = $cgi->url();
  50         our $my_uri = $cgi->url(-absolute => 1);
  51
  52         # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
  53         # needed and used only for URLs with nonempty PATH_INFO
  54         # This must be an absolute URL (i.e. no scheme, host or port), NOT a full one
  55         our $base_url = $my_uri || '/';
  56
  57         # When the script is used as DirectoryIndex, the URL does not contain the name
  58         # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
  59         # have to do it ourselves. We make $path_info global because it's also used
  60         # later on.
  61         #
  62         # Another issue with the script being the DirectoryIndex is that the resulting
  63         # $my_url data is not the full script URL: this is good, because we want
  64         # generated links to keep implying the script name if it wasn't explicitly
  65         # indicated in the URL we're handling, but it means that $my_url cannot be used
  66         # as base URL.
  67         # Therefore, if we needed to strip PATH_INFO, then we know that we have
  68         # to build the base URL ourselves:
  69         our $path_info = decode_utf8($ENV{"PATH_INFO"});
  70         if ($path_info) {
  71                 # $path_info has already been URL-decoded by the web server, but
  72                 # $my_url and $my_uri have not. URL-decode them so we can properly
  73                 # strip $path_info.
  74                 $my_url = unescape($my_url);
  75                 $my_uri = unescape($my_uri);
  76                 if ($my_url =~ s,\Q$path_info\E$,, &&
  77                     $my_uri =~ s,\Q$path_info\E$,, &&
  78                     defined $ENV{'SCRIPT_NAME'}) {
  79                         $base_url = $ENV{'SCRIPT_NAME'} || '/';
  80                 }
  81         }
  82
  83         # target of the home link on top of all pages
  84         our $home_link = $my_uri || "/";
  85 }
  86
  87 # core git executable to use
  88 # this can just be "git" if your webserver has a sensible PATH
  89 our $GIT = "++GIT_BINDIR++/git";
  90
  91 # absolute fs-path which will be prepended to the project path
  92 #our $projectroot = "/pub/scm";
  93 our $projectroot = "++GITWEB_PROJECTROOT++";
  94
  95 # fs traversing limit for getting project list
  96 # the number is relative to the projectroot
  97 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
  98
  99 # string of the home link on top of all pages
 100 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
 101
 102 # extra breadcrumbs preceding the home link
 103 our @extra_breadcrumbs = ();
 104
 105 # name of your site or organization to appear in page titles
 106 # replace this with something more descriptive for clearer bookmarks
 107 our $site_name = "++GITWEB_SITENAME++"
 108                  || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
 109
 110 # html snippet to include in the <head> section of each page
 111 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
 112 # filename of html text to include at top of each page
 113 our $site_header = "++GITWEB_SITE_HEADER++";
 114 # html text to include at home page
 115 our $home_text = "++GITWEB_HOMETEXT++";
 116 # filename of html text to include at bottom of each page
 117 our $site_footer = "++GITWEB_SITE_FOOTER++";
 118
 119 # URI of stylesheets
 120 our @stylesheets = ("++GITWEB_CSS++");
 121 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
 122 our $stylesheet = undef;
 123 # URI of GIT logo (72x27 size)
 124 our $logo = "++GITWEB_LOGO++";
 125 # URI of GIT favicon, assumed to be image/png type
 126 our $favicon = "++GITWEB_FAVICON++";
 127 # URI of gitweb.js (JavaScript code for gitweb)
 128 our $javascript = "++GITWEB_JS++";
 129
 130 # URI and label (title) of GIT logo link
 131 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
 132 #our $logo_label = "git documentation";
 133 our $logo_url = "http://git-scm.com/";
 134 our $logo_label = "git homepage";
 135
 136 # source of projects list
 137 our $projects_list = "++GITWEB_LIST++";
 138
 139 # the width (in characters) of the projects list "Description" column
 140 our $projects_list_description_width = 25;
 141
 142 # group projects by category on the projects list
 143 # (enabled if this variable evaluates to true)
 144 our $projects_list_group_categories = 0;
 145
 146 # default category if none specified
 147 # (leave the empty string for no category)
 148 our $project_list_default_category = "";
 149
 150 # default order of projects list
 151 # valid values are none, project, descr, owner, and age
 152 our $default_projects_order = "project";
 153
 154 # default order of refs list
 155 # valid values are age and name
 156 our $default_refs_order = "age";
 157
 158 # show repository only if this file exists
 159 # (only effective if this variable evaluates to true)
 160 our $export_ok = "++GITWEB_EXPORT_OK++";
 161
 162 # don't generate age column on the projects list page
 163 our $omit_age_column = 0;
 164
 165 # use contents of this file (in iso, iso-strict or raw format) as
 166 # the last activity data if it exists and is a valid date
 167 our $lastactivity_file = undef;
 168
 169 # don't generate information about owners of repositories
 170 our $omit_owner=0;
 171
 172 # owner link hook given owner name (full and NOT obfuscated)
 173 # should return full URL-escaped link to attach to owner, for example:
 174 #    sub { return "/showowner.cgi?owner=".CGI::Util::escape($_[0]); }
 175 our $owner_link_hook = undef;
 176
 177 # show repository only if this subroutine returns true
 178 # when given the path to the project, for example:
 179 #    sub { return -e "$_[0]/git-daemon-export-ok"; }
 180 our $export_auth_hook = undef;
 181
 182 # only allow viewing of repositories also shown on the overview page
 183 our $strict_export = "++GITWEB_STRICT_EXPORT++";
 184
 185 # base URL for bundle info link shown on summary page, but only if
 186 # this config item is defined AND a 'bundles' subdirectory exists
 187 # in the project's repository.
 188 # i.e. full URL is "git_base_bundles_url/$project/bundles"
 189 our $git_base_bundles_url = undef;
 190
 191 ## URL Hints
 192 ##
 193 ## Any of the urls in @git_base_url_list, @git_base_mirror_urls or
 194 ## @git_base_push_urls may be an array ref instead of a scalar in which
 195 ## case ${}[0] is the url and ${}[1] is an html fragment "hint" to display
 196 ## right after the URL.
 197
 198 # list of git base URLs used for URL to where fetch project from,
 199 # i.e. full URL is "$git_base_url/$project"
 200 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
 201
 202 ## For push projects (a .nofetch file exists OR gitweb.showpush is true)
 203 ## @git_base_url_list entries are shown as "URL" and @git_base_push_urls
 204 ## are shown as "push URL" and @git_base_mirror_urls are ignored.
 205 ## For non-push projects, @git_base_url_list and @git_base_mirror_urls are shown
 206 ## as "URL" and @git_base_push_urls are ignored.
 207
 208 # URLs shown for mirrors but not for push projects in addition to base_url_list,
 209 # extended by the project name (i.e. full URL is "$git_mirror_url/$project")
 210 our @git_base_mirror_urls = ();
 211
 212 # URLs designated for pushing new changes, extended by the
 213 # project name (i.e. "$git_base_push_url[0]/$project")
 214 our @git_base_push_urls = ();
 215
 216 # https hint html inserted right after any https push URL (undef for none)
 217 # ignored if the url already has its own hint
 218 # this is supported for backwards compatibility but is now deprecated in favor
 219 # of using an array ref in the @git_base_push_urls list instead
 220 our $https_hint_html = undef;
 221
 222 # default blob_plain mimetype and default charset for text/plain blob
 223 our $default_blob_plain_mimetype = 'application/octet-stream';
 224 our $default_text_plain_charset  = undef;
 225
 226 # file to use for guessing MIME types before trying /etc/mime.types
 227 # (relative to the current git repository)
 228 our $mimetypes_file = undef;
 229
 230 # assume this charset if line contains non-UTF-8 characters;
 231 # it should be valid encoding (see Encoding::Supported(3pm) for list),
 232 # for which encoding all byte sequences are valid, for example
 233 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
 234 # could be even 'utf-8' for the old behavior)
 235 our $fallback_encoding = 'latin1';
 236
 237 # rename detection options for git-diff and git-diff-tree
 238 # - default is '-M', with the cost proportional to
 239 #   (number of removed files) * (number of new files).
 240 # - more costly is '-C' (which implies '-M'), with the cost proportional to
 241 #   (number of changed files + number of removed files) * (number of new files)
 242 # - even more costly is '-C', '--find-copies-harder' with cost
 243 #   (number of files in the original tree) * (number of new files)
 244 # - one might want to include '-B' option, e.g. '-B', '-M'
 245 our @diff_opts = ('-M'); # taken from git_commit
 246
 247 # cache directory (relative to $GIT_DIR) for project-specific html page caches.
 248 # the directory must exist and be writable by the process running gitweb.
 249 # additionally some actions must be selected for caching in %html_cache_actions
 250 # - default is 'htmlcache'
 251 our $html_cache_dir = 'htmlcache';
 252
 253 # which actions to cache in $html_cache_dir
 254 # if $html_cache_dir exists (relative to $GIT_DIR) and is writable by the
 255 # process running gitweb, then any actions selected here will have their output
 256 # cached and the cache file will be returned instead of regenerating the page
 257 # if it exists.  For this to be useful, an external process must create the
 258 # 'changed' file (if it does not already exist) in the $html_cache_dir whenever
 259 # the project information has been changed.  Alternatively it may create a
 260 # "$action.changed" file (if it does not exist) instead to limit the changes
 261 # to just "$action" instead of any action.  If 'changed' or "$action.changed"
 262 # exist, then the cached version will never be used for "$action" and a new
 263 # cache page will be regenerated (and the "changed" files removed as appropriate).
 264 #
 265 # Additionally if $projlist_cache_lifetime is > 0 AND the forks feature has been
 266 # enabled ('$feature{'forks'}{'default'} = [1];') then additionally an external
 267 # process must create the 'forkchange' file or update its timestamp if it already
 268 # exists whenever a fork is added to or removed from the project (as well as
 269 # create the 'changed' or "$action.changed" file).  Otherwise the "forks"
 270 # section on the summary page may remain out-of-date indefinately.
 271 #
 272 # - default is none
 273 #   currently only caching of the summary page is supported
 274 # - to enable caching of the summary page use:
 275 #   $html_cache_actions{'summary'} = 1;
 276 our %html_cache_actions = ();
 277
 278 # utility to automatically produce a default README.html if README.html is
 279 # enabled and it does not exist or is 0 bytes in length.  If this is set to an
 280 # executable utility that takes an absolute path to a .git directory as its
 281 # first argument and outputs an HTML fragment to use for README.html, then
 282 # it will be called when README.html is enabled but empty or missing.
 283 our $git_automatic_readme_html = undef;
 284
 285 # Disables features that would allow repository owners to inject script into
 286 # the gitweb domain.
 287 our $prevent_xss = 0;
 288
 289 # Path to a POSIX shell.  Needed to run $highlight_bin and a snapshot compressor.
 290 # Only used when highlight is enabled or snapshots with compressors are enabled.
 291 our $posix_shell_bin = "++POSIX_SHELL_BIN++";
 292
 293 # Path to the highlight executable to use (must be the one from
 294 # http://www.andre-simon.de due to assumptions about parameters and output).
 295 # Useful if highlight is not installed on your webserver's PATH.
 296 # [Default: highlight]
 297 our $highlight_bin = "++HIGHLIGHT_BIN++";
 298
 299 # Whether to include project list on the gitweb front page; 0 means yes,
 300 # 1 means no list but show tag cloud if enabled (all projects still need
 301 # to be scanned, unless the info is cached), 2 means no list and no tag cloud
 302 # (very fast)
 303 our $frontpage_no_project_list = 0;
 304
 305 # projects list cache for busy sites with many projects;
 306 # if you set this to non-zero, it will be used as the cached
 307 # index lifetime in minutes
 308 #
 309 # the cached list version is stored in $cache_dir/$cache_name and can
 310 # be tweaked by other scripts running with the same uid as gitweb -
 311 # use this ONLY at secure installations; only single gitweb project
 312 # root per system is supported, unless you tweak configuration!
 313 our $projlist_cache_lifetime = 0; # in minutes
 314 # FHS compliant $cache_dir would be "/var/cache/gitweb"
 315 our $cache_dir =
 316         (defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp').'/gitweb';
 317 our $projlist_cache_name = 'gitweb.index.cache';
 318 our $cache_grpshared = 0;
 319
 320 # information about snapshot formats that gitweb is capable of serving
 321 our %known_snapshot_formats = (
 322         # name => {
 323         #       'display' => display name,
 324         #       'type' => mime type,
 325         #       'suffix' => filename suffix,
 326         #       'format' => --format for git-archive,
 327         #       'compressor' => [compressor command and arguments]
 328         #                       (array reference, optional)
 329         #       'disabled' => boolean (optional)}
 330         #
 331         'tgz' => {
 332                 'display' => 'tar.gz',
 333                 'type' => 'application/x-gzip',
 334                 'suffix' => '.tar.gz',
 335                 'format' => 'tar',
 336                 'compressor' => ['gzip', '-n']},
 337
 338         'tbz2' => {
 339                 'display' => 'tar.bz2',
 340                 'type' => 'application/x-bzip2',
 341                 'suffix' => '.tar.bz2',
 342                 'format' => 'tar',
 343                 'compressor' => ['bzip2']},
 344
 345         'txz' => {
 346                 'display' => 'tar.xz',
 347                 'type' => 'application/x-xz',
 348                 'suffix' => '.tar.xz',
 349                 'format' => 'tar',
 350                 'compressor' => ['xz'],
 351                 'disabled' => 1},
 352
 353         'zip' => {
 354                 'display' => 'zip',
 355                 'type' => 'application/x-zip',
 356                 'suffix' => '.zip',
 357                 'format' => 'zip'},
 358 );
 359
 360 # Aliases so we understand old gitweb.snapshot values in repository
 361 # configuration.
 362 our %known_snapshot_format_aliases = (
 363         'gzip'  => 'tgz',
 364         'bzip2' => 'tbz2',
 365         'xz'    => 'txz',
 366
 367         # backward compatibility: legacy gitweb config support
 368         'x-gzip' => undef, 'gz' => undef,
 369         'x-bzip2' => undef, 'bz2' => undef,
 370         'x-zip' => undef, '' => undef,
 371 );
 372
 373 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
 374 # are changed, it may be appropriate to change these values too via
 375 # $GITWEB_CONFIG.
 376 our %avatar_size = (
 377         'default' => 16,
 378         'double'  => 32
 379 );
 380
 381 # Used to set the maximum load that we will still respond to gitweb queries.
 382 # If server load exceed this value then return "503 server busy" error.
 383 # If gitweb cannot determined server load, it is taken to be 0.
 384 # Leave it undefined (or set to 'undef') to turn off load checking.
 385 our $maxload = 300;
 386
 387 # configuration for 'highlight' (http://www.andre-simon.de/)
 388 # match by basename
 389 our %highlight_basename = (
 390         #'Program' => 'py',
 391         #'Library' => 'py',
 392         'SConstruct' => 'py', # SCons equivalent of Makefile
 393         'Makefile' => 'make',
 394         'makefile' => 'make',
 395         'GNUmakefile' => 'make',
 396         'BSDmakefile' => 'make',
 397 );
 398 # match by shebang regex
 399 our %highlight_shebang = (
 400         # Each entry has a key which is the syntax to use and
 401         # a value which is either a qr regex or an array of qr regexs to match
 402         # against the first 128 (less if the blob is shorter) BYTES of the blob.
 403         # We match /usr/bin/env items separately to require "/usr/bin/env" and
 404         # allow a limited subset of NAME=value items to appear.
 405         'awk'    => [ qr,^#!\s*/(?:\w+/)*(?:[gnm]?awk)(?:\s|$),mo,
 406                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[gnm]?awk)(?:\s|$),mo ],
 407         'make'   => [ qr,^#!\s*/(?:\w+/)*(?:g?make)(?:\s|$),mo,
 408                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:g?make)(?:\s|$),mo ],
 409         'php'    => [ qr,^#!\s*/(?:\w+/)*(?:php)(?:\s|$),mo,
 410                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:php)(?:\s|$),mo ],
 411         'pl'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 412                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 413         'py'     => [ qr,^#!\s*/(?:\w+/)*(?:python)(?:\s|$),mo,
 414                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:python)(?:\s|$),mo ],
 415         'sh'     => [ qr,^#!\s*/(?:\w+/)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo,
 416                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo ],
 417         'rb'     => [ qr,^#!\s*/(?:\w+/)*(?:ruby)(?:\s|$),mo,
 418                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:ruby)(?:\s|$),mo ],
 419 );
 420 # match by extension
 421 our %highlight_ext = (
 422         # main extensions, defining name of syntax;
 423         # see files in /usr/share/highlight/langDefs/ directory
 424         (map { $_ => $_ } qw(
 425                 4gl a4c abnf abp ada agda ahk ampl amtrix applescript arc
 426                 arm as asm asp aspect ats au3 avenue awk bat bb bbcode bib
 427                 bms bnf boo c cb cfc chl clipper clojure clp cob cs css d
 428                 diff dot dylan e ebnf erl euphoria exp f90 flx for frink fs
 429                 go haskell hcl html httpd hx icl icn idl idlang ili
 430                 inc_luatex ini inp io iss j java js jsp lbn ldif lgt lhs
 431                 lisp lotos ls lsl lua ly make mel mercury mib miranda ml mo
 432                 mod2 mod3 mpl ms mssql n nas nbc nice nrx nsi nut nxc oberon
 433                 objc octave oorexx os oz pas php pike pl pl1 pov pro
 434                 progress ps ps1 psl pure py pyx q qmake qu r rb rebol rexx
 435                 rnc s sas sc scala scilab sh sma smalltalk sml sno spec spn
 436                 sql sybase tcl tcsh tex ttcn3 vala vb verilog vhd xml xpp y
 437                 yaiff znn)),
 438         # alternate extensions, see /etc/highlight/filetypes.conf
 439         (map { $_ => '4gl' } qw(informix)),
 440         (map { $_ => 'a4c' } qw(ascend)),
 441         (map { $_ => 'abp' } qw(abp4)),
 442         (map { $_ => 'ada' } qw(a adb ads gnad)),
 443         (map { $_ => 'ahk' } qw(autohotkey)),
 444         (map { $_ => 'ampl' } qw(dat run)),
 445         (map { $_ => 'amtrix' } qw(hnd s4 s4h s4t t4)),
 446         (map { $_ => 'as' } qw(actionscript)),
 447         (map { $_ => 'asm' } qw(29k 68s 68x a51 assembler x68 x86)),
 448         (map { $_ => 'asp' } qw(asa)),
 449         (map { $_ => 'aspect' } qw(was wud)),
 450         (map { $_ => 'ats' } qw(dats)),
 451         (map { $_ => 'au3' } qw(autoit)),
 452         (map { $_ => 'bat' } qw(cmd)),
 453         (map { $_ => 'bb' } qw(blitzbasic)),
 454         (map { $_ => 'bib' } qw(bibtex)),
 455         (map { $_ => 'c' } qw(c++ cc cpp cu cxx h hh hpp hxx)),
 456         (map { $_ => 'cb' } qw(clearbasic)),
 457         (map { $_ => 'cfc' } qw(cfm coldfusion)),
 458         (map { $_ => 'chl' } qw(chill)),
 459         (map { $_ => 'cob' } qw(cbl cobol)),
 460         (map { $_ => 'cs' } qw(csharp)),
 461         (map { $_ => 'diff' } qw(patch)),
 462         (map { $_ => 'dot' } qw(graphviz)),
 463         (map { $_ => 'e' } qw(eiffel se)),
 464         (map { $_ => 'erl' } qw(erlang hrl)),
 465         (map { $_ => 'euphoria' } qw(eu ew ex exu exw wxu)),
 466         (map { $_ => 'exp' } qw(express)),
 467         (map { $_ => 'f90' } qw(f95)),
 468         (map { $_ => 'flx' } qw(felix)),
 469         (map { $_ => 'for' } qw(f f77 ftn)),
 470         (map { $_ => 'fs' } qw(fsharp fsx)),
 471         (map { $_ => 'haskell' } qw(hs)),
 472         (map { $_ => 'html' } qw(htm xhtml)),
 473         (map { $_ => 'hx' } qw(haxe)),
 474         (map { $_ => 'icl' } qw(clean)),
 475         (map { $_ => 'icn' } qw(icon)),
 476         (map { $_ => 'ili' } qw(interlis)),
 477         (map { $_ => 'inp' } qw(fame)),
 478         (map { $_ => 'iss' } qw(innosetup)),
 479         (map { $_ => 'j' } qw(jasmin)),
 480         (map { $_ => 'java' } qw(groovy grv)),
 481         (map { $_ => 'lbn' } qw(luban)),
 482         (map { $_ => 'lgt' } qw(logtalk)),
 483         (map { $_ => 'lisp' } qw(cl clisp el lsp sbcl scom)),
 484         (map { $_ => 'ls' } qw(lotus)),
 485         (map { $_ => 'lsl' } qw(lindenscript)),
 486         (map { $_ => 'ly' } qw(lilypond)),
 487         (map { $_ => 'make' } qw(mak mk kmk)),
 488         (map { $_ => 'mel' } qw(maya)),
 489         (map { $_ => 'mib' } qw(smi snmp)),
 490         (map { $_ => 'ml' } qw(mli ocaml)),
 491         (map { $_ => 'mo' } qw(modelica)),
 492         (map { $_ => 'mod2' } qw(def mod)),
 493         (map { $_ => 'mod3' } qw(i3 m3)),
 494         (map { $_ => 'mpl' } qw(maple)),
 495         (map { $_ => 'n' } qw(nemerle)),
 496         (map { $_ => 'nas' } qw(nasal)),
 497         (map { $_ => 'nrx' } qw(netrexx)),
 498         (map { $_ => 'nsi' } qw(nsis)),
 499         (map { $_ => 'nut' } qw(squirrel)),
 500         (map { $_ => 'oberon' } qw(ooc)),
 501         (map { $_ => 'objc' } qw(M m mm)),
 502         (map { $_ => 'php' } qw(php3 php4 php5 php6)),
 503         (map { $_ => 'pike' } qw(pmod)),
 504         (map { $_ => 'pl' } qw(perl plex plx pm)),
 505         (map { $_ => 'pl1' } qw(bdy ff fp fpp rpp sf sp spb spe spp sps wf wp wpb wpp wps)),
 506         (map { $_ => 'progress' } qw(i p w)),
 507         (map { $_ => 'py' } qw(python)),
 508         (map { $_ => 'pyx' } qw(pyrex)),
 509         (map { $_ => 'rb' } qw(pp rjs ruby)),
 510         (map { $_ => 'rexx' } qw(rex rx the)),
 511         (map { $_ => 'sc' } qw(paradox)),
 512         (map { $_ => 'scilab' } qw(sce sci)),
 513         (map { $_ => 'sh' } qw(bash ebuild eclass ksh zsh)),
 514         (map { $_ => 'sma' } qw(small)),
 515         (map { $_ => 'smalltalk' } qw(gst sq st)),
 516         (map { $_ => 'sno' } qw(snobal)),
 517         (map { $_ => 'sybase' } qw(sp)),
 518         (map { $_ => 'tcl' } qw(itcl wish)),
 519         (map { $_ => 'tex' } qw(cls sty)),
 520         (map { $_ => 'vb' } qw(bas basic bi vbs)),
 521         (map { $_ => 'verilog' } qw(v)),
 522         (map { $_ => 'xml' } qw(dtd ecf ent hdr hub jnlp nrm plist resx sgm sgml svg tld vxml wml xsd xsl)),
 523         (map { $_ => 'y' } qw(bison)),
 524 );
 525
 526 # You define site-wide feature defaults here; override them with
 527 # $GITWEB_CONFIG as necessary.
 528 our %feature = (
 529         # feature => {
 530         #       'sub' => feature-sub (subroutine),
 531         #       'override' => allow-override (boolean),
 532         #       'default' => [ default options...] (array reference)}
 533         #
 534         # if feature is overridable (it means that allow-override has true value),
 535         # then feature-sub will be called with default options as parameters;
 536         # return value of feature-sub indicates if to enable specified feature
 537         #
 538         # if there is no 'sub' key (no feature-sub), then feature cannot be
 539         # overridden
 540         #
 541         # use gitweb_get_feature(<feature>) to retrieve the <feature> value
 542         # (an array) or gitweb_check_feature(<feature>) to check if <feature>
 543         # is enabled
 544
 545         # Enable the 'blame' blob view, showing the last commit that modified
 546         # each line in the file. This can be very CPU-intensive.
 547
 548         # To enable system wide have in $GITWEB_CONFIG
 549         # $feature{'blame'}{'default'} = [1];
 550         # To have project specific config enable override in $GITWEB_CONFIG
 551         # $feature{'blame'}{'override'} = 1;
 552         # and in project config gitweb.blame = 0|1;
 553         'blame' => {
 554                 'sub' => sub { feature_bool('blame', @_) },
 555                 'override' => 0,
 556                 'default' => [0]},
 557
 558         # Enable the 'incremental blame' blob view, which uses javascript to
 559         # incrementally show the revisions of lines as they are discovered
 560         # in the history. It is better for large histories, files and slow
 561         # servers, but requires javascript in the client and can slow down the
 562         # browser on large files.
 563
 564         # To enable system wide have in $GITWEB_CONFIG
 565         # $feature{'blame_incremental'}{'default'} = [1];
 566         # To have project specific config enable override in $GITWEB_CONFIG
 567         # $feature{'blame_incremental'}{'override'} = 1;
 568         # and in project config gitweb.blame_incremental = 0|1;
 569         'blame_incremental' => {
 570                 'sub' => sub { feature_bool('blame_incremental', @_) },
 571                 'override' => 0,
 572                 'default' => [0]},
 573
 574         # Enable the 'snapshot' link, providing a compressed archive of any
 575         # tree. This can potentially generate high traffic if you have large
 576         # project.
 577
 578         # Value is a list of formats defined in %known_snapshot_formats that
 579         # you wish to offer.
 580         # To disable system wide have in $GITWEB_CONFIG
 581         # $feature{'snapshot'}{'default'} = [];
 582         # To have project specific config enable override in $GITWEB_CONFIG
 583         # $feature{'snapshot'}{'override'} = 1;
 584         # and in project config, a comma-separated list of formats or "none"
 585         # to disable.  Example: gitweb.snapshot = tbz2,zip;
 586         'snapshot' => {
 587                 'sub' => \&feature_snapshot,
 588                 'override' => 0,
 589                 'default' => ['tgz']},
 590
 591         # Enable text search, which will list the commits which match author,
 592         # committer or commit text to a given string.  Enabled by default.
 593         # Project specific override is not supported.
 594         #
 595         # Note that this controls all search features, which means that if
 596         # it is disabled, then 'grep' and 'pickaxe' search would also be
 597         # disabled.
 598         'search' => {
 599                 'override' => 0,
 600                 'default' => [1]},
 601
 602         # Enable regular expression search.  Enabled by default.
 603         # Note that you need to have 'search' feature enabled too.
 604         #
 605         # Note that this affects all git search features, which means that if
 606         # it is disabled, none of the git search options will allow a regular
 607         # expression (the "RE" checkbox) to be used.  However, the project
 608         # list search is unaffected by this setting (it uses Perl to do the
 609         # matching not Git) and will always allow a regular expression to
 610         # be used (by checking the box) regardless of this setting.
 611         'regexp' => {
 612                 'sub' => sub { feature_bool('regexp', @_) },
 613                 'override' => 0,
 614                 'default' => [1]},
 615
 616         # Enable grep search, which will list the files in currently selected
 617         # tree containing the given string. Enabled by default. This can be
 618         # potentially CPU-intensive, of course.
 619         # Note that you need to have 'search' feature enabled too.
 620
 621         # To enable system wide have in $GITWEB_CONFIG
 622         # $feature{'grep'}{'default'} = [1];
 623         # To have project specific config enable override in $GITWEB_CONFIG
 624         # $feature{'grep'}{'override'} = 1;
 625         # and in project config gitweb.grep = 0|1;
 626         'grep' => {
 627                 'sub' => sub { feature_bool('grep', @_) },
 628                 'override' => 0,
 629                 'default' => [1]},
 630
 631         # Enable the pickaxe search, which will list the commits that modified
 632         # a given string in a file. This can be practical and quite faster
 633         # alternative to 'blame', but still potentially CPU-intensive.
 634         # Note that you need to have 'search' feature enabled too.
 635
 636         # To enable system wide have in $GITWEB_CONFIG
 637         # $feature{'pickaxe'}{'default'} = [1];
 638         # To have project specific config enable override in $GITWEB_CONFIG
 639         # $feature{'pickaxe'}{'override'} = 1;
 640         # and in project config gitweb.pickaxe = 0|1;
 641         'pickaxe' => {
 642                 'sub' => sub { feature_bool('pickaxe', @_) },
 643                 'override' => 0,
 644                 'default' => [1]},
 645
 646         # Enable showing size of blobs in a 'tree' view, in a separate
 647         # column, similar to what 'ls -l' does.  This cost a bit of IO.
 648
 649         # To disable system wide have in $GITWEB_CONFIG
 650         # $feature{'show-sizes'}{'default'} = [0];
 651         # To have project specific config enable override in $GITWEB_CONFIG
 652         # $feature{'show-sizes'}{'override'} = 1;
 653         # and in project config gitweb.showsizes = 0|1;
 654         'show-sizes' => {
 655                 'sub' => sub { feature_bool('showsizes', @_) },
 656                 'override' => 0,
 657                 'default' => [1]},
 658
 659         # Make gitweb use an alternative format of the URLs which can be
 660         # more readable and natural-looking: project name is embedded
 661         # directly in the path and the query string contains other
 662         # auxiliary information. All gitweb installations recognize
 663         # URL in either format; this configures in which formats gitweb
 664         # generates links.
 665
 666         # To enable system wide have in $GITWEB_CONFIG
 667         # $feature{'pathinfo'}{'default'} = [1];
 668         # Project specific override is not supported.
 669
 670         # Note that you will need to change the default location of CSS,
 671         # favicon, logo and possibly other files to an absolute URL. Also,
 672         # if gitweb.cgi serves as your indexfile, you will need to force
 673         # $my_uri to contain the script name in your $GITWEB_CONFIG (and you
 674         # will also likely want to set $home_link if you're setting $my_uri).
 675         'pathinfo' => {
 676                 'override' => 0,
 677                 'default' => [0]},
 678
 679         # Make gitweb consider projects in project root subdirectories
 680         # to be forks of existing projects. Given project $projname.git,
 681         # projects matching $projname/*.git will not be shown in the main
 682         # projects list, instead a '+' mark will be added to $projname
 683         # there and a 'forks' view will be enabled for the project, listing
 684         # all the forks. If project list is taken from a file, forks have
 685         # to be listed after the main project.
 686
 687         # To enable system wide have in $GITWEB_CONFIG
 688         # $feature{'forks'}{'default'} = [1];
 689         # Project specific override is not supported.
 690         'forks' => {
 691                 'override' => 0,
 692                 'default' => [0]},
 693
 694         # Insert custom links to the action bar of all project pages.
 695         # This enables you mainly to link to third-party scripts integrating
 696         # into gitweb; e.g. git-browser for graphical history representation
 697         # or custom web-based repository administration interface.
 698
 699         # The 'default' value consists of a list of triplets in the form
 700         # (label, link, position) where position is the label after which
 701         # to insert the link and link is a format string where %n expands
 702         # to the project name, %f to the project path within the filesystem,
 703         # %h to the current hash (h gitweb parameter) and %b to the current
 704         # hash base (hb gitweb parameter); %% expands to %.  %e expands to the
 705         # project name where all '+' characters have been replaced with '%2B'.
 706
 707         # To enable system wide have in $GITWEB_CONFIG e.g.
 708         # $feature{'actions'}{'default'} = [('graphiclog',
 709         #       '/git-browser/by-commit.html?r=%n', 'summary')];
 710         # Project specific override is not supported.
 711         'actions' => {
 712                 'override' => 0,
 713                 'default' => []},
 714
 715         # Allow gitweb scan project content tags of project repository,
 716         # and display the popular Web 2.0-ish "tag cloud" near the projects
 717         # list.  Note that this is something COMPLETELY different from the
 718         # normal Git tags.
 719
 720         # gitweb by itself can show existing tags, but it does not handle
 721         # tagging itself; you need to do it externally, outside gitweb.
 722         # The format is described in git_get_project_ctags() subroutine.
 723         # You may want to install the HTML::TagCloud Perl module to get
 724         # a pretty tag cloud instead of just a list of tags.
 725
 726         # To enable system wide have in $GITWEB_CONFIG
 727         # $feature{'ctags'}{'default'} = [1];
 728         # Project specific override is not supported.
 729
 730         # A value of 0 means no ctags display or editing.  A value of
 731         # 1 enables ctags display but never editing.  A non-empty value
 732         # that is not a string of digits enables ctags display AND the
 733         # ability to add tags using a form that uses method POST and
 734         # an action value set to the configured 'ctags' value.
 735         'ctags' => {
 736                 'override' => 0,
 737                 'default' => [0]},
 738
 739         # The maximum number of patches in a patchset generated in patch
 740         # view. Set this to 0 or undef to disable patch view, or to a
 741         # negative number to remove any limit.
 742
 743         # To disable system wide have in $GITWEB_CONFIG
 744         # $feature{'patches'}{'default'} = [0];
 745         # To have project specific config enable override in $GITWEB_CONFIG
 746         # $feature{'patches'}{'override'} = 1;
 747         # and in project config gitweb.patches = 0|n;
 748         # where n is the maximum number of patches allowed in a patchset.
 749         'patches' => {
 750                 'sub' => \&feature_patches,
 751                 'override' => 0,
 752                 'default' => [16]},
 753
 754         # Avatar support. When this feature is enabled, views such as
 755         # shortlog or commit will display an avatar associated with
 756         # the email of the committer(s) and/or author(s).
 757
 758         # Currently available providers are gravatar and picon.
 759         # If an unknown provider is specified, the feature is disabled.
 760
 761         # Gravatar depends on Digest::MD5.
 762         # Picon currently relies on the indiana.edu database.
 763
 764         # To enable system wide have in $GITWEB_CONFIG
 765         # $feature{'avatar'}{'default'} = ['<provider>'];
 766         # where <provider> is either gravatar or picon.
 767         # To have project specific config enable override in $GITWEB_CONFIG
 768         # $feature{'avatar'}{'override'} = 1;
 769         # and in project config gitweb.avatar = <provider>;
 770         'avatar' => {
 771                 'sub' => \&feature_avatar,
 772                 'override' => 0,
 773                 'default' => ['']},
 774
 775         # Enable displaying how much time and how many git commands
 776         # it took to generate and display page.  Disabled by default.
 777         # Project specific override is not supported.
 778         'timed' => {
 779                 'override' => 0,
 780                 'default' => [0]},
 781
 782         # Enable turning some links into links to actions which require
 783         # JavaScript to run (like 'blame_incremental').  Not enabled by
 784         # default.  Project specific override is currently not supported.
 785         'javascript-actions' => {
 786                 'override' => 0,
 787                 'default' => [0]},
 788
 789         # Enable and configure ability to change common timezone for dates
 790         # in gitweb output via JavaScript.  Enabled by default.
 791         # Project specific override is not supported.
 792         'javascript-timezone' => {
 793                 'override' => 0,
 794                 'default' => [
 795                         'local',     # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
 796                                      # or undef to turn off this feature
 797                         'gitweb_tz', # name of cookie where to store selected timezone
 798                         'datetime',  # CSS class used to mark up dates for manipulation
 799                 ]},
 800
 801         # Syntax highlighting support. This is based on Daniel Svensson's
 802         # and Sham Chukoury's work in gitweb-xmms2.git.
 803         # It requires the 'highlight' program present in $PATH,
 804         # and therefore is disabled by default.
 805
 806         # To enable system wide have in $GITWEB_CONFIG
 807         # $feature{'highlight'}{'default'} = [1];
 808
 809         'highlight' => {
 810                 'sub' => sub { feature_bool('highlight', @_) },
 811                 'override' => 0,
 812                 'default' => [0]},
 813
 814         # Enable displaying of remote heads in the heads list
 815
 816         # To enable system wide have in $GITWEB_CONFIG
 817         # $feature{'remote_heads'}{'default'} = [1];
 818         # To have project specific config enable override in $GITWEB_CONFIG
 819         # $feature{'remote_heads'}{'override'} = 1;
 820         # and in project config gitweb.remoteheads = 0|1;
 821         'remote_heads' => {
 822                 'sub' => sub { feature_bool('remote_heads', @_) },
 823                 'override' => 0,
 824                 'default' => [0]},
 825
 826         # Enable showing branches under other refs in addition to heads
 827
 828         # To set system wide extra branch refs have in $GITWEB_CONFIG
 829         # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
 830         # To have project specific config enable override in $GITWEB_CONFIG
 831         # $feature{'extra-branch-refs'}{'override'} = 1;
 832         # and in project config gitweb.extrabranchrefs = dirs of choice
 833         # Every directory is separated with whitespace.
 834
 835         'extra-branch-refs' => {
 836                 'sub' => \&feature_extra_branch_refs,
 837                 'override' => 0,
 838                 'default' => []},
 839 );
 840
 841 sub gitweb_get_feature {
 842         my ($name) = @_;
 843         return unless exists $feature{$name};
 844         my ($sub, $override, @defaults) = (
 845                 $feature{$name}{'sub'},
 846                 $feature{$name}{'override'},
 847                 @{$feature{$name}{'default'}});
 848         # project specific override is possible only if we have project
 849         our $git_dir; # global variable, declared later
 850         if (!$override || !defined $git_dir) {
 851                 return @defaults;
 852         }
 853         if (!defined $sub) {
 854                 warn "feature $name is not overridable";
 855                 return @defaults;
 856         }
 857         return $sub->(@defaults);
 858 }
 859
 860 # A wrapper to check if a given feature is enabled.
 861 # With this, you can say
 862 #
 863 #   my $bool_feat = gitweb_check_feature('bool_feat');
 864 #   gitweb_check_feature('bool_feat') or somecode;
 865 #
 866 # instead of
 867 #
 868 #   my ($bool_feat) = gitweb_get_feature('bool_feat');
 869 #   (gitweb_get_feature('bool_feat'))[0] or somecode;
 870 #
 871 sub gitweb_check_feature {
 872         return (gitweb_get_feature(@_))[0];
 873 }
 874
 875
 876 sub feature_bool {
 877         my $key = shift;
 878         my ($val) = git_get_project_config($key, '--bool');
 879
 880         if (!defined $val) {
 881                 return ($_[0]);
 882         } elsif ($val eq 'true') {
 883                 return (1);
 884         } elsif ($val eq 'false') {
 885                 return (0);
 886         }
 887 }
 888
 889 sub feature_snapshot {
 890         my (@fmts) = @_;
 891
 892         my ($val) = git_get_project_config('snapshot');
 893
 894         if ($val) {
 895                 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
 896         }
 897
 898         return @fmts;
 899 }
 900
 901 sub feature_patches {
 902         my @val = (git_get_project_config('patches', '--int'));
 903
 904         if (@val) {
 905                 return @val;
 906         }
 907
 908         return ($_[0]);
 909 }
 910
 911 sub feature_avatar {
 912         my @val = (git_get_project_config('avatar'));
 913
 914         return @val ? @val : @_;
 915 }
 916
 917 sub feature_extra_branch_refs {
 918         my (@branch_refs) = @_;
 919         my $values = git_get_project_config('extrabranchrefs');
 920
 921         if ($values) {
 922                 $values = config_to_multi ($values);
 923                 @branch_refs = ();
 924                 foreach my $value (@{$values}) {
 925                         push @branch_refs, split /\s+/, $value;
 926                 }
 927         }
 928
 929         return @branch_refs;
 930 }
 931
 932 # checking HEAD file with -e is fragile if the repository was
 933 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
 934 # and then pruned.
 935 sub check_head_link {
 936         my ($dir) = @_;
 937         return 0 unless -d "$dir/objects" && -x _;
 938         return 0 unless -d "$dir/refs" && -x _;
 939         my $headfile = "$dir/HEAD";
 940         return -l $headfile ?
 941                 readlink($headfile) =~ /^refs\/heads\// : -f $headfile;
 942 }
 943
 944 sub check_export_ok {
 945         my ($dir) = @_;
 946         return (check_head_link($dir) &&
 947                 (!$export_ok || -e "$dir/$export_ok") &&
 948                 (!$export_auth_hook || $export_auth_hook->($dir)));
 949 }
 950
 951 # process alternate names for backward compatibility
 952 # filter out unsupported (unknown) snapshot formats
 953 sub filter_snapshot_fmts {
 954         my @fmts = @_;
 955
 956         @fmts = map {
 957                 exists $known_snapshot_format_aliases{$_} ?
 958                        $known_snapshot_format_aliases{$_} : $_} @fmts;
 959         @fmts = grep {
 960                 exists $known_snapshot_formats{$_} &&
 961                 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
 962 }
 963
 964 sub filter_and_validate_refs {
 965         my @refs = @_;
 966         my %unique_refs = ();
 967
 968         foreach my $ref (@refs) {
 969                 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
 970                 # 'heads' are added implicitly in get_branch_refs().
 971                 $unique_refs{$ref} = 1 if ($ref ne 'heads');
 972         }
 973         return sort keys %unique_refs;
 974 }
 975
 976 # If it is set to code reference, it is code that it is to be run once per
 977 # request, allowing updating configurations that change with each request,
 978 # while running other code in config file only once.
 979 #
 980 # Otherwise, if it is false then gitweb would process config file only once;
 981 # if it is true then gitweb config would be run for each request.
 982 our $per_request_config = 1;
 983
 984 # If true and fileno STDIN is 0 and getsockname succeeds and getpeername fails
 985 # with ENOTCONN, then FCGI mode will be activated automatically in just the
 986 # same way as though the --fcgi option had been given instead.
 987 our $auto_fcgi = 0;
 988
 989 # read and parse gitweb config file given by its parameter.
 990 # returns true on success, false on recoverable error, allowing
 991 # to chain this subroutine, using first file that exists.
 992 # dies on errors during parsing config file, as it is unrecoverable.
 993 sub read_config_file {
 994         my $filename = shift;
 995         return unless defined $filename;
 996         # die if there are errors parsing config file
 997         if (-e $filename) {
 998                 do $filename;
 999                 die $@ if $@;
1000                 return 1;
1001         }
1002         return;
1003 }
1004
1005 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
1006 sub evaluate_gitweb_config {
1007         our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
1008         our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
1009         our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
1010
1011         # Protect against duplications of file names, to not read config twice.
1012         # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
1013         # there possibility of duplication of filename there doesn't matter.
1014         $GITWEB_CONFIG = ""        if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
1015         $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
1016
1017         # Common system-wide settings for convenience.
1018         # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
1019         read_config_file($GITWEB_CONFIG_COMMON);
1020
1021         # Use first config file that exists.  This means use the per-instance
1022         # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
1023         read_config_file($GITWEB_CONFIG) and return;
1024         read_config_file($GITWEB_CONFIG_SYSTEM);
1025 }
1026
1027 our $encode_object;
1028 our $to_utf8_pipe_command = '';
1029
1030 sub evaluate_encoding {
1031         my $requested = $fallback_encoding || 'ISO-8859-1';
1032         my $obj = Encode::find_encoding($requested) or
1033                 die_error(400, "Requested fallback encoding not found");
1034         if ($obj->name eq 'iso-8859-1') {
1035                 # Use Windows-1252 instead as required by the HTML 5 standard
1036                 my $altobj = Encode::find_encoding('Windows-1252');
1037                 $obj = $altobj if $altobj;
1038         }
1039         $encode_object = $obj;
1040         my $nm = lc($encode_object->name);
1041         unless ($nm eq 'cp1252' || $nm eq 'ascii' || $nm eq 'utf8' ||
1042                 $nm =~ /^utf-8/ || $nm =~ /^iso-8859-/) {
1043                 $to_utf8_pipe_command =
1044                   quote_command($^X, '-CO', '-MEncode=decode,FB_DEFAULT', '-pse',
1045                     '$_ = decode($fe, $_, FB_DEFAULT) if !utf8::decode($_);',
1046                     '--', "-fe=$fallback_encoding")." | ";
1047         }
1048 }
1049
1050 sub evaluate_email_obfuscate {
1051         # email obfuscation
1052         our $email;
1053         if (!$email && eval { require HTML::Email::Obfuscate; 1 }) {
1054                 $email = HTML::Email::Obfuscate->new(lite => 1);
1055         }
1056 }
1057
1058 # Get loadavg of system, to compare against $maxload.
1059 # Currently it requires '/proc/loadavg' present to get loadavg;
1060 # if it is not present it returns 0, which means no load checking.
1061 sub get_loadavg {
1062         if( -e '/proc/loadavg' ){
1063                 open my $fd, '<', '/proc/loadavg'
1064                         or return 0;
1065                 my @load = split(/\s+/, scalar <$fd>);
1066                 close $fd;
1067
1068                 # The first three columns measure CPU and IO utilization of the last one,
1069                 # five, and 10 minute periods.  The fourth column shows the number of
1070                 # currently running processes and the total number of processes in the m/n
1071                 # format.  The last column displays the last process ID used.
1072                 return $load[0] || 0;
1073         }
1074         # additional checks for load average should go here for things that don't export
1075         # /proc/loadavg
1076
1077         return 0;
1078 }
1079
1080 # version of the core git binary
1081 our $git_version;
1082 our $git_vernum = "0"; # guaranteed to always match /^\d+(\.\d+)*$/
1083 sub evaluate_git_version {
1084         $git_version = $version; # don't leak system information to attackers
1085         $git_vernum eq "0" or return; # don't run it again
1086         sub cmd_pipe;
1087         my $vers;
1088         if (defined(my $fd = cmd_pipe $GIT, '--version')) {
1089                 $vers = <$fd>;
1090                 close $fd;
1091                 $number_of_git_cmds++;
1092         }
1093         $git_vernum = $1 if defined($vers) && $vers =~ /git\s+version\s+(\d+(?:\.\d+)*)$/io;
1094 }
1095
1096 sub check_loadavg {
1097         if (defined $maxload && get_loadavg() > $maxload) {
1098                 die_error(503, "The load average on the server is too high");
1099         }
1100 }
1101
1102 # ======================================================================
1103 # input validation and dispatch
1104
1105 # input parameters can be collected from a variety of sources (presently, CGI
1106 # and PATH_INFO), so we define an %input_params hash that collects them all
1107 # together during validation: this allows subsequent uses (e.g. href()) to be
1108 # agnostic of the parameter origin
1109
1110 our %input_params = ();
1111
1112 # input parameters are stored with the long parameter name as key. This will
1113 # also be used in the href subroutine to convert parameters to their CGI
1114 # equivalent, and since the href() usage is the most frequent one, we store
1115 # the name -> CGI key mapping here, instead of the reverse.
1116 #
1117 # XXX: Warning: If you touch this, check the search form for updating,
1118 # too.
1119
1120 our @cgi_param_mapping = (
1121         project => "p",
1122         action => "a",
1123         file_name => "f",
1124         file_parent => "fp",
1125         hash => "h",
1126         hash_parent => "hp",
1127         hash_base => "hb",
1128         hash_parent_base => "hpb",
1129         page => "pg",
1130         order => "o",
1131         searchtext => "s",
1132         searchtype => "st",
1133         snapshot_format => "sf",
1134         ctag_filter => 't',
1135         extra_options => "opt",
1136         search_use_regexp => "sr",
1137         ctag => "by_tag",
1138         diff_style => "ds",
1139         project_filter => "pf",
1140         # this must be last entry (for manipulation from JavaScript)
1141         javascript => "js"
1142 );
1143 our %cgi_param_mapping = @cgi_param_mapping;
1144
1145 # we will also need to know the possible actions, for validation
1146 our %actions = (
1147         "blame" => \&git_blame,
1148         "blame_incremental" => \&git_blame_incremental,
1149         "blame_data" => \&git_blame_data,
1150         "blobdiff" => \&git_blobdiff,
1151         "blobdiff_plain" => \&git_blobdiff_plain,
1152         "blob" => \&git_blob,
1153         "blob_plain" => \&git_blob_plain,
1154         "commitdiff" => \&git_commitdiff,
1155         "commitdiff_plain" => \&git_commitdiff_plain,
1156         "commit" => \&git_commit,
1157         "forks" => \&git_forks,
1158         "heads" => \&git_heads,
1159         "history" => \&git_history,
1160         "log" => \&git_log,
1161         "patch" => \&git_patch,
1162         "patches" => \&git_patches,
1163         "refs" => \&git_refs,
1164         "remotes" => \&git_remotes,
1165         "rss" => \&git_rss,
1166         "atom" => \&git_atom,
1167         "search" => \&git_search,
1168         "search_help" => \&git_search_help,
1169         "shortlog" => \&git_shortlog,
1170         "summary" => \&git_summary,
1171         "tag" => \&git_tag,
1172         "tags" => \&git_tags,
1173         "tree" => \&git_tree,
1174         "snapshot" => \&git_snapshot,
1175         "object" => \&git_object,
1176         # those below don't need $project
1177         "opml" => \&git_opml,
1178         "frontpage" => \&git_frontpage,
1179         "project_list" => \&git_project_list,
1180         "project_index" => \&git_project_index,
1181 );
1182
1183 # the only actions we will allow to be cached
1184 my %supported_cache_actions;
1185 BEGIN {%supported_cache_actions = map {( $_ => 1 )} qw(summary)}
1186
1187 # finally, we have the hash of allowed extra_options for the commands that
1188 # allow them
1189 our %allowed_options = (
1190         "--no-merges" => [ qw(rss atom log shortlog history) ],
1191 );
1192
1193 # fill %input_params with the CGI parameters. All values except for 'opt'
1194 # should be single values, but opt can be an array. We should probably
1195 # build an array of parameters that can be multi-valued, but since for the time
1196 # being it's only this one, we just single it out
1197 sub evaluate_query_params {
1198         our $cgi;
1199
1200         while (my ($name, $symbol) = each %cgi_param_mapping) {
1201                 if ($symbol eq 'opt') {
1202                         $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
1203                 } else {
1204                         $input_params{$name} = decode_utf8($cgi->param($symbol));
1205                 }
1206         }
1207
1208         # Backwards compatibility - by_tag= <=> t=
1209         if ($input_params{'ctag'}) {
1210                 $input_params{'ctag_filter'} = $input_params{'ctag'};
1211         }
1212 }
1213
1214 # now read PATH_INFO and update the parameter list for missing parameters
1215 sub evaluate_path_info {
1216         return if defined $input_params{'project'};
1217         return if !$path_info;
1218         $path_info =~ s,^/+,,;
1219         return if !$path_info;
1220
1221         # find which part of PATH_INFO is project
1222         my $project = $path_info;
1223         $project =~ s,/+$,,;
1224         while ($project && !check_head_link("$projectroot/$project")) {
1225                 $project =~ s,/*[^/]*$,,;
1226         }
1227         return unless $project;
1228         $input_params{'project'} = $project;
1229
1230         # do not change any parameters if an action is given using the query string
1231         return if $input_params{'action'};
1232         $path_info =~ s,^\Q$project\E/*,,;
1233
1234         # next, check if we have an action
1235         my $action = $path_info;
1236         $action =~ s,/.*$,,;
1237         if (exists $actions{$action}) {
1238                 $path_info =~ s,^$action/*,,;
1239                 $input_params{'action'} = $action;
1240         }
1241
1242         # list of actions that want hash_base instead of hash, but can have no
1243         # pathname (f) parameter
1244         my @wants_base = (
1245                 'tree',
1246                 'history',
1247         );
1248
1249         # we want to catch, among others
1250         # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
1251         my ($parentrefname, $parentpathname, $refname, $pathname) =
1252                 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
1253
1254         # first, analyze the 'current' part
1255         if (defined $pathname) {
1256                 # we got "branch:filename" or "branch:dir/"
1257                 # we could use git_get_type(branch:pathname), but:
1258                 # - it needs $git_dir
1259                 # - it does a git() call
1260                 # - the convention of terminating directories with a slash
1261                 #   makes it superfluous
1262                 # - embedding the action in the PATH_INFO would make it even
1263                 #   more superfluous
1264                 $pathname =~ s,^/+,,;
1265                 if (!$pathname || substr($pathname, -1) eq "/") {
1266                         $input_params{'action'} ||= "tree";
1267                         $pathname =~ s,/$,,;
1268                 } else {
1269                         # the default action depends on whether we had parent info
1270                         # or not
1271                         if ($parentrefname) {
1272                                 $input_params{'action'} ||= "blobdiff_plain";
1273                         } else {
1274                                 $input_params{'action'} ||= "blob_plain";
1275                         }
1276                 }
1277                 $input_params{'hash_base'} ||= $refname;
1278                 $input_params{'file_name'} ||= $pathname;
1279         } elsif (defined $refname) {
1280                 # we got "branch". In this case we have to choose if we have to
1281                 # set hash or hash_base.
1282                 #
1283                 # Most of the actions without a pathname only want hash to be
1284                 # set, except for the ones specified in @wants_base that want
1285                 # hash_base instead. It should also be noted that hand-crafted
1286                 # links having 'history' as an action and no pathname or hash
1287                 # set will fail, but that happens regardless of PATH_INFO.
1288                 if (defined $parentrefname) {
1289                         # if there is parent let the default be 'shortlog' action
1290                         # (for http://git.example.com/repo.git/A..B links); if there
1291                         # is no parent, dispatch will detect type of object and set
1292                         # action appropriately if required (if action is not set)
1293                         $input_params{'action'} ||= "shortlog";
1294                 }
1295                 if ($input_params{'action'} &&
1296                     grep { $_ eq $input_params{'action'} } @wants_base) {
1297                         $input_params{'hash_base'} ||= $refname;
1298                 } else {
1299                         $input_params{'hash'} ||= $refname;
1300                 }
1301         }
1302
1303         # next, handle the 'parent' part, if present
1304         if (defined $parentrefname) {
1305                 # a missing pathspec defaults to the 'current' filename, allowing e.g.
1306                 # someproject/blobdiff/oldrev..newrev:/filename
1307                 if ($parentpathname) {
1308                         $parentpathname =~ s,^/+,,;
1309                         $parentpathname =~ s,/$,,;
1310                         $input_params{'file_parent'} ||= $parentpathname;
1311                 } else {
1312                         $input_params{'file_parent'} ||= $input_params{'file_name'};
1313                 }
1314                 # we assume that hash_parent_base is wanted if a path was specified,
1315                 # or if the action wants hash_base instead of hash
1316                 if (defined $input_params{'file_parent'} ||
1317                         grep { $_ eq $input_params{'action'} } @wants_base) {
1318                         $input_params{'hash_parent_base'} ||= $parentrefname;
1319                 } else {
1320                         $input_params{'hash_parent'} ||= $parentrefname;
1321                 }
1322         }
1323
1324         # for the snapshot action, we allow URLs in the form
1325         # $project/snapshot/$hash.ext
1326         # where .ext determines the snapshot and gets removed from the
1327         # passed $refname to provide the $hash.
1328         #
1329         # To be able to tell that $refname includes the format extension, we
1330         # require the following two conditions to be satisfied:
1331         # - the hash input parameter MUST have been set from the $refname part
1332         #   of the URL (i.e. they must be equal)
1333         # - the snapshot format MUST NOT have been defined already (e.g. from
1334         #   CGI parameter sf)
1335         # It's also useless to try any matching unless $refname has a dot,
1336         # so we check for that too
1337         if (defined $input_params{'action'} &&
1338                 $input_params{'action'} eq 'snapshot' &&
1339                 defined $refname && index($refname, '.') != -1 &&
1340                 $refname eq $input_params{'hash'} &&
1341                 !defined $input_params{'snapshot_format'}) {
1342                 # We loop over the known snapshot formats, checking for
1343                 # extensions. Allowed extensions are both the defined suffix
1344                 # (which includes the initial dot already) and the snapshot
1345                 # format key itself, with a prepended dot
1346                 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1347                         my $hash = $refname;
1348                         unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1349                                 next;
1350                         }
1351                         my $sfx = $1;
1352                         # a valid suffix was found, so set the snapshot format
1353                         # and reset the hash parameter
1354                         $input_params{'snapshot_format'} = $fmt;
1355                         $input_params{'hash'} = $hash;
1356                         # we also set the format suffix to the one requested
1357                         # in the URL: this way a request for e.g. .tgz returns
1358                         # a .tgz instead of a .tar.gz
1359                         $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1360                         last;
1361                 }
1362         }
1363 }
1364
1365 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1366      $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1367      $searchtext, $search_regexp, $project_filter);
1368 sub evaluate_and_validate_params {
1369         our $action = $input_params{'action'};
1370         if (defined $action) {
1371                 if (!is_valid_action($action)) {
1372                         die_error(400, "Invalid action parameter");
1373                 }
1374         }
1375
1376         # parameters which are pathnames
1377         our $project = $input_params{'project'};
1378         if (defined $project) {
1379                 if (!is_valid_project($project)) {
1380                         undef $project;
1381                         die_error(404, "No such project");
1382                 }
1383         }
1384
1385         our $project_filter = $input_params{'project_filter'};
1386         if (defined $project_filter) {
1387                 if (!is_valid_pathname($project_filter)) {
1388                         die_error(404, "Invalid project_filter parameter");
1389                 }
1390         }
1391
1392         our $file_name = $input_params{'file_name'};
1393         if (defined $file_name) {
1394                 if (!is_valid_pathname($file_name)) {
1395                         die_error(400, "Invalid file parameter");
1396                 }
1397         }
1398
1399         our $file_parent = $input_params{'file_parent'};
1400         if (defined $file_parent) {
1401                 if (!is_valid_pathname($file_parent)) {
1402                         die_error(400, "Invalid file parent parameter");
1403                 }
1404         }
1405
1406         # parameters which are refnames
1407         our $hash = $input_params{'hash'};
1408         if (defined $hash) {
1409                 if (!is_valid_refname($hash)) {
1410                         die_error(400, "Invalid hash parameter");
1411                 }
1412         }
1413
1414         our $hash_parent = $input_params{'hash_parent'};
1415         if (defined $hash_parent) {
1416                 if (!is_valid_refname($hash_parent)) {
1417                         die_error(400, "Invalid hash parent parameter");
1418                 }
1419         }
1420
1421         our $hash_base = $input_params{'hash_base'};
1422         if (defined $hash_base) {
1423                 if (!is_valid_refname($hash_base)) {
1424                         die_error(400, "Invalid hash base parameter");
1425                 }
1426         }
1427
1428         our @extra_options = @{$input_params{'extra_options'}};
1429         # @extra_options is always defined, since it can only be (currently) set from
1430         # CGI, and $cgi->param() returns the empty array in array context if the param
1431         # is not set
1432         foreach my $opt (@extra_options) {
1433                 if (not exists $allowed_options{$opt}) {
1434                         die_error(400, "Invalid option parameter");
1435                 }
1436                 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1437                         die_error(400, "Invalid option parameter for this action");
1438                 }
1439         }
1440
1441         our $hash_parent_base = $input_params{'hash_parent_base'};
1442         if (defined $hash_parent_base) {
1443                 if (!is_valid_refname($hash_parent_base)) {
1444                         die_error(400, "Invalid hash parent base parameter");
1445                 }
1446         }
1447
1448         # other parameters
1449         our $page = $input_params{'page'};
1450         if (defined $page) {
1451                 if ($page =~ m/[^0-9]/) {
1452                         die_error(400, "Invalid page parameter");
1453                 }
1454         }
1455
1456         our $searchtype = $input_params{'searchtype'};
1457         if (defined $searchtype) {
1458                 if ($searchtype =~ m/[^a-z]/) {
1459                         die_error(400, "Invalid searchtype parameter");
1460                 }
1461         }
1462
1463         our $search_use_regexp = $input_params{'search_use_regexp'};
1464
1465         our $searchtext = $input_params{'searchtext'};
1466         our $search_regexp = undef;
1467         if (defined $searchtext) {
1468                 if (length($searchtext) < 2) {
1469                         die_error(403, "At least two characters are required for search parameter");
1470                 }
1471                 if ($search_use_regexp) {
1472                         $search_regexp = $searchtext;
1473                         if (!eval { qr/$search_regexp/; 1; }) {
1474                                 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1475                                 die_error(400, "Invalid search regexp '$search_regexp'",
1476                                           esc_html($error));
1477                         }
1478                 } else {
1479                         $search_regexp = quotemeta $searchtext;
1480                 }
1481         }
1482 }
1483
1484 # path to the current git repository
1485 our $git_dir;
1486 sub evaluate_git_dir {
1487         our $git_dir = $project ? "$projectroot/$project" : undef;
1488 }
1489
1490 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1491 sub configure_gitweb_features {
1492         # list of supported snapshot formats
1493         our @snapshot_fmts = gitweb_get_feature('snapshot');
1494         @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1495
1496         # check that the avatar feature is set to a known provider name,
1497         # and for each provider check if the dependencies are satisfied.
1498         # if the provider name is invalid or the dependencies are not met,
1499         # reset $git_avatar to the empty string.
1500         our ($git_avatar) = gitweb_get_feature('avatar');
1501         if ($git_avatar eq 'gravatar') {
1502                 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1503         } elsif ($git_avatar eq 'picon') {
1504                 # no dependencies
1505         } else {
1506                 $git_avatar = '';
1507         }
1508
1509         our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1510         @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1511 }
1512
1513 sub get_branch_refs {
1514         return ('heads', @extra_branch_refs);
1515 }
1516
1517 # custom error handler: 'die <message>' is Internal Server Error
1518 sub handle_errors_html {
1519         my $msg = shift; # it is already HTML escaped
1520
1521         # to avoid infinite loop where error occurs in die_error,
1522         # change handler to default handler, disabling handle_errors_html
1523         set_message("Error occurred when inside die_error:\n$msg");
1524
1525         # you cannot jump out of die_error when called as error handler;
1526         # the subroutine set via CGI::Carp::set_message is called _after_
1527         # HTTP headers are already written, so it cannot write them itself
1528         die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1529 }
1530 set_message(\&handle_errors_html);
1531
1532 our $shown_stale_message = 0;
1533 our $cache_dump = undef;
1534 our $cache_dump_mtime = undef;
1535
1536 # dispatch
1537 my $cache_mode_active;
1538 sub dispatch {
1539         if (!defined $action) {
1540                 if (defined $hash) {
1541                         $action = git_get_type($hash);
1542                         $action or die_error(404, "Object does not exist");
1543                 } elsif (defined $hash_base && defined $file_name) {
1544                         $action = git_get_type("$hash_base:$file_name");
1545                         $action or die_error(404, "File or directory does not exist");
1546                 } elsif (defined $project) {
1547                         $action = 'summary';
1548                 } else {
1549                         $action = 'frontpage';
1550                 }
1551         }
1552         if (!defined($actions{$action})) {
1553                 die_error(400, "Unknown action");
1554         }
1555         if ($action !~ m/^(?:opml|frontpage|project_list|project_index)$/ &&
1556             !$project) {
1557                 die_error(400, "Project needed");
1558         }
1559
1560         my $defstyle = $stylesheet;
1561         local $stylesheet = $defstyle;
1562         if ($ENV{'HTTP_COOKIE'} && ";$ENV{'HTTP_COOKIE'};" =~ /;\s*style\s*=\s*([a-z][a-z0-9_-]*)\s*;/) {{
1563                 my $stylename = $1;
1564                 last unless $ENV{'DOCUMENT_ROOT'} && -r "$ENV{'DOCUMENT_ROOT'}/style/$stylename.css";
1565                 $stylesheet = "/style/$stylename.css";
1566         }}
1567
1568         my $cached_page = $supported_cache_actions{$action}
1569                 ? cached_action_page($action)
1570                 : undef;
1571         goto DUMPCACHE if $cached_page;
1572         local *SAVEOUT = *STDOUT;
1573         $cache_mode_active = $supported_cache_actions{$action}
1574                 ? cached_action_start($action)
1575                 : undef;
1576
1577         configure_gitweb_features();
1578         $actions{$action}->();
1579
1580         return unless $cache_mode_active;
1581
1582         $cached_page = cached_action_finish($action);
1583         *STDOUT = *SAVEOUT;
1584
1585         DUMPCACHE:
1586
1587         $cache_mode_active = 0;
1588         # Avoid any extra unwanted encoding steps as $cached_page is raw bytes
1589         binmode STDOUT, ':raw';
1590         our $fcgi_raw_mode = 1;
1591         print expand_gitweb_pi($cached_page, time);
1592         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
1593         $fcgi_raw_mode = 0;
1594 }
1595
1596 sub reset_timer {
1597         our $t0 = [ gettimeofday() ]
1598                 if defined $t0;
1599         our $number_of_git_cmds = 0;
1600 }
1601
1602 our $first_request = 1;
1603 our $evaluate_uri_force = undef;
1604 sub run_request {
1605         reset_timer();
1606
1607         # Only allow GET and HEAD methods
1608         if (!$ENV{'REQUEST_METHOD'} || ($ENV{'REQUEST_METHOD'} ne 'GET' && $ENV{'REQUEST_METHOD'} ne 'HEAD')) {
1609                 print <<EOT;
1610 Status: 405 Method Not Allowed
1611 Content-Type: text/plain
1612 Allow: GET,HEAD
1613
1614 405 Method Not Allowed
1615 EOT
1616                 return;
1617         }
1618
1619         evaluate_uri();
1620         &$evaluate_uri_force() if $evaluate_uri_force;
1621         if ($per_request_config) {
1622                 if (ref($per_request_config) eq 'CODE') {
1623                         $per_request_config->();
1624                 } elsif (!$first_request) {
1625                         evaluate_gitweb_config();
1626                         evaluate_email_obfuscate();
1627                 }
1628         }
1629         check_loadavg();
1630
1631         # $projectroot and $projects_list might be set in gitweb config file
1632         $projects_list ||= $projectroot;
1633
1634         evaluate_query_params();
1635         evaluate_path_info();
1636         evaluate_and_validate_params();
1637         evaluate_git_dir();
1638
1639         dispatch();
1640 }
1641
1642 our $is_last_request = sub { 1 };
1643 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1644 our $CGI = 'CGI';
1645 our $cgi;
1646 our $fcgi_mode = 0;
1647 our $fcgi_nproc_active = 0;
1648 our $fcgi_raw_mode = 0;
1649 sub is_fcgi {
1650         use Errno;
1651         my $stdinfno = fileno STDIN;
1652         return 0 unless defined $stdinfno && $stdinfno == 0;
1653         return 0 unless getsockname STDIN;
1654         return 0 if getpeername STDIN;
1655         return $!{ENOTCONN}?1:0;
1656 }
1657 sub configure_as_fcgi {
1658         return if $fcgi_mode;
1659
1660         require FCGI;
1661         require CGI::Fast;
1662
1663         # We have gone to great effort to make sure that all incoming data has
1664         # been converted from whatever format it was in into UTF-8.  We have
1665         # even taken care to make sure the output handle is in ':utf8' mode.
1666         # Now along comes FCGI and blows it with:
1667         #
1668         #     Use of wide characters in FCGI::Stream::PRINT is deprecated
1669         #      and will stop wprking[sic] in a future version of FCGI
1670         #
1671         # To fix this we replace FCGI::Stream::PRINT with our own routine that
1672         # first encodes everything and then calls the original routine, but
1673         # not if $fcgi_raw_mode is true (then we just call the original routine).
1674         #
1675         # Note that we could do this by using utf8::is_utf8 to check instead
1676         # of having a $fcgi_raw_mode global, but that would be slower to run
1677         # the test on each element and much slower than skipping the conversion
1678         # entirely when we know we're outputting raw bytes.
1679         my $orig = \&FCGI::Stream::PRINT;
1680         undef *FCGI::Stream::PRINT;
1681         *FCGI::Stream::PRINT = sub {
1682                 @_ = (shift, map {my $x=$_; utf8::encode($x); $x} @_)
1683                         unless $fcgi_raw_mode;
1684                 goto $orig;
1685         };
1686
1687         our $CGI = 'CGI::Fast';
1688
1689         $fcgi_mode = 1;
1690         $first_request = 0;
1691         my $request_number = 0;
1692         # let each child service 100 requests
1693         our $is_last_request = sub { ++$request_number >= 100 };
1694 }
1695 sub evaluate_argv {
1696         my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1697         configure_as_fcgi()
1698                 if $script_name =~ /\.fcgi$/ || ($auto_fcgi && is_fcgi());
1699
1700         my $nproc_sub = sub {
1701                 my ($arg, $val) = @_;
1702                 return unless eval { require FCGI::ProcManager; 1; };
1703                 $fcgi_nproc_active = 1;
1704                 my $proc_manager = FCGI::ProcManager->new({
1705                         n_processes => $val,
1706                 });
1707                 our $pre_listen_hook    = sub { $proc_manager->pm_manage()        };
1708                 our $pre_dispatch_hook  = sub { $proc_manager->pm_pre_dispatch()  };
1709                 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1710         };
1711         if (@ARGV) {
1712                 require Getopt::Long;
1713                 Getopt::Long::GetOptions(
1714                         'fastcgi|fcgi|f' => \&configure_as_fcgi,
1715                         'nproc|n=i' => $nproc_sub,
1716                 );
1717         };
1718         if (!$fcgi_nproc_active && defined $ENV{'GITWEB_FCGI_NPROC'} && $ENV{'GITWEB_FCGI_NPROC'} =~ /^\d+$/) {
1719                 &$nproc_sub('nproc', $ENV{'GITWEB_FCGI_NPROC'});
1720         }
1721 }
1722
1723 # Any "our" variable that could possibly influence correct handling of
1724 # a CGI request MUST be reset in this subroutine
1725 sub _reset_globals {
1726         # Note that $t0 and $number_of_git_commands are handled by reset_timer
1727         our %input_params = ();
1728         our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1729              $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1730              $searchtext, $search_regexp, $project_filter) = ();
1731         our $git_dir = undef;
1732         our (@snapshot_fmts, $git_avatar, @extra_branch_refs) = ();
1733         our %avatar_cache = ();
1734         our $config_file = '';
1735         our %config = ();
1736         our $gitweb_project_owner = undef;
1737         our $shown_stale_message = 0;
1738         our $fcgi_raw_mode = 0;
1739         keys %known_snapshot_formats; # reset 'each' iterator
1740 }
1741
1742 sub run {
1743         evaluate_gitweb_config();
1744         evaluate_encoding();
1745         evaluate_email_obfuscate();
1746         evaluate_git_version();
1747         my ($ml, $mi, $bu, $hl, $subroutine) = ($my_url, $my_uri, $base_url, $home_link, '');
1748         $subroutine .= '$my_url = $ml;' if defined $my_url && $my_url ne '';
1749         $subroutine .= '$my_uri = $mi;' if defined $my_uri; # this one can be ""
1750         $subroutine .= '$base_url = $bu;' if defined $base_url && $base_url ne '';
1751         $subroutine .= '$home_link = $hl;' if defined $home_link && $home_link ne '';
1752         $evaluate_uri_force = eval "sub {$subroutine}" if $subroutine;
1753         $first_request = 1;
1754         evaluate_argv();
1755
1756         $pre_listen_hook->()
1757                 if $pre_listen_hook;
1758
1759  REQUEST:
1760         while ($cgi = $CGI->new()) {
1761                 $pre_dispatch_hook->()
1762                         if $pre_dispatch_hook;
1763                 {
1764                         # most globals can simply be reset
1765                         _reset_globals;
1766
1767                         # evaluate_path_info corrupts %known_snapshot_formats
1768                         # so we need a deepish copy of it -- note that
1769                         # _reset_globals already took care of resetting its
1770                         # hash iterator that evaluate_path_info also leaves
1771                         # in an indeterminate state
1772                         my %formats = ();
1773                         while (my ($k,$v) = each(%known_snapshot_formats)) {
1774                                 $formats{$k} = {%{$known_snapshot_formats{$k}}};
1775                         }
1776                         local *known_snapshot_formats = \%formats;
1777
1778                         eval {run_request()};
1779                 }
1780                 $post_dispatch_hook->()
1781                         if $post_dispatch_hook;
1782                 $first_request = 0;
1783
1784                 last REQUEST if ($is_last_request->());
1785         }
1786
1787         1;
1788 }
1789
1790 run();
1791
1792 if (defined caller) {
1793         # wrapped in a subroutine processing requests,
1794         # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1795         return;
1796 } else {
1797         # pure CGI script, serving single request
1798         exit;
1799 }
1800
1801 ## ======================================================================
1802 ## action links
1803
1804 # possible values of extra options
1805 # -full => 0|1      - use absolute/full URL ($my_uri/$my_url as base)
1806 # -replay => 1      - start from a current view (replay with modifications)
1807 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1808 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1809 sub href {
1810         my %params = @_;
1811         # default is to use -absolute url() i.e. $my_uri
1812         my $href = $params{-full} ? $my_url : $my_uri;
1813
1814         # implicit -replay, must be first of implicit params
1815         $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1816
1817         $params{'project'} = $project unless exists $params{'project'};
1818
1819         if ($params{-replay}) {
1820                 while (my ($name, $symbol) = each %cgi_param_mapping) {
1821                         if (!exists $params{$name}) {
1822                                 $params{$name} = $input_params{$name};
1823                         }
1824                 }
1825         }
1826
1827         my $use_pathinfo = gitweb_check_feature('pathinfo');
1828         if (defined $params{'project'} &&
1829             (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1830                 # try to put as many parameters as possible in PATH_INFO:
1831                 #   - project name
1832                 #   - action
1833                 #   - hash_parent or hash_parent_base:/file_parent
1834                 #   - hash or hash_base:/filename
1835                 #   - the snapshot_format as an appropriate suffix
1836
1837                 # When the script is the root DirectoryIndex for the domain,
1838                 # $href here would be something like http://gitweb.example.com/
1839                 # Thus, we strip any trailing / from $href, to spare us double
1840                 # slashes in the final URL
1841                 $href =~ s,/$,,;
1842
1843                 # Then add the project name, if present
1844                 $href .= "/".esc_path_info($params{'project'});
1845                 delete $params{'project'};
1846
1847                 # since we destructively absorb parameters, we keep this
1848                 # boolean that remembers if we're handling a snapshot
1849                 my $is_snapshot = $params{'action'} eq 'snapshot';
1850
1851                 # Summary just uses the project path URL, any other action is
1852                 # added to the URL
1853                 if (defined $params{'action'}) {
1854                         $href .= "/".esc_path_info($params{'action'})
1855                                 unless $params{'action'} eq 'summary';
1856                         delete $params{'action'};
1857                 }
1858
1859                 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1860                 # stripping nonexistent or useless pieces
1861                 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1862                         || $params{'hash_parent'} || $params{'hash'});
1863                 if (defined $params{'hash_base'}) {
1864                         if (defined $params{'hash_parent_base'}) {
1865                                 $href .= esc_path_info($params{'hash_parent_base'});
1866                                 # skip the file_parent if it's the same as the file_name
1867                                 if (defined $params{'file_parent'}) {
1868                                         if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1869                                                 delete $params{'file_parent'};
1870                                         } elsif ($params{'file_parent'} !~ /\.\./) {
1871                                                 $href .= ":/".esc_path_info($params{'file_parent'});
1872                                                 delete $params{'file_parent'};
1873                                         }
1874                                 }
1875                                 $href .= "..";
1876                                 delete $params{'hash_parent'};
1877                                 delete $params{'hash_parent_base'};
1878                         } elsif (defined $params{'hash_parent'}) {
1879                                 $href .= esc_path_info($params{'hash_parent'}). "..";
1880                                 delete $params{'hash_parent'};
1881                         }
1882
1883                         $href .= esc_path_info($params{'hash_base'});
1884                         if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1885                                 $href .= ":/".esc_path_info($params{'file_name'});
1886                                 delete $params{'file_name'};
1887                         }
1888                         delete $params{'hash'};
1889                         delete $params{'hash_base'};
1890                 } elsif (defined $params{'hash'}) {
1891                         $href .= esc_path_info($params{'hash'});
1892                         delete $params{'hash'};
1893                 }
1894
1895                 # If the action was a snapshot, we can absorb the
1896                 # snapshot_format parameter too
1897                 if ($is_snapshot) {
1898                         my $fmt = $params{'snapshot_format'};
1899                         # snapshot_format should always be defined when href()
1900                         # is called, but just in case some code forgets, we
1901                         # fall back to the default
1902                         $fmt ||= $snapshot_fmts[0];
1903                         $href .= $known_snapshot_formats{$fmt}{'suffix'};
1904                         delete $params{'snapshot_format'};
1905                 }
1906         }
1907
1908         # now encode the parameters explicitly
1909         my @result = ();
1910         for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1911                 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1912                 if (defined $params{$name}) {
1913                         if (ref($params{$name}) eq "ARRAY") {
1914                                 foreach my $par (@{$params{$name}}) {
1915                                         push @result, $symbol . "=" . esc_param($par);
1916                                 }
1917                         } else {
1918                                 push @result, $symbol . "=" . esc_param($params{$name});
1919                         }
1920                 }
1921         }
1922         $href .= "?" . join(';', @result) if scalar @result;
1923
1924         # final transformation: trailing spaces must be escaped (URI-encoded)
1925         $href =~ s/(\s+)$/CGI::escape($1)/e;
1926
1927         if ($params{-anchor}) {
1928                 $href .= "#".esc_param($params{-anchor});
1929         }
1930
1931         return $href;
1932 }
1933
1934
1935 ## ======================================================================
1936 ## validation, quoting/unquoting and escaping
1937
1938 sub is_valid_action {
1939         my $input = shift;
1940         return undef unless exists $actions{$input};
1941         return 1;
1942 }
1943
1944 sub is_valid_project {
1945         my $input = shift;
1946
1947         return unless defined $input;
1948         if (!is_valid_pathname($input) ||
1949                 $input =~ m!^/*_! ||
1950                 $input =~ m!\.\.! ||
1951                 !($input =~ m!\.git/*$!) ||
1952                 $input =~ m!\.git/.*\.git/*$!i ||
1953                 !(-d "$projectroot/$input") ||
1954                 !check_export_ok("$projectroot/$input") ||
1955                 ($strict_export && !project_in_list($input))) {
1956                 return undef;
1957         } else {
1958                 return 1;
1959         }
1960 }
1961
1962 sub is_valid_pathname {
1963         my $input = shift;
1964
1965         return undef unless defined $input;
1966         # no '.' or '..' as elements of path, i.e. no '.' or '..'
1967         # at the beginning, at the end, and between slashes.
1968         # also this catches doubled slashes
1969         if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1970                 return undef;
1971         }
1972         # no null characters
1973         if ($input =~ m!\0!) {
1974                 return undef;
1975         }
1976         return 1;
1977 }
1978
1979 sub is_valid_ref_format {
1980         my $input = shift;
1981
1982         return undef unless defined $input;
1983         # restrictions on ref name according to git-check-ref-format
1984         if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1985                 return undef;
1986         }
1987         return 1;
1988 }
1989
1990 sub is_valid_refname {
1991         my $input = shift;
1992
1993         return undef unless defined $input;
1994         # textual hashes are O.K.
1995         if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1996                 return 1;
1997         }
1998         # allow repeated trailing '[~^]n*' suffix(es)
1999         $input =~ s/^([^~^]+)(?:[~^]\d*)+$/$1/;
2000         # it must be correct pathname
2001         is_valid_pathname($input) or return undef;
2002         # check git-check-ref-format restrictions
2003         is_valid_ref_format($input) or return undef;
2004         return 1;
2005 }
2006
2007 # decode sequences of octets in utf8 into Perl's internal form,
2008 # which is utf-8 with utf8 flag set if needed.  gitweb writes out
2009 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
2010 sub to_utf8 {
2011         my $str = shift;
2012         return undef unless defined $str;
2013
2014         if (utf8::is_utf8($str) || utf8::decode($str)) {
2015                 return $str;
2016         } else {
2017                 return $encode_object->decode($str, Encode::FB_DEFAULT);
2018         }
2019 }
2020
2021 # quote unsafe chars, but keep the slash, even when it's not
2022 # correct, but quoted slashes look too horrible in bookmarks
2023 sub esc_param {
2024         my $str = shift;
2025         return undef unless defined $str;
2026         $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
2027         $str =~ s/ /\+/g;
2028         return $str;
2029 }
2030
2031 # the quoting rules for path_info fragment are slightly different
2032 sub esc_path_info {
2033         my $str = shift;
2034         return undef unless defined $str;
2035
2036         # path_info doesn't treat '+' as space (specially), but '?' must be escaped
2037         $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
2038
2039         return $str;
2040 }
2041
2042 # quote unsafe chars in whole URL, so some characters cannot be quoted
2043 sub esc_url {
2044         my $str = shift;
2045         return undef unless defined $str;
2046         $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
2047         $str =~ s/ /\+/g;
2048         return $str;
2049 }
2050
2051 # quote unsafe characters in HTML attributes
2052 sub esc_attr {
2053
2054         # for XHTML conformance escaping '"' to '&quot;' is not enough
2055         return esc_html(@_);
2056 }
2057
2058 # replace invalid utf8 character with SUBSTITUTION sequence
2059 sub esc_html {
2060         my $str = shift;
2061         my %opts = @_;
2062
2063         return undef unless defined $str;
2064
2065         $str = to_utf8($str);
2066         $str = $cgi->escapeHTML($str);
2067         if ($opts{'-nbsp'}) {
2068                 $str =~ s/ /&#160;/g;
2069         }
2070         use bytes;
2071         $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
2072         return $str;
2073 }
2074
2075 # quote control characters and escape filename to HTML
2076 sub esc_path {
2077         my $str = shift;
2078         my %opts = @_;
2079
2080         return undef unless defined $str;
2081
2082         $str = to_utf8($str);
2083         $str = $cgi->escapeHTML($str);
2084         if ($opts{'-nbsp'}) {
2085                 $str =~ s/ /&#160;/g;
2086         }
2087         use bytes;
2088         $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
2089         return $str;
2090 }
2091
2092 # Sanitize for use in XHTML + application/xml+xhtml (valid XML 1.0)
2093 sub sanitize {
2094         my $str = shift;
2095
2096         return undef unless defined $str;
2097
2098         $str = to_utf8($str);
2099         use bytes;
2100         $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
2101         return $str;
2102 }
2103
2104 # Make control characters "printable", using character escape codes (CEC)
2105 sub quot_cec {
2106         my $cntrl = shift;
2107         my %opts = @_;
2108         my %es = ( # character escape codes, aka escape sequences
2109                 "\t" => '\t',   # tab            (HT)
2110                 "\n" => '\n',   # line feed      (LF)
2111                 "\r" => '\r',   # carrige return (CR)
2112                 "\f" => '\f',   # form feed      (FF)
2113                 "\b" => '\b',   # backspace      (BS)
2114                 "\a" => '\a',   # alarm (bell)   (BEL)
2115                 "\e" => '\e',   # escape         (ESC)
2116                 "\013" => '\v', # vertical tab   (VT)
2117                 "\000" => '\0', # nul character  (NUL)
2118         );
2119         my $chr = ( (exists $es{$cntrl})
2120                     ? $es{$cntrl}
2121                     : sprintf('\x%02x', ord($cntrl)) );
2122         if ($opts{-nohtml}) {
2123                 return $chr;
2124         } else {
2125                 return "<span class=\"cntrl\">$chr</span>";
2126         }
2127 }
2128
2129 # Alternatively use unicode control pictures codepoints,
2130 # Unicode "printable representation" (PR)
2131 sub quot_upr {
2132         my $cntrl = shift;
2133         my %opts = @_;
2134
2135         my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
2136         if ($opts{-nohtml}) {
2137                 return $chr;
2138         } else {
2139                 return "<span class=\"cntrl\">$chr</span>";
2140         }
2141 }
2142
2143 # git may return quoted and escaped filenames
2144 sub unquote {
2145         my $str = shift;
2146
2147         sub unq {
2148                 my $seq = shift;
2149                 my %es = ( # character escape codes, aka escape sequences
2150                         't' => "\t",   # tab            (HT, TAB)
2151                         'n' => "\n",   # newline        (NL)
2152                         'r' => "\r",   # return         (CR)
2153                         'f' => "\f",   # form feed      (FF)
2154                         'b' => "\b",   # backspace      (BS)
2155                         'a' => "\a",   # alarm (bell)   (BEL)
2156                         'e' => "\e",   # escape         (ESC)
2157                         'v' => "\013", # vertical tab   (VT)
2158                 );
2159
2160                 if ($seq =~ m/^[0-7]{1,3}$/) {
2161                         # octal char sequence
2162                         return chr(oct($seq));
2163                 } elsif (exists $es{$seq}) {
2164                         # C escape sequence, aka character escape code
2165                         return $es{$seq};
2166                 }
2167                 # quoted ordinary character
2168                 return $seq;
2169         }
2170
2171         if ($str =~ m/^"(.*)"$/) {
2172                 # needs unquoting
2173                 $str = $1;
2174                 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
2175         }
2176         return $str;
2177 }
2178
2179 # escape tabs (convert tabs to spaces)
2180 sub untabify {
2181         my $line = shift;
2182
2183         while ((my $pos = index($line, "\t")) != -1) {
2184                 if (my $count = (8 - ($pos % 8))) {
2185                         my $spaces = ' ' x $count;
2186                         $line =~ s/\t/$spaces/;
2187                 }
2188         }
2189
2190         return $line;
2191 }
2192
2193 sub project_in_list {
2194         my $project = shift;
2195         my @list = git_get_projects_list();
2196         return @list && scalar(grep { $_->{'path'} eq $project } @list);
2197 }
2198
2199 sub cached_page_precondition_check {
2200         my $action = shift;
2201         return 1 unless
2202                 $action eq 'summary' &&
2203                 $projlist_cache_lifetime > 0 &&
2204                 gitweb_check_feature('forks');
2205
2206         # Note that ALL the 'forkchange' logic is in this function.
2207         # It does NOT belong in cached_action_page NOR in cached_action_start
2208         # NOR in cached_action_finish.  None of those functions should know anything
2209         # about nor do anything to any of the 'forkchange'/"$action.forkchange" files.
2210
2211         # besides the basic 'changed' "$action.changed" check, we may only use
2212         # a summary cache if:
2213         #
2214         #   1) we are not using a project list cache file
2215         #   -OR-
2216         #   2) we are not using the 'forks' feature
2217         #   -OR-
2218         #   3) there is no 'forkchange' nor "$action.forkchange" file in $html_cache_dir
2219         #   -OR-
2220         #   4) there is no cache file ("$cache_dir/$projlist_cache_name")
2221         #   -OR-
2222         #   5) the OLDER of 'forkchange'/"$action.forkchange" is NEWER than the cache file
2223         #
2224         # Otherwise we must re-generate the cache because we've had a fork change
2225         # (either a fork was added or a fork was removed) AND the change has been
2226         # picked up in the cache file AND we've not got that in our cached copy
2227         #
2228         # For (5) regenerating the cached page wouldn't get us anything if the project
2229         # cache file is older than the 'forkchange'/"$action.forkchange" because the
2230         # forks information comes from the project cache file and it's clearly not
2231         # picked up the changes yet so we may continue to use a cached page until it does.
2232
2233         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2234         my $fc_mt = (stat("$htmlcd/forkchange"))[9];
2235         my $afc_mt = (stat("$htmlcd/$action.forkchange"))[9];
2236         return 1 unless defined($fc_mt) || defined($afc_mt);
2237         my $prj_mt = (stat("$cache_dir/$projlist_cache_name"))[9];
2238         return 1 unless $prj_mt;
2239         my $old_mt = $fc_mt;
2240         $old_mt = $afc_mt if !defined($old_mt) || (defined($afc_mt) && $afc_mt < $old_mt);
2241         return 1 if $old_mt > $prj_mt;
2242
2243         # We're going to regenerate the cached page because we know the project cache
2244         # has new fork information that we cannot possibly have in our cached copy.
2245         #
2246         # However, if both 'forkchange' and "$action.forkchange" exist and one of
2247         # them is older than the project cache and one of them is newer, we still
2248         # need to regenerate the page cache, but we will also need to do it again
2249         # in the future because there's yet another fork update not yet in the cache.
2250         #
2251         # So we make sure to touch "$action.changed" to force a cache regeneration
2252         # and then we remove either or both of 'forkchange'/"$action.forkchange" if
2253         # they're older than the project cache (they've served their purpose, we're
2254         # forcing a page regeneration by touching "$action.changed" but the project
2255         # cache was rebuilt since then so there are no more pending fork updates to
2256         # pick up in the future and they need to go).
2257
2258         # For best results, the external code that touches 'forkchange' should always
2259         # touch 'forkchange' and additionally touch 'summary.forkchange' but only
2260         # if it does not already exist.  That way the cached page will be regenerated
2261         # each time it's requested and ANY fork updates are available in the proj
2262         # cache rather than waiting until they all are before updating.
2263
2264         # Note that we take a shortcut here and will zap 'forkchange' since we know
2265         # that it only affects the 'summary' cache.  If, in the future, it affects
2266         # other cache types, it will first need to be propogated down to
2267         # "$action.forkchange" for those types before we zap it.
2268
2269         my $fd;
2270         open $fd, '>', "$htmlcd/$action.changed" and close $fd;
2271         $fc_mt=undef, unlink "$htmlcd/forkchange" if defined $fc_mt && $fc_mt < $prj_mt;
2272         $afc_mt=undef, unlink "$htmlcd/$action.forkchange" if defined $afc_mt && $afc_mt < $prj_mt;
2273
2274         # Now we propagate 'forkchange' to "$action.forkchange" if we have the
2275         # one and not the other.
2276
2277         if (defined $fc_mt && ! defined $afc_mt) {
2278                 open $fd, '>', "$htmlcd/$action.forkchange" and close $fd;
2279                 -e "$htmlcd/$action.forkchange" and
2280                 utime($fc_mt, $fc_mt, "$htmlcd/$action.forkchange") and
2281                 unlink "$htmlcd/forkchange";
2282         }
2283
2284         return 0;
2285 }
2286
2287 sub cached_action_page {
2288         my $action = shift;
2289
2290         return undef unless $action && $html_cache_actions{$action} && $html_cache_dir;
2291         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2292         return undef if -e "$htmlcd/changed" || -e "$htmlcd/$action.changed";
2293         return undef unless cached_page_precondition_check($action);
2294         open my $fd, '<', "$htmlcd/$action" or return undef;
2295         binmode $fd;
2296         local $/;
2297         my $cached_page = <$fd>;
2298         close $fd or return undef;
2299         return $cached_page;
2300 }
2301
2302 package Git::Gitweb::CacheFile;
2303
2304 sub TIEHANDLE {
2305         use POSIX qw(:fcntl_h);
2306         my $class = shift;
2307         my $cachefile = shift;
2308
2309         sysopen(my $self, $cachefile, O_WRONLY|O_CREAT|O_EXCL, 0664)
2310                 or return undef;
2311         $$self->{'cachefile'} = $cachefile;
2312         $$self->{'opened'} = 1;
2313         $$self->{'contents'} = '';
2314         return bless $self, $class;
2315 }
2316
2317 sub CLOSE {
2318         my $self = shift;
2319         if ($$self->{'opened'}) {
2320                 $$self->{'opened'} = 0;
2321                 my $result = close $self;
2322                 unlink $$self->{'cachefile'} unless $result;
2323                 return $result;
2324         }
2325         return 0;
2326 }
2327
2328 sub DESTROY {
2329         my $self = shift;
2330         if ($$self->{'opened'}) {
2331                 $self->CLOSE() and unlink $$self->{'cachefile'};
2332         }
2333 }
2334
2335 sub PRINT {
2336         my $self = shift;
2337         @_ = (map {my $x=$_; utf8::encode($x); $x} @_) unless $fcgi_raw_mode;
2338         print $self @_ if $$self->{'opened'};
2339         $$self->{'contents'} .= join('', @_);
2340         return 1;
2341 }
2342
2343 sub PRINTF {
2344         my $self = shift;
2345         my $template = shift;
2346         return $self->PRINT(sprintf $template, @_);
2347 }
2348
2349 sub contents {
2350         my $self = shift;
2351         return $$self->{'contents'};
2352 }
2353
2354 package main;
2355
2356 # Caller is responsible for preserving STDOUT beforehand if needed
2357 sub cached_action_start {
2358         my $action = shift;
2359
2360         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2361         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2362         return undef unless -d $htmlcd;
2363         if (-e "$htmlcd/changed") {
2364                 foreach my $cacheable (keys(%html_cache_actions)) {
2365                         next unless $supported_cache_actions{$cacheable} &&
2366                                     $html_cache_actions{$cacheable};
2367                         my $fd;
2368                         open $fd, '>', "$htmlcd/$cacheable.changed"
2369                         and close $fd;
2370                 }
2371                 unlink "$htmlcd/changed";
2372         }
2373         local *CACHEFILE;
2374         tie *CACHEFILE, 'Git::Gitweb::CacheFile', "$htmlcd/$action.lock"  or return undef;
2375         *STDOUT = *CACHEFILE;
2376         unlink "$htmlcd/$action", "$htmlcd/$action.changed";
2377         return 1;
2378 }
2379
2380 # Caller is responsible for restoring STDOUT afterward if needed
2381 sub cached_action_finish {
2382         my $action = shift;
2383
2384         use File::Spec;
2385
2386         my $obj = tied *STDOUT;
2387         return undef unless ref($obj) eq 'Git::Gitweb::CacheFile';
2388         my $cached_page = $obj->contents;
2389         (my $result = close(STDOUT)) or warn "couldn't close cache file on STDOUT: $!";
2390         # Do not leave STDOUT file descriptor invalid!
2391         local *NULL;
2392         open(NULL, '>', File::Spec->devnull) or die "couldn't open NULL to devnull: $!";
2393         *STDOUT = *NULL;
2394         return $cached_page unless $result;
2395         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2396         return $cached_page unless -d $htmlcd;
2397         unlink "$htmlcd/$action.lock" unless rename "$htmlcd/$action.lock", "$htmlcd/$action";
2398         return $cached_page;
2399 }
2400
2401 my %expand_pi_subs;
2402 BEGIN {%expand_pi_subs = (
2403         'age_string'               => \&age_string,
2404         'age_string_date'          => \&age_string_date,
2405         'age_string_age'           => \&age_string_age,
2406         'compute_timed_interval'   => \&compute_timed_interval,
2407         'compute_commands_count'   => \&compute_commands_count,
2408         'format_lastrefresh_row'   => \&format_lastrefresh_row,
2409         'compute_stylesheet_links' => \&compute_stylesheet_links,
2410 )}
2411
2412 # Expands any <?gitweb...> processing instructions and returns the result
2413 sub expand_gitweb_pi {
2414         my $page = shift;
2415         $page .= '';
2416         my @time_now = gettimeofday();
2417         $page =~ s{<\?gitweb(?:\s+([^\s>]+)([^>]*))?\s*\?>}
2418                   {defined($1) ?
2419                           (ref($expand_pi_subs{$1}) eq 'CODE' ?
2420                                   $expand_pi_subs{$1}->(split(' ',$2), @time_now) :
2421                                   '') :
2422                           '' }goes;
2423         return $page;
2424 }
2425
2426 ## ----------------------------------------------------------------------
2427 ## HTML aware string manipulation
2428
2429 # Try to chop given string on a word boundary between position
2430 # $len and $len+$add_len. If there is no word boundary there,
2431 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
2432 # (marking chopped part) would be longer than given string.
2433 sub chop_str {
2434         my $str = shift;
2435         my $len = shift;
2436         my $add_len = shift || 10;
2437         my $where = shift || 'right'; # 'left' | 'center' | 'right'
2438
2439         # Make sure perl knows it is utf8 encoded so we don't
2440         # cut in the middle of a utf8 multibyte char.
2441         $str = to_utf8($str);
2442
2443         # allow only $len chars, but don't cut a word if it would fit in $add_len
2444         # if it doesn't fit, cut it if it's still longer than the dots we would add
2445         # remove chopped character entities entirely
2446
2447         # when chopping in the middle, distribute $len into left and right part
2448         # return early if chopping wouldn't make string shorter
2449         if ($where eq 'center') {
2450                 return $str if ($len + 5 >= length($str)); # filler is length 5
2451                 $len = int($len/2);
2452         } else {
2453                 return $str if ($len + 4 >= length($str)); # filler is length 4
2454         }
2455
2456         # regexps: ending and beginning with word part up to $add_len
2457         my $endre = qr/.{$len}\w{0,$add_len}/;
2458         my $begre = qr/\w{0,$add_len}.{$len}/;
2459
2460         if ($where eq 'left') {
2461                 $str =~ m/^(.*?)($begre)$/;
2462                 my ($lead, $body) = ($1, $2);
2463                 if (length($lead) > 4) {
2464                         $lead = " ...";
2465                 }
2466                 return "$lead$body";
2467
2468         } elsif ($where eq 'center') {
2469                 $str =~ m/^($endre)(.*)$/;
2470                 my ($left, $str)  = ($1, $2);
2471                 $str =~ m/^(.*?)($begre)$/;
2472                 my ($mid, $right) = ($1, $2);
2473                 if (length($mid) > 5) {
2474                         $mid = " ... ";
2475                 }
2476                 return "$left$mid$right";
2477
2478         } else {
2479                 $str =~ m/^($endre)(.*)$/;
2480                 my $body = $1;
2481                 my $tail = $2;
2482                 if (length($tail) > 4) {
2483                         $tail = "... ";
2484                 }
2485                 return "$body$tail";
2486         }
2487 }
2488
2489 # pass-through email filter, obfuscating it when possible
2490 sub email_obfuscate {
2491         our $email;
2492         my ($str) = @_;
2493         if ($email) {
2494                 $str = $email->escape_html($str);
2495                 # Stock HTML::Email::Obfuscate version likes to produce
2496                 # invalid XHTML...
2497                 $str =~ s#<(/?)B>#<$1b>#g;
2498                 return $str;
2499         } else {
2500                 $str = esc_html($str);
2501                 $str =~ s/@/&#x40;/;
2502                 return $str;
2503         }
2504 }
2505
2506 # takes the same arguments as chop_str, but also wraps a <span> around the
2507 # result with a title attribute if it does get chopped. Additionally, the
2508 # string is HTML-escaped.
2509 sub chop_and_escape_str {
2510         my ($str) = @_;
2511
2512         my $chopped = chop_str(@_);
2513         $str = to_utf8($str);
2514         if ($chopped eq $str) {
2515                 return email_obfuscate($chopped);
2516         } else {
2517                 use bytes;
2518                 $str =~ s/[[:cntrl:]]/?/g;
2519                 return $cgi->span({-title=>$str}, email_obfuscate($chopped));
2520         }
2521 }
2522
2523 # Highlight selected fragments of string, using given CSS class,
2524 # and escape HTML.  It is assumed that fragments do not overlap.
2525 # Regions are passed as list of pairs (array references).
2526 #
2527 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
2528 # '<span class="mark">foo</span>bar'
2529 sub esc_html_hl_regions {
2530         my ($str, $css_class, @sel) = @_;
2531         my %opts = grep { ref($_) ne 'ARRAY' } @sel;
2532         @sel     = grep { ref($_) eq 'ARRAY' } @sel;
2533         return esc_html($str, %opts) unless @sel;
2534
2535         my $out = '';
2536         my $pos = 0;
2537
2538         for my $s (@sel) {
2539                 my ($begin, $end) = @$s;
2540
2541                 # Don't create empty <span> elements.
2542                 next if $end <= $begin;
2543
2544                 my $escaped = esc_html(substr($str, $begin, $end - $begin),
2545                                        %opts);
2546
2547                 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
2548                         if ($begin - $pos > 0);
2549                 $out .= $cgi->span({-class => $css_class}, $escaped);
2550
2551                 $pos = $end;
2552         }
2553         $out .= esc_html(substr($str, $pos), %opts)
2554                 if ($pos < length($str));
2555
2556         return $out;
2557 }
2558
2559 # return positions of beginning and end of each match
2560 sub matchpos_list {
2561         my ($str, $regexp) = @_;
2562         return unless (defined $str && defined $regexp);
2563
2564         my @matches;
2565         while ($str =~ /$regexp/g) {
2566                 push @matches, [$-[0], $+[0]];
2567         }
2568         return @matches;
2569 }
2570
2571 # highlight match (if any), and escape HTML
2572 sub esc_html_match_hl {
2573         my ($str, $regexp) = @_;
2574         return esc_html($str) unless defined $regexp;
2575
2576         my @matches = matchpos_list($str, $regexp);
2577         return esc_html($str) unless @matches;
2578
2579         return esc_html_hl_regions($str, 'match', @matches);
2580 }
2581
2582
2583 # highlight match (if any) of shortened string, and escape HTML
2584 sub esc_html_match_hl_chopped {
2585         my ($str, $chopped, $regexp) = @_;
2586         return esc_html_match_hl($str, $regexp) unless defined $chopped;
2587
2588         my @matches = matchpos_list($str, $regexp);
2589         return esc_html($chopped) unless @matches;
2590
2591         # filter matches so that we mark chopped string
2592         my $tail = "... "; # see chop_str
2593         unless ($chopped =~ s/\Q$tail\E$//) {
2594                 $tail = '';
2595         }
2596         my $chop_len = length($chopped);
2597         my $tail_len = length($tail);
2598         my @filtered;
2599
2600         for my $m (@matches) {
2601                 if ($m->[0] > $chop_len) {
2602                         push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
2603                         last;
2604                 } elsif ($m->[1] > $chop_len) {
2605                         push @filtered, [ $m->[0], $chop_len + $tail_len ];
2606                         last;
2607                 }
2608                 push @filtered, $m;
2609         }
2610
2611         return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
2612 }
2613
2614 ## ----------------------------------------------------------------------
2615 ## functions returning short strings
2616
2617 # CSS class for given age epoch value (in seconds)
2618 # and reference time (optional, defaults to now) as second value
2619 sub age_class {
2620         my ($age_epoch, $time_now) = @_;
2621         return "noage" unless defined $age_epoch;
2622         defined $time_now or $time_now = time;
2623         my $age = $time_now - $age_epoch;
2624
2625         if ($age < 60*60*2) {
2626                 return "age0";
2627         } elsif ($age < 60*60*24*2) {
2628                 return "age1";
2629         } else {
2630                 return "age2";
2631         }
2632 }
2633
2634 # convert age epoch in seconds to "nn units ago" string
2635 # reference time used is now unless second argument passed in
2636 # to get the old behavior, pass 0 as the first argument and
2637 # the time in seconds as the second
2638 sub age_string {
2639         my ($age_epoch, $time_now) = @_;
2640         return "unknown" unless defined $age_epoch;
2641         return "<?gitweb age_string $age_epoch?>" if $cache_mode_active;
2642         defined $time_now or $time_now = time;
2643         my $age = $time_now - $age_epoch;
2644         my $age_str;
2645
2646         if ($age > 60*60*24*365*2) {
2647                 $age_str = (int $age/60/60/24/365);
2648                 $age_str .= " years ago";
2649         } elsif ($age > 60*60*24*(365/12)*2) {
2650                 $age_str = int $age/60/60/24/(365/12);
2651                 $age_str .= " months ago";
2652         } elsif ($age > 60*60*24*7*2) {
2653                 $age_str = int $age/60/60/24/7;
2654                 $age_str .= " weeks ago";
2655         } elsif ($age > 60*60*24*2) {
2656                 $age_str = int $age/60/60/24;
2657                 $age_str .= " days ago";
2658         } elsif ($age > 60*60*2) {
2659                 $age_str = int $age/60/60;
2660                 $age_str .= " hours ago";
2661         } elsif ($age > 60*2) {
2662                 $age_str = int $age/60;
2663                 $age_str .= " min ago";
2664         } elsif ($age > 2) {
2665                 $age_str = int $age;
2666                 $age_str .= " sec ago";
2667         } else {
2668                 $age_str .= " right now";
2669         }
2670         return $age_str;
2671 }
2672
2673 # returns age_string if the age is <= 2 weeks otherwise an absolute date
2674 # this is typically shown to the user directly with the age_string_age as a title
2675 sub age_string_date {
2676         my ($age_epoch, $time_now) = @_;
2677         return "unknown" unless defined $age_epoch;
2678         return "<?gitweb age_string_date $age_epoch?>" if $cache_mode_active;
2679         defined $time_now or $time_now = time;
2680         my $age = $time_now - $age_epoch;
2681
2682         if ($age > 60*60*24*7*2) {
2683                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2684                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2685         } else {
2686                 return age_string($age_epoch, $time_now);
2687         }
2688 }
2689
2690 # returns an absolute date if the age is <= 2 weeks otherwise age_string
2691 # this is typically used for the 'title' attribute so it will show as a tooltip
2692 sub age_string_age {
2693         my ($age_epoch, $time_now) = @_;
2694         return "unknown" unless defined $age_epoch;
2695         return "<?gitweb age_string_age $age_epoch?>" if $cache_mode_active;
2696         defined $time_now or $time_now = time;
2697         my $age = $time_now - $age_epoch;
2698
2699         if ($age > 60*60*24*7*2) {
2700                 return age_string($age_epoch, $time_now);
2701         } else {
2702                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2703                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2704         }
2705 }
2706
2707 use constant {
2708         S_IFINVALID => 0030000,
2709         S_IFGITLINK => 0160000,
2710 };
2711
2712 # submodule/subproject, a commit object reference
2713 sub S_ISGITLINK {
2714         my $mode = shift;
2715
2716         return (($mode & S_IFMT) == S_IFGITLINK)
2717 }
2718
2719 # convert file mode in octal to symbolic file mode string
2720 sub mode_str {
2721         my $mode = oct shift;
2722
2723         if (S_ISGITLINK($mode)) {
2724                 return 'm---------';
2725         } elsif (S_ISDIR($mode & S_IFMT)) {
2726                 return 'drwxr-xr-x';
2727         } elsif (S_ISLNK($mode)) {
2728                 return 'lrwxrwxrwx';
2729         } elsif (S_ISREG($mode)) {
2730                 # git cares only about the executable bit
2731                 if ($mode & S_IXUSR) {
2732                         return '-rwxr-xr-x';
2733                 } else {
2734                         return '-rw-r--r--';
2735                 };
2736         } else {
2737                 return '----------';
2738         }
2739 }
2740
2741 # convert file mode in octal to file type string
2742 sub file_type {
2743         my $mode = shift;
2744
2745         if ($mode !~ m/^[0-7]+$/) {
2746                 return $mode;
2747         } else {
2748                 $mode = oct $mode;
2749         }
2750
2751         if (S_ISGITLINK($mode)) {
2752                 return "submodule";
2753         } elsif (S_ISDIR($mode & S_IFMT)) {
2754                 return "directory";
2755         } elsif (S_ISLNK($mode)) {
2756                 return "symlink";
2757         } elsif (S_ISREG($mode)) {
2758                 return "file";
2759         } else {
2760                 return "unknown";
2761         }
2762 }
2763
2764 # convert file mode in octal to file type description string
2765 sub file_type_long {
2766         my $mode = shift;
2767
2768         if ($mode !~ m/^[0-7]+$/) {
2769                 return $mode;
2770         } else {
2771                 $mode = oct $mode;
2772         }
2773
2774         if (S_ISGITLINK($mode)) {
2775                 return "submodule";
2776         } elsif (S_ISDIR($mode & S_IFMT)) {
2777                 return "directory";
2778         } elsif (S_ISLNK($mode)) {
2779                 return "symlink";
2780         } elsif (S_ISREG($mode)) {
2781                 if ($mode & S_IXUSR) {
2782                         return "executable";
2783                 } else {
2784                         return "file";
2785                 };
2786         } else {
2787                 return "unknown";
2788         }
2789 }
2790
2791
2792 ## ----------------------------------------------------------------------
2793 ## functions returning short HTML fragments, or transforming HTML fragments
2794 ## which don't belong to other sections
2795
2796 # format line of commit message.
2797 sub format_log_line_html {
2798         my $line = shift;
2799
2800         $line = esc_html($line, -nbsp=>1);
2801         $line =~ s{
2802         \b
2803         (
2804             # The output of "git describe", e.g. v2.10.0-297-gf6727b0
2805             # or hadoop-20160921-113441-20-g094fb7d
2806             (?<!-) # see strbuf_check_tag_ref(). Tags can't start with -
2807             [A-Za-z0-9.-]+
2808             (?!\.) # refs can't end with ".", see check_refname_format()
2809             -g[0-9a-fA-F]{7,40}
2810             |
2811             # Just a normal looking Git SHA1
2812             [0-9a-fA-F]{7,40}
2813         )
2814         \b
2815     }{
2816                 $cgi->a({-href => href(action=>"object", hash=>$1),
2817                                         -class => "text"}, $1);
2818         }egx unless $line =~ /^\s*git-svn-id:/;
2819
2820         return $line;
2821 }
2822
2823 # format marker of refs pointing to given object
2824
2825 # the destination action is chosen based on object type and current context:
2826 # - for annotated tags, we choose the tag view unless it's the current view
2827 #   already, in which case we go to shortlog view
2828 # - for other refs, we keep the current view if we're in history, shortlog or
2829 #   log view, and select shortlog otherwise
2830 sub format_ref_marker {
2831         my ($refs, $id) = @_;
2832         my $markers = '';
2833
2834         if (defined $refs->{$id}) {
2835                 foreach my $ref (@{$refs->{$id}}) {
2836                         # this code exploits the fact that non-lightweight tags are the
2837                         # only indirect objects, and that they are the only objects for which
2838                         # we want to use tag instead of shortlog as action
2839                         my ($type, $name) = qw();
2840                         my $indirect = ($ref =~ s/\^\{\}$//);
2841                         # e.g. tags/v2.6.11 or heads/next
2842                         if ($ref =~ m!^(.*?)s?/(.*)$!) {
2843                                 $type = $1;
2844                                 $name = $2;
2845                         } else {
2846                                 $type = "ref";
2847                                 $name = $ref;
2848                         }
2849
2850                         my $class = $type;
2851                         $class .= " indirect" if $indirect;
2852
2853                         my $dest_action = "shortlog";
2854
2855                         if ($indirect) {
2856                                 $dest_action = "tag" unless $action eq "tag";
2857                         } elsif ($action =~ /^(history|(short)?log)$/) {
2858                                 $dest_action = $action;
2859                         }
2860
2861                         my $dest = "";
2862                         $dest .= "refs/" unless $ref =~ m!^refs/!;
2863                         $dest .= $ref;
2864
2865                         my $link = $cgi->a({
2866                                 -href => href(
2867                                         action=>$dest_action,
2868                                         hash=>$dest
2869                                 )}, esc_html($name));
2870
2871                         $markers .= "<span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2872                                 $link . "</span>";
2873                 }
2874         }
2875
2876         if ($markers) {
2877                 return '<span class="refs">'. $markers . '</span>';
2878         } else {
2879                 return "";
2880         }
2881 }
2882
2883 # format, perhaps shortened and with markers, title line
2884 sub format_subject_html {
2885         my ($long, $short, $href, $extra) = @_;
2886         $extra = '' unless defined($extra);
2887
2888         if (length($short) < length($long)) {
2889                 use bytes;
2890                 $long =~ s/[[:cntrl:]]/?/g;
2891                 return $cgi->a({-href => $href, -class => "list subject",
2892                                 -title => to_utf8($long)},
2893                        esc_html($short)) . $extra;
2894         } else {
2895                 return $cgi->a({-href => $href, -class => "list subject"},
2896                        esc_html($long)) . $extra;
2897         }
2898 }
2899
2900 # Rather than recomputing the url for an email multiple times, we cache it
2901 # after the first hit. This gives a visible benefit in views where the avatar
2902 # for the same email is used repeatedly (e.g. shortlog).
2903 # The cache is shared by all avatar engines (currently gravatar only), which
2904 # are free to use it as preferred. Since only one avatar engine is used for any
2905 # given page, there's no risk for cache conflicts.
2906 our %avatar_cache = ();
2907
2908 # Compute the picon url for a given email, by using the picon search service over at
2909 # http://www.cs.indiana.edu/picons/search.html
2910 sub picon_url {
2911         my $email = lc shift;
2912         if (!$avatar_cache{$email}) {
2913                 my ($user, $domain) = split('@', $email);
2914                 $avatar_cache{$email} =
2915                         "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2916                         "$domain/$user/" .
2917                         "users+domains+unknown/up/single";
2918         }
2919         return $avatar_cache{$email};
2920 }
2921
2922 # Compute the gravatar url for a given email, if it's not in the cache already.
2923 # Gravatar stores only the part of the URL before the size, since that's the
2924 # one computationally more expensive. This also allows reuse of the cache for
2925 # different sizes (for this particular engine).
2926 sub gravatar_url {
2927         my $email = lc shift;
2928         my $size = shift;
2929         $avatar_cache{$email} ||=
2930                 "//www.gravatar.com/avatar/" .
2931                         Digest::MD5::md5_hex($email) . "?s=";
2932         return $avatar_cache{$email} . $size;
2933 }
2934
2935 # Insert an avatar for the given $email at the given $size if the feature
2936 # is enabled.
2937 sub git_get_avatar {
2938         my ($email, %opts) = @_;
2939         my $pre_white  = ($opts{-pad_before} ? "&#160;" : "");
2940         my $post_white = ($opts{-pad_after}  ? "&#160;" : "");
2941         $opts{-size} ||= 'default';
2942         my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2943         my $url = "";
2944         if ($git_avatar eq 'gravatar') {
2945                 $url = gravatar_url($email, $size);
2946         } elsif ($git_avatar eq 'picon') {
2947                 $url = picon_url($email);
2948         }
2949         # Other providers can be added by extending the if chain, defining $url
2950         # as needed. If no variant puts something in $url, we assume avatars
2951         # are completely disabled/unavailable.
2952         if ($url) {
2953                 return $pre_white .
2954                        "<img width=\"$size\" " .
2955                             "class=\"avatar\" " .
2956                             "src=\"".esc_url($url)."\" " .
2957                             "alt=\"\" " .
2958                        "/>" . $post_white;
2959         } else {
2960                 return "";
2961         }
2962 }
2963
2964 sub format_search_author {
2965         my ($author, $searchtype, $displaytext) = @_;
2966         my $have_search = gitweb_check_feature('search');
2967
2968         if ($have_search) {
2969                 my $performed = "";
2970                 if ($searchtype eq 'author') {
2971                         $performed = "authored";
2972                 } elsif ($searchtype eq 'committer') {
2973                         $performed = "committed";
2974                 }
2975
2976                 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2977                                 searchtext=>$author,
2978                                 searchtype=>$searchtype), class=>"list",
2979                                 title=>"Search for commits $performed by $author"},
2980                                 $displaytext);
2981
2982         } else {
2983                 return $displaytext;
2984         }
2985 }
2986
2987 # format the author name of the given commit with the given tag
2988 # the author name is chopped and escaped according to the other
2989 # optional parameters (see chop_str).
2990 sub format_author_html {
2991         my $tag = shift;
2992         my $co = shift;
2993         my $author = chop_and_escape_str($co->{'author_name'}, @_);
2994         return "<$tag class=\"author\">" .
2995                format_search_author($co->{'author_name'}, "author",
2996                        git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2997                        $author) .
2998                "</$tag>";
2999 }
3000
3001 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
3002 sub format_git_diff_header_line {
3003         my $line = shift;
3004         my $diffinfo = shift;
3005         my ($from, $to) = @_;
3006
3007         if ($diffinfo->{'nparents'}) {
3008                 # combined diff
3009                 $line =~ s!^(diff (.*?) )"?.*$!$1!;
3010                 if ($to->{'href'}) {
3011                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
3012                                          esc_path($to->{'file'}));
3013                 } else { # file was deleted (no href)
3014                         $line .= esc_path($to->{'file'});
3015                 }
3016         } else {
3017                 # "ordinary" diff
3018                 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
3019                 if ($from->{'href'}) {
3020                         $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
3021                                          'a/' . esc_path($from->{'file'}));
3022                 } else { # file was added (no href)
3023                         $line .= 'a/' . esc_path($from->{'file'});
3024                 }
3025                 $line .= ' ';
3026                 if ($to->{'href'}) {
3027                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
3028                                          'b/' . esc_path($to->{'file'}));
3029                 } else { # file was deleted
3030                         $line .= 'b/' . esc_path($to->{'file'});
3031                 }
3032         }
3033
3034         return "<div class=\"diff header\">$line</div>\n";
3035 }
3036
3037 # format extended diff header line, before patch itself
3038 sub format_extended_diff_header_line {
3039         my $line = shift;
3040         my $diffinfo = shift;
3041         my ($from, $to) = @_;
3042
3043         # match <path>
3044         if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
3045                 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
3046                                        esc_path($from->{'file'}));
3047         }
3048         if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
3049                 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3050                                  esc_path($to->{'file'}));
3051         }
3052         # match single <mode>
3053         if ($line =~ m/\s(\d{6})$/) {
3054                 $line .= '<span class="info"> (' .
3055                          file_type_long($1) .
3056                          ')</span>';
3057         }
3058         # match <hash>
3059         if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
3060                 # can match only for combined diff
3061                 $line = 'index ';
3062                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3063                         if ($from->{'href'}[$i]) {
3064                                 $line .= $cgi->a({-href=>$from->{'href'}[$i],
3065                                                   -class=>"hash"},
3066                                                  substr($diffinfo->{'from_id'}[$i],0,7));
3067                         } else {
3068                                 $line .= '0' x 7;
3069                         }
3070                         # separator
3071                         $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
3072                 }
3073                 $line .= '..';
3074                 if ($to->{'href'}) {
3075                         $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
3076                                          substr($diffinfo->{'to_id'},0,7));
3077                 } else {
3078                         $line .= '0' x 7;
3079                 }
3080
3081         } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
3082                 # can match only for ordinary diff
3083                 my ($from_link, $to_link);
3084                 if ($from->{'href'}) {
3085                         $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
3086                                              substr($diffinfo->{'from_id'},0,7));
3087                 } else {
3088                         $from_link = '0' x 7;
3089                 }
3090                 if ($to->{'href'}) {
3091                         $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
3092                                            substr($diffinfo->{'to_id'},0,7));
3093                 } else {
3094                         $to_link = '0' x 7;
3095                 }
3096                 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
3097                 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
3098         }
3099
3100         return $line . "<br/>\n";
3101 }
3102
3103 # format from-file/to-file diff header
3104 sub format_diff_from_to_header {
3105         my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
3106         my $line;
3107         my $result = '';
3108
3109         $line = $from_line;
3110         #assert($line =~ m/^---/) if DEBUG;
3111         # no extra formatting for "^--- /dev/null"
3112         if (! $diffinfo->{'nparents'}) {
3113                 # ordinary (single parent) diff
3114                 if ($line =~ m!^--- "?a/!) {
3115                         if ($from->{'href'}) {
3116                                 $line = '--- a/' .
3117                                         $cgi->a({-href=>$from->{'href'}, -class=>"path"},
3118                                                 esc_path($from->{'file'}));
3119                         } else {
3120                                 $line = '--- a/' .
3121                                         esc_path($from->{'file'});
3122                         }
3123                 }
3124                 $result .= qq!<div class="diff from_file">$line</div>\n!;
3125
3126         } else {
3127                 # combined diff (merge commit)
3128                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3129                         if ($from->{'href'}[$i]) {
3130                                 $line = '--- ' .
3131                                         $cgi->a({-href=>href(action=>"blobdiff",
3132                                                              hash_parent=>$diffinfo->{'from_id'}[$i],
3133                                                              hash_parent_base=>$parents[$i],
3134                                                              file_parent=>$from->{'file'}[$i],
3135                                                              hash=>$diffinfo->{'to_id'},
3136                                                              hash_base=>$hash,
3137                                                              file_name=>$to->{'file'}),
3138                                                  -class=>"path",
3139                                                  -title=>"diff" . ($i+1)},
3140                                                 $i+1) .
3141                                         '/' .
3142                                         $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
3143                                                 esc_path($from->{'file'}[$i]));
3144                         } else {
3145                                 $line = '--- /dev/null';
3146                         }
3147                         $result .= qq!<div class="diff from_file">$line</div>\n!;
3148                 }
3149         }
3150
3151         $line = $to_line;
3152         #assert($line =~ m/^\+\+\+/) if DEBUG;
3153         # no extra formatting for "^+++ /dev/null"
3154         if ($line =~ m!^\+\+\+ "?b/!) {
3155                 if ($to->{'href'}) {
3156                         $line = '+++ b/' .
3157                                 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3158                                         esc_path($to->{'file'}));
3159                 } else {
3160                         $line = '+++ b/' .
3161                                 esc_path($to->{'file'});
3162                 }
3163         }
3164         $result .= qq!<div class="diff to_file">$line</div>\n!;
3165
3166         return $result;
3167 }
3168
3169 # create note for patch simplified by combined diff
3170 sub format_diff_cc_simplified {
3171         my ($diffinfo, @parents) = @_;
3172         my $result = '';
3173
3174         $result .= "<div class=\"diff header\">" .
3175                    "diff --cc ";
3176         if (!is_deleted($diffinfo)) {
3177                 $result .= $cgi->a({-href => href(action=>"blob",
3178                                                   hash_base=>$hash,
3179                                                   hash=>$diffinfo->{'to_id'},
3180                                                   file_name=>$diffinfo->{'to_file'}),
3181                                     -class => "path"},
3182                                    esc_path($diffinfo->{'to_file'}));
3183         } else {
3184                 $result .= esc_path($diffinfo->{'to_file'});
3185         }
3186         $result .= "</div>\n" . # class="diff header"
3187                    "<div class=\"diff nodifferences\">" .
3188                    "Simple merge" .
3189                    "</div>\n"; # class="diff nodifferences"
3190
3191         return $result;
3192 }
3193
3194 sub diff_line_class {
3195         my ($line, $from, $to) = @_;
3196
3197         # ordinary diff
3198         my $num_sign = 1;
3199         # combined diff
3200         if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
3201                 $num_sign = scalar @{$from->{'href'}};
3202         }
3203
3204         my @diff_line_classifier = (
3205                 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
3206                 { regexp => qr/^\\/,               class => "incomplete"  },
3207                 { regexp => qr/^ {$num_sign}/,     class => "ctx" },
3208                 # classifier for context must come before classifier add/rem,
3209                 # or we would have to use more complicated regexp, for example
3210                 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
3211                 { regexp => qr/^[+ ]{$num_sign}/,   class => "add" },
3212                 { regexp => qr/^[- ]{$num_sign}/,   class => "rem" },
3213         );
3214         for my $clsfy (@diff_line_classifier) {
3215                 return $clsfy->{'class'}
3216                         if ($line =~ $clsfy->{'regexp'});
3217         }
3218
3219         # fallback
3220         return "";
3221 }
3222
3223 # assumes that $from and $to are defined and correctly filled,
3224 # and that $line holds a line of chunk header for unified diff
3225 sub format_unidiff_chunk_header {
3226         my ($line, $from, $to) = @_;
3227
3228         my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
3229                 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
3230
3231         $from_lines = 0 unless defined $from_lines;
3232         $to_lines   = 0 unless defined $to_lines;
3233
3234         if ($from->{'href'}) {
3235                 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
3236                                      -class=>"list"}, $from_text);
3237         }
3238         if ($to->{'href'}) {
3239                 $to_text   = $cgi->a({-href=>"$to->{'href'}#l$to_start",
3240                                      -class=>"list"}, $to_text);
3241         }
3242         $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
3243                 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3244         return $line;
3245 }
3246
3247 # assumes that $from and $to are defined and correctly filled,
3248 # and that $line holds a line of chunk header for combined diff
3249 sub format_cc_diff_chunk_header {
3250         my ($line, $from, $to) = @_;
3251
3252         my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
3253         my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
3254
3255         @from_text = split(' ', $ranges);
3256         for (my $i = 0; $i < @from_text; ++$i) {
3257                 ($from_start[$i], $from_nlines[$i]) =
3258                         (split(',', substr($from_text[$i], 1)), 0);
3259         }
3260
3261         $to_text   = pop @from_text;
3262         $to_start  = pop @from_start;
3263         $to_nlines = pop @from_nlines;
3264
3265         $line = "<span class=\"chunk_info\">$prefix ";
3266         for (my $i = 0; $i < @from_text; ++$i) {
3267                 if ($from->{'href'}[$i]) {
3268                         $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
3269                                           -class=>"list"}, $from_text[$i]);
3270                 } else {
3271                         $line .= $from_text[$i];
3272                 }
3273                 $line .= " ";
3274         }
3275         if ($to->{'href'}) {
3276                 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
3277                                   -class=>"list"}, $to_text);
3278         } else {
3279                 $line .= $to_text;
3280         }
3281         $line .= " $prefix</span>" .
3282                  "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3283         return $line;
3284 }
3285
3286 # process patch (diff) line (not to be used for diff headers),
3287 # returning HTML-formatted (but not wrapped) line.
3288 # If the line is passed as a reference, it is treated as HTML and not
3289 # esc_html()'ed.
3290 sub format_diff_line {
3291         my ($line, $diff_class, $from, $to) = @_;
3292
3293         if (ref($line)) {
3294                 $line = $$line;
3295         } else {
3296                 chomp $line;
3297                 $line = untabify($line);
3298
3299                 if ($from && $to && $line =~ m/^\@{2} /) {
3300                         $line = format_unidiff_chunk_header($line, $from, $to);
3301                 } elsif ($from && $to && $line =~ m/^\@{3}/) {
3302                         $line = format_cc_diff_chunk_header($line, $from, $to);
3303                 } else {
3304                         $line = esc_html($line, -nbsp=>1);
3305                 }
3306         }
3307
3308         my $diff_classes = "diff diff_body";
3309         $diff_classes .= " $diff_class" if ($diff_class);
3310         $line = "<div class=\"$diff_classes\">$line</div>\n";
3311
3312         return $line;
3313 }
3314
3315 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
3316 # linked.  Pass the hash of the tree/commit to snapshot.
3317 sub format_snapshot_links {
3318         my ($hash) = @_;
3319         my $num_fmts = @snapshot_fmts;
3320         if ($num_fmts > 1) {
3321                 # A parenthesized list of links bearing format names.
3322                 # e.g. "snapshot (_tar.gz_ _zip_)"
3323                 return "<span class=\"snapshots\">snapshot (" . join(' ', map
3324                         $cgi->a({
3325                                 -href => href(
3326                                         action=>"snapshot",
3327                                         hash=>$hash,
3328                                         snapshot_format=>$_
3329                                 )
3330                         }, $known_snapshot_formats{$_}{'display'})
3331                 , @snapshot_fmts) . ")</span>";
3332         } elsif ($num_fmts == 1) {
3333                 # A single "snapshot" link whose tooltip bears the format name.
3334                 # i.e. "_snapshot_"
3335                 my ($fmt) = @snapshot_fmts;
3336                 return "<span class=\"snapshots\">" .
3337                         $cgi->a({
3338                                 -href => href(
3339                                         action=>"snapshot",
3340                                         hash=>$hash,
3341                                         snapshot_format=>$fmt
3342                                 ),
3343                                 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
3344                         }, "snapshot") . "</span>";
3345         } else { # $num_fmts == 0
3346                 return undef;
3347         }
3348 }
3349
3350 ## ......................................................................
3351 ## functions returning values to be passed, perhaps after some
3352 ## transformation, to other functions; e.g. returning arguments to href()
3353
3354 # returns hash to be passed to href to generate gitweb URL
3355 # in -title key it returns description of link
3356 sub get_feed_info {
3357         my $format = shift || 'Atom';
3358         my %res = (action => lc($format));
3359         my $matched_ref = 0;
3360
3361         # feed links are possible only for project views
3362         return unless (defined $project);
3363         # some views should link to OPML, or to generic project feed,
3364         # or don't have specific feed yet (so they should use generic)
3365         return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
3366
3367         my $branch = undef;
3368         # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
3369         # (fullname) to differentiate from tag links; this also makes
3370         # possible to detect branch links
3371         for my $ref (get_branch_refs()) {
3372                 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
3373                     (defined $hash      && $hash      =~ m!^refs/\Q$ref\E/(.*)$!)) {
3374                         $branch = $1;
3375                         $matched_ref = $ref;
3376                         last;
3377                 }
3378         }
3379         # find log type for feed description (title)
3380         my $type = 'log';
3381         if (defined $file_name) {
3382                 $type  = "history of $file_name";
3383                 $type .= "/" if ($action eq 'tree');
3384                 $type .= " on '$branch'" if (defined $branch);
3385         } else {
3386                 $type = "log of $branch" if (defined $branch);
3387         }
3388
3389         $res{-title} = $type;
3390         $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
3391         $res{'file_name'} = $file_name;
3392
3393         return %res;
3394 }
3395
3396 ## ----------------------------------------------------------------------
3397 ## git utility subroutines, invoking git commands
3398
3399 # returns path to the core git executable and the --git-dir parameter as list
3400 sub git_cmd {
3401         $number_of_git_cmds++;
3402         return $GIT, '--git-dir='.$git_dir;
3403 }
3404
3405 # opens a "-|" cmd pipe handle with 2>/dev/null and returns it
3406 sub cmd_pipe {
3407
3408         # In order to be compatible with FCGI mode we must use POSIX
3409         # and access the STDERR_FILENO file descriptor directly
3410
3411         use POSIX qw(STDERR_FILENO dup dup2);
3412
3413         open(my $null, '>', File::Spec->devnull) or die "couldn't open devnull: $!";
3414         (my $saveerr = dup(STDERR_FILENO)) or die "couldn't dup STDERR: $!";
3415         my $dup2ok = dup2(fileno($null), STDERR_FILENO);
3416         close($null) or !$dup2ok or die "couldn't close NULL: $!";
3417         $dup2ok or POSIX::close($saveerr), die "couldn't dup NULL to STDERR: $!";
3418         my $result = open(my $fd, "-|", @_);
3419         $dup2ok = dup2($saveerr, STDERR_FILENO);
3420         POSIX::close($saveerr) or !$dup2ok or die "couldn't close SAVEERR: $!";
3421         $dup2ok or die "couldn't dup SAVERR to STDERR: $!";
3422
3423         return $result ? $fd : undef;
3424 }
3425
3426 # opens a "-|" git_cmd pipe handle with 2>/dev/null and returns it
3427 sub git_cmd_pipe {
3428         return cmd_pipe git_cmd(), @_;
3429 }
3430
3431 # quote the given arguments for passing them to the shell
3432 # quote_command("command", "arg 1", "arg with ' and ! characters")
3433 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
3434 # Try to avoid using this function wherever possible.
3435 sub quote_command {
3436         return join(' ',
3437                 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
3438 }
3439
3440 # get HEAD ref of given project as hash
3441 sub git_get_head_hash {
3442         return git_get_full_hash(shift, 'HEAD');
3443 }
3444
3445 sub git_get_full_hash {
3446         return git_get_hash(@_);
3447 }
3448
3449 sub git_get_short_hash {
3450         return git_get_hash(@_, '--short=7');
3451 }
3452
3453 sub git_get_hash {
3454         my ($project, $hash, @options) = @_;
3455         my $o_git_dir = $git_dir;
3456         my $retval = undef;
3457         $git_dir = "$projectroot/$project";
3458         if (defined(my $fd = git_cmd_pipe 'rev-parse',
3459             '--verify', '-q', @options, $hash)) {
3460                 $retval = <$fd>;
3461                 chomp $retval if defined $retval;
3462                 close $fd;
3463         }
3464         if (defined $o_git_dir) {
3465                 $git_dir = $o_git_dir;
3466         }
3467         return $retval;
3468 }
3469
3470 # get type of given object
3471 sub git_get_type {
3472         my $hash = shift;
3473
3474         defined(my $fd = git_cmd_pipe "cat-file", '-t', $hash) or return;
3475         my $type = <$fd>;
3476         close $fd or return;
3477         chomp $type;
3478         return $type;
3479 }
3480
3481 # repository configuration
3482 our $config_file = '';
3483 our %config;
3484
3485 # store multiple values for single key as anonymous array reference
3486 # single values stored directly in the hash, not as [ <value> ]
3487 sub hash_set_multi {
3488         my ($hash, $key, $value) = @_;
3489
3490         if (!exists $hash->{$key}) {
3491                 $hash->{$key} = $value;
3492         } elsif (!ref $hash->{$key}) {
3493                 $hash->{$key} = [ $hash->{$key}, $value ];
3494         } else {
3495                 push @{$hash->{$key}}, $value;
3496         }
3497 }
3498
3499 # return hash of git project configuration
3500 # optionally limited to some section, e.g. 'gitweb'
3501 sub git_parse_project_config {
3502         my $section_regexp = shift;
3503         my %config;
3504
3505         local $/ = "\0";
3506
3507         defined(my $fh = git_cmd_pipe "config", '-z', '-l')
3508                 or return;
3509
3510         while (my $keyval = to_utf8(scalar <$fh>)) {
3511                 chomp $keyval;
3512                 my ($key, $value) = split(/\n/, $keyval, 2);
3513
3514                 hash_set_multi(\%config, $key, $value)
3515                         if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
3516         }
3517         close $fh;
3518
3519         return %config;
3520 }
3521
3522 # convert config value to boolean: 'true' or 'false'
3523 # no value, number > 0, 'true' and 'yes' values are true
3524 # rest of values are treated as false (never as error)
3525 sub config_to_bool {
3526         my $val = shift;
3527
3528         return 1 if !defined $val;             # section.key
3529
3530         # strip leading and trailing whitespace
3531         $val =~ s/^\s+//;
3532         $val =~ s/\s+$//;
3533
3534         return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
3535                 ($val =~ /^(?:true|yes)$/i));  # section.key = true
3536 }
3537
3538 # convert config value to simple decimal number
3539 # an optional value suffix of 'k', 'm', or 'g' will cause the value
3540 # to be multiplied by 1024, 1048576, or 1073741824
3541 sub config_to_int {
3542         my $val = shift;
3543
3544         # strip leading and trailing whitespace
3545         $val =~ s/^\s+//;
3546         $val =~ s/\s+$//;
3547
3548         if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
3549                 $unit = lc($unit);
3550                 # unknown unit is treated as 1
3551                 return $num * ($unit eq 'g' ? 1073741824 :
3552                                $unit eq 'm' ?    1048576 :
3553                                $unit eq 'k' ?       1024 : 1);
3554         }
3555         return $val;
3556 }
3557
3558 # convert config value to array reference, if needed
3559 sub config_to_multi {
3560         my $val = shift;
3561
3562         return ref($val) ? $val : (defined($val) ? [ $val ] : []);
3563 }
3564
3565 sub git_get_project_config {
3566         my ($key, $type) = @_;
3567
3568         return unless defined $git_dir;
3569
3570         # key sanity check
3571         return unless ($key);
3572         # only subsection, if exists, is case sensitive,
3573         # and not lowercased by 'git config -z -l'
3574         if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
3575                 $lo =~ s/_//g;
3576                 $key = join(".", lc($hi), $mi, lc($lo));
3577                 return if ($lo =~ /\W/ || $hi =~ /\W/);
3578         } else {
3579                 $key = lc($key);
3580                 $key =~ s/_//g;
3581                 return if ($key =~ /\W/);
3582         }
3583         $key =~ s/^gitweb\.//;
3584
3585         # type sanity check
3586         if (defined $type) {
3587                 $type =~ s/^--//;
3588                 $type = undef
3589                         unless ($type eq 'bool' || $type eq 'int');
3590         }
3591
3592         # get config
3593         if (!defined $config_file ||
3594             $config_file ne "$git_dir/config") {
3595                 %config = git_parse_project_config('gitweb');
3596                 $config_file = "$git_dir/config";
3597         }
3598
3599         # check if config variable (key) exists
3600         return unless exists $config{"gitweb.$key"};
3601
3602         # ensure given type
3603         if (!defined $type) {
3604                 return $config{"gitweb.$key"};
3605         } elsif ($type eq 'bool') {
3606                 # backward compatibility: 'git config --bool' returns true/false
3607                 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
3608         } elsif ($type eq 'int') {
3609                 return config_to_int($config{"gitweb.$key"});
3610         }
3611         return $config{"gitweb.$key"};
3612 }
3613
3614 # get hash of given path at given ref
3615 sub git_get_hash_by_path {
3616         my $base = shift;
3617         my $path = shift || return undef;
3618         my $type = shift;
3619
3620         $path =~ s,/+$,,;
3621
3622         defined(my $fd = git_cmd_pipe "ls-tree", $base, "--", $path)
3623                 or die_error(500, "Open git-ls-tree failed");
3624         my $line = to_utf8(scalar <$fd>);
3625         close $fd or return undef;
3626
3627         if (!defined $line) {
3628                 # there is no tree or hash given by $path at $base
3629                 return undef;
3630         }
3631
3632         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3633         $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
3634         if (defined $type && $type ne $2) {
3635                 # type doesn't match
3636                 return undef;
3637         }
3638         return $3;
3639 }
3640
3641 # get path of entry with given hash at given tree-ish (ref)
3642 # used to get 'from' filename for combined diff (merge commit) for renames
3643 sub git_get_path_by_hash {
3644         my $base = shift || return;
3645         my $hash = shift || return;
3646
3647         local $/ = "\0";
3648
3649         defined(my $fd = git_cmd_pipe "ls-tree", '-r', '-t', '-z', $base)
3650                 or return undef;
3651         while (my $line = to_utf8(scalar <$fd>)) {
3652                 chomp $line;
3653
3654                 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423  gitweb'
3655                 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f  gitweb/README'
3656                 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
3657                         close $fd;
3658                         return $1;
3659                 }
3660         }
3661         close $fd;
3662         return undef;
3663 }
3664
3665 ## ......................................................................
3666 ## git utility functions, directly accessing git repository
3667
3668 # get the value of config variable either from file named as the variable
3669 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
3670 # configuration variable in the repository config file.
3671 sub git_get_file_or_project_config {
3672         my ($path, $name) = @_;
3673
3674         $git_dir = "$projectroot/$path";
3675         open my $fd, '<', "$git_dir/$name"
3676                 or return git_get_project_config($name);
3677         my $conf = to_utf8(scalar <$fd>);
3678         close $fd;
3679         if (defined $conf) {
3680                 chomp $conf;
3681         }
3682         return $conf;
3683 }
3684
3685 sub git_get_project_description {
3686         my $path = shift;
3687         return git_get_file_or_project_config($path, 'description');
3688 }
3689
3690 sub git_get_project_category {
3691         my $path = shift;
3692         return git_get_file_or_project_config($path, 'category');
3693 }
3694
3695
3696 # supported formats:
3697 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
3698 #   - if its contents is a number, use it as tag weight,
3699 #   - otherwise add a tag with weight 1
3700 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
3701 #   the same value multiple times increases tag weight
3702 # * `gitweb.ctag' multi-valued repo config variable
3703 sub git_get_project_ctags {
3704         my $project = shift;
3705         my $ctags = {};
3706
3707         $git_dir = "$projectroot/$project";
3708         if (opendir my $dh, "$git_dir/ctags") {
3709                 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
3710                 foreach my $tagfile (@files) {
3711                         open my $ct, '<', $tagfile
3712                                 or next;
3713                         my $val = <$ct>;
3714                         chomp $val if $val;
3715                         close $ct;
3716
3717                         (my $ctag = $tagfile) =~ s#.*/##;
3718                         $ctag = to_utf8($ctag);
3719                         if ($val =~ /^\d+$/) {
3720                                 $ctags->{$ctag} = $val;
3721                         } else {
3722                                 $ctags->{$ctag} = 1;
3723                         }
3724                 }
3725                 closedir $dh;
3726
3727         } elsif (open my $fh, '<', "$git_dir/ctags") {
3728                 while (my $line = to_utf8(scalar <$fh>)) {
3729                         chomp $line;
3730                         $ctags->{$line}++ if $line;
3731                 }
3732                 close $fh;
3733
3734         } else {
3735                 my $taglist = config_to_multi(git_get_project_config('ctag'));
3736                 foreach my $tag (@$taglist) {
3737                         $ctags->{$tag}++;
3738                 }
3739         }
3740
3741         return $ctags;
3742 }
3743
3744 # return hash, where keys are content tags ('ctags'),
3745 # and values are sum of weights of given tag in every project
3746 sub git_gather_all_ctags {
3747         my $projects = shift;
3748         my $ctags = {};
3749
3750         foreach my $p (@$projects) {
3751                 foreach my $ct (keys %{$p->{'ctags'}}) {
3752                         $ctags->{$ct} += $p->{'ctags'}->{$ct};
3753                 }
3754         }
3755
3756         return $ctags;
3757 }
3758
3759 sub git_populate_project_tagcloud {
3760         my ($ctags, $action) = @_;
3761
3762         # First, merge different-cased tags; tags vote on casing
3763         my %ctags_lc;
3764         foreach (keys %$ctags) {
3765                 $ctags_lc{lc $_}->{count} += $ctags->{$_};
3766                 if (not $ctags_lc{lc $_}->{topcount}
3767                     or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
3768                         $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
3769                         $ctags_lc{lc $_}->{topname} = $_;
3770                 }
3771         }
3772
3773         my $cloud;
3774         my $matched = $input_params{'ctag_filter'};
3775         if (eval { require HTML::TagCloud; 1; }) {
3776                 $cloud = HTML::TagCloud->new;
3777                 foreach my $ctag (sort keys %ctags_lc) {
3778                         # Pad the title with spaces so that the cloud looks
3779                         # less crammed.
3780                         my $title = esc_html($ctags_lc{$ctag}->{topname});
3781                         $title =~ s/ /&#160;/g;
3782                         $title =~ s/^/&#160;/g;
3783                         $title =~ s/$/&#160;/g;
3784                         if (defined $matched && $matched eq $ctag) {
3785                                 $title = qq(<span class="match">$title</span>);
3786                         }
3787                         $cloud->add($title, href(-replay=>1, action=>$action, ctag_filter=>$ctag),
3788                                     $ctags_lc{$ctag}->{count});
3789                 }
3790         } else {
3791                 $cloud = {};
3792                 foreach my $ctag (keys %ctags_lc) {
3793                         my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3794                         if (defined $matched && $matched eq $ctag) {
3795                                 $title = qq(<span class="match">$title</span>);
3796                         }
3797                         $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3798                         $cloud->{$ctag}{ctag} =
3799                                 $cgi->a({-href=>href(-replay=>1, action=>$action, ctag_filter=>$ctag)}, $title);
3800                 }
3801         }
3802         return $cloud;
3803 }
3804
3805 sub git_show_project_tagcloud {
3806         my ($cloud, $count) = @_;
3807         if (ref $cloud eq 'HTML::TagCloud') {
3808                 return $cloud->html_and_css($count);
3809         } else {
3810                 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3811                 return
3812                         '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3813                         join (', ', map {
3814                                 $cloud->{$_}->{'ctag'}
3815                         } splice(@tags, 0, $count)) .
3816                         '</div>';
3817         }
3818 }
3819
3820 sub git_get_project_url_list {
3821         my $path = shift;
3822
3823         $git_dir = "$projectroot/$path";
3824         open my $fd, '<', "$git_dir/cloneurl"
3825                 or return wantarray ?
3826                 @{ config_to_multi(git_get_project_config('url')) } :
3827                    config_to_multi(git_get_project_config('url'));
3828         my @git_project_url_list = map { chomp; to_utf8($_) } <$fd>;
3829         close $fd;
3830
3831         return wantarray ? @git_project_url_list : \@git_project_url_list;
3832 }
3833
3834 sub git_get_projects_list {
3835         my $filter = shift;
3836         my $paranoid = shift;
3837         my @list;
3838         defined($filter) or $filter = "";
3839
3840         if (-d $projects_list) {
3841                 # search in directory
3842                 my $dir = $projects_list;
3843                 # remove the trailing "/"
3844                 $dir =~ s!/+$!!;
3845                 my $pfxlen = length("$dir");
3846                 my $pfxdepth = ($dir =~ tr!/!!);
3847                 # when filtering, search only given subdirectory
3848                 if ($filter ne "" && !$paranoid) {
3849                         $dir .= "/$filter";
3850                         $dir =~ s!/+$!!;
3851                 }
3852
3853                 File::Find::find({
3854                         follow_fast => 1, # follow symbolic links
3855                         follow_skip => 2, # ignore duplicates
3856                         dangling_symlinks => 0, # ignore dangling symlinks, silently
3857                         wanted => sub {
3858                                 # global variables
3859                                 our $project_maxdepth;
3860                                 our $projectroot;
3861                                 # skip project-list toplevel, if we get it.
3862                                 return if (m!^[/.]$!);
3863                                 # only directories can be git repositories
3864                                 return unless (-d $_);
3865                                 # don't traverse too deep (Find is super slow on os x)
3866                                 # $project_maxdepth excludes depth of $projectroot
3867                                 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3868                                         $File::Find::prune = 1;
3869                                         return;
3870                                 }
3871
3872                                 my $path = substr($File::Find::name, $pfxlen + 1);
3873                                 # paranoidly only filter here
3874                                 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3875                                         next;
3876                                 }
3877                                 # we check related file in $projectroot
3878                                 if (check_export_ok("$projectroot/$path")) {
3879                                         push @list, { path => $path };
3880                                         $File::Find::prune = 1;
3881                                 }
3882                         },
3883                 }, "$dir");
3884
3885         } elsif (-f $projects_list) {
3886                 # read from file(url-encoded):
3887                 # 'git%2Fgit.git Linus+Torvalds'
3888                 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3889                 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3890                 open my $fd, '<', $projects_list or return;
3891         PROJECT:
3892                 while (my $line = <$fd>) {
3893                         chomp $line;
3894                         my ($path, $owner) = split ' ', $line;
3895                         $path = unescape($path);
3896                         $owner = unescape($owner);
3897                         if (!defined $path) {
3898                                 next;
3899                         }
3900                         # if $filter is rpovided, check if $path begins with $filter
3901                         if ($filter ne "" && $path !~ m!^\Q$filter\E/!) {
3902                                 next;
3903                         }
3904                         if (check_export_ok("$projectroot/$path")) {
3905                                 my $pr = {
3906                                         path => $path
3907                                 };
3908                                 if ($owner) {
3909                                         $pr->{'owner'} = to_utf8($owner);
3910                                 }
3911                                 push @list, $pr;
3912                         }
3913                 }
3914                 close $fd;
3915         }
3916         return @list;
3917 }
3918
3919 # written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
3920 # as side effects it sets 'forks' field to list of forks for forked projects
3921 sub filter_forks_from_projects_list {
3922         my $projects = shift;
3923
3924         my %trie; # prefix tree of directories (path components)
3925         # generate trie out of those directories that might contain forks
3926         foreach my $pr (@$projects) {
3927                 my $path = $pr->{'path'};
3928                 $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
3929                 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3930                 next if ($path eq "");    # skip '.git' repository: tests, git-instaweb
3931                 next unless (-d "$projectroot/$path"); # containing directory exists
3932                 $pr->{'forks'} = [];      # there can be 0 or more forks of project
3933
3934                 # add to trie
3935                 my @dirs = split('/', $path);
3936                 # walk the trie, until either runs out of components or out of trie
3937                 my $ref = \%trie;
3938                 while (scalar @dirs &&
3939                        exists($ref->{$dirs[0]})) {
3940                         $ref = $ref->{shift @dirs};
3941                 }
3942                 # create rest of trie structure from rest of components
3943                 foreach my $dir (@dirs) {
3944                         $ref = $ref->{$dir} = {};
3945                 }
3946                 # create end marker, store $pr as a data
3947                 $ref->{''} = $pr if (!exists $ref->{''});
3948         }
3949
3950         # filter out forks, by finding shortest prefix match for paths
3951         my @filtered;
3952  PROJECT:
3953         foreach my $pr (@$projects) {
3954                 # trie lookup
3955                 my $ref = \%trie;
3956         DIR:
3957                 foreach my $dir (split('/', $pr->{'path'})) {
3958                         if (exists $ref->{''}) {
3959                                 # found [shortest] prefix, is a fork - skip it
3960                                 push @{$ref->{''}{'forks'}}, $pr;
3961                                 next PROJECT;
3962                         }
3963                         if (!exists $ref->{$dir}) {
3964                                 # not in trie, cannot have prefix, not a fork
3965                                 push @filtered, $pr;
3966                                 next PROJECT;
3967                         }
3968                         # If the dir is there, we just walk one step down the trie.
3969                         $ref = $ref->{$dir};
3970                 }
3971                 # we ran out of trie
3972                 # (shouldn't happen: it's either no match, or end marker)
3973                 push @filtered, $pr;
3974         }
3975
3976         return @filtered;
3977 }
3978
3979 # note: fill_project_list_info must be run first,
3980 # for 'descr_long' and 'ctags' to be filled
3981 sub search_projects_list {
3982         my ($projlist, %opts) = @_;
3983         my $tagfilter  = $opts{'tagfilter'};
3984         my $search_re = $opts{'search_regexp'};
3985
3986         return @$projlist
3987                 unless ($tagfilter || $search_re);
3988
3989         # searching projects require filling to be run before it;
3990         fill_project_list_info($projlist,
3991                                $tagfilter  ? 'ctags' : (),
3992                                $search_re ? ('path', 'descr') : ());
3993         my @projects;
3994  PROJECT:
3995         foreach my $pr (@$projlist) {
3996
3997                 if ($tagfilter) {
3998                         next unless ref($pr->{'ctags'}) eq 'HASH';
3999                         next unless
4000                                 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
4001                 }
4002
4003                 if ($search_re) {
4004                         my $path = $pr->{'path'};
4005                         $path =~ s/\.git$//; # should not be included in search
4006                         next unless
4007                                 $path =~ /$search_re/ ||
4008                                 $pr->{'descr_long'} =~ /$search_re/;
4009                 }
4010
4011                 push @projects, $pr;
4012         }
4013
4014         return @projects;
4015 }
4016
4017 our $gitweb_project_owner = undef;
4018 sub git_get_project_list_from_file {
4019
4020         return if (defined $gitweb_project_owner);
4021
4022         $gitweb_project_owner = {};
4023         # read from file (url-encoded):
4024         # 'git%2Fgit.git Linus+Torvalds'
4025         # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
4026         # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
4027         if (-f $projects_list) {
4028                 open(my $fd, '<', $projects_list);
4029                 while (my $line = <$fd>) {
4030                         chomp $line;
4031                         my ($pr, $ow) = split ' ', $line;
4032                         $pr = unescape($pr);
4033                         $ow = unescape($ow);
4034                         $gitweb_project_owner->{$pr} = to_utf8($ow);
4035                 }
4036                 close $fd;
4037         }
4038 }
4039
4040 sub git_get_project_owner {
4041         my $proj = shift;
4042         my $owner;
4043
4044         return undef unless $proj;
4045         $git_dir = "$projectroot/$proj";
4046
4047         if (defined $project && $proj eq $project) {
4048                 $owner = git_get_project_config('owner');
4049         }
4050         if (!defined $owner && !defined $gitweb_project_owner) {
4051                 git_get_project_list_from_file();
4052         }
4053         if (!defined $owner && exists $gitweb_project_owner->{$proj}) {
4054                 $owner = $gitweb_project_owner->{$proj};
4055         }
4056         if (!defined $owner && (!defined $project || $proj ne $project)) {
4057                 $owner = git_get_project_config('owner');
4058         }
4059         if (!defined $owner) {
4060                 $owner = get_file_owner("$git_dir");
4061         }
4062
4063         return $owner;
4064 }
4065
4066 sub parse_activity_date {
4067         my $dstr = shift;
4068
4069         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
4070                 # Unix timestamp
4071                 return 0 + $1;
4072         }
4073         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt _](\d{1,2}):(\d{2}):(\d{2})(?:[ _]?([Zz]|(?:[-+]\d{1,2}:?\d{2})))?\s*$/) {
4074                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
4075                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, 0+$Y);
4076                 defined($z) && $z ne '' or $z = 'Z';
4077                 $z =~ s/://;
4078                 substr($z,1,0) = '0' if length($z) == 4;
4079                 my $off = 0;
4080                 if (uc($z) ne 'Z') {
4081                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
4082                         $off = -$off if substr($z,0,1) eq '-';
4083                 }
4084                 return $seconds - $off;
4085         }
4086         return undef;
4087 }
4088
4089 # If $quick is true only look at $lastactivity_file
4090 sub git_get_last_activity {
4091         my ($path, $quick) = @_;
4092         my $fd;
4093
4094         $git_dir = "$projectroot/$path";
4095         if ($lastactivity_file && open($fd, "<", "$git_dir/$lastactivity_file")) {
4096                 my $activity = <$fd>;
4097                 close $fd;
4098                 return (undef) unless defined $activity;
4099                 chomp $activity;
4100                 return (undef) if $activity eq '';
4101                 if (my $timestamp = parse_activity_date($activity)) {
4102                         return ($timestamp);
4103                 }
4104         }
4105         return (undef) if $quick;
4106         defined($fd = git_cmd_pipe 'for-each-ref',
4107              '--format=%(committer)',
4108              '--sort=-committerdate',
4109              '--count=1',
4110              map { "refs/$_" } get_branch_refs ()) or return;
4111         my $most_recent = <$fd>;
4112         close $fd or return (undef);
4113         if (defined $most_recent &&
4114             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
4115                 my $timestamp = $1;
4116                 return ($timestamp);
4117         }
4118         return (undef);
4119 }
4120
4121 # Implementation note: when a single remote is wanted, we cannot use 'git
4122 # remote show -n' because that command always work (assuming it's a remote URL
4123 # if it's not defined), and we cannot use 'git remote show' because that would
4124 # try to make a network roundtrip. So the only way to find if that particular
4125 # remote is defined is to walk the list provided by 'git remote -v' and stop if
4126 # and when we find what we want.
4127 sub git_get_remotes_list {
4128         my $wanted = shift;
4129         my %remotes = ();
4130
4131         my $fd = git_cmd_pipe 'remote', '-v';
4132         return unless $fd;
4133         while (my $remote = to_utf8(scalar <$fd>)) {
4134                 chomp $remote;
4135                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
4136                 next if $wanted and not $remote eq $wanted;
4137                 my ($url, $key) = ($1, $2);
4138
4139                 $remotes{$remote} ||= { 'heads' => [] };
4140                 $remotes{$remote}{$key} = $url;
4141         }
4142         close $fd or return;
4143         return wantarray ? %remotes : \%remotes;
4144 }
4145
4146 # Takes a hash of remotes as first parameter and fills it by adding the
4147 # available remote heads for each of the indicated remotes.
4148 sub fill_remote_heads {
4149         my $remotes = shift;
4150         my @heads = map { "remotes/$_" } keys %$remotes;
4151         my @remoteheads = git_get_heads_list(undef, @heads);
4152         foreach my $remote (keys %$remotes) {
4153                 $remotes->{$remote}{'heads'} = [ grep {
4154                         $_->{'name'} =~ s!^$remote/!!
4155                         } @remoteheads ];
4156         }
4157 }
4158
4159 sub git_get_references {
4160         my $type = shift || "";
4161         my %refs;
4162         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
4163         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
4164         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
4165                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
4166                 or return;
4167
4168         while (my $line = to_utf8(scalar <$fd>)) {
4169                 chomp $line;
4170                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
4171                         if (defined $refs{$1}) {
4172                                 push @{$refs{$1}}, $2;
4173                         } else {
4174                                 $refs{$1} = [ $2 ];
4175                         }
4176                 }
4177         }
4178         close $fd or return;
4179         return \%refs;
4180 }
4181
4182 sub git_get_rev_name_tags {
4183         my $hash = shift || return undef;
4184
4185         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
4186                 or return;
4187         my $name_rev = to_utf8(scalar <$fd>);
4188         close $fd;
4189
4190         if ($name_rev =~ m|^$hash tags/(.*)$|) {
4191                 return $1;
4192         } else {
4193                 # catches also '$hash undefined' output
4194                 return undef;
4195         }
4196 }
4197
4198 ## ----------------------------------------------------------------------
4199 ## parse to hash functions
4200
4201 sub parse_date {
4202         my $epoch = shift;
4203         my $tz = shift || "-0000";
4204
4205         my %date;
4206         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
4207         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
4208         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
4209         $date{'hour'} = $hour;
4210         $date{'minute'} = $min;
4211         $date{'mday'} = $mday;
4212         $date{'day'} = $days[$wday];
4213         $date{'month'} = $months[$mon];
4214         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
4215                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
4216         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
4217                              $mday, $months[$mon], $hour ,$min;
4218         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
4219                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
4220
4221         my ($tz_sign, $tz_hour, $tz_min) =
4222                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
4223         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
4224         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
4225         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
4226         $date{'hour_local'} = $hour;
4227         $date{'minute_local'} = $min;
4228         $date{'mday_local'} = $mday;
4229         $date{'tz_local'} = $tz;
4230         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
4231                                   1900+$year, $mon+1, $mday,
4232                                   $hour, $min, $sec, $tz);
4233         return %date;
4234 }
4235
4236 sub parse_file_date {
4237         my $file = shift;
4238         my $mtime = (stat("$projectroot/$project/$file"))[9];
4239         return () unless defined $mtime;
4240         my ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
4241         my $tzoffset = timegm($sec,$min,$hour,$mday,$mon,$year+1900) - $mtime;
4242         my $tzstring = '+';
4243         if ($tzoffset <= 0) {
4244                 $tzstring = '-';
4245                 $tzoffset *= -1;
4246         }
4247         $tzoffset = int($tzoffset/60);
4248         $tzstring .= sprintf("%02d%02d", int($tzoffset/60), $tzoffset%60);
4249         return parse_date($mtime, $tzstring);
4250 }
4251
4252 sub parse_tag {
4253         my $tag_id = shift;
4254         my %tag;
4255         my @comment;
4256
4257         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
4258         $tag{'id'} = $tag_id;
4259         while (my $line = to_utf8(scalar <$fd>)) {
4260                 chomp $line;
4261                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
4262                         $tag{'object'} = $1;
4263                 } elsif ($line =~ m/^type (.+)$/) {
4264                         $tag{'type'} = $1;
4265                 } elsif ($line =~ m/^tag (.+)$/) {
4266                         $tag{'name'} = $1;
4267                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
4268                         $tag{'author'} = $1;
4269                         $tag{'author_epoch'} = $2;
4270                         $tag{'author_tz'} = $3;
4271                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4272                                 $tag{'author_name'}  = $1;
4273                                 $tag{'author_email'} = $2;
4274                         } else {
4275                                 $tag{'author_name'} = $tag{'author'};
4276                         }
4277                 } elsif ($line =~ m/--BEGIN/) {
4278                         push @comment, $line;
4279                         last;
4280                 } elsif ($line eq "") {
4281                         last;
4282                 }
4283         }
4284         push @comment, map(to_utf8($_), <$fd>);
4285         $tag{'comment'} = \@comment;
4286         close $fd or return;
4287         if (!defined $tag{'name'}) {
4288                 return
4289         };
4290         return %tag
4291 }
4292
4293 sub parse_commit_text {
4294         my ($commit_text, $withparents) = @_;
4295         my @commit_lines = split '\n', $commit_text;
4296         my %co;
4297
4298         pop @commit_lines; # Remove '\0'
4299
4300         if (! @commit_lines) {
4301                 return;
4302         }
4303
4304         my $header = shift @commit_lines;
4305         if ($header !~ m/^[0-9a-fA-F]{40}/) {
4306                 return;
4307         }
4308         ($co{'id'}, my @parents) = split ' ', $header;
4309         while (my $line = shift @commit_lines) {
4310                 last if $line eq "\n";
4311                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
4312                         $co{'tree'} = $1;
4313                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
4314                         push @parents, $1;
4315                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
4316                         $co{'author'} = to_utf8($1);
4317                         $co{'author_epoch'} = $2;
4318                         $co{'author_tz'} = $3;
4319                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4320                                 $co{'author_name'}  = $1;
4321                                 $co{'author_email'} = $2;
4322                         } else {
4323                                 $co{'author_name'} = $co{'author'};
4324                         }
4325                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
4326                         $co{'committer'} = to_utf8($1);
4327                         $co{'committer_epoch'} = $2;
4328                         $co{'committer_tz'} = $3;
4329                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
4330                                 $co{'committer_name'}  = $1;
4331                                 $co{'committer_email'} = $2;
4332                         } else {
4333                                 $co{'committer_name'} = $co{'committer'};
4334                         }
4335                 }
4336         }
4337         if (!defined $co{'tree'}) {
4338                 return;
4339         };
4340         $co{'parents'} = \@parents;
4341         $co{'parent'} = $parents[0];
4342
4343         @commit_lines = map to_utf8($_), @commit_lines;
4344         foreach my $title (@commit_lines) {
4345                 $title =~ s/^    //;
4346                 if ($title ne "") {
4347                         $co{'title'} = chop_str($title, 80, 5);
4348                         # remove leading stuff of merges to make the interesting part visible
4349                         if (length($title) > 50) {
4350                                 $title =~ s/^Automatic //;
4351                                 $title =~ s/^merge (of|with) /Merge ... /i;
4352                                 if (length($title) > 50) {
4353                                         $title =~ s/(http|rsync):\/\///;
4354                                 }
4355                                 if (length($title) > 50) {
4356                                         $title =~ s/(master|www|rsync)\.//;
4357                                 }
4358                                 if (length($title) > 50) {
4359                                         $title =~ s/kernel.org:?//;
4360                                 }
4361                                 if (length($title) > 50) {
4362                                         $title =~ s/\/pub\/scm//;
4363                                 }
4364                         }
4365                         $co{'title_short'} = chop_str($title, 50, 5);
4366                         last;
4367                 }
4368         }
4369         if (! defined $co{'title'} || $co{'title'} eq "") {
4370                 $co{'title'} = $co{'title_short'} = '(no commit message)';
4371         }
4372         # remove added spaces
4373         foreach my $line (@commit_lines) {
4374                 $line =~ s/^    //;
4375         }
4376         $co{'comment'} = \@commit_lines;
4377
4378         my $age_epoch = $co{'committer_epoch'};
4379         $co{'age_epoch'} = $age_epoch;
4380         my $time_now = time;
4381         $co{'age_string'} = age_string($age_epoch, $time_now);
4382         $co{'age_string_date'} = age_string_date($age_epoch, $time_now);
4383         $co{'age_string_age'} = age_string_age($age_epoch, $time_now);
4384         return %co;
4385 }
4386
4387 sub parse_commit {
4388         my ($commit_id) = @_;
4389         my %co;
4390
4391         local $/ = "\0";
4392
4393         defined(my $fd = git_cmd_pipe "rev-list",
4394                 "--parents",
4395                 "--header",
4396                 "--max-count=1",
4397                 $commit_id,
4398                 "--")
4399                 or die_error(500, "Open git-rev-list failed");
4400         %co = parse_commit_text(<$fd>, 1);
4401         close $fd;
4402
4403         return %co;
4404 }
4405
4406 sub parse_commits {
4407         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
4408         my @cos;
4409
4410         $maxcount ||= 1;
4411         $skip ||= 0;
4412
4413         local $/ = "\0";
4414
4415         defined(my $fd = git_cmd_pipe "rev-list",
4416                 "--header",
4417                 @args,
4418                 ("--max-count=" . $maxcount),
4419                 ("--skip=" . $skip),
4420                 @extra_options,
4421                 $commit_id,
4422                 "--",
4423                 ($filename ? ($filename) : ()))
4424                 or die_error(500, "Open git-rev-list failed");
4425         while (my $line = <$fd>) {
4426                 my %co = parse_commit_text($line);
4427                 push @cos, \%co;
4428         }
4429         close $fd;
4430
4431         return wantarray ? @cos : \@cos;
4432 }
4433
4434 # parse line of git-diff-tree "raw" output
4435 sub parse_difftree_raw_line {
4436         my $line = shift;
4437         my %res;
4438
4439         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
4440         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
4441         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
4442                 $res{'from_mode'} = $1;
4443                 $res{'to_mode'} = $2;
4444                 $res{'from_id'} = $3;
4445                 $res{'to_id'} = $4;
4446                 $res{'status'} = $5;
4447                 $res{'similarity'} = $6;
4448                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
4449                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
4450                 } else {
4451                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
4452                 }
4453         }
4454         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
4455         # combined diff (for merge commit)
4456         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
4457                 $res{'nparents'}  = length($1);
4458                 $res{'from_mode'} = [ split(' ', $2) ];
4459                 $res{'to_mode'} = pop @{$res{'from_mode'}};
4460                 $res{'from_id'} = [ split(' ', $3) ];
4461                 $res{'to_id'} = pop @{$res{'from_id'}};
4462                 $res{'status'} = [ split('', $4) ];
4463                 $res{'to_file'} = unquote($5);
4464         }
4465         # 'c512b523472485aef4fff9e57b229d9d243c967f'
4466         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
4467                 $res{'commit'} = $1;
4468         }
4469
4470         return wantarray ? %res : \%res;
4471 }
4472
4473 # wrapper: return parsed line of git-diff-tree "raw" output
4474 # (the argument might be raw line, or parsed info)
4475 sub parsed_difftree_line {
4476         my $line_or_ref = shift;
4477
4478         if (ref($line_or_ref) eq "HASH") {
4479                 # pre-parsed (or generated by hand)
4480                 return $line_or_ref;
4481         } else {
4482                 return parse_difftree_raw_line($line_or_ref);
4483         }
4484 }
4485
4486 # parse line of git-ls-tree output
4487 sub parse_ls_tree_line {
4488         my $line = shift;
4489         my %opts = @_;
4490         my %res;
4491
4492         if ($opts{'-l'}) {
4493                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
4494                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
4495
4496                 $res{'mode'} = $1;
4497                 $res{'type'} = $2;
4498                 $res{'hash'} = $3;
4499                 $res{'size'} = $4;
4500                 if ($opts{'-z'}) {
4501                         $res{'name'} = $5;
4502                 } else {
4503                         $res{'name'} = unquote($5);
4504                 }
4505         } else {
4506                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
4507                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
4508
4509                 $res{'mode'} = $1;
4510                 $res{'type'} = $2;
4511                 $res{'hash'} = $3;
4512                 if ($opts{'-z'}) {
4513                         $res{'name'} = $4;
4514                 } else {
4515                         $res{'name'} = unquote($4);
4516                 }
4517         }
4518
4519         return wantarray ? %res : \%res;
4520 }
4521
4522 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4523 sub parse_from_to_diffinfo {
4524         my ($diffinfo, $from, $to, @parents) = @_;
4525
4526         if ($diffinfo->{'nparents'}) {
4527                 # combined diff
4528                 $from->{'file'} = [];
4529                 $from->{'href'} = [];
4530                 fill_from_file_info($diffinfo, @parents)
4531                         unless exists $diffinfo->{'from_file'};
4532                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4533                         $from->{'file'}[$i] =
4534                                 defined $diffinfo->{'from_file'}[$i] ?
4535                                         $diffinfo->{'from_file'}[$i] :
4536                                         $diffinfo->{'to_file'};
4537                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4538                                 $from->{'href'}[$i] = href(action=>"blob",
4539                                                            hash_base=>$parents[$i],
4540                                                            hash=>$diffinfo->{'from_id'}[$i],
4541                                                            file_name=>$from->{'file'}[$i]);
4542                         } else {
4543                                 $from->{'href'}[$i] = undef;
4544                         }
4545                 }
4546         } else {
4547                 # ordinary (not combined) diff
4548                 $from->{'file'} = $diffinfo->{'from_file'};
4549                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4550                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4551                                                hash=>$diffinfo->{'from_id'},
4552                                                file_name=>$from->{'file'});
4553                 } else {
4554                         delete $from->{'href'};
4555                 }
4556         }
4557
4558         $to->{'file'} = $diffinfo->{'to_file'};
4559         if (!is_deleted($diffinfo)) { # file exists in result
4560                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4561                                      hash=>$diffinfo->{'to_id'},
4562                                      file_name=>$to->{'file'});
4563         } else {
4564                 delete $to->{'href'};
4565         }
4566 }
4567
4568 ## ......................................................................
4569 ## parse to array of hashes functions
4570
4571 sub git_get_heads_list {
4572         my ($limit, @classes) = @_;
4573         @classes = get_branch_refs() unless @classes;
4574         my @patterns = map { "refs/$_" } @classes;
4575         my @headslist;
4576
4577         defined(my $fd = git_cmd_pipe 'for-each-ref',
4578                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4579                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4580                 @patterns)
4581                 or return;
4582         while (my $line = to_utf8(scalar <$fd>)) {
4583                 my %ref_item;
4584
4585                 chomp $line;
4586                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4587                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4588                 my ($committer, $epoch, $tz) =
4589                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4590                 $ref_item{'fullname'}  = $name;
4591                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4592                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4593                 $ref_item{'name'} = $name;
4594                 # for refs neither in 'heads' nor 'remotes' we want to
4595                 # show their ref dir
4596                 my $ref_dir = (defined $1) ? $1 : '';
4597                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4598                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4599                 }
4600
4601                 $ref_item{'id'}    = $hash;
4602                 $ref_item{'title'} = $title || '(no commit message)';
4603                 $ref_item{'epoch'} = $epoch;
4604                 if ($epoch) {
4605                         $ref_item{'age'} = age_string($ref_item{'epoch'});
4606                 } else {
4607                         $ref_item{'age'} = "unknown";
4608                 }
4609
4610                 push @headslist, \%ref_item;
4611         }
4612         close $fd;
4613
4614         return wantarray ? @headslist : \@headslist;
4615 }
4616
4617 sub git_get_tags_list {
4618         my $limit = shift;
4619         my @tagslist;
4620         my $all = shift || 0;
4621         my $order = shift || $default_refs_order;
4622         my $sortkey = $all && $order eq 'name' ? 'refname' : '-creatordate';
4623
4624         defined(my $fd = git_cmd_pipe 'for-each-ref',
4625                 ($limit ? '--count='.($limit+1) : ()), "--sort=$sortkey",
4626                 '--format=%(objectname) %(objecttype) %(refname) '.
4627                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4628                 ($all ? 'refs' : 'refs/tags'))
4629                 or return;
4630         while (my $line = to_utf8(scalar <$fd>)) {
4631                 my %ref_item;
4632
4633                 chomp $line;
4634                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4635                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4636                 my ($creator, $epoch, $tz) =
4637                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4638                 $ref_item{'fullname'} = $name;
4639                 $name =~ s!^refs/!! if $all;
4640                 $name =~ s!^refs/tags/!! unless $all;
4641
4642                 $ref_item{'type'} = $type;
4643                 $ref_item{'id'} = $id;
4644                 $ref_item{'name'} = $name;
4645                 if ($type eq "tag") {
4646                         $ref_item{'subject'} = $title;
4647                         $ref_item{'reftype'} = $reftype;
4648                         $ref_item{'refid'}   = $refid;
4649                 } else {
4650                         $ref_item{'reftype'} = $type;
4651                         $ref_item{'refid'}   = $id;
4652                 }
4653
4654                 if ($type eq "tag" || $type eq "commit") {
4655                         $ref_item{'epoch'} = $epoch;
4656                         if ($epoch) {
4657                                 $ref_item{'age'} = age_string($ref_item{'epoch'});
4658                         } else {
4659                                 $ref_item{'age'} = "unknown";
4660                         }
4661                 }
4662
4663                 push @tagslist, \%ref_item;
4664         }
4665         close $fd;
4666
4667         return wantarray ? @tagslist : \@tagslist;
4668 }
4669
4670 ## ----------------------------------------------------------------------
4671 ## filesystem-related functions
4672
4673 sub get_file_owner {
4674         my $path = shift;
4675
4676         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4677         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4678         if (!defined $gcos) {
4679                 return undef;
4680         }
4681         my $owner = $gcos;
4682         $owner =~ s/[,;].*$//;
4683         return to_utf8($owner);
4684 }
4685
4686 # assume that file exists
4687 sub insert_file {
4688         my $filename = shift;
4689
4690         open my $fd, '<', $filename;
4691         while (<$fd>) {
4692                 print to_utf8($_);
4693         }
4694         close $fd;
4695 }
4696
4697 # return undef on failure
4698 sub collect_output {
4699         defined(my $fd = cmd_pipe @_) or return undef;
4700         if (eof $fd) {
4701                 close $fd;
4702                 return undef;
4703         }
4704         my $result = join('', map({ to_utf8($_) } <$fd>));
4705         close $fd or return undef;
4706         return $result;
4707 }
4708
4709 # return undef on failure
4710 # return '' if only comments
4711 sub collect_html_file {
4712         my $filename = shift;
4713
4714         open my $fd, '<', $filename or return undef;
4715         my $result = join('', map({ to_utf8($_) } <$fd>));
4716         close $fd or return undef;
4717         return undef unless defined($result);
4718         my $test = $result;
4719         $test =~ s/<!--(?:[^-]|(?:-(?!-)))*-->//gs;
4720         $test =~ s/\s+//s;
4721         return $test eq '' ? '' : $result;
4722 }
4723
4724 ## ......................................................................
4725 ## mimetype related functions
4726
4727 sub mimetype_guess_file {
4728         my $filename = shift;
4729         my $mimemap = shift;
4730         my $rawmode = shift;
4731         -r $mimemap or return undef;
4732
4733         my %mimemap;
4734         open(my $mh, '<', $mimemap) or return undef;
4735         while (<$mh>) {
4736                 next if m/^#/; # skip comments
4737                 my ($mimetype, @exts) = split(/\s+/);
4738                 foreach my $ext (@exts) {
4739                         $mimemap{$ext} = $mimetype;
4740                 }
4741         }
4742         close($mh);
4743
4744         my ($ext, $ans);
4745         $ext = $1 if $filename =~ /\.([^.]*)$/;
4746         $ans = $mimemap{$ext} if $ext;
4747         if (defined $ans) {
4748                 my $l = lc($ans);
4749                 $ans = 'text/html' if $l eq 'application/xhtml+xml';
4750                 if (!$rawmode) {
4751                         $ans = 'text/xml' if $l =~ m!^application/[^\s:;,=]+\+xml$! ||
4752                                              $l eq 'image/svg+xml' ||
4753                                              $l eq 'application/xml-dtd' ||
4754                                              $l eq 'application/xml-external-parsed-entity';
4755                 }
4756         }
4757         return $ans;
4758 }
4759
4760 sub mimetype_guess {
4761         my $filename = shift;
4762         my $rawmode = shift;
4763         my $mime;
4764         $filename =~ /\./ or return undef;
4765
4766         if ($mimetypes_file) {
4767                 my $file = $mimetypes_file;
4768                 if ($file !~ m!^/!) { # if it is relative path
4769                         # it is relative to project
4770                         $file = "$projectroot/$project/$file";
4771                 }
4772                 $mime = mimetype_guess_file($filename, $file, $rawmode);
4773         }
4774         $mime ||= mimetype_guess_file($filename, '/etc/mime.types', $rawmode);
4775         return $mime;
4776 }
4777
4778 sub blob_mimetype {
4779         my $fd = shift;
4780         my $filename = shift;
4781         my $rawmode = shift;
4782         my $mime;
4783
4784         # The -T/-B file operators produce the wrong result unless a perlio
4785         # layer is present when the file handle is a pipe that delivers less
4786         # than 512 bytes of data before reaching EOF.
4787         #
4788         # If we are running in a Perl that uses the stdio layer rather than the
4789         # unix+perlio layers we will end up adding a perlio layer on top of the
4790         # stdio layer and get a second level of buffering.  This is harmless
4791         # and it makes the -T/-B file operators work properly in all cases.
4792
4793         binmode $fd, ":perlio" or die_error(500, "Adding perlio layer failed")
4794                 unless grep /^perlio$/, PerlIO::get_layers($fd);
4795
4796         $mime = mimetype_guess($filename, $rawmode) if defined $filename;
4797
4798         if (!$mime && $filename) {
4799                 if ($filename =~ m/\.html?$/i) {
4800                         $mime = 'text/html';
4801                 } elsif ($filename =~ m/\.xht(?:ml)?$/i) {
4802                         $mime = 'text/html';
4803                 } elsif ($filename =~ m/\.te?xt?$/i) {
4804                         $mime = 'text/plain';
4805                 } elsif ($filename =~ m/\.(?:markdown|md)$/i) {
4806                         $mime = 'text/plain';
4807                 } elsif ($filename =~ m/\.png$/i) {
4808                         $mime = 'image/png';
4809                 } elsif ($filename =~ m/\.gif$/i) {
4810                         $mime = 'image/gif';
4811                 } elsif ($filename =~ m/\.jpe?g$/i) {
4812                         $mime = 'image/jpeg';
4813                 } elsif ($filename =~ m/\.svgz?$/i) {
4814                         $mime = 'image/svg+xml';
4815                 }
4816         }
4817
4818         # just in case
4819         return $default_blob_plain_mimetype || 'application/octet-stream' unless $fd || $mime;
4820
4821         $mime = -T $fd ? 'text/plain' : 'application/octet-stream' unless $mime;
4822
4823         return $mime;
4824 }
4825
4826 sub is_ascii {
4827         use bytes;
4828         my $data = shift;
4829         return scalar($data =~ /^[\x00-\x7f]*$/);
4830 }
4831
4832 sub is_valid_utf8 {
4833         my $data = shift;
4834         return utf8::decode($data);
4835 }
4836
4837 sub extract_html_charset {
4838         return undef unless $_[0] && "$_[0]</head>" =~ m#<head(?:\s+[^>]*)?(?<!/)>(.*?)</head\s*>#is;
4839         my $head = $1;
4840         return $2 if $head =~ m#<meta\s+charset\s*=\s*(['"])\s*([a-z0-9(:)_.+-]+)\s*\1\s*/?>#is;
4841         while ($head =~ m#<meta\s+(http-equiv|content)\s*=\s*(['"])\s*([^\2]+?)\s*\2\s*(http-equiv|content)\s*=\s*(['"])\s*([^\5]+?)\s*\5\s*/?>#sig) {
4842                 my %kv = (lc($1) => $3, lc($4) => $6);
4843                 my ($he, $c) = (lc($kv{'http-equiv'}), $kv{'content'});
4844                 return $1 if $he && $c && $he eq 'content-type' &&
4845                         $c =~ m!\s*text/html\s*;\s*charset\s*=\s*([a-z0-9(:)_.+-]+)\s*$!is;
4846         }
4847         return undef;
4848 }
4849
4850 sub blob_contenttype {
4851         my ($fd, $file_name, $type) = @_;
4852
4853         $type ||= blob_mimetype($fd, $file_name, 1);
4854         return $type unless $type =~ m!^text/.+!i;
4855         my ($leader, $charset, $htmlcharset);
4856         if ($fd && read($fd, $leader, 32768)) {{
4857                 $charset='US-ASCII' if is_ascii($leader);
4858                 return ("$type; charset=UTF-8", $leader) if !$charset && is_valid_utf8($leader);
4859                 $charset='ISO-8859-1' unless $charset;
4860                 $htmlcharset = extract_html_charset($leader) if $type eq 'text/html';
4861                 if ($htmlcharset && $charset ne 'US-ASCII') {
4862                         $htmlcharset = undef if $htmlcharset =~ /^(?:utf-8|us-ascii)$/i
4863                 }
4864         }}
4865         return ("$type; charset=$htmlcharset", $leader) if $htmlcharset;
4866         my $defcharset = $default_text_plain_charset || '';
4867         $defcharset =~ s/^\s+//;
4868         $defcharset =~ s/\s+$//;
4869         $defcharset = '' if $charset && $charset ne 'US-ASCII' && $defcharset =~ /^(?:utf-8|us-ascii)$/i;
4870         return ("$type; charset=" . ($defcharset || 'ISO-8859-1'), $leader);
4871 }
4872
4873 # peek the first upto 128 bytes off a file handle
4874 sub peek128bytes {
4875         my $fd = shift;
4876
4877         use IO::Handle;
4878         use bytes;
4879
4880         my $prefix128;
4881         return '' unless $fd && read($fd, $prefix128, 128);
4882
4883         # In the general case, we're guaranteed only to be able to ungetc one
4884         # character (provided, of course, we actually got a character first).
4885         #
4886         # However, we know:
4887         #
4888         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4889         #    already been called at least once on the file handle before us
4890         #
4891         # 2) we have an $fd positioned at the start of the input stream and
4892         #    therefore know we were positioned at a buffer boundary before
4893         #    reading the initial upto 128 bytes
4894         #
4895         # 3) the buffer size is at least 512 bytes
4896         #
4897         # 4) we are careful to only unget raw bytes
4898         #
4899         # 5) we are attempting to unget exactly the same number of bytes we got
4900         #
4901         # Given the above conditions we will ALWAYS be able to safely unget
4902         # the $prefix128 value we just got.
4903         #
4904         # In fact, we could read up to 511 bytes and still be sure.
4905         # (Reading 512 might pop us into the next internal buffer, but probably
4906         # not since that could break the always able to unget at least the one
4907         # you just got guarantee.)
4908
4909         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4910
4911         return $prefix128;
4912 }
4913
4914 # guess file syntax for syntax highlighting; return undef if no highlighting
4915 # the name of syntax can (in the future) depend on syntax highlighter used
4916 sub guess_file_syntax {
4917         my ($fd, $mimetype, $file_name) = @_;
4918         return undef unless $fd && defined $file_name &&
4919                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4920         my $basename = basename($file_name, '.in');
4921         return $highlight_basename{$basename}
4922                 if exists $highlight_basename{$basename};
4923
4924         # Peek to see if there's a shebang or xml line.
4925         # We always operate on bytes when testing this.
4926         {
4927                 use bytes;
4928                 my $shebang = peek128bytes($fd);
4929                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4930                         foreach my $key (keys %highlight_shebang) {
4931                                 my $ar = ref($highlight_shebang{$key}) ?
4932                                         $highlight_shebang{$key} :
4933                                         [$highlight_shebang{key}];
4934                                 map {return $key if $shebang =~ /$_/} @$ar;
4935                         }
4936                 }
4937                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4938         }
4939
4940         $basename =~ /\.([^.]*)$/;
4941         my $ext = $1 or return undef;
4942         return $highlight_ext{$ext}
4943                 if exists $highlight_ext{$ext};
4944
4945         return undef;
4946 }
4947
4948 # run highlighter and return FD of its output,
4949 # or return original FD if no highlighting
4950 sub run_highlighter {
4951         my ($fd, $syntax) = @_;
4952         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4953
4954         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4955                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4956                 $to_utf8_pipe_command.
4957                 quote_command($highlight_bin).
4958                 " --replace-tabs=8 --fragment --syntax $syntax")
4959                 or die_error(500, "Couldn't open file or run syntax highlighter");
4960         if (eof $hifd) {
4961                 # just in case, should not happen as we tested !eof($fd) above
4962                 return $fd if close($hifd);
4963
4964                 # should not happen
4965                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4966
4967                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4968                 # instead of dying horribly on this, just skip the highlighting
4969                 # but do output a message about it to STDERR that will end up in the log
4970                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4971                         sprintf("child exit status 0x%x\n", $?);
4972                 return $fd
4973         }
4974         close $fd;
4975         return ($hifd, 1);
4976 }
4977
4978 ## ======================================================================
4979 ## functions printing HTML: header, footer, error page
4980
4981 sub get_page_title {
4982         my $title = to_utf8($site_name);
4983
4984         unless (defined $project) {
4985                 if (defined $project_filter) {
4986                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4987                 }
4988                 return $title;
4989         }
4990         $title .= " - " . to_utf8($project);
4991
4992         return $title unless (defined $action);
4993         my $action_print = $action eq 'blame_incremental' ? 'blame' : $action;
4994         $title .= "/$action_print"; # $action is US-ASCII (7bit ASCII)
4995
4996         return $title unless (defined $file_name);
4997         $title .= " - " . esc_path($file_name);
4998         if ($action eq "tree" && $file_name !~ m|/$|) {
4999                 $title .= "/";
5000         }
5001
5002         return $title;
5003 }
5004
5005 sub get_content_type_html {
5006         # We do not ever emit application/xhtml+xml since that gives us
5007         # no benefits and it makes many browsers (e.g. Firefox) exceedingly
5008         # strict, which is troublesome for example when showing user-supplied
5009         # README.html files.
5010         return 'text/html';
5011 }
5012
5013 sub print_feed_meta {
5014         if (defined $project) {
5015                 my %href_params = get_feed_info();
5016                 if (!exists $href_params{'-title'}) {
5017                         $href_params{'-title'} = 'log';
5018                 }
5019
5020                 foreach my $format (qw(RSS Atom)) {
5021                         my $type = lc($format);
5022                         my %link_attr = (
5023                                 '-rel' => 'alternate',
5024                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
5025                                 '-type' => "application/$type+xml"
5026                         );
5027
5028                         $href_params{'extra_options'} = undef;
5029                         $href_params{'action'} = $type;
5030                         $link_attr{'-href'} = href(%href_params);
5031                         print "<link ".
5032                               "rel=\"$link_attr{'-rel'}\" ".
5033                               "title=\"$link_attr{'-title'}\" ".
5034                               "href=\"$link_attr{'-href'}\" ".
5035                               "type=\"$link_attr{'-type'}\" ".
5036                               "/>\n";
5037
5038                         $href_params{'extra_options'} = '--no-merges';
5039                         $link_attr{'-href'} = href(%href_params);
5040                         $link_attr{'-title'} .= ' (no merges)';
5041                         print "<link ".
5042                               "rel=\"$link_attr{'-rel'}\" ".
5043                               "title=\"$link_attr{'-title'}\" ".
5044                               "href=\"$link_attr{'-href'}\" ".
5045                               "type=\"$link_attr{'-type'}\" ".
5046                               "/>\n";
5047                 }
5048
5049         } else {
5050                 printf('<link rel="alternate" title="%s projects list" '.
5051                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
5052                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
5053                 printf('<link rel="alternate" title="%s projects feeds" '.
5054                        'href="%s" type="text/x-opml" />'."\n",
5055                        esc_attr($site_name), href(project=>undef, action=>"opml"));
5056         }
5057 }
5058
5059 sub compute_stylesheet_links {
5060         return "<?gitweb compute_stylesheet_links?>" if $cache_mode_active;
5061
5062         # include each stylesheet that exists, providing backwards capability
5063         # for those people who defined $stylesheet in a config file
5064         if (defined $stylesheet) {
5065                 return '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
5066         } else {
5067                 my $sheets = '';
5068                 foreach my $stylesheet (@stylesheets) {
5069                         next unless $stylesheet;
5070                         $sheets .= '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
5071                 }
5072                 return $sheets;
5073         }
5074 }
5075
5076 sub print_header_links {
5077         my $status = shift;
5078
5079         print compute_stylesheet_links();
5080         print_feed_meta()
5081                 if ($status eq '200 OK');
5082         if (defined $favicon) {
5083                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
5084         }
5085 }
5086
5087 sub print_nav_breadcrumbs_path {
5088         my $dirprefix = undef;
5089         while (my $part = shift) {
5090                 $dirprefix .= "/" if defined $dirprefix;
5091                 $dirprefix .= $part;
5092                 print $cgi->a({-href => href(project => undef,
5093                                              project_filter => $dirprefix,
5094                                              action => "project_list")},
5095                               esc_html($part)) . $slssep;
5096         }
5097 }
5098
5099 sub print_nav_breadcrumbs {
5100         my %opts = @_;
5101
5102         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
5103                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . $slssep;
5104         }
5105         if (defined $project) {
5106                 my @dirname = split '/', $project;
5107                 my $projectbasename = pop @dirname;
5108                 print_nav_breadcrumbs_path(@dirname);
5109                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
5110                 if (defined $action) {
5111                         my $action_print = $action ;
5112                         $action_print = 'blame' if $action_print eq 'blame_incremental';
5113                         if (defined $opts{-action_extra}) {
5114                                 $action_print = $cgi->a({-href => href(action=>$action)},
5115                                         $action);
5116                         }
5117                         print "$slssep$action_print";
5118                 }
5119                 if (defined $opts{-action_extra}) {
5120                         print "$slssep$opts{-action_extra}";
5121                 }
5122                 print "\n";
5123         } elsif (defined $project_filter) {
5124                 print_nav_breadcrumbs_path(split '/', $project_filter);
5125         }
5126 }
5127
5128 sub print_search_form {
5129         if (!defined $searchtext) {
5130                 $searchtext = "";
5131         }
5132         my $search_hash;
5133         if (defined $hash_base) {
5134                 $search_hash = $hash_base;
5135         } elsif (defined $hash) {
5136                 $search_hash = $hash;
5137         } else {
5138                 $search_hash = "HEAD";
5139         }
5140         # We can't use href() here because we need to encode the
5141         # URL parameters into the form, not into the action link.
5142         my $action = $my_uri;
5143         my $use_pathinfo = gitweb_check_feature('pathinfo');
5144         if ($use_pathinfo) {
5145                 # See notes about doubled / in href()
5146                 $action =~ s,/$,,;
5147                 $action .= "/".esc_path_info($project);
5148         }
5149         $cgi->start_form(-method => "get", -action => $action);
5150         print sprintf(qq/<form method="%s" action="%s" enctype="%s">\n/,
5151               "get", CGI::escapeHTML($action), &CGI::URL_ENCODED) .
5152               "<div class=\"search\">\n" .
5153               (!$use_pathinfo &&
5154               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
5155               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
5156               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
5157               $cgi->popup_menu(-name => 'st', -default => 'commit',
5158                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
5159               $cgi->sup($cgi->a({-href => href(action=>"search_help"),
5160                                  -title => "search help" },
5161                                 "<span style=\"padding-bottom:1em\">?&#160;</span>")) . " search:\n",
5162               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
5163               "<span title=\"Extended regular expression\">" .
5164               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5165                              -checked => $search_use_regexp) .
5166               "</span>" .
5167               "</div>" .
5168               $cgi->end_form() . "\n";
5169 }
5170
5171 sub git_header_html {
5172         my $status = shift || "200 OK";
5173         my $expires = shift;
5174         my %opts = @_;
5175
5176         my $title = get_page_title();
5177         my $content_type = get_content_type_html();
5178         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
5179                            -status=> $status, -expires => $expires)
5180                 unless ($opts{'-no_http_header'});
5181         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
5182         print <<EOF;
5183 <?xml version="1.0" encoding="utf-8"?>
5184 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
5185 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
5186 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
5187 <!-- git core binaries version $git_version -->
5188 <head>
5189 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
5190 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
5191 <meta name="robots" content="index, nofollow"/>
5192 <title>$title</title>
5193 <script type="text/javascript">/* <![CDATA[ */
5194 function fixBlameLinks() {
5195         var allLinks = document.getElementsByTagName("a");
5196         for (var i = 0; i < allLinks.length; i++) {
5197                 var link = allLinks.item(i);
5198                 if (link.className == 'blamelink')
5199                         link.href = link.href.replace("/blame/", "/blame_incremental/");
5200         }
5201 }
5202 /* ]]> */</script>
5203 EOF
5204         # the stylesheet, favicon etc urls won't work correctly with path_info
5205         # unless we set the appropriate base URL
5206         if ($ENV{'PATH_INFO'}) {
5207                 print "<base href=\"".esc_url($base_url)."\" />\n";
5208         }
5209         print_header_links($status);
5210
5211         if (defined $site_html_head_string) {
5212                 print to_utf8($site_html_head_string);
5213         }
5214
5215         print "</head>\n" .
5216               "<body><span class=\"body\">\n";
5217
5218         if (defined $site_header && -f $site_header) {
5219                 insert_file($site_header);
5220         }
5221
5222         print "<div class=\"page_header\">\n";
5223         print "<span class=\"logo-container\"><span class=\"logo-default\">";
5224         if (defined $logo) {
5225                 print $cgi->a({-href => esc_url($logo_url),
5226                                -title => $logo_label,
5227                                -class => "logo-link"},
5228                               $cgi->img({-src => esc_url($logo),
5229                                          -width => 72, -height => 27,
5230                                          -alt => "git",
5231                                          -class => "logo"}));
5232         }
5233         print "</span></span>$spctxt<span class=\"banner-container\">";
5234         print_nav_breadcrumbs(%opts);
5235         print "</span></div>\n";
5236
5237         my $have_search = gitweb_check_feature('search');
5238         if (defined $project && $have_search) {
5239                 print_search_form();
5240         }
5241 }
5242
5243 sub compute_timed_interval {
5244         return "<?gitweb compute_timed_interval?>" if $cache_mode_active;
5245         return tv_interval($t0, [ gettimeofday() ]);
5246 }
5247
5248 sub compute_commands_count {
5249         return "<?gitweb compute_commands_count?>" if $cache_mode_active;
5250         my $s = $number_of_git_cmds == 1 ? '' : 's';
5251         return '<span id="generating_cmd">'.
5252                 $number_of_git_cmds.
5253                 "</span> git command$s";
5254 }
5255
5256 sub git_footer_html {
5257         my $feed_class = 'rss_logo';
5258
5259         print "<div class=\"page_footer\">\n";
5260         if (defined $project) {
5261                 my $descr = git_get_project_description($project);
5262                 if (defined $descr) {
5263                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
5264                 }
5265
5266                 my %href_params = get_feed_info();
5267                 if (!%href_params) {
5268                         $feed_class .= ' generic';
5269                 }
5270                 $href_params{'-title'} ||= 'log';
5271
5272                 foreach my $format (qw(RSS Atom)) {
5273                         $href_params{'action'} = lc($format);
5274                         print $cgi->a({-href => href(%href_params),
5275                                       -title => "$href_params{'-title'} $format feed",
5276                                       -class => $feed_class}, $format)."\n";
5277                 }
5278
5279         } else {
5280                 print $cgi->a({-href => href(project=>undef, action=>"opml",
5281                                              project_filter => $project_filter),
5282                               -class => $feed_class}, "OPML") . " ";
5283                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
5284                                              project_filter => $project_filter),
5285                               -class => $feed_class}, "TXT") . "\n";
5286         }
5287         print "</div>\n"; # class="page_footer"
5288
5289         if (defined $t0 && gitweb_check_feature('timed')) {
5290                 print "<div id=\"generating_info\">\n";
5291                 print 'This page took '.
5292                       '<span id="generating_time" class="time_span">'.
5293                       compute_timed_interval().
5294                       ' seconds </span>'.
5295                       ' and '.
5296                       compute_commands_count().
5297                       " to generate.\n";
5298                 print "</div>\n"; # class="page_footer"
5299         }
5300
5301         if (defined $site_footer && -f $site_footer) {
5302                 insert_file($site_footer);
5303         }
5304
5305         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
5306         if (defined $action &&
5307             $action eq 'blame_incremental') {
5308                 print qq!<script type="text/javascript">\n!.
5309                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
5310                       qq!           "!. href() .qq!");\n!.
5311                       qq!</script>\n!;
5312         } else {
5313                 my ($jstimezone, $tz_cookie, $datetime_class) =
5314                         gitweb_get_feature('javascript-timezone');
5315
5316                 print qq!<script type="text/javascript">\n!.
5317                       qq!window.onload = function () {\n!;
5318                 if (gitweb_check_feature('blame_incremental')) {
5319                         print qq!       fixBlameLinks();\n!;
5320                 }
5321                 if (gitweb_check_feature('javascript-actions')) {
5322                         print qq!       fixLinks();\n!;
5323                 }
5324                 if ($jstimezone && $tz_cookie && $datetime_class) {
5325                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
5326                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
5327                 }
5328                 print qq!};\n!.
5329                       qq!</script>\n!;
5330         }
5331
5332         print "</span></body>\n" .
5333               "</html>";
5334 }
5335
5336 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
5337 # Example: die_error(404, 'Hash not found')
5338 # By convention, use the following status codes (as defined in RFC 2616):
5339 # 400: Invalid or missing CGI parameters, or
5340 #      requested object exists but has wrong type.
5341 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
5342 #      this server or project.
5343 # 404: Requested object/revision/project doesn't exist.
5344 # 500: The server isn't configured properly, or
5345 #      an internal error occurred (e.g. failed assertions caused by bugs), or
5346 #      an unknown error occurred (e.g. the git binary died unexpectedly).
5347 # 503: The server is currently unavailable (because it is overloaded,
5348 #      or down for maintenance).  Generally, this is a temporary state.
5349 sub die_error {
5350         my $status = shift || 500;
5351         my $error = esc_html(shift) || "Internal Server Error";
5352         my $extra = shift;
5353         my %opts = @_;
5354
5355         my %http_responses = (
5356                 400 => '400 Bad Request',
5357                 403 => '403 Forbidden',
5358                 404 => '404 Not Found',
5359                 500 => '500 Internal Server Error',
5360                 503 => '503 Service Unavailable',
5361         );
5362         git_header_html($http_responses{$status}, undef, %opts);
5363         print <<EOF;
5364 <div class="page_body">
5365 <br /><br />
5366 $status - $error
5367 <br />
5368 EOF
5369         if (defined $extra) {
5370                 print "<hr />\n" .
5371                       "$extra\n";
5372         }
5373         print "</div>\n";
5374
5375         git_footer_html();
5376         CORE::die
5377                 unless ($opts{'-error_handler'});
5378 }
5379
5380 ## ----------------------------------------------------------------------
5381 ## functions printing or outputting HTML: navigation
5382
5383 # $content is wrapped in a span with class 'tab'
5384 # If $selected is true it also has class 'selected'
5385 # If $disabled is true it also has class 'disabled'
5386 # Whether or not a tab can be disabled and selected at the same time
5387 # is up to the caller
5388 # If $extra_classes is non-empty, it is a whitespace-separated list of
5389 # additional class names to include
5390 # Note that $content MUST already be html-escaped as needed because
5391 # it is included verbatim.  And so are any extra class names.
5392 sub tabspan {
5393         my ($content, $selected, $disabled, $extra_classes) = @_;
5394         my @classes = ("tab");
5395         push(@classes, "selected") if $selected;
5396         push(@classes, "disabled") if $disabled;
5397         push(@classes, split(' ', $extra_classes)) if $extra_classes;
5398         return "<span class=\"" . join(" ", @classes) . "\">". $content . "</span>";
5399 }
5400
5401 sub git_print_page_nav {
5402         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
5403         $extra = '' if !defined $extra; # pager or formats
5404         $extra = "<span class=\"page_nav_sub\">".$extra."</span>" if $extra ne '';
5405
5406         my @navs = qw(summary log commit commitdiff tree refs);
5407         if ($suppress) {
5408                 my %omit;
5409                 if (ref($suppress) eq 'ARRAY') {
5410                         %omit = map { ($_ => 1) } @$suppress;
5411                 } else {
5412                         %omit = ($suppress => 1);
5413                 }
5414                 @navs = grep { !$omit{$_} } @navs;
5415         }
5416
5417         my %arg = map { $_ => {action=>$_} } @navs;
5418         if (defined $head) {
5419                 for (qw(commit commitdiff)) {
5420                         $arg{$_}{'hash'} = $head;
5421                 }
5422                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
5423                         $arg{'log'}{'hash'} = $head;
5424                 }
5425         }
5426
5427         $arg{'log'}{'action'} = 'shortlog';
5428         if ($current eq 'log') {
5429                 $current = 'shortlog';
5430         } elsif ($current eq 'shortlog') {
5431                 $current = 'log';
5432         }
5433         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
5434         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
5435
5436         my @actions = gitweb_get_feature('actions');
5437         my $escname = $project;
5438         $escname =~ s/[+]/%2B/g;
5439         my %repl = (
5440                 '%' => '%',
5441                 'n' => $project,         # project name
5442                 'f' => $git_dir,         # project path within filesystem
5443                 'h' => $treehead || '',  # current hash ('h' parameter)
5444                 'b' => $treebase || '',  # hash base ('hb' parameter)
5445                 'e' => $escname,         # project name with '+' escaped
5446         );
5447         while (@actions) {
5448                 my ($label, $link, $pos) = splice(@actions,0,3);
5449                 # insert
5450                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
5451                 # munch munch
5452                 $link =~ s/%([%nfhbe])/$repl{$1}/g;
5453                 $arg{$label}{'_href'} = $link;
5454         }
5455
5456         print "<div class=\"page_nav\">\n" .
5457                 (join $barsep,
5458                  map { $_ eq $current ?
5459                        tabspan($_, 1) :
5460                        tabspan($cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_"))
5461                  } @navs);
5462         print "<br/>\n$extra<br/>\n" .
5463               "</div>\n";
5464 }
5465
5466 # returns a submenu for the nagivation of the refs views (tags, heads,
5467 # remotes) with the current view disabled and the remotes view only
5468 # available if the feature is enabled
5469 sub format_ref_views {
5470         my ($current) = @_;
5471         my @ref_views = qw{tags heads};
5472         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
5473         return join $barsep, map {
5474                 $_ eq $current ? tabspan($_, 1) :
5475                 tabspan($cgi->a({-href => href(action=>$_)}, $_))
5476         } @ref_views
5477 }
5478
5479 sub format_paging_nav {
5480         my ($action, $page, $has_next_link) = @_;
5481         my $paging_nav = "<span class=\"paging_nav\">";
5482
5483         if ($page > 0) {
5484                 $paging_nav .= tabspan(
5485                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first")) .
5486                         $mdotsep . tabspan(
5487                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
5488                                  -accesskey => "p", -title => "Alt-p"}, "prev"));
5489         } else {
5490                 $paging_nav .= tabspan("first", 1).${mdotsep}.tabspan("prev", 0, 1);
5491         }
5492
5493         if ($has_next_link) {
5494                 $paging_nav .= $mdotsep . tabspan(
5495                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
5496                                  -accesskey => "n", -title => "Alt-n"}, "next"));
5497         } else {
5498                 $paging_nav .= ${mdotsep}.tabspan("next", 0, 1);
5499         }
5500
5501         return $paging_nav."</span>";
5502 }
5503
5504 sub format_log_nav {
5505         my ($action, $page, $has_next_link, $extra) = @_;
5506         my $paging_nav;
5507         defined $extra or $extra = '';
5508         $extra eq '' or $extra .= $barsep;
5509
5510         if ($action eq 'shortlog') {
5511                 $paging_nav .= tabspan('shortlog', 1);
5512         } else {
5513                 $paging_nav .= tabspan($cgi->a({-href => href(action=>'shortlog', -replay=>1)}, 'shortlog'));
5514         }
5515         $paging_nav .= $barsep;
5516         if ($action eq 'log') {
5517                 $paging_nav .= tabspan('fulllog', 1);
5518         } else {
5519                 $paging_nav .= tabspan($cgi->a({-href => href(action=>'log', -replay=>1)}, 'fulllog'));
5520         }
5521
5522         $paging_nav .= $barsep . $extra . format_paging_nav($action, $page, $has_next_link);
5523         return $paging_nav;
5524 }
5525
5526 ## ......................................................................
5527 ## functions printing or outputting HTML: div
5528
5529 sub git_print_header_div {
5530         my ($action, $title, $hash, $hash_base, $extra) = @_;
5531         my %args = ();
5532         defined $extra or $extra = '';
5533
5534         $args{'action'} = $action;
5535         $args{'hash'} = $hash if $hash;
5536         $args{'hash_base'} = $hash_base if $hash_base;
5537
5538         my $link1 = $cgi->a({-href => href(%args), -class => "title"},
5539                             $title ? $title : $action);
5540         my $link2 = $cgi->a({-href => href(%args), -class => "cover"}, "");
5541         print "<div class=\"header\">\n" . '<span class="title">' .
5542               $link1 . $extra . $link2 . '</span>' . "\n</div>\n";
5543 }
5544
5545 sub format_repo_url {
5546         my ($name, $url) = @_;
5547         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
5548 }
5549
5550 # Group output by placing it in a DIV element and adding a header.
5551 # Options for start_div() can be provided by passing a hash reference as the
5552 # first parameter to the function.
5553 # Options to git_print_header_div() can be provided by passing an array
5554 # reference. This must follow the options to start_div if they are present.
5555 # The content can be a scalar, which is output as-is, a scalar reference, which
5556 # is output after html escaping, an IO handle passed either as *handle or
5557 # *handle{IO}, or a function reference. In the latter case all following
5558 # parameters will be taken as argument to the content function call.
5559 sub git_print_section {
5560         my ($div_args, $header_args, $content);
5561         my $arg = shift;
5562         if (ref($arg) eq 'HASH') {
5563                 $div_args = $arg;
5564                 $arg = shift;
5565         }
5566         if (ref($arg) eq 'ARRAY') {
5567                 $header_args = $arg;
5568                 $arg = shift;
5569         }
5570         $content = $arg;
5571
5572         print $cgi->start_div($div_args);
5573         git_print_header_div(@$header_args);
5574
5575         if (ref($content) eq 'CODE') {
5576                 $content->(@_);
5577         } elsif (ref($content) eq 'SCALAR') {
5578                 print esc_html($$content);
5579         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
5580                 while (<$content>) {
5581                         print to_utf8($_);
5582                 }
5583         } elsif (!ref($content) && defined($content)) {
5584                 print $content;
5585         }
5586
5587         print $cgi->end_div;
5588 }
5589
5590 sub format_timestamp_html {
5591         my $date = shift;
5592         my $useatnight = shift;
5593         defined($useatnight) or $useatnight = 1;
5594         my $strtime = $date->{'rfc2822'};
5595
5596         my (undef, undef, $datetime_class) =
5597                 gitweb_get_feature('javascript-timezone');
5598         if ($datetime_class) {
5599                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
5600         }
5601
5602         my $localtime_format = '(%d %02d:%02d %s)';
5603         if ($useatnight && $date->{'hour_local'} < 6) {
5604                 $localtime_format = '(%d <span class="atnight">%02d:%02d</span> %s)';
5605         }
5606         $strtime .= ' ' .
5607                     sprintf($localtime_format, $date->{'mday_local'},
5608                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
5609
5610         return $strtime;
5611 }
5612
5613 sub format_lastrefresh_row {
5614         return "<?gitweb format_lastrefresh_row?>" if $cache_mode_active;
5615         my %rd = parse_file_date('.last_refresh');
5616         if (defined $rd{'rfc2822'}) {
5617                 return "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td>" .
5618                        "<td>".format_timestamp_html(\%rd,0)."</td></tr>";
5619         }
5620         return "";
5621 }
5622
5623 # Outputs the author name and date in long form
5624 sub git_print_authorship {
5625         my $co = shift;
5626         my %opts = @_;
5627         my $tag = $opts{-tag} || 'div';
5628         my $author = $co->{'author_name'};
5629
5630         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
5631         print "<$tag class=\"author_date\">" .
5632               format_search_author($author, "author", esc_html($author)) .
5633               " [".format_timestamp_html(\%ad)."]".
5634               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
5635               "</$tag>\n";
5636 }
5637
5638 # Outputs table rows containing the full author or committer information,
5639 # in the format expected for 'commit' view (& similar).
5640 # Parameters are a commit hash reference, followed by the list of people
5641 # to output information for. If the list is empty it defaults to both
5642 # author and committer.
5643 sub git_print_authorship_rows {
5644         my $co = shift;
5645         # too bad we can't use @people = @_ || ('author', 'committer')
5646         my @people = @_;
5647         @people = ('author', 'committer') unless @people;
5648         foreach my $who (@people) {
5649                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
5650                 print "<tr><td>$who</td><td>" .
5651                       format_search_author($co->{"${who}_name"}, $who,
5652                                            esc_html($co->{"${who}_name"})) . " " .
5653                       format_search_author($co->{"${who}_email"}, $who,
5654                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
5655                       "</td><td rowspan=\"2\">" .
5656                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
5657                       "</td></tr>\n" .
5658                       "<tr>" .
5659                       "<td></td><td>" .
5660                       format_timestamp_html(\%wd) .
5661                       "</td>" .
5662                       "</tr>\n";
5663         }
5664 }
5665
5666 sub git_print_page_path {
5667         my $name = shift;
5668         my $type = shift;
5669         my $hb = shift;
5670
5671
5672         print "<div class=\"page_path\">";
5673         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
5674                       -title => 'tree root'}, to_utf8("[$project]"));
5675         print $slssep;
5676         if (defined $name) {
5677                 my @dirname = split '/', $name;
5678                 my $basename = pop @dirname;
5679                 my $fullname = '';
5680
5681                 foreach my $dir (@dirname) {
5682                         $fullname .= ($fullname ? '/' : '') . $dir;
5683                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
5684                                                      hash_base=>$hb),
5685                                       -title => $fullname}, esc_path($dir));
5686                         print $slssep;
5687                 }
5688                 if (defined $type && $type eq 'blob') {
5689                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
5690                                                      hash_base=>$hb),
5691                                       -title => $name}, esc_path($basename));
5692                 } elsif (defined $type && $type eq 'tree') {
5693                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
5694                                                      hash_base=>$hb),
5695                                       -title => $name}, esc_path($basename));
5696                         print $slssep;
5697                 } else {
5698                         print esc_path($basename);
5699                 }
5700         }
5701         print "<br/></div>\n";
5702 }
5703
5704 sub git_print_log {
5705         my $log = shift;
5706         my %opts = @_;
5707
5708         if ($opts{'-remove_title'}) {
5709                 # remove title, i.e. first line of log
5710                 shift @$log;
5711         }
5712         # remove leading empty lines
5713         while (defined $log->[0] && $log->[0] eq "") {
5714                 shift @$log;
5715         }
5716
5717         # print log
5718         my $skip_blank_line = 0;
5719         foreach my $line (@$log) {
5720                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5721                         if (! $opts{'-remove_signoff'}) {
5722                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5723                                 $skip_blank_line = 1;
5724                         }
5725                         next;
5726                 }
5727
5728                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5729                         if (! $opts{'-remove_signoff'}) {
5730                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5731                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5732                                         "</span><br/>\n";
5733                                 $skip_blank_line = 1;
5734                         }
5735                         next;
5736                 }
5737
5738                 # print only one empty line
5739                 # do not print empty line after signoff
5740                 if ($line eq "") {
5741                         next if ($skip_blank_line);
5742                         $skip_blank_line = 1;
5743                 } else {
5744                         $skip_blank_line = 0;
5745                 }
5746
5747                 print format_log_line_html($line) . "<br/>\n";
5748         }
5749
5750         if ($opts{'-final_empty_line'}) {
5751                 # end with single empty line
5752                 print "<br/>\n" unless $skip_blank_line;
5753         }
5754 }
5755
5756 # return link target (what link points to)
5757 sub git_get_link_target {
5758         my $hash = shift;
5759         my $link_target;
5760
5761         # read link
5762         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5763                 or return;
5764         {
5765                 local $/ = undef;
5766                 $link_target = to_utf8(scalar <$fd>);
5767         }
5768         close $fd
5769                 or return;
5770
5771         return $link_target;
5772 }
5773
5774 # given link target, and the directory (basedir) the link is in,
5775 # return target of link relative to top directory (top tree);
5776 # return undef if it is not possible (including absolute links).
5777 sub normalize_link_target {
5778         my ($link_target, $basedir) = @_;
5779
5780         # absolute symlinks (beginning with '/') cannot be normalized
5781         return if (substr($link_target, 0, 1) eq '/');
5782
5783         # normalize link target to path from top (root) tree (dir)
5784         my $path;
5785         if ($basedir) {
5786                 $path = $basedir . '/' . $link_target;
5787         } else {
5788                 # we are in top (root) tree (dir)
5789                 $path = $link_target;
5790         }
5791
5792         # remove //, /./, and /../
5793         my @path_parts;
5794         foreach my $part (split('/', $path)) {
5795                 # discard '.' and ''
5796                 next if (!$part || $part eq '.');
5797                 # handle '..'
5798                 if ($part eq '..') {
5799                         if (@path_parts) {
5800                                 pop @path_parts;
5801                         } else {
5802                                 # link leads outside repository (outside top dir)
5803                                 return;
5804                         }
5805                 } else {
5806                         push @path_parts, $part;
5807                 }
5808         }
5809         $path = join('/', @path_parts);
5810
5811         return $path;
5812 }
5813
5814 # print tree entry (row of git_tree), but without encompassing <tr> element
5815 sub git_print_tree_entry {
5816         my ($t, $basedir, $hash_base, $have_blame) = @_;
5817
5818         my %base_key = ();
5819         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5820
5821         # The format of a table row is: mode list link.  Where mode is
5822         # the mode of the entry, list is the name of the entry, an href,
5823         # and link is the action links of the entry.
5824
5825         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5826         if (exists $t->{'size'}) {
5827                 print "<td class=\"size\">$t->{'size'}</td>\n";
5828         }
5829         if ($t->{'type'} eq "blob") {
5830                 print "<td class=\"list\">" .
5831                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5832                                                file_name=>"$basedir$t->{'name'}", %base_key),
5833                                 -class => "list"}, esc_path($t->{'name'}));
5834                 if (S_ISLNK(oct $t->{'mode'})) {
5835                         my $link_target = git_get_link_target($t->{'hash'});
5836                         if ($link_target) {
5837                                 my $norm_target = normalize_link_target($link_target, $basedir);
5838                                 if (defined $norm_target) {
5839                                         print " -> " .
5840                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5841                                                                      file_name=>$norm_target),
5842                                                        -title => $norm_target}, esc_path($link_target));
5843                                 } else {
5844                                         print " -> " . esc_path($link_target);
5845                                 }
5846                         }
5847                 }
5848                 print "</td>\n";
5849                 print "<td class=\"link\">";
5850                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5851                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5852                               "blob");
5853                 if ($have_blame) {
5854                         print $barsep .
5855                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5856                                                      file_name=>"$basedir$t->{'name'}", %base_key),
5857                                       -class => "blamelink"},
5858                                       "blame");
5859                 }
5860                 if (defined $hash_base) {
5861                         print $barsep .
5862                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5863                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5864                                       "history");
5865                 }
5866                 print $barsep .
5867                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5868                                                file_name=>"$basedir$t->{'name'}")},
5869                                 "raw");
5870                 print "</td>\n";
5871
5872         } elsif ($t->{'type'} eq "tree") {
5873                 print "<td class=\"list\">";
5874                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5875                                              file_name=>"$basedir$t->{'name'}",
5876                                              %base_key)},
5877                               esc_path($t->{'name'}));
5878                 print "</td>\n";
5879                 print "<td class=\"link\">";
5880                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5881                                              file_name=>"$basedir$t->{'name'}",
5882                                              %base_key)},
5883                               "tree");
5884                 if (defined $hash_base) {
5885                         print $barsep .
5886                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5887                                                      file_name=>"$basedir$t->{'name'}")},
5888                                       "history");
5889                 }
5890                 print "</td>\n";
5891         } else {
5892                 # unknown object: we can only present history for it
5893                 # (this includes 'commit' object, i.e. submodule support)
5894                 print "<td class=\"list\">" .
5895                       esc_path($t->{'name'}) .
5896                       "</td>\n";
5897                 print "<td class=\"link\">";
5898                 if (defined $hash_base) {
5899                         print $cgi->a({-href => href(action=>"history",
5900                                                      hash_base=>$hash_base,
5901                                                      file_name=>"$basedir$t->{'name'}")},
5902                                       "history");
5903                 }
5904                 print "</td>\n";
5905         }
5906 }
5907
5908 ## ......................................................................
5909 ## functions printing large fragments of HTML
5910
5911 # get pre-image filenames for merge (combined) diff
5912 sub fill_from_file_info {
5913         my ($diff, @parents) = @_;
5914
5915         $diff->{'from_file'} = [ ];
5916         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5917         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5918                 if ($diff->{'status'}[$i] eq 'R' ||
5919                     $diff->{'status'}[$i] eq 'C') {
5920                         $diff->{'from_file'}[$i] =
5921                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5922                 }
5923         }
5924
5925         return $diff;
5926 }
5927
5928 # is current raw difftree line of file deletion
5929 sub is_deleted {
5930         my $diffinfo = shift;
5931
5932         return $diffinfo->{'to_id'} eq ('0' x 40);
5933 }
5934
5935 # does patch correspond to [previous] difftree raw line
5936 # $diffinfo  - hashref of parsed raw diff format
5937 # $patchinfo - hashref of parsed patch diff format
5938 #              (the same keys as in $diffinfo)
5939 sub is_patch_split {
5940         my ($diffinfo, $patchinfo) = @_;
5941
5942         return defined $diffinfo && defined $patchinfo
5943                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5944 }
5945
5946
5947 sub git_difftree_body {
5948         my ($difftree, $hash, @parents) = @_;
5949         my ($parent) = $parents[0];
5950         my $have_blame = gitweb_check_feature('blame');
5951         print "<div class=\"list_head\">\n";
5952         if ($#{$difftree} > 10) {
5953                 print(($#{$difftree} + 1) . " files changed:\n");
5954         }
5955         print "</div>\n";
5956
5957         print "<table class=\"" .
5958               (@parents > 1 ? "combined " : "") .
5959               "diff_tree\">\n";
5960
5961         # header only for combined diff in 'commitdiff' view
5962         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5963         if ($has_header) {
5964                 # table header
5965                 print "<thead><tr>\n" .
5966                        "<th></th><th></th>\n"; # filename, patchN link
5967                 for (my $i = 0; $i < @parents; $i++) {
5968                         my $par = $parents[$i];
5969                         print "<th>" .
5970                               $cgi->a({-href => href(action=>"commitdiff",
5971                                                      hash=>$hash, hash_parent=>$par),
5972                                        -title => 'commitdiff to parent number ' .
5973                                                   ($i+1) . ': ' . substr($par,0,7)},
5974                                       $i+1) .
5975                               "&#160;</th>\n";
5976                 }
5977                 print "</tr></thead>\n<tbody>\n";
5978         }
5979
5980         my $alternate = 1;
5981         my $patchno = 0;
5982         foreach my $line (@{$difftree}) {
5983                 my $diff = parsed_difftree_line($line);
5984
5985                 if ($alternate) {
5986                         print "<tr class=\"dark\">\n";
5987                 } else {
5988                         print "<tr class=\"light\">\n";
5989                 }
5990                 $alternate ^= 1;
5991
5992                 if (exists $diff->{'nparents'}) { # combined diff
5993
5994                         fill_from_file_info($diff, @parents)
5995                                 unless exists $diff->{'from_file'};
5996
5997                         if (!is_deleted($diff)) {
5998                                 # file exists in the result (child) commit
5999                                 print "<td>" .
6000                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6001                                                              file_name=>$diff->{'to_file'},
6002                                                              hash_base=>$hash),
6003                                               -class => "list"}, esc_path($diff->{'to_file'})) .
6004                                       "</td>\n";
6005                         } else {
6006                                 print "<td>" .
6007                                       esc_path($diff->{'to_file'}) .
6008                                       "</td>\n";
6009                         }
6010
6011                         if ($action eq 'commitdiff') {
6012                                 # link to patch
6013                                 $patchno++;
6014                                 print "<td class=\"link\">" .
6015                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
6016                                               "patch") .
6017                                       $barsep .
6018                                       "</td>\n";
6019                         }
6020
6021                         my $has_history = 0;
6022                         my $not_deleted = 0;
6023                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
6024                                 my $hash_parent = $parents[$i];
6025                                 my $from_hash = $diff->{'from_id'}[$i];
6026                                 my $from_path = $diff->{'from_file'}[$i];
6027                                 my $status = $diff->{'status'}[$i];
6028
6029                                 $has_history ||= ($status ne 'A');
6030                                 $not_deleted ||= ($status ne 'D');
6031
6032                                 if ($status eq 'A') {
6033                                         print "<td  class=\"link\" align=\"right\">$barsep</td>\n";
6034                                 } elsif ($status eq 'D') {
6035                                         print "<td class=\"link\">" .
6036                                               $cgi->a({-href => href(action=>"blob",
6037                                                                      hash_base=>$hash,
6038                                                                      hash=>$from_hash,
6039                                                                      file_name=>$from_path)},
6040                                                       "blob" . ($i+1)) .
6041                                               "$barsep</td>\n";
6042                                 } else {
6043                                         if ($diff->{'to_id'} eq $from_hash) {
6044                                                 print "<td class=\"link nochange\">";
6045                                         } else {
6046                                                 print "<td class=\"link\">";
6047                                         }
6048                                         print $cgi->a({-href => href(action=>"blobdiff",
6049                                                                      hash=>$diff->{'to_id'},
6050                                                                      hash_parent=>$from_hash,
6051                                                                      hash_base=>$hash,
6052                                                                      hash_parent_base=>$hash_parent,
6053                                                                      file_name=>$diff->{'to_file'},
6054                                                                      file_parent=>$from_path)},
6055                                                       "diff" . ($i+1)) .
6056                                               "$barsep</td>\n";
6057                                 }
6058                         }
6059
6060                         print "<td class=\"link\">";
6061                         if ($not_deleted) {
6062                                 print $cgi->a({-href => href(action=>"blob",
6063                                                              hash=>$diff->{'to_id'},
6064                                                              file_name=>$diff->{'to_file'},
6065                                                              hash_base=>$hash)},
6066                                               "blob");
6067                                 print $barsep if ($has_history);
6068                         }
6069                         if ($has_history) {
6070                                 print $cgi->a({-href => href(action=>"history",
6071                                                              file_name=>$diff->{'to_file'},
6072                                                              hash_base=>$hash)},
6073                                               "history");
6074                         }
6075                         print "</td>\n";
6076
6077                         print "</tr>\n";
6078                         next; # instead of 'else' clause, to avoid extra indent
6079                 }
6080                 # else ordinary diff
6081
6082                 my ($to_mode_oct, $to_mode_str, $to_file_type);
6083                 my ($from_mode_oct, $from_mode_str, $from_file_type);
6084                 if ($diff->{'to_mode'} ne ('0' x 6)) {
6085                         $to_mode_oct = oct $diff->{'to_mode'};
6086                         if (S_ISREG($to_mode_oct)) { # only for regular file
6087                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
6088                         }
6089                         $to_file_type = file_type($diff->{'to_mode'});
6090                 }
6091                 if ($diff->{'from_mode'} ne ('0' x 6)) {
6092                         $from_mode_oct = oct $diff->{'from_mode'};
6093                         if (S_ISREG($from_mode_oct)) { # only for regular file
6094                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
6095                         }
6096                         $from_file_type = file_type($diff->{'from_mode'});
6097                 }
6098
6099                 if ($diff->{'status'} eq "A") { # created
6100                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
6101                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
6102                         $mode_chng   .= "]</span>";
6103                         print "<td>";
6104                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6105                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6106                                       -class => "list"}, esc_path($diff->{'file'}));
6107                         print "</td>\n";
6108                         print "<td>$mode_chng</td>\n";
6109                         print "<td class=\"link\">";
6110                         if ($action eq 'commitdiff') {
6111                                 # link to patch
6112                                 $patchno++;
6113                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6114                                               "patch") .
6115                                       $barsep;
6116                         }
6117                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6118                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6119                                       "blob");
6120                         print "</td>\n";
6121
6122                 } elsif ($diff->{'status'} eq "D") { # deleted
6123                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
6124                         print "<td>";
6125                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
6126                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
6127                                        -class => "list"}, esc_path($diff->{'file'}));
6128                         print "</td>\n";
6129                         print "<td>$mode_chng</td>\n";
6130                         print "<td class=\"link\">";
6131                         if ($action eq 'commitdiff') {
6132                                 # link to patch
6133                                 $patchno++;
6134                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6135                                               "patch") .
6136                                       $barsep;
6137                         }
6138                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
6139                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
6140                                       "blob") . $barsep;
6141                         if ($have_blame) {
6142                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
6143                                                              file_name=>$diff->{'file'}),
6144                                               -class => "blamelink"},
6145                                               "blame") . $barsep;
6146                         }
6147                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
6148                                                      file_name=>$diff->{'file'})},
6149                                       "history");
6150                         print "</td>\n";
6151
6152                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
6153                         my $mode_chnge = "";
6154                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6155                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
6156                                 if ($from_file_type ne $to_file_type) {
6157                                         $mode_chnge .= " from $from_file_type to $to_file_type";
6158                                 }
6159                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
6160                                         if ($from_mode_str && $to_mode_str) {
6161                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
6162                                         } elsif ($to_mode_str) {
6163                                                 $mode_chnge .= " mode: $to_mode_str";
6164                                         }
6165                                 }
6166                                 $mode_chnge .= "]</span>\n";
6167                         }
6168                         print "<td>";
6169                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6170                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6171                                       -class => "list"}, esc_path($diff->{'file'}));
6172                         print "</td>\n";
6173                         print "<td>$mode_chnge</td>\n";
6174                         print "<td class=\"link\">";
6175                         if ($action eq 'commitdiff') {
6176                                 # link to patch
6177                                 $patchno++;
6178                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6179                                               "patch") .
6180                                       $barsep;
6181                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6182                                 # "commit" view and modified file (not onlu mode changed)
6183                                 print $cgi->a({-href => href(action=>"blobdiff",
6184                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6185                                                              hash_base=>$hash, hash_parent_base=>$parent,
6186                                                              file_name=>$diff->{'file'})},
6187                                               "diff") .
6188                                       $barsep;
6189                         }
6190                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6191                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6192                                        "blob") . $barsep;
6193                         if ($have_blame) {
6194                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6195                                                              file_name=>$diff->{'file'}),
6196                                               -class => "blamelink"},
6197                                               "blame") . $barsep;
6198                         }
6199                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6200                                                      file_name=>$diff->{'file'})},
6201                                       "history");
6202                         print "</td>\n";
6203
6204                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
6205                         my %status_name = ('R' => 'moved', 'C' => 'copied');
6206                         my $nstatus = $status_name{$diff->{'status'}};
6207                         my $mode_chng = "";
6208                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6209                                 # mode also for directories, so we cannot use $to_mode_str
6210                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
6211                         }
6212                         print "<td>" .
6213                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
6214                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
6215                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
6216                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
6217                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
6218                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
6219                                       -class => "list"}, esc_path($diff->{'from_file'})) .
6220                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
6221                               "<td class=\"link\">";
6222                         if ($action eq 'commitdiff') {
6223                                 # link to patch
6224                                 $patchno++;
6225                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6226                                               "patch") .
6227                                       $barsep;
6228                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6229                                 # "commit" view and modified file (not only pure rename or copy)
6230                                 print $cgi->a({-href => href(action=>"blobdiff",
6231                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6232                                                              hash_base=>$hash, hash_parent_base=>$parent,
6233                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
6234                                               "diff") .
6235                                       $barsep;
6236                         }
6237                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6238                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
6239                                       "blob") . $barsep;
6240                         if ($have_blame) {
6241                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6242                                                              file_name=>$diff->{'to_file'}),
6243                                               -class => "blamelink"},
6244                                               "blame") . $barsep;
6245                         }
6246                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6247                                                     file_name=>$diff->{'to_file'})},
6248                                       "history");
6249                         print "</td>\n";
6250
6251                 } # we should not encounter Unmerged (U) or Unknown (X) status
6252                 print "</tr>\n";
6253         }
6254         print "</tbody>" if $has_header;
6255         print "</table>\n";
6256 }
6257
6258 # Print context lines and then rem/add lines in a side-by-side manner.
6259 sub print_sidebyside_diff_lines {
6260         my ($ctx, $rem, $add) = @_;
6261
6262         # print context block before add/rem block
6263         if (@$ctx) {
6264                 print join '',
6265                         '<div class="chunk_block ctx">',
6266                                 '<div class="old">',
6267                                 @$ctx,
6268                                 '</div>',
6269                                 '<div class="new">',
6270                                 @$ctx,
6271                                 '</div>',
6272                         '</div>';
6273         }
6274
6275         if (!@$add) {
6276                 # pure removal
6277                 print join '',
6278                         '<div class="chunk_block rem">',
6279                                 '<div class="old">',
6280                                 @$rem,
6281                                 '</div>',
6282                         '</div>';
6283         } elsif (!@$rem) {
6284                 # pure addition
6285                 print join '',
6286                         '<div class="chunk_block add">',
6287                                 '<div class="new">',
6288                                 @$add,
6289                                 '</div>',
6290                         '</div>';
6291         } else {
6292                 print join '',
6293                         '<div class="chunk_block chg">',
6294                                 '<div class="old">',
6295                                 @$rem,
6296                                 '</div>',
6297                                 '<div class="new">',
6298                                 @$add,
6299                                 '</div>',
6300                         '</div>';
6301         }
6302 }
6303
6304 # Print context lines and then rem/add lines in inline manner.
6305 sub print_inline_diff_lines {
6306         my ($ctx, $rem, $add) = @_;
6307
6308         print @$ctx, @$rem, @$add;
6309 }
6310
6311 # Format removed and added line, mark changed part and HTML-format them.
6312 # Implementation is based on contrib/diff-highlight
6313 sub format_rem_add_lines_pair {
6314         my ($rem, $add, $num_parents) = @_;
6315
6316         # We need to untabify lines before split()'ing them;
6317         # otherwise offsets would be invalid.
6318         chomp $rem;
6319         chomp $add;
6320         $rem = untabify($rem);
6321         $add = untabify($add);
6322
6323         my @rem = split(//, $rem);
6324         my @add = split(//, $add);
6325         my ($esc_rem, $esc_add);
6326         # Ignore leading +/- characters for each parent.
6327         my ($prefix_len, $suffix_len) = ($num_parents, 0);
6328         my ($prefix_has_nonspace, $suffix_has_nonspace);
6329
6330         my $shorter = (@rem < @add) ? @rem : @add;
6331         while ($prefix_len < $shorter) {
6332                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
6333
6334                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
6335                 $prefix_len++;
6336         }
6337
6338         while ($prefix_len + $suffix_len < $shorter) {
6339                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
6340
6341                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
6342                 $suffix_len++;
6343         }
6344
6345         # Mark lines that are different from each other, but have some common
6346         # part that isn't whitespace.  If lines are completely different, don't
6347         # mark them because that would make output unreadable, especially if
6348         # diff consists of multiple lines.
6349         if ($prefix_has_nonspace || $suffix_has_nonspace) {
6350                 $esc_rem = esc_html_hl_regions($rem, 'marked',
6351                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
6352                 $esc_add = esc_html_hl_regions($add, 'marked',
6353                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
6354         } else {
6355                 $esc_rem = esc_html($rem, -nbsp=>1);
6356                 $esc_add = esc_html($add, -nbsp=>1);
6357         }
6358
6359         return format_diff_line(\$esc_rem, 'rem'),
6360                format_diff_line(\$esc_add, 'add');
6361 }
6362
6363 # HTML-format diff context, removed and added lines.
6364 sub format_ctx_rem_add_lines {
6365         my ($ctx, $rem, $add, $num_parents) = @_;
6366         my (@new_ctx, @new_rem, @new_add);
6367         my $can_highlight = 0;
6368         my $is_combined = ($num_parents > 1);
6369
6370         # Highlight if every removed line has a corresponding added line.
6371         if (@$add > 0 && @$add == @$rem) {
6372                 $can_highlight = 1;
6373
6374                 # Highlight lines in combined diff only if the chunk contains
6375                 # diff between the same version, e.g.
6376                 #
6377                 #    - a
6378                 #   -  b
6379                 #    + c
6380                 #   +  d
6381                 #
6382                 # Otherwise the highlightling would be confusing.
6383                 if ($is_combined) {
6384                         for (my $i = 0; $i < @$add; $i++) {
6385                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
6386                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
6387
6388                                 $prefix_rem =~ s/-/+/g;
6389
6390                                 if ($prefix_rem ne $prefix_add) {
6391                                         $can_highlight = 0;
6392                                         last;
6393                                 }
6394                         }
6395                 }
6396         }
6397
6398         if ($can_highlight) {
6399                 for (my $i = 0; $i < @$add; $i++) {
6400                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
6401                                 $rem->[$i], $add->[$i], $num_parents);
6402                         push @new_rem, $line_rem;
6403                         push @new_add, $line_add;
6404                 }
6405         } else {
6406                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
6407                 @new_add = map { format_diff_line($_, 'add') } @$add;
6408         }
6409
6410         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
6411
6412         return (\@new_ctx, \@new_rem, \@new_add);
6413 }
6414
6415 # Print context lines and then rem/add lines.
6416 sub print_diff_lines {
6417         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
6418         my $is_combined = $num_parents > 1;
6419
6420         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
6421                 $num_parents);
6422
6423         if ($diff_style eq 'sidebyside' && !$is_combined) {
6424                 print_sidebyside_diff_lines($ctx, $rem, $add);
6425         } else {
6426                 # default 'inline' style and unknown styles
6427                 print_inline_diff_lines($ctx, $rem, $add);
6428         }
6429 }
6430
6431 sub print_diff_chunk {
6432         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
6433         my (@ctx, @rem, @add);
6434
6435         # The class of the previous line.
6436         my $prev_class = '';
6437
6438         return unless @chunk;
6439
6440         # incomplete last line might be among removed or added lines,
6441         # or both, or among context lines: find which
6442         for (my $i = 1; $i < @chunk; $i++) {
6443                 if ($chunk[$i][0] eq 'incomplete') {
6444                         $chunk[$i][0] = $chunk[$i-1][0];
6445                 }
6446         }
6447
6448         # guardian
6449         push @chunk, ["", ""];
6450
6451         foreach my $line_info (@chunk) {
6452                 my ($class, $line) = @$line_info;
6453
6454                 # print chunk headers
6455                 if ($class && $class eq 'chunk_header') {
6456                         print format_diff_line($line, $class, $from, $to);
6457                         next;
6458                 }
6459
6460                 ## print from accumulator when have some add/rem lines or end
6461                 # of chunk (flush context lines), or when have add and rem
6462                 # lines and new block is reached (otherwise add/rem lines could
6463                 # be reordered)
6464                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
6465                     (@rem && @add && $class ne $prev_class)) {
6466                         print_diff_lines(\@ctx, \@rem, \@add,
6467                                          $diff_style, $num_parents);
6468                         @ctx = @rem = @add = ();
6469                 }
6470
6471                 ## adding lines to accumulator
6472                 # guardian value
6473                 last unless $line;
6474                 # rem, add or change
6475                 if ($class eq 'rem') {
6476                         push @rem, $line;
6477                 } elsif ($class eq 'add') {
6478                         push @add, $line;
6479                 }
6480                 # context line
6481                 if ($class eq 'ctx') {
6482                         push @ctx, $line;
6483                 }
6484
6485                 $prev_class = $class;
6486         }
6487 }
6488
6489 sub git_patchset_body {
6490         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
6491         my ($hash_parent) = $hash_parents[0];
6492
6493         my $is_combined = (@hash_parents > 1);
6494         my $patch_idx = 0;
6495         my $patch_number = 0;
6496         my $patch_line;
6497         my $diffinfo;
6498         my $to_name;
6499         my (%from, %to);
6500         my @chunk; # for side-by-side diff
6501
6502         print "<div class=\"patchset\">\n";
6503
6504         # skip to first patch
6505         while ($patch_line = to_utf8(scalar <$fd>)) {
6506                 chomp $patch_line;
6507
6508                 last if ($patch_line =~ m/^diff /);
6509         }
6510
6511  PATCH:
6512         while ($patch_line) {
6513
6514                 # parse "git diff" header line
6515                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
6516                         # $1 is from_name, which we do not use
6517                         $to_name = unquote($2);
6518                         $to_name =~ s!^b/!!;
6519                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
6520                         # $1 is 'cc' or 'combined', which we do not use
6521                         $to_name = unquote($2);
6522                 } else {
6523                         $to_name = undef;
6524                 }
6525
6526                 # check if current patch belong to current raw line
6527                 # and parse raw git-diff line if needed
6528                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
6529                         # this is continuation of a split patch
6530                         print "<div class=\"patch cont\">\n";
6531                 } else {
6532                         # advance raw git-diff output if needed
6533                         $patch_idx++ if defined $diffinfo;
6534
6535                         # read and prepare patch information
6536                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6537
6538                         # compact combined diff output can have some patches skipped
6539                         # find which patch (using pathname of result) we are at now;
6540                         if ($is_combined) {
6541                                 while ($to_name ne $diffinfo->{'to_file'}) {
6542                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6543                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
6544                                               "</div>\n";  # class="patch"
6545
6546                                         $patch_idx++;
6547                                         $patch_number++;
6548
6549                                         last if $patch_idx > $#$difftree;
6550                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6551                                 }
6552                         }
6553
6554                         # modifies %from, %to hashes
6555                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
6556
6557                         # this is first patch for raw difftree line with $patch_idx index
6558                         # we index @$difftree array from 0, but number patches from 1
6559                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
6560                 }
6561
6562                 # git diff header
6563                 #assert($patch_line =~ m/^diff /) if DEBUG;
6564                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
6565                 $patch_number++;
6566                 # print "git diff" header
6567                 print format_git_diff_header_line($patch_line, $diffinfo,
6568                                                   \%from, \%to);
6569
6570                 # print extended diff header
6571                 print "<div class=\"diff extended_header\">\n";
6572         EXTENDED_HEADER:
6573                 while ($patch_line = to_utf8(scalar<$fd>)) {
6574                         chomp $patch_line;
6575
6576                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
6577
6578                         print format_extended_diff_header_line($patch_line, $diffinfo,
6579                                                                \%from, \%to);
6580                 }
6581                 print "</div>\n"; # class="diff extended_header"
6582
6583                 # from-file/to-file diff header
6584                 if (! $patch_line) {
6585                         print "</div>\n"; # class="patch"
6586                         last PATCH;
6587                 }
6588                 next PATCH if ($patch_line =~ m/^diff /);
6589                 #assert($patch_line =~ m/^---/) if DEBUG;
6590
6591                 my $last_patch_line = $patch_line;
6592                 $patch_line = to_utf8(scalar <$fd>);
6593                 chomp $patch_line;
6594                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
6595
6596                 print format_diff_from_to_header($last_patch_line, $patch_line,
6597                                                  $diffinfo, \%from, \%to,
6598                                                  @hash_parents);
6599
6600                 # the patch itself
6601         LINE:
6602                 while ($patch_line = to_utf8(scalar <$fd>)) {
6603                         chomp $patch_line;
6604
6605                         next PATCH if ($patch_line =~ m/^diff /);
6606
6607                         my $class = diff_line_class($patch_line, \%from, \%to);
6608
6609                         if ($class eq 'chunk_header') {
6610                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6611                                 @chunk = ();
6612                         }
6613
6614                         push @chunk, [ $class, $patch_line ];
6615                 }
6616
6617         } continue {
6618                 if (@chunk) {
6619                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6620                         @chunk = ();
6621                 }
6622                 print "</div>\n"; # class="patch"
6623         }
6624
6625         # for compact combined (--cc) format, with chunk and patch simplification
6626         # the patchset might be empty, but there might be unprocessed raw lines
6627         for (++$patch_idx if $patch_number > 0;
6628              $patch_idx < @$difftree;
6629              ++$patch_idx) {
6630                 # read and prepare patch information
6631                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6632
6633                 # generate anchor for "patch" links in difftree / whatchanged part
6634                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6635                       format_diff_cc_simplified($diffinfo, @hash_parents) .
6636                       "</div>\n";  # class="patch"
6637
6638                 $patch_number++;
6639         }
6640
6641         if ($patch_number == 0) {
6642                 if (@hash_parents > 1) {
6643                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
6644                 } else {
6645                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
6646                 }
6647         }
6648
6649         print "</div>\n"; # class="patchset"
6650 }
6651
6652 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6653
6654 sub git_project_search_form {
6655         my ($searchtext, $search_use_regexp) = @_;
6656
6657         my $limit = '';
6658         if ($project_filter) {
6659                 $limit = " in '$project_filter'";
6660         }
6661
6662         print "<div class=\"projsearch\">\n";
6663         $cgi->start_form(-method => 'get', -action => $my_uri);
6664         print sprintf(qq/<form method="%s" action="%s" enctype="%s">\n/,
6665               'get', CGI::escapeHTML($my_uri), &CGI::URL_ENCODED) .
6666               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
6667         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
6668                 if (defined $project_filter);
6669         print $cgi->textfield(-name => 's', -value => $searchtext,
6670                               -title => "Search project by name and description$limit",
6671                               -size => 60) . "\n" .
6672               "<span title=\"Extended regular expression\">" .
6673               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
6674                              -checked => $search_use_regexp) .
6675               "</span>\n" .
6676               $cgi->submit(-name => 'btnS', -value => 'Search') .
6677               $cgi->end_form() . "\n" .
6678               "<span class=\"projectlist_link\">" .
6679               $cgi->a({-href => href(project => undef, searchtext => undef,
6680                                      action => 'project_list',
6681                                      project_filter => $project_filter)},
6682                       esc_html("List all projects$limit")) . "</span><br />\n";
6683         print "<span class=\"projectlist_link\">" .
6684               $cgi->a({-href => href(project => undef, searchtext => undef,
6685                                      action => 'project_list',
6686                                      project_filter => undef)},
6687                       esc_html("List all projects")) . "</span>\n" if $project_filter;
6688         print "</div>\n";
6689 }
6690
6691 # entry for given @keys needs filling if at least one of keys in list
6692 # is not present in %$project_info
6693 sub project_info_needs_filling {
6694         my ($project_info, @keys) = @_;
6695
6696         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
6697         foreach my $key (@keys) {
6698                 if (!exists $project_info->{$key}) {
6699                         return 1;
6700                 }
6701         }
6702         return;
6703 }
6704
6705 sub git_cache_file_format {
6706         return GITWEB_CACHE_FORMAT .
6707                 (gitweb_check_feature('forks') ? " (forks)" : "");
6708 }
6709
6710 sub git_retrieve_cache_file {
6711         my $cache_file = shift;
6712
6713         use Storable qw(retrieve);
6714
6715         if ((my $dump = eval { retrieve($cache_file) })) {
6716                 return $$dump[1] if
6717                         ref($dump) eq 'ARRAY' &&
6718                         @$dump == 2 &&
6719                         ref($$dump[1]) eq 'ARRAY' &&
6720                         @{$$dump[1]} == 2 &&
6721                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
6722                         ref(${$$dump[1]}[1]) eq 'HASH' &&
6723                         $$dump[0] eq git_cache_file_format();
6724         }
6725
6726         return undef;
6727 }
6728
6729 sub git_store_cache_file {
6730         my ($cache_file, $cachedata) = @_;
6731
6732         use File::Basename qw(dirname);
6733         use File::stat;
6734         use POSIX qw(:fcntl_h);
6735         use Storable qw(store_fd);
6736
6737         my $result = undef;
6738         my $cache_d = dirname($cache_file);
6739         my $mask = umask();
6740         umask($mask & ~0070) if $cache_grpshared;
6741         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6742             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6743                 store_fd([git_cache_file_format(), $cachedata], $fd);
6744                 close $fd;
6745                 rename "$cache_file.lock", $cache_file;
6746                 $result = stat($cache_file)->mtime;
6747         }
6748         umask($mask) if $cache_grpshared;
6749         return $result;
6750 }
6751
6752 sub verify_cached_project {
6753         my ($hashref, $path) = @_;
6754         return undef unless $path;
6755         delete $$hashref{$path}, return undef unless is_valid_project($path);
6756         return $$hashref{$path} if exists $$hashref{$path};
6757
6758         # A valid project was requested but it's not yet in the cache
6759         # Manufacture a minimal project entry (path, name, description)
6760         # Also provide age, but only if it's available via $lastactivity_file
6761
6762         my %proj = ('path' => $path);
6763         my $val = git_get_project_description($path);
6764         defined $val or $val = '';
6765         $proj{'descr_long'} = $val;
6766         $proj{'descr'} = chop_str($val, $projects_list_description_width, 5);
6767         unless ($omit_owner) {
6768                 $val = git_get_project_owner($path);
6769                 defined $val or $val = '';
6770                 $proj{'owner'} = $val;
6771         }
6772         unless ($omit_age_column) {
6773                 ($val) = git_get_last_activity($path, 1);
6774                 $proj{'age_epoch'} = $val if defined $val;
6775         }
6776         $$hashref{$path} = \%proj;
6777         return \%proj;
6778 }
6779
6780 sub git_filter_cached_projects {
6781         my ($cache, $projlist, $verify) = @_;
6782         my $hashref = $$cache[1];
6783         my $sub = $verify ?
6784                 sub {verify_cached_project($hashref, $_[0])} :
6785                 sub {$$hashref{$_[0]}};
6786         return map {
6787                 my $c = &$sub($_->{'path'});
6788                 defined $c ? ($_ = $c) : ()
6789         } @$projlist;
6790 }
6791
6792 # fills project list info (age, description, owner, category, forks, etc.)
6793 # for each project in the list, removing invalid projects from
6794 # returned list, or fill only specified info.
6795 #
6796 # Invalid projects are removed from the returned list if and only if you
6797 # ask 'age_epoch' to be filled, because they are the only fields
6798 # that run unconditionally git command that requires repository, and
6799 # therefore do always check if project repository is invalid.
6800 #
6801 # USAGE:
6802 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6803 #   ensures that 'descr_long' and 'ctags' fields are filled
6804 # * @project_list = fill_project_list_info(\@project_list)
6805 #   ensures that all fields are filled (and invalid projects removed)
6806 #
6807 # NOTE: modifies $projlist, but does not remove entries from it
6808 sub fill_project_list_info {
6809         my ($projlist, @wanted_keys) = @_;
6810
6811         my $rebuild = @wanted_keys && $wanted_keys[0] eq 'rebuild-cache' && shift @wanted_keys;
6812         return fill_project_list_info_uncached($projlist, @wanted_keys)
6813                 unless $projlist_cache_lifetime && $projlist_cache_lifetime > 0;
6814
6815         use File::stat;
6816
6817         my $cache_lifetime = $rebuild ? 0 : $projlist_cache_lifetime;
6818         my $cache_file = "$cache_dir/$projlist_cache_name";
6819
6820         my @projects;
6821         my $stale = 0;
6822         my $now = time();
6823         my $cache_mtime;
6824         if ($cache_lifetime && -f $cache_file) {
6825                 $cache_mtime = stat($cache_file)->mtime;
6826                 $cache_dump = undef if $cache_mtime &&
6827                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6828         }
6829         if (defined $cache_mtime && # caching is on and $cache_file exists
6830             $cache_mtime + $cache_lifetime*60 > $now &&
6831             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6832                 # Cache hit.
6833                 $cache_dump_mtime = $cache_mtime;
6834                 $stale = $now - $cache_mtime;
6835                 my $verify = ($action eq 'summary' || $action eq 'forks') &&
6836                         gitweb_check_feature('forks');
6837                 @projects = git_filter_cached_projects($cache_dump, $projlist, $verify);
6838
6839         } else { # Cache miss.
6840                 if (defined $cache_mtime) {
6841                         # Postpone timeout by two minutes so that we get
6842                         # enough time to do our job, or to be more exact
6843                         # make cache expire after two minutes from now.
6844                         my $time = $now - $cache_lifetime*60 + 120;
6845                         utime $time, $time, $cache_file;
6846                 }
6847                 my @all_projects = git_get_projects_list();
6848                 my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6849                         fill_project_list_info_uncached(\@all_projects);
6850                 map { $all_projects_filled{$_->{'path'}} = $_ }
6851                         filter_forks_from_projects_list([values(%all_projects_filled)])
6852                         if gitweb_check_feature('forks');
6853                 $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6854                                \%all_projects_filled];
6855                 $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6856                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6857         }
6858
6859         if ($cache_lifetime && $stale > 0) {
6860                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6861                         unless $shown_stale_message;
6862                 $shown_stale_message = 1;
6863         }
6864
6865         return @projects;
6866 }
6867
6868 sub fill_project_list_info_uncached {
6869         my ($projlist, @wanted_keys) = @_;
6870         my @projects;
6871         my $filter_set = sub { return @_; };
6872         if (@wanted_keys) {
6873                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6874                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6875         }
6876
6877         my $show_ctags = gitweb_check_feature('ctags');
6878  PROJECT:
6879         foreach my $pr (@$projlist) {
6880                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6881                         my (@activity) = git_get_last_activity($pr->{'path'});
6882                         unless (@activity) {
6883                                 next PROJECT;
6884                         }
6885                         ($pr->{'age_epoch'}) = @activity;
6886                 }
6887                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6888                         my $descr = git_get_project_description($pr->{'path'}) || "";
6889                         $descr = to_utf8($descr);
6890                         $pr->{'descr_long'} = $descr;
6891                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6892                 }
6893                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6894                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6895                 }
6896                 if ($show_ctags &&
6897                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6898                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6899                 }
6900                 if ($projects_list_group_categories &&
6901                     project_info_needs_filling($pr, $filter_set->('category'))) {
6902                         my $cat = git_get_project_category($pr->{'path'}) ||
6903                                                            $project_list_default_category;
6904                         $pr->{'category'} = to_utf8($cat);
6905                 }
6906
6907                 push @projects, $pr;
6908         }
6909
6910         return @projects;
6911 }
6912
6913 sub sort_projects_list {
6914         my ($projlist, $order) = @_;
6915
6916         sub order_str {
6917                 my $key = shift;
6918                 return sub { lc($a->{$key}) cmp lc($b->{$key}) };
6919         }
6920
6921         sub order_reverse_num_then_undef {
6922                 my $key = shift;
6923                 return sub {
6924                         defined $a->{$key} ?
6925                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6926                                 (defined $b->{$key} ? 1 : 0)
6927                 };
6928         }
6929
6930         my %orderings = (
6931                 project => order_str('path'),
6932                 descr => order_str('descr_long'),
6933                 owner => order_str('owner'),
6934                 age => order_reverse_num_then_undef('age_epoch'),
6935         );
6936
6937         my $ordering = $orderings{$order};
6938         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6939 }
6940
6941 # returns a hash of categories, containing the list of project
6942 # belonging to each category
6943 sub build_projlist_by_category {
6944         my ($projlist, $from, $to) = @_;
6945         my %categories;
6946
6947         $from = 0 unless defined $from;
6948         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6949
6950         for (my $i = $from; $i <= $to; $i++) {
6951                 my $pr = $projlist->[$i];
6952                 push @{$categories{ $pr->{'category'} }}, $pr;
6953         }
6954
6955         return wantarray ? %categories : \%categories;
6956 }
6957
6958 # print 'sort by' <th> element, generating 'sort by $name' replay link
6959 # if that order is not selected
6960 sub print_sort_th {
6961         print format_sort_th(@_);
6962 }
6963
6964 sub format_sort_th {
6965         my ($name, $order, $header) = @_;
6966         my $sort_th = "";
6967         $header ||= ucfirst($name);
6968
6969         if ($order eq $name) {
6970                 $sort_th .= "<th>$header</th>\n";
6971         } else {
6972                 $sort_th .= "<th>" .
6973                             $cgi->a({-href => href(-replay=>1, order=>$name),
6974                                      -class => "header"}, $header) .
6975                             "</th>\n";
6976         }
6977
6978         return $sort_th;
6979 }
6980
6981 sub git_project_list_rows {
6982         my ($projlist, $from, $to, $check_forks) = @_;
6983
6984         $from = 0 unless defined $from;
6985         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6986
6987         my $now = time;
6988         my $alternate = 1;
6989         for (my $i = $from; $i <= $to; $i++) {
6990                 my $pr = $projlist->[$i];
6991
6992                 if ($alternate) {
6993                         print "<tr class=\"dark\">\n";
6994                 } else {
6995                         print "<tr class=\"light\">\n";
6996                 }
6997                 $alternate ^= 1;
6998
6999                 if ($check_forks) {
7000                         print "<td>";
7001                         if ($pr->{'forks'}) {
7002                                 my $nforks = scalar @{$pr->{'forks'}};
7003                                 my $s = $nforks == 1 ? '' : 's';
7004                                 if ($nforks > 0) {
7005                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
7006                                                        -title => "$nforks fork$s"}, "+");
7007                                 } else {
7008                                         print $cgi->span({-title => "$nforks fork$s"}, "+");
7009                                 }
7010                         }
7011                         print "</td>\n";
7012                 }
7013                 my $path = $pr->{'path'};
7014                 my $dotgit = $path =~ s/\.git$// ? '.git' : '';
7015                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
7016                                         -class => "list"},
7017                                        esc_html_match_hl($path, $search_regexp).$dotgit) .
7018                       "</td>\n" .
7019                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
7020                                         -class => "list",
7021                                         -title => $pr->{'descr_long'}},
7022                                         $search_regexp
7023                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
7024                                                                     $pr->{'descr'}, $search_regexp)
7025                                         : esc_html($pr->{'descr'})) .
7026                       "</td>\n";
7027                 unless ($omit_owner) {
7028                         print "<td><i>" . ($owner_link_hook
7029                                           ? $cgi->a({-href => $owner_link_hook->($pr->{'owner'}), -class => "list"},
7030                                                     chop_and_escape_str($pr->{'owner'}, 15))
7031                                           : chop_and_escape_str($pr->{'owner'}, 15)) . "</i></td>\n";
7032                 }
7033                 unless ($omit_age_column) {
7034                         my ($age_epoch, $age_string) = ($pr->{'age_epoch'});
7035                         $age_string = defined $age_epoch ? age_string($age_epoch, $now) : "No commits";
7036                         print "<td class=\"". age_class($age_epoch, $now) . "\">" . $age_string . "</td>\n";
7037                 }
7038                 print"<td class=\"link\">" .
7039                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . $barsep .
7040                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "log") . $barsep .
7041                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
7042                       ($pr->{'forks'} ? $barsep . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
7043                       "</td>\n" .
7044                       "</tr>\n";
7045         }
7046 }
7047
7048 sub git_project_list_body {
7049         # actually uses global variable $project
7050         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action, $keep_top) = @_;
7051         my @projects = @$projlist;
7052
7053         my $check_forks = gitweb_check_feature('forks');
7054         my $show_ctags  = gitweb_check_feature('ctags');
7055         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
7056         $check_forks = undef
7057                 if ($tagfilter || $search_regexp);
7058
7059         # filtering out forks before filling info allows us to do less work
7060         if ($check_forks) {
7061                 @projects = filter_forks_from_projects_list(\@projects);
7062                 push @projects, { 'path' => "$project_filter.git" }
7063                         if $project_filter && $keep_top && is_valid_project("$project_filter.git");
7064         }
7065         # search_projects_list pre-fills required info
7066         @projects = search_projects_list(\@projects,
7067                                          'search_regexp' => $search_regexp,
7068                                          'tagfilter'  => $tagfilter)
7069                 if ($tagfilter || $search_regexp);
7070         # fill the rest
7071         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
7072         push @all_fields, 'age_epoch' unless($omit_age_column);
7073         push @all_fields, 'owner' unless($omit_owner);
7074         @projects = fill_project_list_info(\@projects, @all_fields);
7075
7076         $order ||= $default_projects_order;
7077         $from = 0 unless defined $from;
7078         $to = $#projects if (!defined $to || $#projects < $to);
7079
7080         # short circuit
7081         if ($from > $to) {
7082                 print "<center>\n".
7083                       "<b>No such projects found</b><br />\n".
7084                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
7085                       "</center>\n<br />\n";
7086                 return;
7087         }
7088
7089         @projects = sort_projects_list(\@projects, $order);
7090
7091         if ($show_ctags) {
7092                 my $ctags = git_gather_all_ctags(\@projects);
7093                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
7094                 print git_show_project_tagcloud($cloud, 64);
7095         }
7096
7097         print "<table class=\"project_list\">\n";
7098         unless ($no_header) {
7099                 print "<tr>\n";
7100                 if ($check_forks) {
7101                         print "<th></th>\n";
7102                 }
7103                 print_sort_th('project', $order, 'Project');
7104                 print_sort_th('descr', $order, 'Description');
7105                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
7106                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
7107                 print "<th></th>\n" . # for links
7108                       "</tr>\n";
7109         }
7110
7111         if ($projects_list_group_categories) {
7112                 # only display categories with projects in the $from-$to window
7113                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
7114                 my %categories = build_projlist_by_category(\@projects, $from, $to);
7115                 foreach my $cat (sort keys %categories) {
7116                         unless ($cat eq "") {
7117                                 print "<tr>\n";
7118                                 if ($check_forks) {
7119                                         print "<td></td>\n";
7120                                 }
7121                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
7122                                 print "</tr>\n";
7123                         }
7124
7125                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
7126                 }
7127         } else {
7128                 git_project_list_rows(\@projects, $from, $to, $check_forks);
7129         }
7130
7131         if (defined $extra) {
7132                 print "<tr class=\"extra\">\n";
7133                 if ($check_forks) {
7134                         print "<td></td>\n";
7135                 }
7136                 print "<td colspan=\"5\" class=\"extra\">$extra</td>\n" .
7137                       "</tr>\n";
7138         }
7139         print "</table>\n";
7140 }
7141
7142 sub git_log_body {
7143         # uses global variable $project
7144         my ($commitlist, $from, $to, $refs, $extra) = @_;
7145
7146         $from = 0 unless defined $from;
7147         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7148
7149         for (my $i = 0; $i <= $to; $i++) {
7150                 my %co = %{$commitlist->[$i]};
7151                 next if !%co;
7152                 my $commit = $co{'id'};
7153                 my $ref = format_ref_marker($refs, $commit);
7154                 git_print_header_div('commit',
7155                                "<span class=\"age\">$co{'age_string'}</span>" .
7156                                esc_html($co{'title'}),
7157                                $commit, undef, $ref);
7158                 print "<div class=\"title_text\">\n" .
7159                       "<div class=\"log_link\">\n" .
7160                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
7161                       $barsep .
7162                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
7163                       $barsep .
7164                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
7165                       "<br/>\n" .
7166                       "</div>\n";
7167                       git_print_authorship(\%co, -tag => 'span');
7168                       print "<br/>\n</div>\n";
7169
7170                 print "<div class=\"log_body\">\n";
7171                 git_print_log($co{'comment'}, -final_empty_line=> 1);
7172                 print "</div>\n";
7173         }
7174         if ($extra) {
7175                 print "<div class=\"page_nav_trailer\">\n";
7176                 print "$extra\n";
7177                 print "</div>\n";
7178         }
7179 }
7180
7181 sub git_shortlog_body {
7182         # uses global variable $project
7183         my ($commitlist, $from, $to, $refs, $extra) = @_;
7184
7185         $from = 0 unless defined $from;
7186         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7187
7188         print "<table class=\"shortlog\">\n";
7189         my $alternate = 1;
7190         for (my $i = $from; $i <= $to; $i++) {
7191                 my %co = %{$commitlist->[$i]};
7192                 my $commit = $co{'id'};
7193                 my $ref = format_ref_marker($refs, $commit);
7194                 if ($alternate) {
7195                         print "<tr class=\"dark\">\n";
7196                 } else {
7197                         print "<tr class=\"light\">\n";
7198                 }
7199                 $alternate ^= 1;
7200                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
7201                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7202                       format_author_html('td', \%co, 10) . "<td>";
7203                 print format_subject_html($co{'title'}, $co{'title_short'},
7204                                           href(action=>"commit", hash=>$commit), $ref);
7205                 print "</td>\n" .
7206                       "<td class=\"link\">" .
7207                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . $barsep .
7208                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . $barsep .
7209                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
7210                 my $snapshot_links = format_snapshot_links($commit);
7211                 if (defined $snapshot_links) {
7212                         print $barsep . $snapshot_links;
7213                 }
7214                 print "</td>\n" .
7215                       "</tr>\n";
7216         }
7217         if (defined $extra) {
7218                 print "<tr class=\"extra\">\n" .
7219                       "<td colspan=\"4\" class=\"extra\">$extra</td>\n" .
7220                       "</tr>\n";
7221         }
7222         print "</table>\n";
7223 }
7224
7225 sub git_history_body {
7226         # Warning: assumes constant type (blob or tree) during history
7227         my ($commitlist, $from, $to, $refs, $extra,
7228             $file_name, $file_hash, $ftype) = @_;
7229
7230         $from = 0 unless defined $from;
7231         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
7232
7233         print "<table class=\"history\">\n";
7234         my $alternate = 1;
7235         for (my $i = $from; $i <= $to; $i++) {
7236                 my %co = %{$commitlist->[$i]};
7237                 if (!%co) {
7238                         next;
7239                 }
7240                 my $commit = $co{'id'};
7241
7242                 my $ref = format_ref_marker($refs, $commit);
7243
7244                 if ($alternate) {
7245                         print "<tr class=\"dark\">\n";
7246                 } else {
7247                         print "<tr class=\"light\">\n";
7248                 }
7249                 $alternate ^= 1;
7250                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7251         # shortlog:   format_author_html('td', \%co, 10)
7252                       format_author_html('td', \%co, 15, 3) . "<td>";
7253                 # originally git_history used chop_str($co{'title'}, 50)
7254                 print format_subject_html($co{'title'}, $co{'title_short'},
7255                                           href(action=>"commit", hash=>$commit), $ref);
7256                 print "</td>\n" .
7257                       "<td class=\"link\">" .
7258                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . $barsep .
7259                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
7260
7261                 if ($ftype eq 'blob') {
7262                         my $blob_current = $file_hash;
7263                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
7264                         if (defined $blob_current && defined $blob_parent &&
7265                                         $blob_current ne $blob_parent) {
7266                                 print $barsep .
7267                                         $cgi->a({-href => href(action=>"blobdiff",
7268                                                                hash=>$blob_current, hash_parent=>$blob_parent,
7269                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
7270                                                                file_name=>$file_name)},
7271                                                 "diff to current");
7272                         }
7273                 }
7274                 print "</td>\n" .
7275                       "</tr>\n";
7276         }
7277         if (defined $extra) {
7278                 print "<tr class=\"extra\">\n" .
7279                       "<td colspan=\"4\" class=\"extra\">$extra</td>\n" .
7280                       "</tr>\n";
7281         }
7282         print "</table>\n";
7283 }
7284
7285 sub git_tags_body {
7286         # uses global variable $project
7287         my ($taglist, $from, $to, $extra, $head_at, $full, $order) = @_;
7288         $from = 0 unless defined $from;
7289         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
7290         $order ||= $default_refs_order;
7291
7292         print "<table class=\"tags\">\n";
7293         if ($full) {
7294                 print "<tr class=\"tags_header\">\n";
7295                 print_sort_th('age', $order, 'Last Change');
7296                 print_sort_th('name', $order, 'Name');
7297                 print "<th></th>\n" . # for comment
7298                       "<th></th>\n" . # for tag
7299                       "<th></th>\n" . # for links
7300                       "</tr>\n";
7301         }
7302         my $alternate = 1;
7303         for (my $i = $from; $i <= $to; $i++) {
7304                 my $entry = $taglist->[$i];
7305                 my %tag = %$entry;
7306                 my $comment = $tag{'subject'};
7307                 my $comment_short;
7308                 if (defined $comment) {
7309                         $comment_short = chop_str($comment, 30, 5);
7310                 }
7311                 my $curr = defined $head_at && $tag{'id'} eq $head_at;
7312                 if ($alternate) {
7313                         print "<tr class=\"dark\">\n";
7314                 } else {
7315                         print "<tr class=\"light\">\n";
7316                 }
7317                 $alternate ^= 1;
7318                 if (defined $tag{'age'}) {
7319                         print "<td><i>$tag{'age'}</i></td>\n";
7320                 } else {
7321                         print "<td></td>\n";
7322                 }
7323                 print(($curr ? "<td class=\"current_head\">" : "<td>") .
7324                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
7325                                -class => "list name"}, esc_html($tag{'name'})) .
7326                       "</td>\n" .
7327                       "<td>");
7328                 if (defined $comment) {
7329                         print format_subject_html($comment, $comment_short,
7330                                                   href(action=>"tag", hash=>$tag{'id'}));
7331                 }
7332                 print "</td>\n" .
7333                       "<td class=\"selflink\">";
7334                 if ($tag{'type'} eq "tag") {
7335                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
7336                 } else {
7337                         print "&#160;";
7338                 }
7339                 print "</td>\n" .
7340                       "<td class=\"link\">" . $barsep .
7341                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
7342                 if ($tag{'reftype'} eq "commit") {
7343                         print $barsep . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "log");
7344                         print $barsep . $cgi->a({-href => href(action=>"tree", hash=>$tag{'fullname'})}, "tree") if $full;
7345                 } elsif ($tag{'reftype'} eq "blob") {
7346                         print $barsep . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
7347                 }
7348                 print "</td>\n" .
7349                       "</tr>";
7350         }
7351         if (defined $extra) {
7352                 print "<tr class=\"extra\">\n" .
7353                       "<td colspan=\"5\" class=\"extra\">$extra</td>\n" .
7354                       "</tr>\n";
7355         }
7356         print "</table>\n";
7357 }
7358
7359 sub git_heads_body {
7360         # uses global variable $project
7361         my ($headlist, $head_at, $from, $to, $extra) = @_;
7362         $from = 0 unless defined $from;
7363         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
7364
7365         print "<table class=\"heads\">\n";
7366         my $alternate = 1;
7367         for (my $i = $from; $i <= $to; $i++) {
7368                 my $entry = $headlist->[$i];
7369                 my %ref = %$entry;
7370                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
7371                 if ($alternate) {
7372                         print "<tr class=\"dark\">\n";
7373                 } else {
7374                         print "<tr class=\"light\">\n";
7375                 }
7376                 $alternate ^= 1;
7377                 print "<td><i>$ref{'age'}</i></td>\n" .
7378                       ($curr ? "<td class=\"current_head\">" : "<td>") .
7379                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
7380                                -class => "list name"},esc_html($ref{'name'})) .
7381                       "</td>\n" .
7382                       "<td class=\"link\">" .
7383                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "log") . $barsep .
7384                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
7385                       "</td>\n" .
7386                       "</tr>";
7387         }
7388         if (defined $extra) {
7389                 print "<tr class=\"extra\">\n" .
7390                       "<td colspan=\"3\" class=\"extra\">$extra</td>\n" .
7391                       "</tr>\n";
7392         }
7393         print "</table>\n";
7394 }
7395
7396 # Display a single remote block
7397 sub git_remote_block {
7398         my ($remote, $rdata, $limit, $head) = @_;
7399
7400         my $heads = $rdata->{'heads'};
7401         my $fetch = $rdata->{'fetch'};
7402         my $push = $rdata->{'push'};
7403
7404         my $urls_table = "<table class=\"projects_list\">\n" ;
7405
7406         if (defined $fetch) {
7407                 if ($fetch eq $push) {
7408                         $urls_table .= format_repo_url("URL", $fetch);
7409                 } else {
7410                         $urls_table .= format_repo_url("Fetch&#160;URL", $fetch);
7411                         $urls_table .= format_repo_url("Push&#160;URL", $push) if defined $push;
7412                 }
7413         } elsif (defined $push) {
7414                 $urls_table .= format_repo_url("Push&#160;URL", $push);
7415         } else {
7416                 $urls_table .= format_repo_url("", "No remote URL");
7417         }
7418
7419         $urls_table .= "</table>\n";
7420
7421         my $dots;
7422         if (defined $limit && $limit < @$heads) {
7423                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
7424         }
7425
7426         print $urls_table;
7427         git_heads_body($heads, $head, 0, $limit, $dots);
7428 }
7429
7430 # Display a list of remote names with the respective fetch and push URLs
7431 sub git_remotes_list {
7432         my ($remotedata, $limit) = @_;
7433         print "<table class=\"heads\">\n";
7434         my $alternate = 1;
7435         my @remotes = sort keys %$remotedata;
7436
7437         my $limited = $limit && $limit < @remotes;
7438
7439         $#remotes = $limit - 1 if $limited;
7440
7441         while (my $remote = shift @remotes) {
7442                 my $rdata = $remotedata->{$remote};
7443                 my $fetch = $rdata->{'fetch'};
7444                 my $push = $rdata->{'push'};
7445                 if ($alternate) {
7446                         print "<tr class=\"dark\">\n";
7447                 } else {
7448                         print "<tr class=\"light\">\n";
7449                 }
7450                 $alternate ^= 1;
7451                 print "<td>" .
7452                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
7453                                -class=> "list name"},esc_html($remote)) .
7454                       "</td>";
7455                 print "<td class=\"link\">" .
7456                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
7457                       $barsep .
7458                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
7459                       "</td>";
7460
7461                 print "</tr>\n";
7462         }
7463
7464         if ($limited) {
7465                 print "<tr>\n" .
7466                       "<td colspan=\"3\">" .
7467                       $cgi->a({-href => href(action=>"remotes")}, "...") .
7468                       "</td>\n" . "</tr>\n";
7469         }
7470
7471         print "</table>";
7472 }
7473
7474 # Display remote heads grouped by remote, unless there are too many
7475 # remotes, in which case we only display the remote names
7476 sub git_remotes_body {
7477         my ($remotedata, $limit, $head) = @_;
7478         if ($limit and $limit < keys %$remotedata) {
7479                 git_remotes_list($remotedata, $limit);
7480         } else {
7481                 fill_remote_heads($remotedata);
7482                 while (my ($remote, $rdata) = each %$remotedata) {
7483                         git_print_section({-class=>"remote", -id=>$remote},
7484                                 ["remotes", $remote, $remote], sub {
7485                                         git_remote_block($remote, $rdata, $limit, $head);
7486                                 });
7487                 }
7488         }
7489 }
7490
7491 sub git_search_message {
7492         my %co = @_;
7493
7494         my $greptype;
7495         if ($searchtype eq 'commit') {
7496                 $greptype = "--grep=";
7497         } elsif ($searchtype eq 'author') {
7498                 $greptype = "--author=";
7499         } elsif ($searchtype eq 'committer') {
7500                 $greptype = "--committer=";
7501         }
7502         $greptype .= $searchtext;
7503         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
7504                                        $greptype, '--regexp-ignore-case',
7505                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
7506
7507         my $paging_nav = "<span class=\"paging_nav\">";
7508         if ($page > 0) {
7509                 $paging_nav .= tabspan(
7510                         $cgi->a({-href => href(-replay=>1, page=>undef)},
7511                                 "first")) .
7512                         $mdotsep . tabspan(
7513                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
7514                                  -accesskey => "p", -title => "Alt-p"}, "prev"));
7515         } else {
7516                 $paging_nav .= tabspan("first", 1, 0).${mdotsep}.tabspan("prev", 0, 1);
7517         }
7518         my $next_link = '';
7519         if ($#commitlist >= 100) {
7520                 $next_link = tabspan(
7521                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7522                                  -accesskey => "n", -title => "Alt-n"}, "next"));
7523                 $paging_nav .= "${mdotsep}$next_link";
7524         } else {
7525                 $paging_nav .= ${mdotsep}.tabspan("next", 0, 1);
7526         }
7527
7528         git_header_html();
7529
7530         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav."</span>");
7531         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7532         if ($page == 0 && !@commitlist) {
7533                 print "<p>No match.</p>\n";
7534         } else {
7535                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
7536         }
7537
7538         git_footer_html();
7539 }
7540
7541 sub git_search_changes {
7542         my %co = @_;
7543
7544         local $/ = "\n";
7545         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
7546                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
7547                 ($search_use_regexp ? '--pickaxe-regex' : ()))
7548                         or die_error(500, "Open git-log failed");
7549
7550         git_header_html();
7551
7552         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7553         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7554
7555         print "<table class=\"pickaxe search\">\n";
7556         my $alternate = 1;
7557         undef %co;
7558         my @files;
7559         while (my $line = to_utf8(scalar <$fd>)) {
7560                 chomp $line;
7561                 next unless $line;
7562
7563                 my %set = parse_difftree_raw_line($line);
7564                 if (defined $set{'commit'}) {
7565                         # finish previous commit
7566                         if (%co) {
7567                                 print "</td>\n" .
7568                                       "<td class=\"link\">" .
7569                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7570                                               "commit") .
7571                                       $barsep .
7572                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7573                                                              hash_base=>$co{'id'})},
7574                                               "tree") .
7575                                       "</td>\n" .
7576                                       "</tr>\n";
7577                         }
7578
7579                         if ($alternate) {
7580                                 print "<tr class=\"dark\">\n";
7581                         } else {
7582                                 print "<tr class=\"light\">\n";
7583                         }
7584                         $alternate ^= 1;
7585                         %co = parse_commit($set{'commit'});
7586                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
7587                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7588                               "<td><i>$author</i></td>\n" .
7589                               "<td>" .
7590                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7591                                       -class => "list subject"},
7592                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
7593                 } elsif (defined $set{'to_id'}) {
7594                         next if ($set{'to_id'} =~ m/^0{40}$/);
7595
7596                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
7597                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
7598                                       -class => "list"},
7599                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
7600                               "<br/>\n";
7601                 }
7602         }
7603         close $fd;
7604
7605         # finish last commit (warning: repetition!)
7606         if (%co) {
7607                 print "</td>\n" .
7608                       "<td class=\"link\">" .
7609                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7610                               "commit") .
7611                       $barsep .
7612                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7613                                              hash_base=>$co{'id'})},
7614                               "tree") .
7615                       "</td>\n" .
7616                       "</tr>\n";
7617         }
7618
7619         print "</table>\n";
7620
7621         git_footer_html();
7622 }
7623
7624 sub git_search_files {
7625         my %co = @_;
7626
7627         local $/ = "\n";
7628         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
7629                 $search_use_regexp ? ('-E', '-i') : '-F',
7630                 $searchtext, $co{'tree'})
7631                         or die_error(500, "Open git-grep failed");
7632
7633         git_header_html();
7634
7635         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7636         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7637
7638         print "<table class=\"grep_search\">\n";
7639         my $alternate = 1;
7640         my $matches = 0;
7641         my $lastfile = '';
7642         my $file_href;
7643         while (my $line = to_utf8(scalar <$fd>)) {
7644                 chomp $line;
7645                 my ($file, $lno, $ltext, $binary);
7646                 last if ($matches++ > 1000);
7647                 if ($line =~ /^Binary file (.+) matches$/) {
7648                         $file = $1;
7649                         $binary = 1;
7650                 } else {
7651                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
7652                         $file =~ s/^$co{'tree'}://;
7653                 }
7654                 if ($file ne $lastfile) {
7655                         $lastfile and print "</td></tr>\n";
7656                         if ($alternate++) {
7657                                 print "<tr class=\"dark\">\n";
7658                         } else {
7659                                 print "<tr class=\"light\">\n";
7660                         }
7661                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
7662                                           file_name=>$file);
7663                         print "<td class=\"list\">".
7664                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
7665                         print "</td><td>\n";
7666                         $lastfile = $file;
7667                 }
7668                 if ($binary) {
7669                         print "<div class=\"binary\">Binary file</div>\n";
7670                 } else {
7671                         $ltext = untabify($ltext);
7672                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
7673                                 $ltext = esc_html($1, -nbsp=>1);
7674                                 $ltext .= '<span class="match">';
7675                                 $ltext .= esc_html($2, -nbsp=>1);
7676                                 $ltext .= '</span>';
7677                                 $ltext .= esc_html($3, -nbsp=>1);
7678                         } else {
7679                                 $ltext = esc_html($ltext, -nbsp=>1);
7680                         }
7681                         print "<div class=\"pre\">" .
7682                                 $cgi->a({-href => $file_href.'#l'.$lno,
7683                                         -class => "linenr"}, sprintf('%4i ', $lno)) .
7684                                 $ltext . "</div>\n";
7685                 }
7686         }
7687         if ($lastfile) {
7688                 print "</td></tr>\n";
7689                 if ($matches > 1000) {
7690                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
7691                 }
7692         } else {
7693                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
7694         }
7695         close $fd;
7696
7697         print "</table>\n";
7698
7699         git_footer_html();
7700 }
7701
7702 sub git_search_grep_body {
7703         my ($commitlist, $from, $to, $extra) = @_;
7704         $from = 0 unless defined $from;
7705         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7706
7707         print "<table class=\"commit_search\">\n";
7708         my $alternate = 1;
7709         for (my $i = $from; $i <= $to; $i++) {
7710                 my %co = %{$commitlist->[$i]};
7711                 if (!%co) {
7712                         next;
7713                 }
7714                 my $commit = $co{'id'};
7715                 if ($alternate) {
7716                         print "<tr class=\"dark\">\n";
7717                 } else {
7718                         print "<tr class=\"light\">\n";
7719                 }
7720                 $alternate ^= 1;
7721                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7722                       format_author_html('td', \%co, 15, 5) .
7723                       "<td>" .
7724                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7725                                -class => "list subject"},
7726                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
7727                 my $comment = $co{'comment'};
7728                 foreach my $line (@$comment) {
7729                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
7730                                 my ($lead, $match, $trail) = ($1, $2, $3);
7731                                 $match = chop_str($match, 70, 5, 'center');
7732                                 my $contextlen = int((80 - length($match))/2);
7733                                 $contextlen = 30 if ($contextlen > 30);
7734                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
7735                                 $trail = chop_str($trail, $contextlen, 10, 'right');
7736
7737                                 $lead  = esc_html($lead);
7738                                 $match = esc_html($match);
7739                                 $trail = esc_html($trail);
7740
7741                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
7742                         }
7743                 }
7744                 print "</td>\n" .
7745                       "<td class=\"link\">" .
7746                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7747                       $barsep .
7748                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7749                       $barsep .
7750                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7751                 print "</td>\n" .
7752                       "</tr>\n";
7753         }
7754         if (defined $extra) {
7755                 print "<tr class=\"extra\">\n" .
7756                       "<td colspan=\"3\" class=\"extra\">$extra</td>\n" .
7757                       "</tr>\n";
7758         }
7759         print "</table>\n";
7760 }
7761
7762 ## ======================================================================
7763 ## ======================================================================
7764 ## actions
7765
7766 sub git_project_list_load {
7767         my $empty_list_ok = shift;
7768         my $order = $input_params{'order'};
7769         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7770                 die_error(400, "Unknown order parameter");
7771         }
7772
7773         my @list = git_get_projects_list($project_filter, $strict_export);
7774         if ($project_filter && (!@list || !gitweb_check_feature('forks'))) {
7775                 push @list, { 'path' => "$project_filter.git" }
7776                         if is_valid_project("$project_filter.git");
7777         }
7778         if (!@list) {
7779                 die_error(404, "No projects found") unless $empty_list_ok;
7780         }
7781
7782         return (\@list, $order);
7783 }
7784
7785 sub git_frontpage {
7786         my ($projlist, $order);
7787
7788         if ($frontpage_no_project_list) {
7789                 $project = undef;
7790                 $project_filter = undef;
7791         } else {
7792                 ($projlist, $order) = git_project_list_load(1);
7793         }
7794         git_header_html();
7795         if (defined $home_text && -f $home_text) {
7796                 print "<div class=\"index_include\">\n";
7797                 insert_file($home_text);
7798                 print "</div>\n";
7799         }
7800         git_project_search_form($searchtext, $search_use_regexp);
7801         if ($frontpage_no_project_list) {
7802                 my $show_ctags = gitweb_check_feature('ctags');
7803                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7804                         my @projects = git_get_projects_list($project_filter, $strict_export);
7805                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7806                         @projects = fill_project_list_info(\@projects, 'ctags');
7807                         my $ctags = git_gather_all_ctags(\@projects);
7808                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7809                         print git_show_project_tagcloud($cloud, 64);
7810                 }
7811         } else {
7812                 git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7813         }
7814         git_footer_html();
7815 }
7816
7817 sub git_project_list {
7818         my ($projlist, $order) = git_project_list_load();
7819         git_header_html();
7820         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7821                 print "<div class=\"index_include\">\n";
7822                 insert_file($home_text);
7823                 print "</div>\n";
7824         }
7825         git_project_search_form();
7826         git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7827         git_footer_html();
7828 }
7829
7830 sub git_forks {
7831         my $order = $input_params{'order'};
7832         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7833                 die_error(400, "Unknown order parameter");
7834         }
7835
7836         my $filter = $project;
7837         $filter =~ s/\.git$//;
7838         my @list = git_get_projects_list($filter);
7839         if (!@list) {
7840                 die_error(404, "No forks found");
7841         }
7842
7843         git_header_html();
7844         git_print_page_nav('','');
7845         git_print_header_div('summary', "$project forks");
7846         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7847         git_footer_html();
7848 }
7849
7850 sub git_project_index {
7851         my @projects = git_get_projects_list($project_filter, $strict_export);
7852         if (!@projects) {
7853                 die_error(404, "No projects found");
7854         }
7855
7856         print $cgi->header(
7857                 -type => 'text/plain',
7858                 -charset => 'utf-8',
7859                 -content_disposition => 'inline; filename="index.aux"');
7860
7861         foreach my $pr (@projects) {
7862                 if (!exists $pr->{'owner'}) {
7863                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7864                 }
7865
7866                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7867                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7868                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7869                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7870                 $path  =~ s/ /\+/g;
7871                 $owner =~ s/ /\+/g;
7872
7873                 print "$path $owner\n";
7874         }
7875 }
7876
7877 sub git_summary {
7878         my $descr = git_get_project_description($project) || "none";
7879         my %co = parse_commit("HEAD");
7880         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7881         my $head = $co{'id'};
7882         my $remote_heads = gitweb_check_feature('remote_heads');
7883
7884         my $owner = git_get_project_owner($project);
7885         my $homepage = git_get_project_config('homepage');
7886         my $base_url = git_get_project_config('baseurl');
7887
7888         my $refs = git_get_references();
7889         # These get_*_list functions return one more to allow us to see if
7890         # there are more ...
7891         my @taglist  = git_get_tags_list(16);
7892         my @headlist = git_get_heads_list(16);
7893         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7894         my @forklist;
7895         my $check_forks = gitweb_check_feature('forks');
7896
7897         if ($check_forks) {
7898                 # find forks of a project
7899                 my $filter = $project;
7900                 $filter =~ s/\.git$//;
7901                 @forklist = git_get_projects_list($filter);
7902                 # filter out forks of forks
7903                 @forklist = filter_forks_from_projects_list(\@forklist)
7904                         if (@forklist);
7905         }
7906
7907         git_header_html();
7908         git_print_page_nav('summary','', $head);
7909
7910         if ($check_forks and $project =~ m#/#) {
7911                 my $xproject = $project; $xproject =~ s#/[^/]+$#.git#; #
7912                 if (is_valid_project($xproject) && -f "$projectroot/$project/objects/info/alternates" && -s _) {
7913                         my $r = $cgi->a({-href=> href(project => $xproject, action => 'summary')}, $xproject);
7914                         print <<EOT;
7915 <div class="forkinfo">
7916 This project is a fork of the $r project. If you have that one
7917 already cloned locally, you can use
7918 <pre>git clone --reference /path/to/your/$xproject/incarnation mirror_URL</pre>
7919 to save bandwidth during cloning.
7920 </div>
7921 EOT
7922                 }
7923         }
7924
7925         print "<div class=\"title\">&#160;</div>\n";
7926         print "<table class=\"projects_list\">\n" .
7927               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7928         if ($homepage) {
7929                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7930         }
7931         if ($base_url) {
7932                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7933         }
7934         if ($owner and not $omit_owner) {
7935                 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . ($owner_link_hook
7936                         ? $cgi->a({-href => $owner_link_hook->($owner)}, email_obfuscate($owner))
7937                         : email_obfuscate($owner)) . "</td></tr>\n";
7938         }
7939         if (defined $cd{'rfc2822'}) {
7940                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7941                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7942         }
7943         print format_lastrefresh_row(), "\n";
7944
7945         # use per project git URL list in $projectroot/$project/cloneurl
7946         # or make project git URL from git base URL and project name
7947         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7948         my $url_class = "metadata_url";
7949         my @url_list = git_get_project_url_list($project);
7950         unless (@url_list) {
7951                 @url_list = @git_base_url_list;
7952                 if ((git_get_project_config("showpush", '--bool')||'false') eq "true" ||
7953                     -f "$projectroot/$project/.nofetch") {
7954                         my $pushidx = @url_list;
7955                         foreach (@git_base_push_urls) {
7956                                 if ($https_hint_html && !ref($_) && $_ =~ /^https:/i) {
7957                                         push(@url_list, [$_, $https_hint_html]);
7958                                 } else {
7959                                         push(@url_list, $_);
7960                                 }
7961                         }
7962                         if ($#url_list >= $pushidx) {
7963                                 my $pushtag = "push&#160;URL";
7964                                 my $classtag = "metadata_pushurl";
7965                                 if (ref($url_list[$pushidx])) {
7966                                         $url_list[$pushidx] = [
7967                                                 ${$url_list[$pushidx]}[0],
7968                                                 ${$url_list[$pushidx]}[1],
7969                                                 $pushtag,
7970                                                 $classtag];
7971                                 } else {
7972                                         $url_list[$pushidx] = [
7973                                                 $url_list[$pushidx],
7974                                                 undef,
7975                                                 $pushtag,
7976                                                 $classtag];
7977                                 }
7978                         }
7979                 } else {
7980                         push(@url_list, @git_base_mirror_urls);
7981                 }
7982                 for (my $i=0; $i<=$#url_list; ++$i) {
7983                         if (ref($url_list[$i])) {
7984                                 $url_list[$i] = [
7985                                         ${$url_list[$i]}[0] . "/$project",
7986                                         ${$url_list[$i]}[1],
7987                                         ${$url_list[$i]}[2],
7988                                         ${$url_list[$i]}[3]];
7989                         } else {
7990                                 $url_list[$i] .= "/$project";
7991                         }
7992                 }
7993         }
7994         foreach (@url_list) {
7995                 next unless $_;
7996                 my $git_url;
7997                 my $html_hint = "";
7998                 my $next_tag = undef;
7999                 my $next_class = undef;
8000                 if (ref($_)) {
8001                         $git_url = $$_[0];
8002                         $html_hint = "&#160;" . $$_[1] if defined($$_[1]);
8003                         $next_tag = $$_[2];
8004                         $next_class = $$_[3];
8005                 } else {
8006                         $git_url = $_;
8007                 }
8008                 next unless $git_url;
8009                 $url_class = $next_class if $next_class;
8010                 $url_tag = $next_tag if $next_tag;
8011                 print "<tr class=\"$url_class\"><td>$url_tag</td><td>$git_url$html_hint</td></tr>\n";
8012                 $url_tag = "";
8013         }
8014
8015         if (defined($git_base_bundles_url) && -d "$projectroot/$project/bundles") {
8016                 my $projname = $project;
8017                 $projname =~ s|^.*/||;
8018                 my $url = "$git_base_bundles_url/$project/bundles";
8019                 print format_repo_url(
8020                         "bundle&#160;info",
8021                         "<a rel='nofollow' href='$url'>$projname downloadable bundles</a>");
8022         }
8023
8024         # Tag cloud
8025         my $show_ctags = gitweb_check_feature('ctags');
8026         if ($show_ctags) {
8027                 my $ctags = git_get_project_ctags($project);
8028                 if (%$ctags || $show_ctags !~ /^\d+$/) {
8029                         # without ability to add tags, don't show if there are none
8030                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
8031                         print "<tr id=\"metadata_ctags\">" .
8032                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
8033                         print "</td>\n<td>" unless %$ctags;
8034                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
8035                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
8036                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
8037                               unless $show_ctags =~ /^\d+$/;
8038                         print "</td>\n<td>" if %$ctags;
8039                         print git_show_project_tagcloud($cloud, 48)."</td>" .
8040                               "</tr>\n";
8041                 }
8042         }
8043
8044         print "</table>\n";
8045
8046         # If XSS prevention is on, we don't include README.html.
8047         # TODO: Allow a readme in some safe format.
8048         if (!$prevent_xss) {
8049                 my $readme_name = "readme";
8050                 my $readme;
8051                 if (-s "$projectroot/$project/README.html") {
8052                         $readme = collect_html_file("$projectroot/$project/README.html");
8053                 } else {
8054                         $readme = collect_output($git_automatic_readme_html, "$projectroot/$project");
8055                         if ($readme && $readme =~ /^<!-- README NAME: ((?:[^-]|(?:-(?!-)))+) -->/) {
8056                                 $readme_name = $1;
8057                                 $readme =~ s/^<!--(?:[^-]|(?:-(?!-)))*-->\n?//;
8058                         }
8059                 }
8060                 if (defined($readme)) {
8061                         $readme =~ s/^\s+//s;
8062                         $readme =~ s/\s+$//s;
8063                         print "<div class=\"title\">$readme_name</div>\n",
8064                               "<div id=\"readme\" class=\"readme\">\n",
8065                               $readme,
8066                               "\n</div>\n"
8067                         if $readme ne '';
8068                 }
8069         }
8070
8071         # we need to request one more than 16 (0..15) to check if
8072         # those 16 are all
8073         my @commitlist = $head ? parse_commits($head, 17) : ();
8074         if (@commitlist) {
8075                 git_print_header_div('shortlog');
8076                 git_shortlog_body(\@commitlist, 0, 15, $refs,
8077                                   $#commitlist <=  15 ? undef :
8078                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
8079         }
8080
8081         if (@taglist) {
8082                 git_print_header_div('tags');
8083                 git_tags_body(\@taglist, 0, 15,
8084                               $#taglist <=  15 ? undef :
8085                               $cgi->a({-href => href(action=>"tags")}, "..."));
8086         }
8087
8088         if (@headlist) {
8089                 git_print_header_div('heads');
8090                 git_heads_body(\@headlist, $head, 0, 15,
8091                                $#headlist <= 15 ? undef :
8092                                $cgi->a({-href => href(action=>"heads")}, "..."));
8093         }
8094
8095         if (%remotedata) {
8096                 git_print_header_div('remotes');
8097                 git_remotes_body(\%remotedata, 15, $head);
8098         }
8099
8100         if (@forklist) {
8101                 git_print_header_div('forks');
8102                 git_project_list_body(\@forklist, 'age', 0, 15,
8103                                       $#forklist <= 15 ? undef :
8104                                       $cgi->a({-href => href(action=>"forks")}, "..."),
8105                                       'no_header', 'forks');
8106         }
8107
8108         git_footer_html();
8109 }
8110
8111 sub git_tag {
8112         my %tag = parse_tag($hash);
8113
8114         if (! %tag) {
8115                 die_error(404, "Unknown tag object");
8116         }
8117
8118         my $fullhash;
8119         $fullhash = $hash if $hash =~ m/^[0-9a-fA-F]{40}$/;
8120         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8121
8122         my $obj = $tag{'object'};
8123         git_header_html();
8124         if ($tag{'type'} eq 'commit') {
8125                 git_print_page_nav('','', $obj,undef,$obj);
8126                 git_print_header_div('commit', esc_html($tag{'name'}), $hash);
8127         } else {
8128                 if ($tag{'type'} eq 'tree') {
8129                         git_print_page_nav('',['commit','commitdiff'], undef,undef,$obj);
8130                 } else {
8131                         git_print_page_nav('',['commit','commitdiff','tree'], undef,undef,undef);
8132                 }
8133                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8134         }
8135         print "<div class=\"title_text\">\n" .
8136               "<table class=\"object_header\">\n" .
8137               "<tr><td>tag</td><td class=\"sha1\">$fullhash</td></tr>\n" .
8138               "<tr>\n" .
8139               "<td>object</td>\n" .
8140               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
8141                                $tag{'object'}) . "</td>\n" .
8142               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
8143                                               $tag{'type'}) . "</td>\n" .
8144               "</tr>\n";
8145         if (defined($tag{'author'})) {
8146                 git_print_authorship_rows(\%tag, 'author');
8147         }
8148         print "</table>\n\n" .
8149               "</div>\n";
8150         print "<div class=\"page_body\">";
8151         my $comment = $tag{'comment'};
8152         foreach my $line (@$comment) {
8153                 chomp $line;
8154                 print esc_html($line, -nbsp=>1) . "<br/>\n";
8155         }
8156         print "</div>\n";
8157         git_footer_html();
8158 }
8159
8160 sub git_blame_common {
8161         my $format = shift || 'porcelain';
8162         if ($format eq 'porcelain' && $input_params{'javascript'}) {
8163                 $format = 'incremental';
8164                 $action = 'blame_incremental'; # for page title etc
8165         }
8166
8167         # permissions
8168         gitweb_check_feature('blame')
8169                 or die_error(403, "Blame view not allowed");
8170
8171         # error checking
8172         die_error(400, "No file name given") unless $file_name;
8173         $hash_base ||= git_get_head_hash($project);
8174         die_error(404, "Couldn't find base commit") unless $hash_base;
8175         my %co = parse_commit($hash_base)
8176                 or die_error(404, "Commit not found");
8177         my $ftype = "blob";
8178         if (!defined $hash) {
8179                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
8180                         or die_error(404, "Error looking up file");
8181         } else {
8182                 $ftype = git_get_type($hash);
8183                 if ($ftype !~ "blob") {
8184                         die_error(400, "Object is not a blob");
8185                 }
8186         }
8187
8188         my $fd;
8189         if ($format eq 'incremental') {
8190                 # get file contents (as base)
8191                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
8192                         or die_error(500, "Open git-cat-file failed");
8193         } elsif ($format eq 'data') {
8194                 # run git-blame --incremental
8195                 defined($fd = git_cmd_pipe "blame", "--incremental",
8196                         $hash_base, "--", $file_name)
8197                         or die_error(500, "Open git-blame --incremental failed");
8198         } else {
8199                 # run git-blame --porcelain
8200                 defined($fd = git_cmd_pipe "blame", '-p',
8201                         $hash_base, '--', $file_name)
8202                         or die_error(500, "Open git-blame --porcelain failed");
8203         }
8204
8205         # incremental blame data returns early
8206         if ($format eq 'data') {
8207                 print $cgi->header(
8208                         -type=>"text/plain", -charset => "utf-8",
8209                         -status=> "200 OK");
8210                 local $| = 1; # output autoflush
8211                 while (<$fd>) {
8212                         print to_utf8($_);
8213                 }
8214                 close $fd
8215                         or print "ERROR $!\n";
8216
8217                 print 'END';
8218                 if (defined $t0 && gitweb_check_feature('timed')) {
8219                         print ' '.
8220                               tv_interval($t0, [ gettimeofday() ]).
8221                               ' '.$number_of_git_cmds;
8222                 }
8223                 print "\n";
8224
8225                 return;
8226         }
8227
8228         # page header
8229         git_header_html();
8230         my $formats_nav = tabspan(
8231                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
8232                         "blob"));
8233         $formats_nav .=
8234                 $barsep . tabspan(
8235                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8236                         "history")) .
8237                 $barsep . tabspan(
8238                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
8239                         "HEAD"));
8240         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8241         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8242         git_print_page_path($file_name, $ftype, $hash_base);
8243
8244         # page body
8245         if ($format eq 'incremental') {
8246                 print "<noscript>\n<div class=\"error\"><center><b>\n".
8247                       "This page requires JavaScript to run.\n Use ".
8248                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
8249                               'this page').
8250                       " instead.\n".
8251                       "</b></center></div>\n</noscript>\n";
8252
8253                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
8254         }
8255
8256         print qq!<div class="page_body">\n!;
8257         print qq!<div id="progress_info">...&#160;/&#160;...</div>\n!
8258                 if ($format eq 'incremental');
8259         print qq!<table id="blame_table" class="blame" width="100%">\n!.
8260               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
8261               qq!<thead>\n!.
8262               qq!<tr><th nowrap="nowrap" style="white-space:nowrap">!.
8263               qq!Commit&#160;<a href="javascript:extra_blame_columns()" id="columns_expander" !.
8264               qq!title="toggles blame author information display">[+]</a></th>!.
8265               qq!<th class="extra_column">Author</th><th class="extra_column">Date</th>!.
8266               qq!<th>Line</th><th width="100%">Data</th></tr>\n!.
8267               qq!</thead>\n!.
8268               qq!<tbody>\n!;
8269
8270         my @rev_color = qw(light dark);
8271         my $num_colors = scalar(@rev_color);
8272         my $current_color = 0;
8273
8274         if ($format eq 'incremental') {
8275                 my $color_class = $rev_color[$current_color];
8276
8277                 #contents of a file
8278                 my $linenr = 0;
8279         LINE:
8280                 while (my $line = to_utf8(scalar <$fd>)) {
8281                         chomp $line;
8282                         $linenr++;
8283
8284                         print qq!<tr id="l$linenr" class="$color_class">!.
8285                               qq!<td class="sha1"><a href=""> </a></td>!.
8286                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8287                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8288                               qq!<td class="linenr">!.
8289                               qq!<a class="linenr" href="">$linenr</a></td>!;
8290                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
8291                         print qq!</tr>\n!;
8292                 }
8293
8294         } else { # porcelain, i.e. ordinary blame
8295                 my %metainfo = (); # saves information about commits
8296
8297                 # blame data
8298         LINE:
8299                 while (my $line = to_utf8(scalar <$fd>)) {
8300                         chomp $line;
8301                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
8302                         # no <lines in group> for subsequent lines in group of lines
8303                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
8304                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
8305                         if (!exists $metainfo{$full_rev}) {
8306                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
8307                         }
8308                         my $meta = $metainfo{$full_rev};
8309                         my $data;
8310                         while ($data = to_utf8(scalar <$fd>)) {
8311                                 chomp $data;
8312                                 last if ($data =~ s/^\t//); # contents of line
8313                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
8314                                         $meta->{$1} = $2 unless exists $meta->{$1};
8315                                 }
8316                                 if ($data =~ /^previous /) {
8317                                         $meta->{'nprevious'}++;
8318                                 }
8319                         }
8320                         my $short_rev = substr($full_rev, 0, 8);
8321                         my $author = $meta->{'author'};
8322                         my %date =
8323                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
8324                         my $date = $date{'iso-tz'};
8325                         if ($group_size) {
8326                                 $current_color = ($current_color + 1) % $num_colors;
8327                         }
8328                         my $tr_class = $rev_color[$current_color];
8329                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
8330                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
8331                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
8332                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
8333                         if ($group_size) {
8334                                 my $rowspan = $group_size > 1 ? " rowspan=\"$group_size\"" : "";
8335                                 print "<td class=\"sha1\"";
8336                                 print " title=\"". esc_html($author) . ", $date\"";
8337                                 print "$rowspan>";
8338                                 print $cgi->a({-href => href(action=>"commit",
8339                                                              hash=>$full_rev,
8340                                                              file_name=>$file_name)},
8341                                               esc_html($short_rev));
8342                                 if ($group_size >= 2) {
8343                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
8344                                         if (@author_initials) {
8345                                                 print "<br />" .
8346                                                       esc_html(join('', @author_initials));
8347                                                 #           or join('.', ...)
8348                                         }
8349                                 }
8350                                 print "</td>\n";
8351                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". esc_html($author) . "</td>";
8352                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". $date . "</td>";
8353                         }
8354                         # 'previous' <sha1 of parent commit> <filename at commit>
8355                         if (exists $meta->{'previous'} &&
8356                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
8357                                 $meta->{'parent'} = $1;
8358                                 $meta->{'file_parent'} = unquote($2);
8359                         }
8360                         my $linenr_commit =
8361                                 exists($meta->{'parent'}) ?
8362                                 $meta->{'parent'} : $full_rev;
8363                         my $linenr_filename =
8364                                 exists($meta->{'file_parent'}) ?
8365                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
8366                         my $blamed = href(action => 'blame',
8367                                           file_name => $linenr_filename,
8368                                           hash_base => $linenr_commit);
8369                         print "<td class=\"linenr\">";
8370                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
8371                                         -class => "linenr" },
8372                                       esc_html($lineno));
8373                         print "</td>";
8374                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
8375                         print "</tr>\n";
8376                 } # end while
8377
8378         }
8379
8380         # footer
8381         print "</tbody>\n".
8382               "</table>\n"; # class="blame"
8383         print "</div>\n";   # class="blame_body"
8384         close $fd
8385                 or print "Reading blob failed\n";
8386
8387         git_footer_html();
8388 }
8389
8390 sub git_blame {
8391         git_blame_common();
8392 }
8393
8394 sub git_blame_incremental {
8395         git_blame_common('incremental');
8396 }
8397
8398 sub git_blame_data {
8399         git_blame_common('data');
8400 }
8401
8402 sub git_tags {
8403         my $head = git_get_head_hash($project);
8404         git_header_html();
8405         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
8406         git_print_header_div('summary', $project);
8407
8408         my @tagslist = git_get_tags_list();
8409         if (@tagslist) {
8410                 git_tags_body(\@tagslist);
8411         }
8412         git_footer_html();
8413 }
8414
8415 sub git_refs {
8416         my $order = $input_params{'order'};
8417         if (defined $order && $order !~ m/age|name/) {
8418                 die_error(400, "Unknown order parameter");
8419         }
8420
8421         my $head = git_get_head_hash($project);
8422         git_header_html();
8423         git_print_page_nav('','', $head,undef,$head,format_ref_views('refs'));
8424         git_print_header_div('summary', $project);
8425
8426         my @refslist = git_get_tags_list(undef, 1, $order);
8427         if (@refslist) {
8428                 git_tags_body(\@refslist, undef, undef, undef, $head, 1, $order);
8429         }
8430         git_footer_html();
8431 }
8432
8433 sub git_heads {
8434         my $head = git_get_head_hash($project);
8435         git_header_html();
8436         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
8437         git_print_header_div('summary', $project);
8438
8439         my @headslist = git_get_heads_list();
8440         if (@headslist) {
8441                 git_heads_body(\@headslist, $head);
8442         }
8443         git_footer_html();
8444 }
8445
8446 # used both for single remote view and for list of all the remotes
8447 sub git_remotes {
8448         gitweb_check_feature('remote_heads')
8449                 or die_error(403, "Remote heads view is disabled");
8450
8451         my $head = git_get_head_hash($project);
8452         my $remote = $input_params{'hash'};
8453
8454         my $remotedata = git_get_remotes_list($remote);
8455         die_error(500, "Unable to get remote information") unless defined $remotedata;
8456
8457         unless (%$remotedata) {
8458                 die_error(404, defined $remote ?
8459                         "Remote $remote not found" :
8460                         "No remotes found");
8461         }
8462
8463         git_header_html(undef, undef, -action_extra => $remote);
8464         git_print_page_nav('', '',  $head, undef, $head,
8465                 format_ref_views($remote ? '' : 'remotes'));
8466
8467         fill_remote_heads($remotedata);
8468         if (defined $remote) {
8469                 git_print_header_div('remotes', "$remote remote for $project");
8470                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
8471         } else {
8472                 git_print_header_div('summary', "$project remotes");
8473                 git_remotes_body($remotedata, undef, $head);
8474         }
8475
8476         git_footer_html();
8477 }
8478
8479 sub git_blob_plain {
8480         my $type = shift;
8481         my $expires;
8482
8483         if (!defined $hash) {
8484                 if (defined $file_name) {
8485                         my $base = $hash_base || git_get_head_hash($project);
8486                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8487                                 or die_error(404, "Cannot find file");
8488                 } else {
8489                         die_error(400, "No file name defined");
8490                 }
8491         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8492                 # blobs defined by non-textual hash id's can be cached
8493                 $expires = "+1d";
8494         }
8495
8496         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8497                 or die_error(500, "Open git-cat-file blob '$hash' failed");
8498         binmode($fd);
8499
8500         # content-type (can include charset)
8501         my $leader;
8502         ($type, $leader) = blob_contenttype($fd, $file_name, $type);
8503
8504         # "save as" filename, even when no $file_name is given
8505         my $save_as = "$hash";
8506         if (defined $file_name) {
8507                 $save_as = $file_name;
8508         } elsif ($type =~ m/^text\//) {
8509                 $save_as .= '.txt';
8510         }
8511
8512         # With XSS prevention on, blobs of all types except a few known safe
8513         # ones are served with "Content-Disposition: attachment" to make sure
8514         # they don't run in our security domain.  For certain image types,
8515         # blob view writes an <img> tag referring to blob_plain view, and we
8516         # want to be sure not to break that by serving the image as an
8517         # attachment (though Firefox 3 doesn't seem to care).
8518         my $sandbox = $prevent_xss &&
8519                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
8520
8521         # serve text/* as text/plain
8522         if ($prevent_xss &&
8523             ($type =~ m!^text/[a-z]+\b(.*)$! ||
8524              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
8525                 my $rest = $1;
8526                 $rest = defined $rest ? $rest : '';
8527                 $type = "text/plain$rest";
8528         }
8529
8530         print $cgi->header(
8531                 -type => $type,
8532                 -expires => $expires,
8533                 -content_disposition =>
8534                         ($sandbox ? 'attachment' : 'inline')
8535                         . '; filename="' . $save_as . '"');
8536         binmode STDOUT, ':raw';
8537         $fcgi_raw_mode = 1;
8538         print $leader if defined $leader;
8539         my $buf;
8540         while (read($fd, $buf, 32768)) {
8541                 print $buf;
8542         }
8543         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8544         $fcgi_raw_mode = 0;
8545         close $fd;
8546 }
8547
8548 sub git_blob {
8549         my $expires;
8550
8551         if (!defined $hash) {
8552                 if (defined $file_name) {
8553                         my $base = $hash_base || git_get_head_hash($project);
8554                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8555                                 or die_error(404, "Cannot find file");
8556                 } else {
8557                         die_error(400, "No file name defined");
8558                 }
8559         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8560                 # blobs defined by non-textual hash id's can be cached
8561                 $expires = "+1d";
8562         }
8563         my $fullhash = git_get_full_hash($project, "$hash^{blob}");
8564         die_error(404, "No such blob") unless defined($fullhash);
8565
8566         my $have_blame = gitweb_check_feature('blame');
8567         defined(my $fd = git_cmd_pipe "cat-file", "blob", $fullhash)
8568                 or die_error(500, "Couldn't cat $file_name, $hash");
8569         binmode($fd);
8570         my $mimetype = blob_mimetype($fd, $file_name);
8571         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
8572         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
8573                 close $fd;
8574                 return git_blob_plain($mimetype);
8575         }
8576         # we can have blame only for text/* mimetype
8577         $have_blame &&= ($mimetype =~ m!^text/!);
8578
8579         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
8580         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
8581         my $highlight_mode_active;
8582         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
8583
8584         git_header_html(undef, $expires);
8585         my $formats_nav = '';
8586         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8587                 if (defined $file_name) {
8588                         if ($have_blame) {
8589                                 $formats_nav .= tabspan(
8590                                         $cgi->a({-href => href(action=>"blame", -replay=>1),
8591                                                 -class => "blamelink"},
8592                                                 "blame")) .
8593                                         $barsep;
8594                         }
8595                         $formats_nav .= tabspan(
8596                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8597                                         "history")) .
8598                                 $barsep . tabspan(
8599                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8600                                         "raw")) .
8601                                 $barsep . tabspan(
8602                                 $cgi->a({-href => href(action=>"blob",
8603                                                        hash_base=>"HEAD", file_name=>$file_name)},
8604                                         "HEAD"));
8605                 } else {
8606                         $formats_nav .= tabspan(
8607                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8608                                         "raw"));
8609                 }
8610                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8611                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8612         } else {
8613                 git_print_page_nav('',['commit','commitdiff','tree'], undef,undef,undef);
8614                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8615         }
8616         git_print_page_path($file_name, "blob", $hash_base);
8617         print "<div class=\"title_text\">\n" .
8618               "<table class=\"object_header\">\n";
8619         print "<tr><td>blob</td><td class=\"sha1\">$fullhash</td></tr>\n";
8620         print "</table>".
8621               "</div>\n";
8622         print "<div class=\"page_body\">\n";
8623         if ($mimetype =~ m!^image/!) {
8624                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
8625                 if ($file_name) {
8626                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
8627                 }
8628                 print qq! src="! .
8629                       href(action=>"blob_plain", hash=>$hash,
8630                            hash_base=>$hash_base, file_name=>$file_name) .
8631                       qq!" />\n!;
8632                 close $fd; # ignore likely EPIPE error from child
8633         } else {
8634                 my $nr;
8635                 while (my $line = to_utf8(scalar <$fd>)) {
8636                         chomp $line;
8637                         $nr++;
8638                         $line = untabify($line);
8639                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i </a>%s</div>\n!,
8640                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
8641                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
8642                 }
8643                 close $fd
8644                         or print "Reading blob failed.\n";
8645         }
8646         print "</div>";
8647         git_footer_html();
8648 }
8649
8650 sub git_tree {
8651         if (!defined $hash_base) {
8652                 $hash_base = "HEAD";
8653         }
8654         if (!defined $hash) {
8655                 if (defined $file_name) {
8656                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
8657                 } else {
8658                         $hash = $hash_base;
8659                 }
8660         }
8661         die_error(404, "No such tree") unless defined($hash);
8662         my $fullhash = git_get_full_hash($project, "$hash^{tree}");
8663         die_error(404, "No such tree") unless defined($fullhash);
8664
8665         my $show_sizes = gitweb_check_feature('show-sizes');
8666         my $have_blame = gitweb_check_feature('blame');
8667
8668         my @entries = ();
8669         {
8670                 local $/ = "\0";
8671                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
8672                         ($show_sizes ? '-l' : ()), @extra_options, $fullhash)
8673                         or die_error(500, "Open git-ls-tree failed");
8674                 @entries = map { chomp; to_utf8($_) } <$fd>;
8675                 close $fd
8676                         or die_error(404, "Reading tree failed");
8677         }
8678
8679         git_header_html();
8680         my $basedir = '';
8681         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8682                 my $refs = git_get_references();
8683                 my $ref = format_ref_marker($refs, $co{'id'});
8684                 my @views_nav = ();
8685                 if (defined $file_name) {
8686                         push @views_nav,
8687                                 tabspan($cgi->a({-href => href(action=>"history", -replay=>1)},
8688                                                 "history")),
8689                                 tabspan($cgi->a({-href => href(action=>"tree",
8690                                                                hash_base=>"HEAD", file_name=>$file_name)},
8691                                                  "HEAD")),
8692                 }
8693                 my $snapshot_links = format_snapshot_links($hash);
8694                 if (defined $snapshot_links) {
8695                         # FIXME: Should be available when we have no hash base as well.
8696                         push @views_nav, $snapshot_links;
8697                 }
8698                 git_print_page_nav('tree','', $hash_base, undef, undef,
8699                                    join($barsep, @views_nav));
8700                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base, undef, $ref);
8701         } else {
8702                 git_print_page_nav('tree',['commit','commitdiff'], undef,undef,$hash_base);
8703                 undef $hash_base;
8704                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8705         }
8706         if (defined $file_name) {
8707                 $basedir = $file_name;
8708                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
8709                         $basedir .= '/';
8710                 }
8711                 git_print_page_path($file_name, 'tree', $hash_base);
8712         }
8713         print "<div class=\"title_text\">\n" .
8714               "<table class=\"object_header\">\n";
8715         print "<tr><td>tree</td><td class=\"sha1\">$fullhash</td></tr>\n";
8716         print "</table>".
8717               "</div>\n";
8718         print "<div class=\"page_body\">\n";
8719         print "<table class=\"tree\">\n";
8720         my $alternate = 1;
8721         # '..' (top directory) link if possible
8722         if (defined $hash_base &&
8723             defined $file_name && $file_name =~ m![^/]+$!) {
8724                 if ($alternate) {
8725                         print "<tr class=\"dark\">\n";
8726                 } else {
8727                         print "<tr class=\"light\">\n";
8728                 }
8729                 $alternate ^= 1;
8730
8731                 my $up = $file_name;
8732                 $up =~ s!/?[^/]+$!!;
8733                 undef $up unless $up;
8734                 # based on git_print_tree_entry
8735                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
8736                 print '<td class="size">&#160;</td>'."\n" if $show_sizes;
8737                 print '<td class="list">';
8738                 print $cgi->a({-href => href(action=>"tree",
8739                                              hash_base=>$hash_base,
8740                                              file_name=>$up)},
8741                               "..");
8742                 print "</td>\n";
8743                 print "<td class=\"link\"></td>\n";
8744
8745                 print "</tr>\n";
8746         }
8747         foreach my $line (@entries) {
8748                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
8749
8750                 if ($alternate) {
8751                         print "<tr class=\"dark\">\n";
8752                 } else {
8753                         print "<tr class=\"light\">\n";
8754                 }
8755                 $alternate ^= 1;
8756
8757                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
8758
8759                 print "</tr>\n";
8760         }
8761         print "</table>\n" .
8762               "</div>";
8763         git_footer_html();
8764 }
8765
8766 sub sanitize_for_filename {
8767     my $name = shift;
8768
8769     $name =~ s!/!-!g;
8770     $name =~ s/[^[:alnum:]_.-]//g;
8771
8772     return $name;
8773 }
8774
8775 sub snapshot_name {
8776         my ($project, $hash) = @_;
8777
8778         # path/to/project.git  -> project
8779         # path/to/project/.git -> project
8780         my $name = to_utf8($project);
8781         $name =~ s,([^/])/*\.git$,$1,;
8782         $name = sanitize_for_filename(basename($name));
8783
8784         my $ver = $hash;
8785         if ($hash =~ /^[0-9a-fA-F]+$/) {
8786                 # shorten SHA-1 hash
8787                 my $full_hash = git_get_full_hash($project, $hash);
8788                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
8789                         $ver = git_get_short_hash($project, $hash);
8790                 }
8791         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
8792                 # tags don't need shortened SHA-1 hash
8793                 $ver = $1;
8794         } else {
8795                 # branches and other need shortened SHA-1 hash
8796                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
8797                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
8798                         my $ref_dir = (defined $1) ? $1 : '';
8799                         $ver = $2;
8800
8801                         $ref_dir = sanitize_for_filename($ref_dir);
8802                         # for refs neither in heads nor remotes we want to
8803                         # add a ref dir to archive name
8804                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
8805                                 $ver = $ref_dir . '-' . $ver;
8806                         }
8807                 }
8808                 $ver .= '-' . git_get_short_hash($project, $hash);
8809         }
8810         # special case of sanitization for filename - we change
8811         # slashes to dots instead of dashes
8812         # in case of hierarchical branch names
8813         $ver =~ s!/!.!g;
8814         $ver =~ s/[^[:alnum:]_.-]//g;
8815
8816         # name = project-version_string
8817         $name = "$name-$ver";
8818
8819         return wantarray ? ($name, $name) : $name;
8820 }
8821
8822 sub exit_if_unmodified_since {
8823         my ($latest_epoch) = @_;
8824         our $cgi;
8825
8826         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
8827         if (defined $if_modified) {
8828                 my $since;
8829                 if (eval { require HTTP::Date; 1; }) {
8830                         $since = HTTP::Date::str2time($if_modified);
8831                 } elsif (eval { require Time::ParseDate; 1; }) {
8832                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
8833                 }
8834                 if (defined $since && $latest_epoch <= $since) {
8835                         my %latest_date = parse_date($latest_epoch);
8836                         print $cgi->header(
8837                                 -last_modified => $latest_date{'rfc2822'},
8838                                 -status => '304 Not Modified');
8839                         CORE::die;
8840                 }
8841         }
8842 }
8843
8844 sub git_snapshot {
8845         my $format = $input_params{'snapshot_format'};
8846         if (!@snapshot_fmts) {
8847                 die_error(403, "Snapshots not allowed");
8848         }
8849         # default to first supported snapshot format
8850         $format ||= $snapshot_fmts[0];
8851         if ($format !~ m/^[a-z0-9]+$/) {
8852                 die_error(400, "Invalid snapshot format parameter");
8853         } elsif (!exists($known_snapshot_formats{$format})) {
8854                 die_error(400, "Unknown snapshot format");
8855         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
8856                 die_error(403, "Snapshot format not allowed");
8857         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
8858                 die_error(403, "Unsupported snapshot format");
8859         }
8860
8861         my $type = git_get_type("$hash^{}");
8862         if (!$type) {
8863                 die_error(404, 'Object does not exist');
8864         }  elsif ($type eq 'blob') {
8865                 die_error(400, 'Object is not a tree-ish');
8866         }
8867
8868         my ($name, $prefix) = snapshot_name($project, $hash);
8869         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
8870
8871         my %co = parse_commit($hash);
8872         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
8873
8874         my @cmd = (
8875                 git_cmd(), 'archive',
8876                 "--format=$known_snapshot_formats{$format}{'format'}",
8877                 "--prefix=$prefix/", $hash);
8878         if (exists $known_snapshot_formats{$format}{'compressor'}) {
8879                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
8880                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
8881         }
8882
8883         $filename =~ s/(["\\])/\\$1/g;
8884         my %latest_date;
8885         if (%co) {
8886                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
8887         }
8888
8889         print $cgi->header(
8890                 -type => $known_snapshot_formats{$format}{'type'},
8891                 -content_disposition => 'inline; filename="' . $filename . '"',
8892                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8893                 -status => '200 OK');
8894
8895         defined(my $fd = cmd_pipe @cmd)
8896                 or die_error(500, "Execute git-archive failed");
8897         binmode($fd);
8898         binmode STDOUT, ':raw';
8899         $fcgi_raw_mode = 1;
8900         my $buf;
8901         while (read($fd, $buf, 32768)) {
8902                 print $buf;
8903         }
8904         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8905         $fcgi_raw_mode = 0;
8906         close $fd;
8907 }
8908
8909 sub git_log_generic {
8910         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8911
8912         my $head = git_get_head_hash($project);
8913         if (!defined $base) {
8914                 $base = $head;
8915         }
8916         if (!defined $page) {
8917                 $page = 0;
8918         }
8919         my $refs = git_get_references();
8920
8921         my $commit_hash = $base;
8922         if (defined $parent) {
8923                 $commit_hash = "$parent..$base";
8924         }
8925         my @commitlist =
8926                 parse_commits($commit_hash, 101, (100 * $page),
8927                               defined $file_name ? ($file_name, "--full-history") : ());
8928
8929         my $ftype;
8930         if (!defined $file_hash && defined $file_name) {
8931                 # some commits could have deleted file in question,
8932                 # and not have it in tree, but one of them has to have it
8933                 for (my $i = 0; $i < @commitlist; $i++) {
8934                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8935                         last if defined $file_hash;
8936                 }
8937         }
8938         if (defined $file_hash) {
8939                 $ftype = git_get_type($file_hash);
8940         }
8941         if (defined $file_name && !defined $ftype) {
8942                 die_error(500, "Unknown type of object");
8943         }
8944         my %co;
8945         if (defined $file_name) {
8946                 %co = parse_commit($base)
8947                         or die_error(404, "Unknown commit object");
8948         }
8949
8950
8951         my $next_link = '';
8952         if ($#commitlist >= 100) {
8953                 $next_link =
8954                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8955                                  -accesskey => "n", -title => "Alt-n"}, "next");
8956         }
8957         my $extra = '';
8958         my ($patch_max) = gitweb_get_feature('patches');
8959         if ($patch_max && !defined $file_name) {
8960                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8961                         $extra = $cgi->a({-href => href(action=>"patches", -replay=>1)},
8962                                         "patches");
8963                 }
8964         }
8965         my $paging_nav = format_log_nav($fmt_name, $page, $#commitlist >= 100, $extra);
8966
8967         {
8968                 local $action = 'log';
8969                 git_header_html();
8970         }
8971         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8972         if (defined $file_name) {
8973                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8974         } else {
8975                 git_print_header_div('summary', $project)
8976         }
8977         git_print_page_path($file_name, $ftype, $hash_base)
8978                 if (defined $file_name);
8979
8980         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8981                      $file_name, $file_hash, $ftype);
8982
8983         git_footer_html();
8984 }
8985
8986 sub git_log {
8987         git_log_generic('log', \&git_log_body,
8988                         $hash, $hash_parent);
8989 }
8990
8991 sub git_commit {
8992         $hash ||= $hash_base || "HEAD";
8993         my %co = parse_commit($hash)
8994             or die_error(404, "Unknown commit object");
8995
8996         my $parent  = $co{'parent'};
8997         my $parents = $co{'parents'}; # listref
8998
8999         # we need to prepare $formats_nav before any parameter munging
9000         my $formats_nav;
9001         if (!defined $parent) {
9002                 # --root commitdiff
9003                 $formats_nav .= '<span class="parents none">(initial)</span>';
9004         } elsif (@$parents == 1) {
9005                 # single parent commit
9006                 $formats_nav .=
9007                         '<span class="parents single">(parent:&#160;' .
9008                         $cgi->a({-href => href(action=>"commit",
9009                                                hash=>$parent)},
9010                                 esc_html(substr($parent, 0, 7))) .
9011                         ')</span>';
9012         } else {
9013                 # merge commit
9014                 $formats_nav .=
9015                         '<span class="parents multiple">(merge:&#160;' .
9016                         join(' ', map {
9017                                 $cgi->a({-href => href(action=>"commit",
9018                                                        hash=>$_)},
9019                                         esc_html(substr($_, 0, 7)));
9020                         } @$parents ) .
9021                         ')</span>';
9022         }
9023         if (gitweb_check_feature('patches') && @$parents <= 1) {
9024                 $formats_nav .= $barsep . tabspan(
9025                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
9026                                 "patch"));
9027         }
9028
9029         if (!defined $parent) {
9030                 $parent = "--root";
9031         }
9032         my @difftree;
9033         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
9034                 @diff_opts,
9035                 (@$parents <= 1 ? $parent : '-c'),
9036                 $hash, "--")
9037                 or die_error(500, "Open git-diff-tree failed");
9038         @difftree = map { chomp; to_utf8($_) } <$fd>;
9039         close $fd or die_error(404, "Reading git-diff-tree failed");
9040
9041         # non-textual hash id's can be cached
9042         my $expires;
9043         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9044                 $expires = "+1d";
9045         }
9046         my $refs = git_get_references();
9047         my $ref = format_ref_marker($refs, $co{'id'});
9048
9049         git_header_html(undef, $expires);
9050         git_print_page_nav('commit', '',
9051                            $hash, $co{'tree'}, $hash,
9052                            $formats_nav);
9053
9054         if (defined $co{'parent'}) {
9055                 git_print_header_div('commitdiff', esc_html($co{'title'}), $hash, undef, $ref);
9056         } else {
9057                 git_print_header_div('tree', esc_html($co{'title'}), $co{'tree'}, $hash, $ref);
9058         }
9059         print "<div class=\"title_text\">\n" .
9060               "<table class=\"object_header\">\n";
9061         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
9062         git_print_authorship_rows(\%co);
9063         print "<tr>" .
9064               "<td>tree</td>" .
9065               "<td class=\"sha1\">" .
9066               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
9067                        class => "list"}, $co{'tree'}) .
9068               "</td>" .
9069               "<td class=\"link\">" .
9070               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
9071                       "tree");
9072         my $snapshot_links = format_snapshot_links($hash);
9073         if (defined $snapshot_links) {
9074                 print $barsep . $snapshot_links;
9075         }
9076         print "</td>" .
9077               "</tr>\n";
9078
9079         foreach my $par (@$parents) {
9080                 print "<tr>" .
9081                       "<td>parent</td>" .
9082                       "<td class=\"sha1\">" .
9083                       $cgi->a({-href => href(action=>"commit", hash=>$par),
9084                                class => "list"}, $par) .
9085                       "</td>" .
9086                       "<td class=\"link\">" .
9087                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
9088                       $barsep .
9089                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
9090                       "</td>" .
9091                       "</tr>\n";
9092         }
9093         print "</table>".
9094               "</div>\n";
9095
9096         print "<div class=\"page_body\">\n";
9097         git_print_log($co{'comment'});
9098         print "</div>\n";
9099
9100         git_difftree_body(\@difftree, $hash, @$parents);
9101
9102         git_footer_html();
9103 }
9104
9105 sub git_object {
9106         # object is defined by:
9107         # - hash or hash_base alone
9108         # - hash_base and file_name
9109         my $type;
9110
9111         # - hash or hash_base alone
9112         if ($hash || ($hash_base && !defined $file_name)) {
9113                 my $object_id = $hash || $hash_base;
9114
9115                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
9116                         or die_error(404, "Object does not exist");
9117                 $type = <$fd>;
9118                 defined $type && chomp $type;
9119                 close $fd
9120                         or die_error(404, "Object does not exist");
9121
9122         # - hash_base and file_name
9123         } elsif ($hash_base && defined $file_name) {
9124                 $file_name =~ s,/+$,,;
9125
9126                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
9127                         or die_error(404, "Base object does not exist");
9128
9129                 # here errors should not happen
9130                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
9131                         or die_error(500, "Open git-ls-tree failed");
9132                 my $line = to_utf8(scalar <$fd>);
9133                 close $fd;
9134
9135                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
9136                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
9137                         die_error(404, "File or directory for given base does not exist");
9138                 }
9139                 $type = $2;
9140                 $hash = $3;
9141         } else {
9142                 die_error(400, "Not enough information to find object");
9143         }
9144
9145         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
9146                                           hash=>$hash, hash_base=>$hash_base,
9147                                           file_name=>$file_name),
9148                              -status => '302 Found');
9149 }
9150
9151 sub git_blobdiff {
9152         my $format = shift || 'html';
9153         my $diff_style = $input_params{'diff_style'} || 'inline';
9154
9155         my $fd;
9156         my @difftree;
9157         my %diffinfo;
9158         my $expires;
9159
9160         # preparing $fd and %diffinfo for git_patchset_body
9161         # new style URI
9162         if (defined $hash_base && defined $hash_parent_base) {
9163                 if (defined $file_name) {
9164                         # read raw output
9165                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9166                                 $hash_parent_base, $hash_base,
9167                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
9168                                 or die_error(500, "Open git-diff-tree failed");
9169                         @difftree = map { chomp; to_utf8($_) } <$fd>;
9170                         close $fd
9171                                 or die_error(404, "Reading git-diff-tree failed");
9172                         @difftree
9173                                 or die_error(404, "Blob diff not found");
9174
9175                 } elsif (defined $hash &&
9176                          $hash =~ /[0-9a-fA-F]{40}/) {
9177                         # try to find filename from $hash
9178
9179                         # read filtered raw output
9180                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9181                                 $hash_parent_base, $hash_base, "--")
9182                                 or die_error(500, "Open git-diff-tree failed");
9183                         @difftree =
9184                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
9185                                 # $hash == to_id
9186                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
9187                                 map { chomp; to_utf8($_) } <$fd>;
9188                         close $fd
9189                                 or die_error(404, "Reading git-diff-tree failed");
9190                         @difftree
9191                                 or die_error(404, "Blob diff not found");
9192
9193                 } else {
9194                         die_error(400, "Missing one of the blob diff parameters");
9195                 }
9196
9197                 if (@difftree > 1) {
9198                         die_error(400, "Ambiguous blob diff specification");
9199                 }
9200
9201                 %diffinfo = parse_difftree_raw_line($difftree[0]);
9202                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
9203                 $file_name   ||= $diffinfo{'to_file'};
9204
9205                 $hash_parent ||= $diffinfo{'from_id'};
9206                 $hash        ||= $diffinfo{'to_id'};
9207
9208                 # non-textual hash id's can be cached
9209                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
9210                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
9211                         $expires = '+1d';
9212                 }
9213
9214                 # open patch output
9215                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9216                         '-p', ($format eq 'html' ? "--full-index" : ()),
9217                         $hash_parent_base, $hash_base,
9218                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
9219                         or die_error(500, "Open git-diff-tree failed");
9220         }
9221
9222         # old/legacy style URI -- not generated anymore since 1.4.3.
9223         if (!%diffinfo) {
9224                 die_error('404 Not Found', "Missing one of the blob diff parameters")
9225         }
9226
9227         # header
9228         if ($format eq 'html') {
9229                 my $formats_nav =
9230                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
9231                                 "raw");
9232                 $formats_nav .= diff_style_nav($diff_style);
9233                 git_header_html(undef, $expires);
9234                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
9235                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
9236                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
9237                 } else {
9238                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
9239                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
9240                 }
9241                 if (defined $file_name) {
9242                         git_print_page_path($file_name, "blob", $hash_base);
9243                 } else {
9244                         print "<div class=\"page_path\"></div>\n";
9245                 }
9246
9247         } elsif ($format eq 'plain') {
9248                 print $cgi->header(
9249                         -type => 'text/plain',
9250                         -charset => 'utf-8',
9251                         -expires => $expires,
9252                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
9253
9254                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9255
9256         } else {
9257                 die_error(400, "Unknown blobdiff format");
9258         }
9259
9260         # patch
9261         if ($format eq 'html') {
9262                 print "<div class=\"page_body\">\n";
9263
9264                 git_patchset_body($fd, $diff_style,
9265                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
9266                 close $fd;
9267
9268                 print "</div>\n"; # class="page_body"
9269                 git_footer_html();
9270
9271         } else {
9272                 while (my $line = to_utf8(scalar <$fd>)) {
9273                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
9274                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
9275
9276                         print $line;
9277
9278                         last if $line =~ m!^\+\+\+!;
9279                 }
9280                 while (<$fd>) {
9281                         print to_utf8($_);
9282                 }
9283                 close $fd;
9284         }
9285 }
9286
9287 sub git_blobdiff_plain {
9288         git_blobdiff('plain');
9289 }
9290
9291 # assumes that it is added as later part of already existing navigation,
9292 # so it returns "| foo | bar" rather than just "foo | bar"
9293 sub diff_style_nav {
9294         my ($diff_style, $is_combined) = @_;
9295         $diff_style ||= 'inline';
9296
9297         return "" if ($is_combined);
9298
9299         my @styles = (inline => 'inline', 'sidebyside' => 'side&#160;by&#160;side');
9300         my %styles = @styles;
9301         @styles =
9302                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
9303
9304         return $barsep . '<span class="diffstyles">' . join($barsep,
9305                 map {
9306                         $_ eq $diff_style ?
9307                         '<span class="diffstyle selected">' . $styles{$_} . '</span>' :
9308                         '<span class="diffstyle">' .
9309                                 $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_}) .
9310                                 '</span>'
9311                 } @styles) . '</span>';
9312 }
9313
9314 sub git_commitdiff {
9315         my %params = @_;
9316         my $format = $params{-format} || 'html';
9317         my $diff_style = $input_params{'diff_style'} || 'inline';
9318
9319         my ($patch_max) = gitweb_get_feature('patches');
9320         if ($format eq 'patch') {
9321                 die_error(403, "Patch view not allowed") unless $patch_max;
9322         }
9323
9324         $hash ||= $hash_base || "HEAD";
9325         my %co = parse_commit($hash)
9326             or die_error(404, "Unknown commit object");
9327
9328         # choose format for commitdiff for merge
9329         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
9330                 $hash_parent = '--cc';
9331         }
9332         # we need to prepare $formats_nav before almost any parameter munging
9333         my $formats_nav;
9334         if ($format eq 'html') {
9335                 $formats_nav = tabspan(
9336                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
9337                                 "raw"));
9338                 if ($patch_max && @{$co{'parents'}} <= 1) {
9339                         $formats_nav .= $barsep . tabspan(
9340                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
9341                                         "patch"));
9342                 }
9343                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
9344
9345                 if (defined $hash_parent &&
9346                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
9347                         # commitdiff with two commits given
9348                         my $hash_parent_short = $hash_parent;
9349                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
9350                                 $hash_parent_short = substr($hash_parent, 0, 7);
9351                         }
9352                         $formats_nav .= $spcsep . '<span class="parents multiple">' .
9353                                 '(from';
9354                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
9355                                 if ($co{'parents'}[$i] eq $hash_parent) {
9356                                         $formats_nav .= '&#160;parent&#160;' . ($i+1);
9357                                         last;
9358                                 }
9359                         }
9360                         $formats_nav .= ':&#160;' .
9361                                 $cgi->a({-href => href(-replay=>1,
9362                                                        hash=>$hash_parent, hash_base=>undef)},
9363                                         esc_html($hash_parent_short)) .
9364                                 ')</span>';
9365                 } elsif (!$co{'parent'}) {
9366                         # --root commitdiff
9367                         $formats_nav .= $spcsep . '<span class="parents none">(initial)</span>';
9368                 } elsif (scalar @{$co{'parents'}} == 1) {
9369                         # single parent commit
9370                         $formats_nav .= $spcsep .
9371                                 '<span class="parents single">(parent:&#160;' .
9372                                 $cgi->a({-href => href(-replay=>1,
9373                                                        hash=>$co{'parent'}, hash_base=>undef)},
9374                                         esc_html(substr($co{'parent'}, 0, 7))) .
9375                                 ')</span>';
9376                 } else {
9377                         # merge commit
9378                         if ($hash_parent eq '--cc') {
9379                                 $formats_nav .= $barsep . tabspan(
9380                                         $cgi->a({-href => href(-replay=>1,
9381                                                                hash=>$hash, hash_parent=>'-c')},
9382                                                 'combined'));
9383                         } else { # $hash_parent eq '-c'
9384                                 $formats_nav .= $barsep . tabspan(
9385                                         $cgi->a({-href => href(-replay=>1,
9386                                                                hash=>$hash, hash_parent=>'--cc')},
9387                                                 'compact'));
9388                         }
9389                         $formats_nav .= $spcsep .
9390                                 '<span class="parents multiple">(merge:&#160;' .
9391                                 join(' ', map {
9392                                         $cgi->a({-href => href(-replay=>1,
9393                                                                hash=>$_, hash_base=>undef)},
9394                                                 esc_html(substr($_, 0, 7)));
9395                                 } @{$co{'parents'}} ) .
9396                                 ')</span>';
9397                 }
9398         }
9399
9400         my $hash_parent_param = $hash_parent;
9401         if (!defined $hash_parent_param) {
9402                 # --cc for multiple parents, --root for parentless
9403                 $hash_parent_param =
9404                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
9405         }
9406
9407         # read commitdiff
9408         my $fd;
9409         my @difftree;
9410         if ($format eq 'html') {
9411                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9412                         "--no-commit-id", "--patch-with-raw", "--full-index",
9413                         $hash_parent_param, $hash, "--")
9414                         or die_error(500, "Open git-diff-tree failed");
9415
9416                 while (my $line = to_utf8(scalar <$fd>)) {
9417                         chomp $line;
9418                         # empty line ends raw part of diff-tree output
9419                         last unless $line;
9420                         push @difftree, scalar parse_difftree_raw_line($line);
9421                 }
9422
9423         } elsif ($format eq 'plain') {
9424                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9425                         '-p', $hash_parent_param, $hash, "--")
9426                         or die_error(500, "Open git-diff-tree failed");
9427         } elsif ($format eq 'patch') {
9428                 # For commit ranges, we limit the output to the number of
9429                 # patches specified in the 'patches' feature.
9430                 # For single commits, we limit the output to a single patch,
9431                 # diverging from the git-format-patch default.
9432                 my @commit_spec = ();
9433                 if ($hash_parent) {
9434                         if ($patch_max > 0) {
9435                                 push @commit_spec, "-$patch_max";
9436                         }
9437                         push @commit_spec, '-n', "$hash_parent..$hash";
9438                 } else {
9439                         if ($params{-single}) {
9440                                 push @commit_spec, '-1';
9441                         } else {
9442                                 if ($patch_max > 0) {
9443                                         push @commit_spec, "-$patch_max";
9444                                 }
9445                                 push @commit_spec, "-n";
9446                         }
9447                         push @commit_spec, '--root', $hash;
9448                 }
9449                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
9450                         '--encoding=utf8', '--stdout', @commit_spec)
9451                         or die_error(500, "Open git-format-patch failed");
9452         } else {
9453                 die_error(400, "Unknown commitdiff format");
9454         }
9455
9456         # non-textual hash id's can be cached
9457         my $expires;
9458         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9459                 $expires = "+1d";
9460         }
9461
9462         # write commit message
9463         if ($format eq 'html') {
9464                 my $refs = git_get_references();
9465                 my $ref = format_ref_marker($refs, $co{'id'});
9466
9467                 git_header_html(undef, $expires);
9468                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
9469                 git_print_header_div('commit', esc_html($co{'title'}), $hash, undef, $ref);
9470                 print "<div class=\"title_text\">\n" .
9471                       "<table class=\"object_header\">\n";
9472                 git_print_authorship_rows(\%co);
9473                 print "</table>".
9474                       "</div>\n";
9475                 print "<div class=\"page_body\">\n";
9476                 if (@{$co{'comment'}} > 1) {
9477                         print "<div class=\"log\">\n";
9478                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
9479                         print "</div>\n"; # class="log"
9480                 }
9481
9482         } elsif ($format eq 'plain') {
9483                 my $refs = git_get_references("tags");
9484                 my $tagname = git_get_rev_name_tags($hash);
9485                 my $filename = basename($project) . "-$hash.patch";
9486
9487                 print $cgi->header(
9488                         -type => 'text/plain',
9489                         -charset => 'utf-8',
9490                         -expires => $expires,
9491                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9492                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
9493                 print "From: " . to_utf8($co{'author'}) . "\n";
9494                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
9495                 print "Subject: " . to_utf8($co{'title'}) . "\n";
9496
9497                 print "X-Git-Tag: $tagname\n" if $tagname;
9498                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9499
9500                 foreach my $line (@{$co{'comment'}}) {
9501                         print to_utf8($line) . "\n";
9502                 }
9503                 print "---\n\n";
9504         } elsif ($format eq 'patch') {
9505                 my $filename = basename($project) . "-$hash.patch";
9506
9507                 print $cgi->header(
9508                         -type => 'text/plain',
9509                         -charset => 'utf-8',
9510                         -expires => $expires,
9511                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9512         }
9513
9514         # write patch
9515         if ($format eq 'html') {
9516                 my $use_parents = !defined $hash_parent ||
9517                         $hash_parent eq '-c' || $hash_parent eq '--cc';
9518                 git_difftree_body(\@difftree, $hash,
9519                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9520                 print "<br/>\n";
9521
9522                 git_patchset_body($fd, $diff_style,
9523                                   \@difftree, $hash,
9524                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9525                 close $fd;
9526                 print "</div>\n"; # class="page_body"
9527                 git_footer_html();
9528
9529         } elsif ($format eq 'plain') {
9530                 while (<$fd>) {
9531                         print to_utf8($_);
9532                 }
9533                 close $fd
9534                         or print "Reading git-diff-tree failed\n";
9535         } elsif ($format eq 'patch') {
9536                 while (<$fd>) {
9537                         print to_utf8($_);
9538                 }
9539                 close $fd
9540                         or print "Reading git-format-patch failed\n";
9541         }
9542 }
9543
9544 sub git_commitdiff_plain {
9545         git_commitdiff(-format => 'plain');
9546 }
9547
9548 # format-patch-style patches
9549 sub git_patch {
9550         git_commitdiff(-format => 'patch', -single => 1);
9551 }
9552
9553 sub git_patches {
9554         git_commitdiff(-format => 'patch');
9555 }
9556
9557 sub git_history {
9558         git_log_generic('history', \&git_history_body,
9559                         $hash_base, $hash_parent_base,
9560                         $file_name, $hash);
9561 }
9562
9563 sub git_search {
9564         $searchtype ||= 'commit';
9565
9566         # check if appropriate features are enabled
9567         gitweb_check_feature('search')
9568                 or die_error(403, "Search is disabled");
9569         if ($searchtype eq 'pickaxe') {
9570                 # pickaxe may take all resources of your box and run for several minutes
9571                 # with every query - so decide by yourself how public you make this feature
9572                 gitweb_check_feature('pickaxe')
9573                         or die_error(403, "Pickaxe search is disabled");
9574         }
9575         if ($searchtype eq 'grep') {
9576                 # grep search might be potentially CPU-intensive, too
9577                 gitweb_check_feature('grep')
9578                         or die_error(403, "Grep search is disabled");
9579         }
9580         if ($search_use_regexp) {
9581                 # regular expression search can be disabled to avoid potentially
9582                 # malicious regular expressions
9583                 gitweb_check_feature('regexp')
9584                         or die_error(403, "Regular expression search is disabled");
9585         }
9586
9587         if (!defined $searchtext) {
9588                 die_error(400, "Text field is empty");
9589         }
9590         if (!defined $hash) {
9591                 $hash = git_get_head_hash($project);
9592         }
9593         my %co = parse_commit($hash);
9594         if (!%co) {
9595                 die_error(404, "Unknown commit object");
9596         }
9597         if (!defined $page) {
9598                 $page = 0;
9599         }
9600
9601         if ($searchtype eq 'commit' ||
9602             $searchtype eq 'author' ||
9603             $searchtype eq 'committer') {
9604                 git_search_message(%co);
9605         } elsif ($searchtype eq 'pickaxe') {
9606                 git_search_changes(%co);
9607         } elsif ($searchtype eq 'grep') {
9608                 git_search_files(%co);
9609         } else {
9610                 die_error(400, "Unknown search type");
9611         }
9612 }
9613
9614 sub git_search_help {
9615         git_header_html();
9616         git_print_page_nav('','', $hash,$hash,$hash);
9617         print <<EOT;
9618 <div class="search_help">
9619 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
9620 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
9621 the pattern entered is recognized as the POSIX extended
9622 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
9623 insensitive).</p>
9624 <dl>
9625 <dt><b>commit</b></dt>
9626 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
9627 EOT
9628         my $have_grep = gitweb_check_feature('grep');
9629         if ($have_grep) {
9630                 print <<EOT;
9631 <dt><b>grep</b></dt>
9632 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
9633     a different one) are searched for the given pattern. On large trees, this search can take
9634 a while and put some strain on the server, so please use it with some consideration. Note that
9635 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
9636 case-sensitive.</dd>
9637 EOT
9638         }
9639         print <<EOT;
9640 <dt><b>author</b></dt>
9641 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
9642 <dt><b>committer</b></dt>
9643 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
9644 EOT
9645         my $have_pickaxe = gitweb_check_feature('pickaxe');
9646         if ($have_pickaxe) {
9647                 print <<EOT;
9648 <dt><b>pickaxe</b></dt>
9649 <dd>All commits that caused the string to appear or disappear from any file (changes that
9650 added, removed or "modified" the string) will be listed. This search can take a while and
9651 takes a lot of strain on the server, so please use it wisely. Note that since you may be
9652 interested even in changes just changing the case as well, this search is case sensitive.</dd>
9653 EOT
9654         }
9655         print "</dl>\n</div>\n";
9656         git_footer_html();
9657 }
9658
9659 sub git_shortlog {
9660         git_log_generic('shortlog', \&git_shortlog_body,
9661                         $hash, $hash_parent);
9662 }
9663
9664 ## ......................................................................
9665 ## feeds (RSS, Atom; OPML)
9666
9667 sub git_feed {
9668         my $format = shift || 'atom';
9669         my $have_blame = gitweb_check_feature('blame');
9670
9671         # Atom: http://www.atomenabled.org/developers/syndication/
9672         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
9673         if ($format ne 'rss' && $format ne 'atom') {
9674                 die_error(400, "Unknown web feed format");
9675         }
9676
9677         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
9678         my $head = $hash || 'HEAD';
9679         my @commitlist = parse_commits($head, 150, 0, $file_name);
9680
9681         my %latest_commit;
9682         my %latest_date;
9683         my $content_type = "application/$format+xml";
9684         if (defined $cgi->http('HTTP_ACCEPT') &&
9685                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
9686                 # browser (feed reader) prefers text/xml
9687                 $content_type = 'text/xml';
9688         }
9689         if (defined($commitlist[0])) {
9690                 %latest_commit = %{$commitlist[0]};
9691                 my $latest_epoch = $latest_commit{'committer_epoch'};
9692                 exit_if_unmodified_since($latest_epoch);
9693                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
9694         }
9695         print $cgi->header(
9696                 -type => $content_type,
9697                 -charset => 'utf-8',
9698                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
9699                 -status => '200 OK');
9700
9701         # Optimization: skip generating the body if client asks only
9702         # for Last-Modified date.
9703         return if ($cgi->request_method() eq 'HEAD');
9704
9705         # header variables
9706         my $title = "$site_name - $project/$action";
9707         my $feed_type = 'log';
9708         if (defined $hash) {
9709                 $title .= " - '$hash'";
9710                 $feed_type = 'branch log';
9711                 if (defined $file_name) {
9712                         $title .= " :: $file_name";
9713                         $feed_type = 'history';
9714                 }
9715         } elsif (defined $file_name) {
9716                 $title .= " - $file_name";
9717                 $feed_type = 'history';
9718         }
9719         $title .= " $feed_type";
9720         $title = esc_html($title);
9721         my $descr = git_get_project_description($project);
9722         if (defined $descr) {
9723                 $descr = esc_html($descr);
9724         } else {
9725                 $descr = "$project " .
9726                          ($format eq 'rss' ? 'RSS' : 'Atom') .
9727                          " feed";
9728         }
9729         my $owner = git_get_project_owner($project);
9730         $owner = esc_html($owner);
9731
9732         #header
9733         my $alt_url;
9734         if (defined $file_name) {
9735                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
9736         } elsif (defined $hash) {
9737                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
9738         } else {
9739                 $alt_url = href(-full=>1, action=>"summary");
9740         }
9741         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
9742         if ($format eq 'rss') {
9743                 print <<XML;
9744 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
9745 <channel>
9746 XML
9747                 print "<title>$title</title>\n" .
9748                       "<link>$alt_url</link>\n" .
9749                       "<description>$descr</description>\n" .
9750                       "<language>en</language>\n" .
9751                       # project owner is responsible for 'editorial' content
9752                       "<managingEditor>$owner</managingEditor>\n";
9753                 if (defined $logo || defined $favicon) {
9754                         # prefer the logo to the favicon, since RSS
9755                         # doesn't allow both
9756                         my $img = esc_url($logo || $favicon);
9757                         print "<image>\n" .
9758                               "<url>$img</url>\n" .
9759                               "<title>$title</title>\n" .
9760                               "<link>$alt_url</link>\n" .
9761                               "</image>\n";
9762                 }
9763                 if (%latest_date) {
9764                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
9765                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
9766                 }
9767                 print "<generator>gitweb v.$version/$git_version</generator>\n";
9768         } elsif ($format eq 'atom') {
9769                 print <<XML;
9770 <feed xmlns="http://www.w3.org/2005/Atom">
9771 XML
9772                 print "<title>$title</title>\n" .
9773                       "<subtitle>$descr</subtitle>\n" .
9774                       '<link rel="alternate" type="text/html" href="' .
9775                       $alt_url . '" />' . "\n" .
9776                       '<link rel="self" type="' . $content_type . '" href="' .
9777                       $cgi->self_url() . '" />' . "\n" .
9778                       "<id>" . href(-full=>1) . "</id>\n" .
9779                       # use project owner for feed author
9780                       '<author><name>'. email_obfuscate($owner) . '</name></author>\n';
9781                 if (defined $favicon) {
9782                         print "<icon>" . esc_url($favicon) . "</icon>\n";
9783                 }
9784                 if (defined $logo) {
9785                         # not twice as wide as tall: 72 x 27 pixels
9786                         print "<logo>" . esc_url($logo) . "</logo>\n";
9787                 }
9788                 if (! %latest_date) {
9789                         # dummy date to keep the feed valid until commits trickle in:
9790                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
9791                 } else {
9792                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
9793                 }
9794                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
9795         }
9796
9797         # contents
9798         for (my $i = 0; $i <= $#commitlist; $i++) {
9799                 my %co = %{$commitlist[$i]};
9800                 my $commit = $co{'id'};
9801                 # we read 150, we always show 30 and the ones more recent than 48 hours
9802                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
9803                         last;
9804                 }
9805                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
9806
9807                 # get list of changed files
9808                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9809                         $co{'parent'} || "--root",
9810                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
9811                         or next;
9812                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
9813                 close $fd
9814                         or next;
9815
9816                 # print element (entry, item)
9817                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
9818                 if ($format eq 'rss') {
9819                         print "<item>\n" .
9820                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
9821                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
9822                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
9823                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
9824                               "<link>$co_url</link>\n" .
9825                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
9826                               "<content:encoded>" .
9827                               "<![CDATA[\n";
9828                 } elsif ($format eq 'atom') {
9829                         print "<entry>\n" .
9830                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
9831                               "<updated>$cd{'iso-8601'}</updated>\n" .
9832                               "<author>\n" .
9833                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
9834                         if ($co{'author_email'}) {
9835                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
9836                         }
9837                         print "</author>\n" .
9838                               # use committer for contributor
9839                               "<contributor>\n" .
9840                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
9841                         if ($co{'committer_email'}) {
9842                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
9843                         }
9844                         print "</contributor>\n" .
9845                               "<published>$cd{'iso-8601'}</published>\n" .
9846                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
9847                               "<id>$co_url</id>\n" .
9848                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
9849                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
9850                 }
9851                 my $comment = $co{'comment'};
9852                 print "<pre>\n";
9853                 foreach my $line (@$comment) {
9854                         $line = esc_html($line);
9855                         print "$line\n";
9856                 }
9857                 print "</pre><ul>\n";
9858                 foreach my $difftree_line (@difftree) {
9859                         my %difftree = parse_difftree_raw_line($difftree_line);
9860                         next if !$difftree{'from_id'};
9861
9862                         my $file = $difftree{'file'} || $difftree{'to_file'};
9863
9864                         print "<li>" .
9865                               "[" .
9866                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
9867                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
9868                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
9869                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
9870                                       -title => "diff"}, 'D');
9871                         if ($have_blame) {
9872                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
9873                                                              file_name=>$file, hash_base=>$commit),
9874                                               -class => "blamelink",
9875                                               -title => "blame"}, 'B');
9876                         }
9877                         # if this is not a feed of a file history
9878                         if (!defined $file_name || $file_name ne $file) {
9879                                 print $cgi->a({-href => href(-full=>1, action=>"history",
9880                                                              file_name=>$file, hash=>$commit),
9881                                               -title => "history"}, 'H');
9882                         }
9883                         $file = esc_path($file);
9884                         print "] ".
9885                               "$file</li>\n";
9886                 }
9887                 if ($format eq 'rss') {
9888                         print "</ul>]]>\n" .
9889                               "</content:encoded>\n" .
9890                               "</item>\n";
9891                 } elsif ($format eq 'atom') {
9892                         print "</ul>\n</div>\n" .
9893                               "</content>\n" .
9894                               "</entry>\n";
9895                 }
9896         }
9897
9898         # end of feed
9899         if ($format eq 'rss') {
9900                 print "</channel>\n</rss>\n";
9901         } elsif ($format eq 'atom') {
9902                 print "</feed>\n";
9903         }
9904 }
9905
9906 sub git_rss {
9907         git_feed('rss');
9908 }
9909
9910 sub git_atom {
9911         git_feed('atom');
9912 }
9913
9914 sub git_opml {
9915         my @list = git_get_projects_list($project_filter, $strict_export);
9916         if (!@list) {
9917                 die_error(404, "No projects found");
9918         }
9919
9920         print $cgi->header(
9921                 -type => 'text/xml',
9922                 -charset => 'utf-8',
9923                 -content_disposition => 'inline; filename="opml.xml"');
9924
9925         my $title = esc_html($site_name);
9926         my $filter = " within subdirectory ";
9927         if (defined $project_filter) {
9928                 $filter .= esc_html($project_filter);
9929         } else {
9930                 $filter = "";
9931         }
9932         print <<XML;
9933 <?xml version="1.0" encoding="utf-8"?>
9934 <opml version="1.0">
9935 <head>
9936   <title>$title OPML Export$filter</title>
9937 </head>
9938 <body>
9939 <outline text="git RSS feeds">
9940 XML
9941
9942         foreach my $pr (@list) {
9943                 my %proj = %$pr;
9944                 my $head = git_get_head_hash($proj{'path'});
9945                 if (!defined $head) {
9946                         next;
9947                 }
9948                 $git_dir = "$projectroot/$proj{'path'}";
9949                 my %co = parse_commit($head);
9950                 if (!%co) {
9951                         next;
9952                 }
9953
9954                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9955                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9956                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9957                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9958         }
9959         print <<XML;
9960 </outline>
9961 </body>
9962 </opml>
9963 XML
9964 }