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, $spcsep);
  33
  34 BEGIN {
  35         *mdotsep = \'<span class="mdotsep">&#160;&#183;&#160;</span>';
  36         *barsep = \'<span class="barsep">&#160;|&#160;</span>';
  37         *spcsep = \'<span class="spcsep">&#160</span>';
  38         CGI->compile() if $ENV{'MOD_PERL'};
  39 }
  40
  41 our $version = "++GIT_VERSION++";
  42
  43 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
  44 sub evaluate_uri {
  45         our $cgi;
  46
  47         our $my_url = $cgi->url();
  48         our $my_uri = $cgi->url(-absolute => 1);
  49
  50         # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
  51         # needed and used only for URLs with nonempty PATH_INFO
  52         # This must be an absolute URL (i.e. no scheme, host or port), NOT a full one
  53         our $base_url = $my_uri || '/';
  54
  55         # When the script is used as DirectoryIndex, the URL does not contain the name
  56         # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
  57         # have to do it ourselves. We make $path_info global because it's also used
  58         # later on.
  59         #
  60         # Another issue with the script being the DirectoryIndex is that the resulting
  61         # $my_url data is not the full script URL: this is good, because we want
  62         # generated links to keep implying the script name if it wasn't explicitly
  63         # indicated in the URL we're handling, but it means that $my_url cannot be used
  64         # as base URL.
  65         # Therefore, if we needed to strip PATH_INFO, then we know that we have
  66         # to build the base URL ourselves:
  67         our $path_info = decode_utf8($ENV{"PATH_INFO"});
  68         if ($path_info) {
  69                 # $path_info has already been URL-decoded by the web server, but
  70                 # $my_url and $my_uri have not. URL-decode them so we can properly
  71                 # strip $path_info.
  72                 $my_url = unescape($my_url);
  73                 $my_uri = unescape($my_uri);
  74                 if ($my_url =~ s,\Q$path_info\E$,, &&
  75                     $my_uri =~ s,\Q$path_info\E$,, &&
  76                     defined $ENV{'SCRIPT_NAME'}) {
  77                         $base_url = $ENV{'SCRIPT_NAME'} || '/';
  78                 }
  79         }
  80
  81         # target of the home link on top of all pages
  82         our $home_link = $my_uri || "/";
  83 }
  84
  85 # core git executable to use
  86 # this can just be "git" if your webserver has a sensible PATH
  87 our $GIT = "++GIT_BINDIR++/git";
  88
  89 # absolute fs-path which will be prepended to the project path
  90 #our $projectroot = "/pub/scm";
  91 our $projectroot = "++GITWEB_PROJECTROOT++";
  92
  93 # fs traversing limit for getting project list
  94 # the number is relative to the projectroot
  95 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
  96
  97 # string of the home link on top of all pages
  98 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
  99
 100 # extra breadcrumbs preceding the home link
 101 our @extra_breadcrumbs = ();
 102
 103 # name of your site or organization to appear in page titles
 104 # replace this with something more descriptive for clearer bookmarks
 105 our $site_name = "++GITWEB_SITENAME++"
 106                  || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
 107
 108 # html snippet to include in the <head> section of each page
 109 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
 110 # filename of html text to include at top of each page
 111 our $site_header = "++GITWEB_SITE_HEADER++";
 112 # html text to include at home page
 113 our $home_text = "++GITWEB_HOMETEXT++";
 114 # filename of html text to include at bottom of each page
 115 our $site_footer = "++GITWEB_SITE_FOOTER++";
 116
 117 # URI of stylesheets
 118 our @stylesheets = ("++GITWEB_CSS++");
 119 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
 120 our $stylesheet = undef;
 121 # URI of GIT logo (72x27 size)
 122 our $logo = "++GITWEB_LOGO++";
 123 # URI of GIT favicon, assumed to be image/png type
 124 our $favicon = "++GITWEB_FAVICON++";
 125 # URI of gitweb.js (JavaScript code for gitweb)
 126 our $javascript = "++GITWEB_JS++";
 127
 128 # URI and label (title) of GIT logo link
 129 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
 130 #our $logo_label = "git documentation";
 131 our $logo_url = "http://git-scm.com/";
 132 our $logo_label = "git homepage";
 133
 134 # source of projects list
 135 our $projects_list = "++GITWEB_LIST++";
 136
 137 # the width (in characters) of the projects list "Description" column
 138 our $projects_list_description_width = 25;
 139
 140 # group projects by category on the projects list
 141 # (enabled if this variable evaluates to true)
 142 our $projects_list_group_categories = 0;
 143
 144 # default category if none specified
 145 # (leave the empty string for no category)
 146 our $project_list_default_category = "";
 147
 148 # default order of projects list
 149 # valid values are none, project, descr, owner, and age
 150 our $default_projects_order = "project";
 151
 152 # default order of refs list
 153 # valid values are age and name
 154 our $default_refs_order = "age";
 155
 156 # show repository only if this file exists
 157 # (only effective if this variable evaluates to true)
 158 our $export_ok = "++GITWEB_EXPORT_OK++";
 159
 160 # don't generate age column on the projects list page
 161 our $omit_age_column = 0;
 162
 163 # use contents of this file (in iso, iso-strict or raw format) as
 164 # the last activity data if it exists and is a valid date
 165 our $lastactivity_file = undef;
 166
 167 # don't generate information about owners of repositories
 168 our $omit_owner=0;
 169
 170 # owner link hook given owner name (full and NOT obfuscated)
 171 # should return full URL-escaped link to attach to owner, for example:
 172 #    sub { return "/showowner.cgi?owner=".CGI::Util::escape($_[0]); }
 173 our $owner_link_hook = undef;
 174
 175 # show repository only if this subroutine returns true
 176 # when given the path to the project, for example:
 177 #    sub { return -e "$_[0]/git-daemon-export-ok"; }
 178 our $export_auth_hook = undef;
 179
 180 # only allow viewing of repositories also shown on the overview page
 181 our $strict_export = "++GITWEB_STRICT_EXPORT++";
 182
 183 # base URL for bundle info link shown on summary page, but only if
 184 # this config item is defined AND a 'bundles' subdirectory exists
 185 # in the project's repository.
 186 # i.e. full URL is "git_base_bundles_url/$project/bundles"
 187 our $git_base_bundles_url = undef;
 188
 189 ## URL Hints
 190 ##
 191 ## Any of the urls in @git_base_url_list, @git_base_mirror_urls or
 192 ## @git_base_push_urls may be an array ref instead of a scalar in which
 193 ## case ${}[0] is the url and ${}[1] is an html fragment "hint" to display
 194 ## right after the URL.
 195
 196 # list of git base URLs used for URL to where fetch project from,
 197 # i.e. full URL is "$git_base_url/$project"
 198 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
 199
 200 ## For push projects (a .nofetch file exists OR gitweb.showpush is true)
 201 ## @git_base_url_list entries are shown as "URL" and @git_base_push_urls
 202 ## are shown as "push URL" and @git_base_mirror_urls are ignored.
 203 ## For non-push projects, @git_base_url_list and @git_base_mirror_urls are shown
 204 ## as "URL" and @git_base_push_urls are ignored.
 205
 206 # URLs shown for mirrors but not for push projects in addition to base_url_list,
 207 # extended by the project name (i.e. full URL is "$git_mirror_url/$project")
 208 our @git_base_mirror_urls = ();
 209
 210 # URLs designated for pushing new changes, extended by the
 211 # project name (i.e. "$git_base_push_url[0]/$project")
 212 our @git_base_push_urls = ();
 213
 214 # https hint html inserted right after any https push URL (undef for none)
 215 # ignored if the url already has its own hint
 216 # this is supported for backwards compatibility but is now deprecated in favor
 217 # of using an array ref in the @git_base_push_urls list instead
 218 our $https_hint_html = undef;
 219
 220 # default blob_plain mimetype and default charset for text/plain blob
 221 our $default_blob_plain_mimetype = 'application/octet-stream';
 222 our $default_text_plain_charset  = undef;
 223
 224 # file to use for guessing MIME types before trying /etc/mime.types
 225 # (relative to the current git repository)
 226 our $mimetypes_file = undef;
 227
 228 # assume this charset if line contains non-UTF-8 characters;
 229 # it should be valid encoding (see Encoding::Supported(3pm) for list),
 230 # for which encoding all byte sequences are valid, for example
 231 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
 232 # could be even 'utf-8' for the old behavior)
 233 our $fallback_encoding = 'latin1';
 234
 235 # rename detection options for git-diff and git-diff-tree
 236 # - default is '-M', with the cost proportional to
 237 #   (number of removed files) * (number of new files).
 238 # - more costly is '-C' (which implies '-M'), with the cost proportional to
 239 #   (number of changed files + number of removed files) * (number of new files)
 240 # - even more costly is '-C', '--find-copies-harder' with cost
 241 #   (number of files in the original tree) * (number of new files)
 242 # - one might want to include '-B' option, e.g. '-B', '-M'
 243 our @diff_opts = ('-M'); # taken from git_commit
 244
 245 # cache directory (relative to $GIT_DIR) for project-specific html page caches.
 246 # the directory must exist and be writable by the process running gitweb.
 247 # additionally some actions must be selected for caching in %html_cache_actions
 248 # - default is 'htmlcache'
 249 our $html_cache_dir = 'htmlcache';
 250
 251 # which actions to cache in $html_cache_dir
 252 # if $html_cache_dir exists (relative to $GIT_DIR) and is writable by the
 253 # process running gitweb, then any actions selected here will have their output
 254 # cached and the cache file will be returned instead of regenerating the page
 255 # if it exists.  For this to be useful, an external process must create the
 256 # 'changed' file (if it does not already exist) in the $html_cache_dir whenever
 257 # the project information has been changed.  Alternatively it may create a
 258 # "$action.changed" file (if it does not exist) instead to limit the changes
 259 # to just "$action" instead of any action.  If 'changed' or "$action.changed"
 260 # exist, then the cached version will never be used for "$action" and a new
 261 # cache page will be regenerated (and the "changed" files removed as appropriate).
 262 #
 263 # Additionally if $projlist_cache_lifetime is > 0 AND the forks feature has been
 264 # enabled ('$feature{'forks'}{'default'} = [1];') then additionally an external
 265 # process must create the 'forkchange' file or update its timestamp if it already
 266 # exists whenever a fork is added to or removed from the project (as well as
 267 # create the 'changed' or "$action.changed" file).  Otherwise the "forks"
 268 # section on the summary page may remain out-of-date indefinately.
 269 #
 270 # - default is none
 271 #   currently only caching of the summary page is supported
 272 # - to enable caching of the summary page use:
 273 #   $html_cache_actions{'summary'} = 1;
 274 our %html_cache_actions = ();
 275
 276 # utility to automatically produce a default README.html if README.html is
 277 # enabled and it does not exist or is 0 bytes in length.  If this is set to an
 278 # executable utility that takes an absolute path to a .git directory as its
 279 # first argument and outputs an HTML fragment to use for README.html, then
 280 # it will be called when README.html is enabled but empty or missing.
 281 our $git_automatic_readme_html = undef;
 282
 283 # Disables features that would allow repository owners to inject script into
 284 # the gitweb domain.
 285 our $prevent_xss = 0;
 286
 287 # Path to a POSIX shell.  Needed to run $highlight_bin and a snapshot compressor.
 288 # Only used when highlight is enabled or snapshots with compressors are enabled.
 289 our $posix_shell_bin = "++POSIX_SHELL_BIN++";
 290
 291 # Path to the highlight executable to use (must be the one from
 292 # http://www.andre-simon.de due to assumptions about parameters and output).
 293 # Useful if highlight is not installed on your webserver's PATH.
 294 # [Default: highlight]
 295 our $highlight_bin = "++HIGHLIGHT_BIN++";
 296
 297 # Whether to include project list on the gitweb front page; 0 means yes,
 298 # 1 means no list but show tag cloud if enabled (all projects still need
 299 # to be scanned, unless the info is cached), 2 means no list and no tag cloud
 300 # (very fast)
 301 our $frontpage_no_project_list = 0;
 302
 303 # projects list cache for busy sites with many projects;
 304 # if you set this to non-zero, it will be used as the cached
 305 # index lifetime in minutes
 306 #
 307 # the cached list version is stored in $cache_dir/$cache_name and can
 308 # be tweaked by other scripts running with the same uid as gitweb -
 309 # use this ONLY at secure installations; only single gitweb project
 310 # root per system is supported, unless you tweak configuration!
 311 our $projlist_cache_lifetime = 0; # in minutes
 312 # FHS compliant $cache_dir would be "/var/cache/gitweb"
 313 our $cache_dir =
 314         (defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp').'/gitweb';
 315 our $projlist_cache_name = 'gitweb.index.cache';
 316 our $cache_grpshared = 0;
 317
 318 # information about snapshot formats that gitweb is capable of serving
 319 our %known_snapshot_formats = (
 320         # name => {
 321         #       'display' => display name,
 322         #       'type' => mime type,
 323         #       'suffix' => filename suffix,
 324         #       'format' => --format for git-archive,
 325         #       'compressor' => [compressor command and arguments]
 326         #                       (array reference, optional)
 327         #       'disabled' => boolean (optional)}
 328         #
 329         'tgz' => {
 330                 'display' => 'tar.gz',
 331                 'type' => 'application/x-gzip',
 332                 'suffix' => '.tar.gz',
 333                 'format' => 'tar',
 334                 'compressor' => ['gzip', '-n']},
 335
 336         'tbz2' => {
 337                 'display' => 'tar.bz2',
 338                 'type' => 'application/x-bzip2',
 339                 'suffix' => '.tar.bz2',
 340                 'format' => 'tar',
 341                 'compressor' => ['bzip2']},
 342
 343         'txz' => {
 344                 'display' => 'tar.xz',
 345                 'type' => 'application/x-xz',
 346                 'suffix' => '.tar.xz',
 347                 'format' => 'tar',
 348                 'compressor' => ['xz'],
 349                 'disabled' => 1},
 350
 351         'zip' => {
 352                 'display' => 'zip',
 353                 'type' => 'application/x-zip',
 354                 'suffix' => '.zip',
 355                 'format' => 'zip'},
 356 );
 357
 358 # Aliases so we understand old gitweb.snapshot values in repository
 359 # configuration.
 360 our %known_snapshot_format_aliases = (
 361         'gzip'  => 'tgz',
 362         'bzip2' => 'tbz2',
 363         'xz'    => 'txz',
 364
 365         # backward compatibility: legacy gitweb config support
 366         'x-gzip' => undef, 'gz' => undef,
 367         'x-bzip2' => undef, 'bz2' => undef,
 368         'x-zip' => undef, '' => undef,
 369 );
 370
 371 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
 372 # are changed, it may be appropriate to change these values too via
 373 # $GITWEB_CONFIG.
 374 our %avatar_size = (
 375         'default' => 16,
 376         'double'  => 32
 377 );
 378
 379 # Used to set the maximum load that we will still respond to gitweb queries.
 380 # If server load exceed this value then return "503 server busy" error.
 381 # If gitweb cannot determined server load, it is taken to be 0.
 382 # Leave it undefined (or set to 'undef') to turn off load checking.
 383 our $maxload = 300;
 384
 385 # configuration for 'highlight' (http://www.andre-simon.de/)
 386 # match by basename
 387 our %highlight_basename = (
 388         #'Program' => 'py',
 389         #'Library' => 'py',
 390         'SConstruct' => 'py', # SCons equivalent of Makefile
 391         'Makefile' => 'make',
 392         'makefile' => 'make',
 393         'GNUmakefile' => 'make',
 394         'BSDmakefile' => 'make',
 395 );
 396 # match by shebang regex
 397 our %highlight_shebang = (
 398         # Each entry has a key which is the syntax to use and
 399         # a value which is either a qr regex or an array of qr regexs to match
 400         # against the first 128 (less if the blob is shorter) BYTES of the blob.
 401         # We match /usr/bin/env items separately to require "/usr/bin/env" and
 402         # allow a limited subset of NAME=value items to appear.
 403         'awk'    => [ qr,^#!\s*/(?:\w+/)*(?:[gnm]?awk)(?:\s|$),mo,
 404                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[gnm]?awk)(?:\s|$),mo ],
 405         'make'   => [ qr,^#!\s*/(?:\w+/)*(?:g?make)(?:\s|$),mo,
 406                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:g?make)(?:\s|$),mo ],
 407         'php'    => [ qr,^#!\s*/(?:\w+/)*(?:php)(?:\s|$),mo,
 408                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:php)(?:\s|$),mo ],
 409         'pl'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 410                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 411         'py'     => [ qr,^#!\s*/(?:\w+/)*(?:python)(?:\s|$),mo,
 412                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:python)(?:\s|$),mo ],
 413         'sh'     => [ qr,^#!\s*/(?:\w+/)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo,
 414                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo ],
 415         'rb'     => [ qr,^#!\s*/(?:\w+/)*(?:ruby)(?:\s|$),mo,
 416                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:ruby)(?:\s|$),mo ],
 417 );
 418 # match by extension
 419 our %highlight_ext = (
 420         # main extensions, defining name of syntax;
 421         # see files in /usr/share/highlight/langDefs/ directory
 422         (map { $_ => $_ } qw(
 423                 4gl a4c abnf abp ada agda ahk ampl amtrix applescript arc
 424                 arm as asm asp aspect ats au3 avenue awk bat bb bbcode bib
 425                 bms bnf boo c cb cfc chl clipper clojure clp cob cs css d
 426                 diff dot dylan e ebnf erl euphoria exp f90 flx for frink fs
 427                 go haskell hcl html httpd hx icl icn idl idlang ili
 428                 inc_luatex ini inp io iss j java js jsp lbn ldif lgt lhs
 429                 lisp lotos ls lsl lua ly make mel mercury mib miranda ml mo
 430                 mod2 mod3 mpl ms mssql n nas nbc nice nrx nsi nut nxc oberon
 431                 objc octave oorexx os oz pas php pike pl pl1 pov pro
 432                 progress ps ps1 psl pure py pyx q qmake qu r rb rebol rexx
 433                 rnc s sas sc scala scilab sh sma smalltalk sml sno spec spn
 434                 sql sybase tcl tcsh tex ttcn3 vala vb verilog vhd xml xpp y
 435                 yaiff znn)),
 436         # alternate extensions, see /etc/highlight/filetypes.conf
 437         (map { $_ => '4gl' } qw(informix)),
 438         (map { $_ => 'a4c' } qw(ascend)),
 439         (map { $_ => 'abp' } qw(abp4)),
 440         (map { $_ => 'ada' } qw(a adb ads gnad)),
 441         (map { $_ => 'ahk' } qw(autohotkey)),
 442         (map { $_ => 'ampl' } qw(dat run)),
 443         (map { $_ => 'amtrix' } qw(hnd s4 s4h s4t t4)),
 444         (map { $_ => 'as' } qw(actionscript)),
 445         (map { $_ => 'asm' } qw(29k 68s 68x a51 assembler x68 x86)),
 446         (map { $_ => 'asp' } qw(asa)),
 447         (map { $_ => 'aspect' } qw(was wud)),
 448         (map { $_ => 'ats' } qw(dats)),
 449         (map { $_ => 'au3' } qw(autoit)),
 450         (map { $_ => 'bat' } qw(cmd)),
 451         (map { $_ => 'bb' } qw(blitzbasic)),
 452         (map { $_ => 'bib' } qw(bibtex)),
 453         (map { $_ => 'c' } qw(c++ cc cpp cu cxx h hh hpp hxx)),
 454         (map { $_ => 'cb' } qw(clearbasic)),
 455         (map { $_ => 'cfc' } qw(cfm coldfusion)),
 456         (map { $_ => 'chl' } qw(chill)),
 457         (map { $_ => 'cob' } qw(cbl cobol)),
 458         (map { $_ => 'cs' } qw(csharp)),
 459         (map { $_ => 'diff' } qw(patch)),
 460         (map { $_ => 'dot' } qw(graphviz)),
 461         (map { $_ => 'e' } qw(eiffel se)),
 462         (map { $_ => 'erl' } qw(erlang hrl)),
 463         (map { $_ => 'euphoria' } qw(eu ew ex exu exw wxu)),
 464         (map { $_ => 'exp' } qw(express)),
 465         (map { $_ => 'f90' } qw(f95)),
 466         (map { $_ => 'flx' } qw(felix)),
 467         (map { $_ => 'for' } qw(f f77 ftn)),
 468         (map { $_ => 'fs' } qw(fsharp fsx)),
 469         (map { $_ => 'haskell' } qw(hs)),
 470         (map { $_ => 'html' } qw(htm xhtml)),
 471         (map { $_ => 'hx' } qw(haxe)),
 472         (map { $_ => 'icl' } qw(clean)),
 473         (map { $_ => 'icn' } qw(icon)),
 474         (map { $_ => 'ili' } qw(interlis)),
 475         (map { $_ => 'inp' } qw(fame)),
 476         (map { $_ => 'iss' } qw(innosetup)),
 477         (map { $_ => 'j' } qw(jasmin)),
 478         (map { $_ => 'java' } qw(groovy grv)),
 479         (map { $_ => 'lbn' } qw(luban)),
 480         (map { $_ => 'lgt' } qw(logtalk)),
 481         (map { $_ => 'lisp' } qw(cl clisp el lsp sbcl scom)),
 482         (map { $_ => 'ls' } qw(lotus)),
 483         (map { $_ => 'lsl' } qw(lindenscript)),
 484         (map { $_ => 'ly' } qw(lilypond)),
 485         (map { $_ => 'make' } qw(mak mk kmk)),
 486         (map { $_ => 'mel' } qw(maya)),
 487         (map { $_ => 'mib' } qw(smi snmp)),
 488         (map { $_ => 'ml' } qw(mli ocaml)),
 489         (map { $_ => 'mo' } qw(modelica)),
 490         (map { $_ => 'mod2' } qw(def mod)),
 491         (map { $_ => 'mod3' } qw(i3 m3)),
 492         (map { $_ => 'mpl' } qw(maple)),
 493         (map { $_ => 'n' } qw(nemerle)),
 494         (map { $_ => 'nas' } qw(nasal)),
 495         (map { $_ => 'nrx' } qw(netrexx)),
 496         (map { $_ => 'nsi' } qw(nsis)),
 497         (map { $_ => 'nut' } qw(squirrel)),
 498         (map { $_ => 'oberon' } qw(ooc)),
 499         (map { $_ => 'objc' } qw(M m mm)),
 500         (map { $_ => 'php' } qw(php3 php4 php5 php6)),
 501         (map { $_ => 'pike' } qw(pmod)),
 502         (map { $_ => 'pl' } qw(perl plex plx pm)),
 503         (map { $_ => 'pl1' } qw(bdy ff fp fpp rpp sf sp spb spe spp sps wf wp wpb wpp wps)),
 504         (map { $_ => 'progress' } qw(i p w)),
 505         (map { $_ => 'py' } qw(python)),
 506         (map { $_ => 'pyx' } qw(pyrex)),
 507         (map { $_ => 'rb' } qw(pp rjs ruby)),
 508         (map { $_ => 'rexx' } qw(rex rx the)),
 509         (map { $_ => 'sc' } qw(paradox)),
 510         (map { $_ => 'scilab' } qw(sce sci)),
 511         (map { $_ => 'sh' } qw(bash ebuild eclass ksh zsh)),
 512         (map { $_ => 'sma' } qw(small)),
 513         (map { $_ => 'smalltalk' } qw(gst sq st)),
 514         (map { $_ => 'sno' } qw(snobal)),
 515         (map { $_ => 'sybase' } qw(sp)),
 516         (map { $_ => 'tcl' } qw(itcl wish)),
 517         (map { $_ => 'tex' } qw(cls sty)),
 518         (map { $_ => 'vb' } qw(bas basic bi vbs)),
 519         (map { $_ => 'verilog' } qw(v)),
 520         (map { $_ => 'xml' } qw(dtd ecf ent hdr hub jnlp nrm plist resx sgm sgml svg tld vxml wml xsd xsl)),
 521         (map { $_ => 'y' } qw(bison)),
 522 );
 523
 524 # You define site-wide feature defaults here; override them with
 525 # $GITWEB_CONFIG as necessary.
 526 our %feature = (
 527         # feature => {
 528         #       'sub' => feature-sub (subroutine),
 529         #       'override' => allow-override (boolean),
 530         #       'default' => [ default options...] (array reference)}
 531         #
 532         # if feature is overridable (it means that allow-override has true value),
 533         # then feature-sub will be called with default options as parameters;
 534         # return value of feature-sub indicates if to enable specified feature
 535         #
 536         # if there is no 'sub' key (no feature-sub), then feature cannot be
 537         # overridden
 538         #
 539         # use gitweb_get_feature(<feature>) to retrieve the <feature> value
 540         # (an array) or gitweb_check_feature(<feature>) to check if <feature>
 541         # is enabled
 542
 543         # Enable the 'blame' blob view, showing the last commit that modified
 544         # each line in the file. This can be very CPU-intensive.
 545
 546         # To enable system wide have in $GITWEB_CONFIG
 547         # $feature{'blame'}{'default'} = [1];
 548         # To have project specific config enable override in $GITWEB_CONFIG
 549         # $feature{'blame'}{'override'} = 1;
 550         # and in project config gitweb.blame = 0|1;
 551         'blame' => {
 552                 'sub' => sub { feature_bool('blame', @_) },
 553                 'override' => 0,
 554                 'default' => [0]},
 555
 556         # Enable the 'incremental blame' blob view, which uses javascript to
 557         # incrementally show the revisions of lines as they are discovered
 558         # in the history. It is better for large histories, files and slow
 559         # servers, but requires javascript in the client and can slow down the
 560         # browser on large files.
 561
 562         # To enable system wide have in $GITWEB_CONFIG
 563         # $feature{'blame_incremental'}{'default'} = [1];
 564         # To have project specific config enable override in $GITWEB_CONFIG
 565         # $feature{'blame_incremental'}{'override'} = 1;
 566         # and in project config gitweb.blame_incremental = 0|1;
 567         'blame_incremental' => {
 568                 'sub' => sub { feature_bool('blame_incremental', @_) },
 569                 'override' => 0,
 570                 'default' => [0]},
 571
 572         # Enable the 'snapshot' link, providing a compressed archive of any
 573         # tree. This can potentially generate high traffic if you have large
 574         # project.
 575
 576         # Value is a list of formats defined in %known_snapshot_formats that
 577         # you wish to offer.
 578         # To disable system wide have in $GITWEB_CONFIG
 579         # $feature{'snapshot'}{'default'} = [];
 580         # To have project specific config enable override in $GITWEB_CONFIG
 581         # $feature{'snapshot'}{'override'} = 1;
 582         # and in project config, a comma-separated list of formats or "none"
 583         # to disable.  Example: gitweb.snapshot = tbz2,zip;
 584         'snapshot' => {
 585                 'sub' => \&feature_snapshot,
 586                 'override' => 0,
 587                 'default' => ['tgz']},
 588
 589         # Enable text search, which will list the commits which match author,
 590         # committer or commit text to a given string.  Enabled by default.
 591         # Project specific override is not supported.
 592         #
 593         # Note that this controls all search features, which means that if
 594         # it is disabled, then 'grep' and 'pickaxe' search would also be
 595         # disabled.
 596         'search' => {
 597                 'override' => 0,
 598                 'default' => [1]},
 599
 600         # Enable regular expression search.  Enabled by default.
 601         # Note that you need to have 'search' feature enabled too.
 602         #
 603         # Note that this affects all git search features, which means that if
 604         # it is disabled, none of the git search options will allow a regular
 605         # expression (the "RE" checkbox) to be used.  However, the project
 606         # list search is unaffected by this setting (it uses Perl to do the
 607         # matching not Git) and will always allow a regular expression to
 608         # be used (by checking the box) regardless of this setting.
 609         'regexp' => {
 610                 'sub' => sub { feature_bool('regexp', @_) },
 611                 'override' => 0,
 612                 'default' => [1]},
 613
 614         # Enable grep search, which will list the files in currently selected
 615         # tree containing the given string. Enabled by default. This can be
 616         # potentially CPU-intensive, of course.
 617         # Note that you need to have 'search' feature enabled too.
 618
 619         # To enable system wide have in $GITWEB_CONFIG
 620         # $feature{'grep'}{'default'} = [1];
 621         # To have project specific config enable override in $GITWEB_CONFIG
 622         # $feature{'grep'}{'override'} = 1;
 623         # and in project config gitweb.grep = 0|1;
 624         'grep' => {
 625                 'sub' => sub { feature_bool('grep', @_) },
 626                 'override' => 0,
 627                 'default' => [1]},
 628
 629         # Enable the pickaxe search, which will list the commits that modified
 630         # a given string in a file. This can be practical and quite faster
 631         # alternative to 'blame', but still potentially CPU-intensive.
 632         # Note that you need to have 'search' feature enabled too.
 633
 634         # To enable system wide have in $GITWEB_CONFIG
 635         # $feature{'pickaxe'}{'default'} = [1];
 636         # To have project specific config enable override in $GITWEB_CONFIG
 637         # $feature{'pickaxe'}{'override'} = 1;
 638         # and in project config gitweb.pickaxe = 0|1;
 639         'pickaxe' => {
 640                 'sub' => sub { feature_bool('pickaxe', @_) },
 641                 'override' => 0,
 642                 'default' => [1]},
 643
 644         # Enable showing size of blobs in a 'tree' view, in a separate
 645         # column, similar to what 'ls -l' does.  This cost a bit of IO.
 646
 647         # To disable system wide have in $GITWEB_CONFIG
 648         # $feature{'show-sizes'}{'default'} = [0];
 649         # To have project specific config enable override in $GITWEB_CONFIG
 650         # $feature{'show-sizes'}{'override'} = 1;
 651         # and in project config gitweb.showsizes = 0|1;
 652         'show-sizes' => {
 653                 'sub' => sub { feature_bool('showsizes', @_) },
 654                 'override' => 0,
 655                 'default' => [1]},
 656
 657         # Make gitweb use an alternative format of the URLs which can be
 658         # more readable and natural-looking: project name is embedded
 659         # directly in the path and the query string contains other
 660         # auxiliary information. All gitweb installations recognize
 661         # URL in either format; this configures in which formats gitweb
 662         # generates links.
 663
 664         # To enable system wide have in $GITWEB_CONFIG
 665         # $feature{'pathinfo'}{'default'} = [1];
 666         # Project specific override is not supported.
 667
 668         # Note that you will need to change the default location of CSS,
 669         # favicon, logo and possibly other files to an absolute URL. Also,
 670         # if gitweb.cgi serves as your indexfile, you will need to force
 671         # $my_uri to contain the script name in your $GITWEB_CONFIG (and you
 672         # will also likely want to set $home_link if you're setting $my_uri).
 673         'pathinfo' => {
 674                 'override' => 0,
 675                 'default' => [0]},
 676
 677         # Make gitweb consider projects in project root subdirectories
 678         # to be forks of existing projects. Given project $projname.git,
 679         # projects matching $projname/*.git will not be shown in the main
 680         # projects list, instead a '+' mark will be added to $projname
 681         # there and a 'forks' view will be enabled for the project, listing
 682         # all the forks. If project list is taken from a file, forks have
 683         # to be listed after the main project.
 684
 685         # To enable system wide have in $GITWEB_CONFIG
 686         # $feature{'forks'}{'default'} = [1];
 687         # Project specific override is not supported.
 688         'forks' => {
 689                 'override' => 0,
 690                 'default' => [0]},
 691
 692         # Insert custom links to the action bar of all project pages.
 693         # This enables you mainly to link to third-party scripts integrating
 694         # into gitweb; e.g. git-browser for graphical history representation
 695         # or custom web-based repository administration interface.
 696
 697         # The 'default' value consists of a list of triplets in the form
 698         # (label, link, position) where position is the label after which
 699         # to insert the link and link is a format string where %n expands
 700         # to the project name, %f to the project path within the filesystem,
 701         # %h to the current hash (h gitweb parameter) and %b to the current
 702         # hash base (hb gitweb parameter); %% expands to %.  %e expands to the
 703         # project name where all '+' characters have been replaced with '%2B'.
 704
 705         # To enable system wide have in $GITWEB_CONFIG e.g.
 706         # $feature{'actions'}{'default'} = [('graphiclog',
 707         #       '/git-browser/by-commit.html?r=%n', 'summary')];
 708         # Project specific override is not supported.
 709         'actions' => {
 710                 'override' => 0,
 711                 'default' => []},
 712
 713         # Allow gitweb scan project content tags of project repository,
 714         # and display the popular Web 2.0-ish "tag cloud" near the projects
 715         # list.  Note that this is something COMPLETELY different from the
 716         # normal Git tags.
 717
 718         # gitweb by itself can show existing tags, but it does not handle
 719         # tagging itself; you need to do it externally, outside gitweb.
 720         # The format is described in git_get_project_ctags() subroutine.
 721         # You may want to install the HTML::TagCloud Perl module to get
 722         # a pretty tag cloud instead of just a list of tags.
 723
 724         # To enable system wide have in $GITWEB_CONFIG
 725         # $feature{'ctags'}{'default'} = [1];
 726         # Project specific override is not supported.
 727
 728         # A value of 0 means no ctags display or editing.  A value of
 729         # 1 enables ctags display but never editing.  A non-empty value
 730         # that is not a string of digits enables ctags display AND the
 731         # ability to add tags using a form that uses method POST and
 732         # an action value set to the configured 'ctags' value.
 733         'ctags' => {
 734                 'override' => 0,
 735                 'default' => [0]},
 736
 737         # The maximum number of patches in a patchset generated in patch
 738         # view. Set this to 0 or undef to disable patch view, or to a
 739         # negative number to remove any limit.
 740
 741         # To disable system wide have in $GITWEB_CONFIG
 742         # $feature{'patches'}{'default'} = [0];
 743         # To have project specific config enable override in $GITWEB_CONFIG
 744         # $feature{'patches'}{'override'} = 1;
 745         # and in project config gitweb.patches = 0|n;
 746         # where n is the maximum number of patches allowed in a patchset.
 747         'patches' => {
 748                 'sub' => \&feature_patches,
 749                 'override' => 0,
 750                 'default' => [16]},
 751
 752         # Avatar support. When this feature is enabled, views such as
 753         # shortlog or commit will display an avatar associated with
 754         # the email of the committer(s) and/or author(s).
 755
 756         # Currently available providers are gravatar and picon.
 757         # If an unknown provider is specified, the feature is disabled.
 758
 759         # Gravatar depends on Digest::MD5.
 760         # Picon currently relies on the indiana.edu database.
 761
 762         # To enable system wide have in $GITWEB_CONFIG
 763         # $feature{'avatar'}{'default'} = ['<provider>'];
 764         # where <provider> is either gravatar or picon.
 765         # To have project specific config enable override in $GITWEB_CONFIG
 766         # $feature{'avatar'}{'override'} = 1;
 767         # and in project config gitweb.avatar = <provider>;
 768         'avatar' => {
 769                 'sub' => \&feature_avatar,
 770                 'override' => 0,
 771                 'default' => ['']},
 772
 773         # Enable displaying how much time and how many git commands
 774         # it took to generate and display page.  Disabled by default.
 775         # Project specific override is not supported.
 776         'timed' => {
 777                 'override' => 0,
 778                 'default' => [0]},
 779
 780         # Enable turning some links into links to actions which require
 781         # JavaScript to run (like 'blame_incremental').  Not enabled by
 782         # default.  Project specific override is currently not supported.
 783         'javascript-actions' => {
 784                 'override' => 0,
 785                 'default' => [0]},
 786
 787         # Enable and configure ability to change common timezone for dates
 788         # in gitweb output via JavaScript.  Enabled by default.
 789         # Project specific override is not supported.
 790         'javascript-timezone' => {
 791                 'override' => 0,
 792                 'default' => [
 793                         'local',     # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
 794                                      # or undef to turn off this feature
 795                         'gitweb_tz', # name of cookie where to store selected timezone
 796                         'datetime',  # CSS class used to mark up dates for manipulation
 797                 ]},
 798
 799         # Syntax highlighting support. This is based on Daniel Svensson's
 800         # and Sham Chukoury's work in gitweb-xmms2.git.
 801         # It requires the 'highlight' program present in $PATH,
 802         # and therefore is disabled by default.
 803
 804         # To enable system wide have in $GITWEB_CONFIG
 805         # $feature{'highlight'}{'default'} = [1];
 806
 807         'highlight' => {
 808                 'sub' => sub { feature_bool('highlight', @_) },
 809                 'override' => 0,
 810                 'default' => [0]},
 811
 812         # Enable displaying of remote heads in the heads list
 813
 814         # To enable system wide have in $GITWEB_CONFIG
 815         # $feature{'remote_heads'}{'default'} = [1];
 816         # To have project specific config enable override in $GITWEB_CONFIG
 817         # $feature{'remote_heads'}{'override'} = 1;
 818         # and in project config gitweb.remoteheads = 0|1;
 819         'remote_heads' => {
 820                 'sub' => sub { feature_bool('remote_heads', @_) },
 821                 'override' => 0,
 822                 'default' => [0]},
 823
 824         # Enable showing branches under other refs in addition to heads
 825
 826         # To set system wide extra branch refs have in $GITWEB_CONFIG
 827         # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
 828         # To have project specific config enable override in $GITWEB_CONFIG
 829         # $feature{'extra-branch-refs'}{'override'} = 1;
 830         # and in project config gitweb.extrabranchrefs = dirs of choice
 831         # Every directory is separated with whitespace.
 832
 833         'extra-branch-refs' => {
 834                 'sub' => \&feature_extra_branch_refs,
 835                 'override' => 0,
 836                 'default' => []},
 837 );
 838
 839 sub gitweb_get_feature {
 840         my ($name) = @_;
 841         return unless exists $feature{$name};
 842         my ($sub, $override, @defaults) = (
 843                 $feature{$name}{'sub'},
 844                 $feature{$name}{'override'},
 845                 @{$feature{$name}{'default'}});
 846         # project specific override is possible only if we have project
 847         our $git_dir; # global variable, declared later
 848         if (!$override || !defined $git_dir) {
 849                 return @defaults;
 850         }
 851         if (!defined $sub) {
 852                 warn "feature $name is not overridable";
 853                 return @defaults;
 854         }
 855         return $sub->(@defaults);
 856 }
 857
 858 # A wrapper to check if a given feature is enabled.
 859 # With this, you can say
 860 #
 861 #   my $bool_feat = gitweb_check_feature('bool_feat');
 862 #   gitweb_check_feature('bool_feat') or somecode;
 863 #
 864 # instead of
 865 #
 866 #   my ($bool_feat) = gitweb_get_feature('bool_feat');
 867 #   (gitweb_get_feature('bool_feat'))[0] or somecode;
 868 #
 869 sub gitweb_check_feature {
 870         return (gitweb_get_feature(@_))[0];
 871 }
 872
 873
 874 sub feature_bool {
 875         my $key = shift;
 876         my ($val) = git_get_project_config($key, '--bool');
 877
 878         if (!defined $val) {
 879                 return ($_[0]);
 880         } elsif ($val eq 'true') {
 881                 return (1);
 882         } elsif ($val eq 'false') {
 883                 return (0);
 884         }
 885 }
 886
 887 sub feature_snapshot {
 888         my (@fmts) = @_;
 889
 890         my ($val) = git_get_project_config('snapshot');
 891
 892         if ($val) {
 893                 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
 894         }
 895
 896         return @fmts;
 897 }
 898
 899 sub feature_patches {
 900         my @val = (git_get_project_config('patches', '--int'));
 901
 902         if (@val) {
 903                 return @val;
 904         }
 905
 906         return ($_[0]);
 907 }
 908
 909 sub feature_avatar {
 910         my @val = (git_get_project_config('avatar'));
 911
 912         return @val ? @val : @_;
 913 }
 914
 915 sub feature_extra_branch_refs {
 916         my (@branch_refs) = @_;
 917         my $values = git_get_project_config('extrabranchrefs');
 918
 919         if ($values) {
 920                 $values = config_to_multi ($values);
 921                 @branch_refs = ();
 922                 foreach my $value (@{$values}) {
 923                         push @branch_refs, split /\s+/, $value;
 924                 }
 925         }
 926
 927         return @branch_refs;
 928 }
 929
 930 # checking HEAD file with -e is fragile if the repository was
 931 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
 932 # and then pruned.
 933 sub check_head_link {
 934         my ($dir) = @_;
 935         return 0 unless -d "$dir/objects" && -x _;
 936         return 0 unless -d "$dir/refs" && -x _;
 937         my $headfile = "$dir/HEAD";
 938         return -l $headfile ?
 939                 readlink($headfile) =~ /^refs\/heads\// : -f $headfile;
 940 }
 941
 942 sub check_export_ok {
 943         my ($dir) = @_;
 944         return (check_head_link($dir) &&
 945                 (!$export_ok || -e "$dir/$export_ok") &&
 946                 (!$export_auth_hook || $export_auth_hook->($dir)));
 947 }
 948
 949 # process alternate names for backward compatibility
 950 # filter out unsupported (unknown) snapshot formats
 951 sub filter_snapshot_fmts {
 952         my @fmts = @_;
 953
 954         @fmts = map {
 955                 exists $known_snapshot_format_aliases{$_} ?
 956                        $known_snapshot_format_aliases{$_} : $_} @fmts;
 957         @fmts = grep {
 958                 exists $known_snapshot_formats{$_} &&
 959                 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
 960 }
 961
 962 sub filter_and_validate_refs {
 963         my @refs = @_;
 964         my %unique_refs = ();
 965
 966         foreach my $ref (@refs) {
 967                 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
 968                 # 'heads' are added implicitly in get_branch_refs().
 969                 $unique_refs{$ref} = 1 if ($ref ne 'heads');
 970         }
 971         return sort keys %unique_refs;
 972 }
 973
 974 # If it is set to code reference, it is code that it is to be run once per
 975 # request, allowing updating configurations that change with each request,
 976 # while running other code in config file only once.
 977 #
 978 # Otherwise, if it is false then gitweb would process config file only once;
 979 # if it is true then gitweb config would be run for each request.
 980 our $per_request_config = 1;
 981
 982 # If true and fileno STDIN is 0 and getsockname succeeds and getpeername fails
 983 # with ENOTCONN, then FCGI mode will be activated automatically in just the
 984 # same way as though the --fcgi option had been given instead.
 985 our $auto_fcgi = 0;
 986
 987 # read and parse gitweb config file given by its parameter.
 988 # returns true on success, false on recoverable error, allowing
 989 # to chain this subroutine, using first file that exists.
 990 # dies on errors during parsing config file, as it is unrecoverable.
 991 sub read_config_file {
 992         my $filename = shift;
 993         return unless defined $filename;
 994         # die if there are errors parsing config file
 995         if (-e $filename) {
 996                 do $filename;
 997                 die $@ if $@;
 998                 return 1;
 999         }
1000         return;
1001 }
1002
1003 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
1004 sub evaluate_gitweb_config {
1005         our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
1006         our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
1007         our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
1008
1009         # Protect against duplications of file names, to not read config twice.
1010         # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
1011         # there possibility of duplication of filename there doesn't matter.
1012         $GITWEB_CONFIG = ""        if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
1013         $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
1014
1015         # Common system-wide settings for convenience.
1016         # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
1017         read_config_file($GITWEB_CONFIG_COMMON);
1018
1019         # Use first config file that exists.  This means use the per-instance
1020         # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
1021         read_config_file($GITWEB_CONFIG) and return;
1022         read_config_file($GITWEB_CONFIG_SYSTEM);
1023 }
1024
1025 our $encode_object;
1026 our $to_utf8_pipe_command = '';
1027
1028 sub evaluate_encoding {
1029         my $requested = $fallback_encoding || 'ISO-8859-1';
1030         my $obj = Encode::find_encoding($requested) or
1031                 die_error(400, "Requested fallback encoding not found");
1032         if ($obj->name eq 'iso-8859-1') {
1033                 # Use Windows-1252 instead as required by the HTML 5 standard
1034                 my $altobj = Encode::find_encoding('Windows-1252');
1035                 $obj = $altobj if $altobj;
1036         }
1037         $encode_object = $obj;
1038         my $nm = lc($encode_object->name);
1039         unless ($nm eq 'cp1252' || $nm eq 'ascii' || $nm eq 'utf8' ||
1040                 $nm =~ /^utf-8/ || $nm =~ /^iso-8859-/) {
1041                 $to_utf8_pipe_command =
1042                   quote_command($^X, '-CO', '-MEncode=decode,FB_DEFAULT', '-pse',
1043                     '$_ = decode($fe, $_, FB_DEFAULT) if !utf8::decode($_);',
1044                     '--', "-fe=$fallback_encoding")." | ";
1045         }
1046 }
1047
1048 sub evaluate_email_obfuscate {
1049         # email obfuscation
1050         our $email;
1051         if (!$email && eval { require HTML::Email::Obfuscate; 1 }) {
1052                 $email = HTML::Email::Obfuscate->new(lite => 1);
1053         }
1054 }
1055
1056 # Get loadavg of system, to compare against $maxload.
1057 # Currently it requires '/proc/loadavg' present to get loadavg;
1058 # if it is not present it returns 0, which means no load checking.
1059 sub get_loadavg {
1060         if( -e '/proc/loadavg' ){
1061                 open my $fd, '<', '/proc/loadavg'
1062                         or return 0;
1063                 my @load = split(/\s+/, scalar <$fd>);
1064                 close $fd;
1065
1066                 # The first three columns measure CPU and IO utilization of the last one,
1067                 # five, and 10 minute periods.  The fourth column shows the number of
1068                 # currently running processes and the total number of processes in the m/n
1069                 # format.  The last column displays the last process ID used.
1070                 return $load[0] || 0;
1071         }
1072         # additional checks for load average should go here for things that don't export
1073         # /proc/loadavg
1074
1075         return 0;
1076 }
1077
1078 # version of the core git binary
1079 our $git_version;
1080 our $git_vernum = "0"; # guaranteed to always match /^\d+(\.\d+)*$/
1081 sub evaluate_git_version {
1082         $git_version = $version; # don't leak system information to attackers
1083         $git_vernum eq "0" or return; # don't run it again
1084         sub cmd_pipe;
1085         my $vers;
1086         if (defined(my $fd = cmd_pipe $GIT, '--version')) {
1087                 $vers = <$fd>;
1088                 close $fd;
1089                 $number_of_git_cmds++;
1090         }
1091         $git_vernum = $1 if defined($vers) && $vers =~ /git\s+version\s+(\d+(?:\.\d+)*)$/io;
1092 }
1093
1094 sub check_loadavg {
1095         if (defined $maxload && get_loadavg() > $maxload) {
1096                 die_error(503, "The load average on the server is too high");
1097         }
1098 }
1099
1100 # ======================================================================
1101 # input validation and dispatch
1102
1103 # input parameters can be collected from a variety of sources (presently, CGI
1104 # and PATH_INFO), so we define an %input_params hash that collects them all
1105 # together during validation: this allows subsequent uses (e.g. href()) to be
1106 # agnostic of the parameter origin
1107
1108 our %input_params = ();
1109
1110 # input parameters are stored with the long parameter name as key. This will
1111 # also be used in the href subroutine to convert parameters to their CGI
1112 # equivalent, and since the href() usage is the most frequent one, we store
1113 # the name -> CGI key mapping here, instead of the reverse.
1114 #
1115 # XXX: Warning: If you touch this, check the search form for updating,
1116 # too.
1117
1118 our @cgi_param_mapping = (
1119         project => "p",
1120         action => "a",
1121         file_name => "f",
1122         file_parent => "fp",
1123         hash => "h",
1124         hash_parent => "hp",
1125         hash_base => "hb",
1126         hash_parent_base => "hpb",
1127         page => "pg",
1128         order => "o",
1129         searchtext => "s",
1130         searchtype => "st",
1131         snapshot_format => "sf",
1132         ctag_filter => 't',
1133         extra_options => "opt",
1134         search_use_regexp => "sr",
1135         ctag => "by_tag",
1136         diff_style => "ds",
1137         project_filter => "pf",
1138         # this must be last entry (for manipulation from JavaScript)
1139         javascript => "js"
1140 );
1141 our %cgi_param_mapping = @cgi_param_mapping;
1142
1143 # we will also need to know the possible actions, for validation
1144 our %actions = (
1145         "blame" => \&git_blame,
1146         "blame_incremental" => \&git_blame_incremental,
1147         "blame_data" => \&git_blame_data,
1148         "blobdiff" => \&git_blobdiff,
1149         "blobdiff_plain" => \&git_blobdiff_plain,
1150         "blob" => \&git_blob,
1151         "blob_plain" => \&git_blob_plain,
1152         "commitdiff" => \&git_commitdiff,
1153         "commitdiff_plain" => \&git_commitdiff_plain,
1154         "commit" => \&git_commit,
1155         "forks" => \&git_forks,
1156         "heads" => \&git_heads,
1157         "history" => \&git_history,
1158         "log" => \&git_log,
1159         "patch" => \&git_patch,
1160         "patches" => \&git_patches,
1161         "refs" => \&git_refs,
1162         "remotes" => \&git_remotes,
1163         "rss" => \&git_rss,
1164         "atom" => \&git_atom,
1165         "search" => \&git_search,
1166         "search_help" => \&git_search_help,
1167         "shortlog" => \&git_shortlog,
1168         "summary" => \&git_summary,
1169         "tag" => \&git_tag,
1170         "tags" => \&git_tags,
1171         "tree" => \&git_tree,
1172         "snapshot" => \&git_snapshot,
1173         "object" => \&git_object,
1174         # those below don't need $project
1175         "opml" => \&git_opml,
1176         "frontpage" => \&git_frontpage,
1177         "project_list" => \&git_project_list,
1178         "project_index" => \&git_project_index,
1179 );
1180
1181 # the only actions we will allow to be cached
1182 my %supported_cache_actions;
1183 BEGIN {%supported_cache_actions = map {( $_ => 1 )} qw(summary)}
1184
1185 # finally, we have the hash of allowed extra_options for the commands that
1186 # allow them
1187 our %allowed_options = (
1188         "--no-merges" => [ qw(rss atom log shortlog history) ],
1189 );
1190
1191 # fill %input_params with the CGI parameters. All values except for 'opt'
1192 # should be single values, but opt can be an array. We should probably
1193 # build an array of parameters that can be multi-valued, but since for the time
1194 # being it's only this one, we just single it out
1195 sub evaluate_query_params {
1196         our $cgi;
1197
1198         while (my ($name, $symbol) = each %cgi_param_mapping) {
1199                 if ($symbol eq 'opt') {
1200                         $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
1201                 } else {
1202                         $input_params{$name} = decode_utf8($cgi->param($symbol));
1203                 }
1204         }
1205
1206         # Backwards compatibility - by_tag= <=> t=
1207         if ($input_params{'ctag'}) {
1208                 $input_params{'ctag_filter'} = $input_params{'ctag'};
1209         }
1210 }
1211
1212 # now read PATH_INFO and update the parameter list for missing parameters
1213 sub evaluate_path_info {
1214         return if defined $input_params{'project'};
1215         return if !$path_info;
1216         $path_info =~ s,^/+,,;
1217         return if !$path_info;
1218
1219         # find which part of PATH_INFO is project
1220         my $project = $path_info;
1221         $project =~ s,/+$,,;
1222         while ($project && !check_head_link("$projectroot/$project")) {
1223                 $project =~ s,/*[^/]*$,,;
1224         }
1225         return unless $project;
1226         $input_params{'project'} = $project;
1227
1228         # do not change any parameters if an action is given using the query string
1229         return if $input_params{'action'};
1230         $path_info =~ s,^\Q$project\E/*,,;
1231
1232         # next, check if we have an action
1233         my $action = $path_info;
1234         $action =~ s,/.*$,,;
1235         if (exists $actions{$action}) {
1236                 $path_info =~ s,^$action/*,,;
1237                 $input_params{'action'} = $action;
1238         }
1239
1240         # list of actions that want hash_base instead of hash, but can have no
1241         # pathname (f) parameter
1242         my @wants_base = (
1243                 'tree',
1244                 'history',
1245         );
1246
1247         # we want to catch, among others
1248         # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
1249         my ($parentrefname, $parentpathname, $refname, $pathname) =
1250                 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
1251
1252         # first, analyze the 'current' part
1253         if (defined $pathname) {
1254                 # we got "branch:filename" or "branch:dir/"
1255                 # we could use git_get_type(branch:pathname), but:
1256                 # - it needs $git_dir
1257                 # - it does a git() call
1258                 # - the convention of terminating directories with a slash
1259                 #   makes it superfluous
1260                 # - embedding the action in the PATH_INFO would make it even
1261                 #   more superfluous
1262                 $pathname =~ s,^/+,,;
1263                 if (!$pathname || substr($pathname, -1) eq "/") {
1264                         $input_params{'action'} ||= "tree";
1265                         $pathname =~ s,/$,,;
1266                 } else {
1267                         # the default action depends on whether we had parent info
1268                         # or not
1269                         if ($parentrefname) {
1270                                 $input_params{'action'} ||= "blobdiff_plain";
1271                         } else {
1272                                 $input_params{'action'} ||= "blob_plain";
1273                         }
1274                 }
1275                 $input_params{'hash_base'} ||= $refname;
1276                 $input_params{'file_name'} ||= $pathname;
1277         } elsif (defined $refname) {
1278                 # we got "branch". In this case we have to choose if we have to
1279                 # set hash or hash_base.
1280                 #
1281                 # Most of the actions without a pathname only want hash to be
1282                 # set, except for the ones specified in @wants_base that want
1283                 # hash_base instead. It should also be noted that hand-crafted
1284                 # links having 'history' as an action and no pathname or hash
1285                 # set will fail, but that happens regardless of PATH_INFO.
1286                 if (defined $parentrefname) {
1287                         # if there is parent let the default be 'shortlog' action
1288                         # (for http://git.example.com/repo.git/A..B links); if there
1289                         # is no parent, dispatch will detect type of object and set
1290                         # action appropriately if required (if action is not set)
1291                         $input_params{'action'} ||= "shortlog";
1292                 }
1293                 if ($input_params{'action'} &&
1294                     grep { $_ eq $input_params{'action'} } @wants_base) {
1295                         $input_params{'hash_base'} ||= $refname;
1296                 } else {
1297                         $input_params{'hash'} ||= $refname;
1298                 }
1299         }
1300
1301         # next, handle the 'parent' part, if present
1302         if (defined $parentrefname) {
1303                 # a missing pathspec defaults to the 'current' filename, allowing e.g.
1304                 # someproject/blobdiff/oldrev..newrev:/filename
1305                 if ($parentpathname) {
1306                         $parentpathname =~ s,^/+,,;
1307                         $parentpathname =~ s,/$,,;
1308                         $input_params{'file_parent'} ||= $parentpathname;
1309                 } else {
1310                         $input_params{'file_parent'} ||= $input_params{'file_name'};
1311                 }
1312                 # we assume that hash_parent_base is wanted if a path was specified,
1313                 # or if the action wants hash_base instead of hash
1314                 if (defined $input_params{'file_parent'} ||
1315                         grep { $_ eq $input_params{'action'} } @wants_base) {
1316                         $input_params{'hash_parent_base'} ||= $parentrefname;
1317                 } else {
1318                         $input_params{'hash_parent'} ||= $parentrefname;
1319                 }
1320         }
1321
1322         # for the snapshot action, we allow URLs in the form
1323         # $project/snapshot/$hash.ext
1324         # where .ext determines the snapshot and gets removed from the
1325         # passed $refname to provide the $hash.
1326         #
1327         # To be able to tell that $refname includes the format extension, we
1328         # require the following two conditions to be satisfied:
1329         # - the hash input parameter MUST have been set from the $refname part
1330         #   of the URL (i.e. they must be equal)
1331         # - the snapshot format MUST NOT have been defined already (e.g. from
1332         #   CGI parameter sf)
1333         # It's also useless to try any matching unless $refname has a dot,
1334         # so we check for that too
1335         if (defined $input_params{'action'} &&
1336                 $input_params{'action'} eq 'snapshot' &&
1337                 defined $refname && index($refname, '.') != -1 &&
1338                 $refname eq $input_params{'hash'} &&
1339                 !defined $input_params{'snapshot_format'}) {
1340                 # We loop over the known snapshot formats, checking for
1341                 # extensions. Allowed extensions are both the defined suffix
1342                 # (which includes the initial dot already) and the snapshot
1343                 # format key itself, with a prepended dot
1344                 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1345                         my $hash = $refname;
1346                         unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1347                                 next;
1348                         }
1349                         my $sfx = $1;
1350                         # a valid suffix was found, so set the snapshot format
1351                         # and reset the hash parameter
1352                         $input_params{'snapshot_format'} = $fmt;
1353                         $input_params{'hash'} = $hash;
1354                         # we also set the format suffix to the one requested
1355                         # in the URL: this way a request for e.g. .tgz returns
1356                         # a .tgz instead of a .tar.gz
1357                         $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1358                         last;
1359                 }
1360         }
1361 }
1362
1363 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1364      $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1365      $searchtext, $search_regexp, $project_filter);
1366 sub evaluate_and_validate_params {
1367         our $action = $input_params{'action'};
1368         if (defined $action) {
1369                 if (!is_valid_action($action)) {
1370                         die_error(400, "Invalid action parameter");
1371                 }
1372         }
1373
1374         # parameters which are pathnames
1375         our $project = $input_params{'project'};
1376         if (defined $project) {
1377                 if (!is_valid_project($project)) {
1378                         undef $project;
1379                         die_error(404, "No such project");
1380                 }
1381         }
1382
1383         our $project_filter = $input_params{'project_filter'};
1384         if (defined $project_filter) {
1385                 if (!is_valid_pathname($project_filter)) {
1386                         die_error(404, "Invalid project_filter parameter");
1387                 }
1388         }
1389
1390         our $file_name = $input_params{'file_name'};
1391         if (defined $file_name) {
1392                 if (!is_valid_pathname($file_name)) {
1393                         die_error(400, "Invalid file parameter");
1394                 }
1395         }
1396
1397         our $file_parent = $input_params{'file_parent'};
1398         if (defined $file_parent) {
1399                 if (!is_valid_pathname($file_parent)) {
1400                         die_error(400, "Invalid file parent parameter");
1401                 }
1402         }
1403
1404         # parameters which are refnames
1405         our $hash = $input_params{'hash'};
1406         if (defined $hash) {
1407                 if (!is_valid_refname($hash)) {
1408                         die_error(400, "Invalid hash parameter");
1409                 }
1410         }
1411
1412         our $hash_parent = $input_params{'hash_parent'};
1413         if (defined $hash_parent) {
1414                 if (!is_valid_refname($hash_parent)) {
1415                         die_error(400, "Invalid hash parent parameter");
1416                 }
1417         }
1418
1419         our $hash_base = $input_params{'hash_base'};
1420         if (defined $hash_base) {
1421                 if (!is_valid_refname($hash_base)) {
1422                         die_error(400, "Invalid hash base parameter");
1423                 }
1424         }
1425
1426         our @extra_options = @{$input_params{'extra_options'}};
1427         # @extra_options is always defined, since it can only be (currently) set from
1428         # CGI, and $cgi->param() returns the empty array in array context if the param
1429         # is not set
1430         foreach my $opt (@extra_options) {
1431                 if (not exists $allowed_options{$opt}) {
1432                         die_error(400, "Invalid option parameter");
1433                 }
1434                 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1435                         die_error(400, "Invalid option parameter for this action");
1436                 }
1437         }
1438
1439         our $hash_parent_base = $input_params{'hash_parent_base'};
1440         if (defined $hash_parent_base) {
1441                 if (!is_valid_refname($hash_parent_base)) {
1442                         die_error(400, "Invalid hash parent base parameter");
1443                 }
1444         }
1445
1446         # other parameters
1447         our $page = $input_params{'page'};
1448         if (defined $page) {
1449                 if ($page =~ m/[^0-9]/) {
1450                         die_error(400, "Invalid page parameter");
1451                 }
1452         }
1453
1454         our $searchtype = $input_params{'searchtype'};
1455         if (defined $searchtype) {
1456                 if ($searchtype =~ m/[^a-z]/) {
1457                         die_error(400, "Invalid searchtype parameter");
1458                 }
1459         }
1460
1461         our $search_use_regexp = $input_params{'search_use_regexp'};
1462
1463         our $searchtext = $input_params{'searchtext'};
1464         our $search_regexp = undef;
1465         if (defined $searchtext) {
1466                 if (length($searchtext) < 2) {
1467                         die_error(403, "At least two characters are required for search parameter");
1468                 }
1469                 if ($search_use_regexp) {
1470                         $search_regexp = $searchtext;
1471                         if (!eval { qr/$search_regexp/; 1; }) {
1472                                 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1473                                 die_error(400, "Invalid search regexp '$search_regexp'",
1474                                           esc_html($error));
1475                         }
1476                 } else {
1477                         $search_regexp = quotemeta $searchtext;
1478                 }
1479         }
1480 }
1481
1482 # path to the current git repository
1483 our $git_dir;
1484 sub evaluate_git_dir {
1485         our $git_dir = $project ? "$projectroot/$project" : undef;
1486 }
1487
1488 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1489 sub configure_gitweb_features {
1490         # list of supported snapshot formats
1491         our @snapshot_fmts = gitweb_get_feature('snapshot');
1492         @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1493
1494         # check that the avatar feature is set to a known provider name,
1495         # and for each provider check if the dependencies are satisfied.
1496         # if the provider name is invalid or the dependencies are not met,
1497         # reset $git_avatar to the empty string.
1498         our ($git_avatar) = gitweb_get_feature('avatar');
1499         if ($git_avatar eq 'gravatar') {
1500                 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1501         } elsif ($git_avatar eq 'picon') {
1502                 # no dependencies
1503         } else {
1504                 $git_avatar = '';
1505         }
1506
1507         our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1508         @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1509 }
1510
1511 sub get_branch_refs {
1512         return ('heads', @extra_branch_refs);
1513 }
1514
1515 # custom error handler: 'die <message>' is Internal Server Error
1516 sub handle_errors_html {
1517         my $msg = shift; # it is already HTML escaped
1518
1519         # to avoid infinite loop where error occurs in die_error,
1520         # change handler to default handler, disabling handle_errors_html
1521         set_message("Error occurred when inside die_error:\n$msg");
1522
1523         # you cannot jump out of die_error when called as error handler;
1524         # the subroutine set via CGI::Carp::set_message is called _after_
1525         # HTTP headers are already written, so it cannot write them itself
1526         die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1527 }
1528 set_message(\&handle_errors_html);
1529
1530 our $shown_stale_message = 0;
1531 our $cache_dump = undef;
1532 our $cache_dump_mtime = undef;
1533
1534 # dispatch
1535 my $cache_mode_active;
1536 sub dispatch {
1537         if (!defined $action) {
1538                 if (defined $hash) {
1539                         $action = git_get_type($hash);
1540                         $action or die_error(404, "Object does not exist");
1541                 } elsif (defined $hash_base && defined $file_name) {
1542                         $action = git_get_type("$hash_base:$file_name");
1543                         $action or die_error(404, "File or directory does not exist");
1544                 } elsif (defined $project) {
1545                         $action = 'summary';
1546                 } else {
1547                         $action = 'frontpage';
1548                 }
1549         }
1550         if (!defined($actions{$action})) {
1551                 die_error(400, "Unknown action");
1552         }
1553         if ($action !~ m/^(?:opml|frontpage|project_list|project_index)$/ &&
1554             !$project) {
1555                 die_error(400, "Project needed");
1556         }
1557
1558         my $defstyle = $stylesheet;
1559         local $stylesheet = $defstyle;
1560         if ($ENV{'HTTP_COOKIE'} && ";$ENV{'HTTP_COOKIE'};" =~ /;\s*style\s*=\s*([a-z][a-z0-9_-]*)\s*;/) {{
1561                 my $stylename = $1;
1562                 last unless $ENV{'DOCUMENT_ROOT'} && -r "$ENV{'DOCUMENT_ROOT'}/style/$stylename.css";
1563                 $stylesheet = "/style/$stylename.css";
1564         }}
1565
1566         my $cached_page = $supported_cache_actions{$action}
1567                 ? cached_action_page($action)
1568                 : undef;
1569         goto DUMPCACHE if $cached_page;
1570         local *SAVEOUT = *STDOUT;
1571         $cache_mode_active = $supported_cache_actions{$action}
1572                 ? cached_action_start($action)
1573                 : undef;
1574
1575         configure_gitweb_features();
1576         $actions{$action}->();
1577
1578         return unless $cache_mode_active;
1579
1580         $cached_page = cached_action_finish($action);
1581         *STDOUT = *SAVEOUT;
1582
1583         DUMPCACHE:
1584
1585         $cache_mode_active = 0;
1586         # Avoid any extra unwanted encoding steps as $cached_page is raw bytes
1587         binmode STDOUT, ':raw';
1588         our $fcgi_raw_mode = 1;
1589         print expand_gitweb_pi($cached_page, time);
1590         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
1591         $fcgi_raw_mode = 0;
1592 }
1593
1594 sub reset_timer {
1595         our $t0 = [ gettimeofday() ]
1596                 if defined $t0;
1597         our $number_of_git_cmds = 0;
1598 }
1599
1600 our $first_request = 1;
1601 our $evaluate_uri_force = undef;
1602 sub run_request {
1603         reset_timer();
1604
1605         # Only allow GET and HEAD methods
1606         if (!$ENV{'REQUEST_METHOD'} || ($ENV{'REQUEST_METHOD'} ne 'GET' && $ENV{'REQUEST_METHOD'} ne 'HEAD')) {
1607                 print <<EOT;
1608 Status: 405 Method Not Allowed
1609 Content-Type: text/plain
1610 Allow: GET,HEAD
1611
1612 405 Method Not Allowed
1613 EOT
1614                 return;
1615         }
1616
1617         evaluate_uri();
1618         &$evaluate_uri_force() if $evaluate_uri_force;
1619         if ($per_request_config) {
1620                 if (ref($per_request_config) eq 'CODE') {
1621                         $per_request_config->();
1622                 } elsif (!$first_request) {
1623                         evaluate_gitweb_config();
1624                         evaluate_email_obfuscate();
1625                 }
1626         }
1627         check_loadavg();
1628
1629         # $projectroot and $projects_list might be set in gitweb config file
1630         $projects_list ||= $projectroot;
1631
1632         evaluate_query_params();
1633         evaluate_path_info();
1634         evaluate_and_validate_params();
1635         evaluate_git_dir();
1636
1637         dispatch();
1638 }
1639
1640 our $is_last_request = sub { 1 };
1641 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1642 our $CGI = 'CGI';
1643 our $cgi;
1644 our $fcgi_mode = 0;
1645 our $fcgi_nproc_active = 0;
1646 our $fcgi_raw_mode = 0;
1647 sub is_fcgi {
1648         use Errno;
1649         my $stdinfno = fileno STDIN;
1650         return 0 unless defined $stdinfno && $stdinfno == 0;
1651         return 0 unless getsockname STDIN;
1652         return 0 if getpeername STDIN;
1653         return $!{ENOTCONN}?1:0;
1654 }
1655 sub configure_as_fcgi {
1656         return if $fcgi_mode;
1657
1658         require FCGI;
1659         require CGI::Fast;
1660
1661         # We have gone to great effort to make sure that all incoming data has
1662         # been converted from whatever format it was in into UTF-8.  We have
1663         # even taken care to make sure the output handle is in ':utf8' mode.
1664         # Now along comes FCGI and blows it with:
1665         #
1666         #     Use of wide characters in FCGI::Stream::PRINT is deprecated
1667         #      and will stop wprking[sic] in a future version of FCGI
1668         #
1669         # To fix this we replace FCGI::Stream::PRINT with our own routine that
1670         # first encodes everything and then calls the original routine, but
1671         # not if $fcgi_raw_mode is true (then we just call the original routine).
1672         #
1673         # Note that we could do this by using utf8::is_utf8 to check instead
1674         # of having a $fcgi_raw_mode global, but that would be slower to run
1675         # the test on each element and much slower than skipping the conversion
1676         # entirely when we know we're outputting raw bytes.
1677         my $orig = \&FCGI::Stream::PRINT;
1678         undef *FCGI::Stream::PRINT;
1679         *FCGI::Stream::PRINT = sub {
1680                 @_ = (shift, map {my $x=$_; utf8::encode($x); $x} @_)
1681                         unless $fcgi_raw_mode;
1682                 goto $orig;
1683         };
1684
1685         our $CGI = 'CGI::Fast';
1686
1687         $fcgi_mode = 1;
1688         $first_request = 0;
1689         my $request_number = 0;
1690         # let each child service 100 requests
1691         our $is_last_request = sub { ++$request_number >= 100 };
1692 }
1693 sub evaluate_argv {
1694         my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1695         configure_as_fcgi()
1696                 if $script_name =~ /\.fcgi$/ || ($auto_fcgi && is_fcgi());
1697
1698         my $nproc_sub = sub {
1699                 my ($arg, $val) = @_;
1700                 return unless eval { require FCGI::ProcManager; 1; };
1701                 $fcgi_nproc_active = 1;
1702                 my $proc_manager = FCGI::ProcManager->new({
1703                         n_processes => $val,
1704                 });
1705                 our $pre_listen_hook    = sub { $proc_manager->pm_manage()        };
1706                 our $pre_dispatch_hook  = sub { $proc_manager->pm_pre_dispatch()  };
1707                 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1708         };
1709         if (@ARGV) {
1710                 require Getopt::Long;
1711                 Getopt::Long::GetOptions(
1712                         'fastcgi|fcgi|f' => \&configure_as_fcgi,
1713                         'nproc|n=i' => $nproc_sub,
1714                 );
1715         };
1716         if (!$fcgi_nproc_active && defined $ENV{'GITWEB_FCGI_NPROC'} && $ENV{'GITWEB_FCGI_NPROC'} =~ /^\d+$/) {
1717                 &$nproc_sub('nproc', $ENV{'GITWEB_FCGI_NPROC'});
1718         }
1719 }
1720
1721 # Any "our" variable that could possibly influence correct handling of
1722 # a CGI request MUST be reset in this subroutine
1723 sub _reset_globals {
1724         # Note that $t0 and $number_of_git_commands are handled by reset_timer
1725         our %input_params = ();
1726         our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1727              $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1728              $searchtext, $search_regexp, $project_filter) = ();
1729         our $git_dir = undef;
1730         our (@snapshot_fmts, $git_avatar, @extra_branch_refs) = ();
1731         our %avatar_cache = ();
1732         our $config_file = '';
1733         our %config = ();
1734         our $gitweb_project_owner = undef;
1735         our $shown_stale_message = 0;
1736         our $fcgi_raw_mode = 0;
1737         keys %known_snapshot_formats; # reset 'each' iterator
1738 }
1739
1740 sub run {
1741         evaluate_gitweb_config();
1742         evaluate_encoding();
1743         evaluate_email_obfuscate();
1744         evaluate_git_version();
1745         my ($ml, $mi, $bu, $hl, $subroutine) = ($my_url, $my_uri, $base_url, $home_link, '');
1746         $subroutine .= '$my_url = $ml;' if defined $my_url && $my_url ne '';
1747         $subroutine .= '$my_uri = $mi;' if defined $my_uri; # this one can be ""
1748         $subroutine .= '$base_url = $bu;' if defined $base_url && $base_url ne '';
1749         $subroutine .= '$home_link = $hl;' if defined $home_link && $home_link ne '';
1750         $evaluate_uri_force = eval "sub {$subroutine}" if $subroutine;
1751         $first_request = 1;
1752         evaluate_argv();
1753
1754         $pre_listen_hook->()
1755                 if $pre_listen_hook;
1756
1757  REQUEST:
1758         while ($cgi = $CGI->new()) {
1759                 $pre_dispatch_hook->()
1760                         if $pre_dispatch_hook;
1761                 {
1762                         # most globals can simply be reset
1763                         _reset_globals;
1764
1765                         # evaluate_path_info corrupts %known_snapshot_formats
1766                         # so we need a deepish copy of it -- note that
1767                         # _reset_globals already took care of resetting its
1768                         # hash iterator that evaluate_path_info also leaves
1769                         # in an indeterminate state
1770                         my %formats = ();
1771                         while (my ($k,$v) = each(%known_snapshot_formats)) {
1772                                 $formats{$k} = {%{$known_snapshot_formats{$k}}};
1773                         }
1774                         local *known_snapshot_formats = \%formats;
1775
1776                         eval {run_request()};
1777                 }
1778                 $post_dispatch_hook->()
1779                         if $post_dispatch_hook;
1780                 $first_request = 0;
1781
1782                 last REQUEST if ($is_last_request->());
1783         }
1784
1785         1;
1786 }
1787
1788 run();
1789
1790 if (defined caller) {
1791         # wrapped in a subroutine processing requests,
1792         # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1793         return;
1794 } else {
1795         # pure CGI script, serving single request
1796         exit;
1797 }
1798
1799 ## ======================================================================
1800 ## action links
1801
1802 # possible values of extra options
1803 # -full => 0|1      - use absolute/full URL ($my_uri/$my_url as base)
1804 # -replay => 1      - start from a current view (replay with modifications)
1805 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1806 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1807 sub href {
1808         my %params = @_;
1809         # default is to use -absolute url() i.e. $my_uri
1810         my $href = $params{-full} ? $my_url : $my_uri;
1811
1812         # implicit -replay, must be first of implicit params
1813         $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1814
1815         $params{'project'} = $project unless exists $params{'project'};
1816
1817         if ($params{-replay}) {
1818                 while (my ($name, $symbol) = each %cgi_param_mapping) {
1819                         if (!exists $params{$name}) {
1820                                 $params{$name} = $input_params{$name};
1821                         }
1822                 }
1823         }
1824
1825         my $use_pathinfo = gitweb_check_feature('pathinfo');
1826         if (defined $params{'project'} &&
1827             (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1828                 # try to put as many parameters as possible in PATH_INFO:
1829                 #   - project name
1830                 #   - action
1831                 #   - hash_parent or hash_parent_base:/file_parent
1832                 #   - hash or hash_base:/filename
1833                 #   - the snapshot_format as an appropriate suffix
1834
1835                 # When the script is the root DirectoryIndex for the domain,
1836                 # $href here would be something like http://gitweb.example.com/
1837                 # Thus, we strip any trailing / from $href, to spare us double
1838                 # slashes in the final URL
1839                 $href =~ s,/$,,;
1840
1841                 # Then add the project name, if present
1842                 $href .= "/".esc_path_info($params{'project'});
1843                 delete $params{'project'};
1844
1845                 # since we destructively absorb parameters, we keep this
1846                 # boolean that remembers if we're handling a snapshot
1847                 my $is_snapshot = $params{'action'} eq 'snapshot';
1848
1849                 # Summary just uses the project path URL, any other action is
1850                 # added to the URL
1851                 if (defined $params{'action'}) {
1852                         $href .= "/".esc_path_info($params{'action'})
1853                                 unless $params{'action'} eq 'summary';
1854                         delete $params{'action'};
1855                 }
1856
1857                 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1858                 # stripping nonexistent or useless pieces
1859                 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1860                         || $params{'hash_parent'} || $params{'hash'});
1861                 if (defined $params{'hash_base'}) {
1862                         if (defined $params{'hash_parent_base'}) {
1863                                 $href .= esc_path_info($params{'hash_parent_base'});
1864                                 # skip the file_parent if it's the same as the file_name
1865                                 if (defined $params{'file_parent'}) {
1866                                         if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1867                                                 delete $params{'file_parent'};
1868                                         } elsif ($params{'file_parent'} !~ /\.\./) {
1869                                                 $href .= ":/".esc_path_info($params{'file_parent'});
1870                                                 delete $params{'file_parent'};
1871                                         }
1872                                 }
1873                                 $href .= "..";
1874                                 delete $params{'hash_parent'};
1875                                 delete $params{'hash_parent_base'};
1876                         } elsif (defined $params{'hash_parent'}) {
1877                                 $href .= esc_path_info($params{'hash_parent'}). "..";
1878                                 delete $params{'hash_parent'};
1879                         }
1880
1881                         $href .= esc_path_info($params{'hash_base'});
1882                         if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1883                                 $href .= ":/".esc_path_info($params{'file_name'});
1884                                 delete $params{'file_name'};
1885                         }
1886                         delete $params{'hash'};
1887                         delete $params{'hash_base'};
1888                 } elsif (defined $params{'hash'}) {
1889                         $href .= esc_path_info($params{'hash'});
1890                         delete $params{'hash'};
1891                 }
1892
1893                 # If the action was a snapshot, we can absorb the
1894                 # snapshot_format parameter too
1895                 if ($is_snapshot) {
1896                         my $fmt = $params{'snapshot_format'};
1897                         # snapshot_format should always be defined when href()
1898                         # is called, but just in case some code forgets, we
1899                         # fall back to the default
1900                         $fmt ||= $snapshot_fmts[0];
1901                         $href .= $known_snapshot_formats{$fmt}{'suffix'};
1902                         delete $params{'snapshot_format'};
1903                 }
1904         }
1905
1906         # now encode the parameters explicitly
1907         my @result = ();
1908         for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1909                 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1910                 if (defined $params{$name}) {
1911                         if (ref($params{$name}) eq "ARRAY") {
1912                                 foreach my $par (@{$params{$name}}) {
1913                                         push @result, $symbol . "=" . esc_param($par);
1914                                 }
1915                         } else {
1916                                 push @result, $symbol . "=" . esc_param($params{$name});
1917                         }
1918                 }
1919         }
1920         $href .= "?" . join(';', @result) if scalar @result;
1921
1922         # final transformation: trailing spaces must be escaped (URI-encoded)
1923         $href =~ s/(\s+)$/CGI::escape($1)/e;
1924
1925         if ($params{-anchor}) {
1926                 $href .= "#".esc_param($params{-anchor});
1927         }
1928
1929         return $href;
1930 }
1931
1932
1933 ## ======================================================================
1934 ## validation, quoting/unquoting and escaping
1935
1936 sub is_valid_action {
1937         my $input = shift;
1938         return undef unless exists $actions{$input};
1939         return 1;
1940 }
1941
1942 sub is_valid_project {
1943         my $input = shift;
1944
1945         return unless defined $input;
1946         if (!is_valid_pathname($input) ||
1947                 $input =~ m!^/*_! ||
1948                 $input =~ m!\.\.! ||
1949                 !($input =~ m!\.git/*$!) ||
1950                 $input =~ m!\.git/.*\.git/*$!i ||
1951                 !(-d "$projectroot/$input") ||
1952                 !check_export_ok("$projectroot/$input") ||
1953                 ($strict_export && !project_in_list($input))) {
1954                 return undef;
1955         } else {
1956                 return 1;
1957         }
1958 }
1959
1960 sub is_valid_pathname {
1961         my $input = shift;
1962
1963         return undef unless defined $input;
1964         # no '.' or '..' as elements of path, i.e. no '.' or '..'
1965         # at the beginning, at the end, and between slashes.
1966         # also this catches doubled slashes
1967         if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1968                 return undef;
1969         }
1970         # no null characters
1971         if ($input =~ m!\0!) {
1972                 return undef;
1973         }
1974         return 1;
1975 }
1976
1977 sub is_valid_ref_format {
1978         my $input = shift;
1979
1980         return undef unless defined $input;
1981         # restrictions on ref name according to git-check-ref-format
1982         if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1983                 return undef;
1984         }
1985         return 1;
1986 }
1987
1988 sub is_valid_refname {
1989         my $input = shift;
1990
1991         return undef unless defined $input;
1992         # textual hashes are O.K.
1993         if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1994                 return 1;
1995         }
1996         # allow repeated trailing '[~^]n*' suffix(es)
1997         $input =~ s/^([^~^]+)(?:[~^]\d*)+$/$1/;
1998         # it must be correct pathname
1999         is_valid_pathname($input) or return undef;
2000         # check git-check-ref-format restrictions
2001         is_valid_ref_format($input) or return undef;
2002         return 1;
2003 }
2004
2005 # decode sequences of octets in utf8 into Perl's internal form,
2006 # which is utf-8 with utf8 flag set if needed.  gitweb writes out
2007 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
2008 sub to_utf8 {
2009         my $str = shift;
2010         return undef unless defined $str;
2011
2012         if (utf8::is_utf8($str) || utf8::decode($str)) {
2013                 return $str;
2014         } else {
2015                 return $encode_object->decode($str, Encode::FB_DEFAULT);
2016         }
2017 }
2018
2019 # quote unsafe chars, but keep the slash, even when it's not
2020 # correct, but quoted slashes look too horrible in bookmarks
2021 sub esc_param {
2022         my $str = shift;
2023         return undef unless defined $str;
2024         $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
2025         $str =~ s/ /\+/g;
2026         return $str;
2027 }
2028
2029 # the quoting rules for path_info fragment are slightly different
2030 sub esc_path_info {
2031         my $str = shift;
2032         return undef unless defined $str;
2033
2034         # path_info doesn't treat '+' as space (specially), but '?' must be escaped
2035         $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
2036
2037         return $str;
2038 }
2039
2040 # quote unsafe chars in whole URL, so some characters cannot be quoted
2041 sub esc_url {
2042         my $str = shift;
2043         return undef unless defined $str;
2044         $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
2045         $str =~ s/ /\+/g;
2046         return $str;
2047 }
2048
2049 # quote unsafe characters in HTML attributes
2050 sub esc_attr {
2051
2052         # for XHTML conformance escaping '"' to '&quot;' is not enough
2053         return esc_html(@_);
2054 }
2055
2056 # replace invalid utf8 character with SUBSTITUTION sequence
2057 sub esc_html {
2058         my $str = shift;
2059         my %opts = @_;
2060
2061         return undef unless defined $str;
2062
2063         $str = to_utf8($str);
2064         $str = $cgi->escapeHTML($str);
2065         if ($opts{'-nbsp'}) {
2066                 $str =~ s/ /&#160;/g;
2067         }
2068         use bytes;
2069         $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
2070         return $str;
2071 }
2072
2073 # quote control characters and escape filename to HTML
2074 sub esc_path {
2075         my $str = shift;
2076         my %opts = @_;
2077
2078         return undef unless defined $str;
2079
2080         $str = to_utf8($str);
2081         $str = $cgi->escapeHTML($str);
2082         if ($opts{'-nbsp'}) {
2083                 $str =~ s/ /&#160;/g;
2084         }
2085         use bytes;
2086         $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
2087         return $str;
2088 }
2089
2090 # Sanitize for use in XHTML + application/xml+xhtml (valid XML 1.0)
2091 sub sanitize {
2092         my $str = shift;
2093
2094         return undef unless defined $str;
2095
2096         $str = to_utf8($str);
2097         use bytes;
2098         $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
2099         return $str;
2100 }
2101
2102 # Make control characters "printable", using character escape codes (CEC)
2103 sub quot_cec {
2104         my $cntrl = shift;
2105         my %opts = @_;
2106         my %es = ( # character escape codes, aka escape sequences
2107                 "\t" => '\t',   # tab            (HT)
2108                 "\n" => '\n',   # line feed      (LF)
2109                 "\r" => '\r',   # carrige return (CR)
2110                 "\f" => '\f',   # form feed      (FF)
2111                 "\b" => '\b',   # backspace      (BS)
2112                 "\a" => '\a',   # alarm (bell)   (BEL)
2113                 "\e" => '\e',   # escape         (ESC)
2114                 "\013" => '\v', # vertical tab   (VT)
2115                 "\000" => '\0', # nul character  (NUL)
2116         );
2117         my $chr = ( (exists $es{$cntrl})
2118                     ? $es{$cntrl}
2119                     : sprintf('\x%02x', ord($cntrl)) );
2120         if ($opts{-nohtml}) {
2121                 return $chr;
2122         } else {
2123                 return "<span class=\"cntrl\">$chr</span>";
2124         }
2125 }
2126
2127 # Alternatively use unicode control pictures codepoints,
2128 # Unicode "printable representation" (PR)
2129 sub quot_upr {
2130         my $cntrl = shift;
2131         my %opts = @_;
2132
2133         my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
2134         if ($opts{-nohtml}) {
2135                 return $chr;
2136         } else {
2137                 return "<span class=\"cntrl\">$chr</span>";
2138         }
2139 }
2140
2141 # git may return quoted and escaped filenames
2142 sub unquote {
2143         my $str = shift;
2144
2145         sub unq {
2146                 my $seq = shift;
2147                 my %es = ( # character escape codes, aka escape sequences
2148                         't' => "\t",   # tab            (HT, TAB)
2149                         'n' => "\n",   # newline        (NL)
2150                         'r' => "\r",   # return         (CR)
2151                         'f' => "\f",   # form feed      (FF)
2152                         'b' => "\b",   # backspace      (BS)
2153                         'a' => "\a",   # alarm (bell)   (BEL)
2154                         'e' => "\e",   # escape         (ESC)
2155                         'v' => "\013", # vertical tab   (VT)
2156                 );
2157
2158                 if ($seq =~ m/^[0-7]{1,3}$/) {
2159                         # octal char sequence
2160                         return chr(oct($seq));
2161                 } elsif (exists $es{$seq}) {
2162                         # C escape sequence, aka character escape code
2163                         return $es{$seq};
2164                 }
2165                 # quoted ordinary character
2166                 return $seq;
2167         }
2168
2169         if ($str =~ m/^"(.*)"$/) {
2170                 # needs unquoting
2171                 $str = $1;
2172                 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
2173         }
2174         return $str;
2175 }
2176
2177 # escape tabs (convert tabs to spaces)
2178 sub untabify {
2179         my $line = shift;
2180
2181         while ((my $pos = index($line, "\t")) != -1) {
2182                 if (my $count = (8 - ($pos % 8))) {
2183                         my $spaces = ' ' x $count;
2184                         $line =~ s/\t/$spaces/;
2185                 }
2186         }
2187
2188         return $line;
2189 }
2190
2191 sub project_in_list {
2192         my $project = shift;
2193         my @list = git_get_projects_list();
2194         return @list && scalar(grep { $_->{'path'} eq $project } @list);
2195 }
2196
2197 sub cached_page_precondition_check {
2198         my $action = shift;
2199         return 1 unless
2200                 $action eq 'summary' &&
2201                 $projlist_cache_lifetime > 0 &&
2202                 gitweb_check_feature('forks');
2203
2204         # Note that ALL the 'forkchange' logic is in this function.
2205         # It does NOT belong in cached_action_page NOR in cached_action_start
2206         # NOR in cached_action_finish.  None of those functions should know anything
2207         # about nor do anything to any of the 'forkchange'/"$action.forkchange" files.
2208
2209         # besides the basic 'changed' "$action.changed" check, we may only use
2210         # a summary cache if:
2211         #
2212         #   1) we are not using a project list cache file
2213         #   -OR-
2214         #   2) we are not using the 'forks' feature
2215         #   -OR-
2216         #   3) there is no 'forkchange' nor "$action.forkchange" file in $html_cache_dir
2217         #   -OR-
2218         #   4) there is no cache file ("$cache_dir/$projlist_cache_name")
2219         #   -OR-
2220         #   5) the OLDER of 'forkchange'/"$action.forkchange" is NEWER than the cache file
2221         #
2222         # Otherwise we must re-generate the cache because we've had a fork change
2223         # (either a fork was added or a fork was removed) AND the change has been
2224         # picked up in the cache file AND we've not got that in our cached copy
2225         #
2226         # For (5) regenerating the cached page wouldn't get us anything if the project
2227         # cache file is older than the 'forkchange'/"$action.forkchange" because the
2228         # forks information comes from the project cache file and it's clearly not
2229         # picked up the changes yet so we may continue to use a cached page until it does.
2230
2231         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2232         my $fc_mt = (stat("$htmlcd/forkchange"))[9];
2233         my $afc_mt = (stat("$htmlcd/$action.forkchange"))[9];
2234         return 1 unless defined($fc_mt) || defined($afc_mt);
2235         my $prj_mt = (stat("$cache_dir/$projlist_cache_name"))[9];
2236         return 1 unless $prj_mt;
2237         my $old_mt = $fc_mt;
2238         $old_mt = $afc_mt if !defined($old_mt) || (defined($afc_mt) && $afc_mt < $old_mt);
2239         return 1 if $old_mt > $prj_mt;
2240
2241         # We're going to regenerate the cached page because we know the project cache
2242         # has new fork information that we cannot possibly have in our cached copy.
2243         #
2244         # However, if both 'forkchange' and "$action.forkchange" exist and one of
2245         # them is older than the project cache and one of them is newer, we still
2246         # need to regenerate the page cache, but we will also need to do it again
2247         # in the future because there's yet another fork update not yet in the cache.
2248         #
2249         # So we make sure to touch "$action.changed" to force a cache regeneration
2250         # and then we remove either or both of 'forkchange'/"$action.forkchange" if
2251         # they're older than the project cache (they've served their purpose, we're
2252         # forcing a page regeneration by touching "$action.changed" but the project
2253         # cache was rebuilt since then so there are no more pending fork updates to
2254         # pick up in the future and they need to go).
2255
2256         # For best results, the external code that touches 'forkchange' should always
2257         # touch 'forkchange' and additionally touch 'summary.forkchange' but only
2258         # if it does not already exist.  That way the cached page will be regenerated
2259         # each time it's requested and ANY fork updates are available in the proj
2260         # cache rather than waiting until they all are before updating.
2261
2262         # Note that we take a shortcut here and will zap 'forkchange' since we know
2263         # that it only affects the 'summary' cache.  If, in the future, it affects
2264         # other cache types, it will first need to be propogated down to
2265         # "$action.forkchange" for those types before we zap it.
2266
2267         my $fd;
2268         open $fd, '>', "$htmlcd/$action.changed" and close $fd;
2269         $fc_mt=undef, unlink "$htmlcd/forkchange" if defined $fc_mt && $fc_mt < $prj_mt;
2270         $afc_mt=undef, unlink "$htmlcd/$action.forkchange" if defined $afc_mt && $afc_mt < $prj_mt;
2271
2272         # Now we propagate 'forkchange' to "$action.forkchange" if we have the
2273         # one and not the other.
2274
2275         if (defined $fc_mt && ! defined $afc_mt) {
2276                 open $fd, '>', "$htmlcd/$action.forkchange" and close $fd;
2277                 -e "$htmlcd/$action.forkchange" and
2278                 utime($fc_mt, $fc_mt, "$htmlcd/$action.forkchange") and
2279                 unlink "$htmlcd/forkchange";
2280         }
2281
2282         return 0;
2283 }
2284
2285 sub cached_action_page {
2286         my $action = shift;
2287
2288         return undef unless $action && $html_cache_actions{$action} && $html_cache_dir;
2289         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2290         return undef if -e "$htmlcd/changed" || -e "$htmlcd/$action.changed";
2291         return undef unless cached_page_precondition_check($action);
2292         open my $fd, '<', "$htmlcd/$action" or return undef;
2293         binmode $fd;
2294         local $/;
2295         my $cached_page = <$fd>;
2296         close $fd or return undef;
2297         return $cached_page;
2298 }
2299
2300 package Git::Gitweb::CacheFile;
2301
2302 sub TIEHANDLE {
2303         use POSIX qw(:fcntl_h);
2304         my $class = shift;
2305         my $cachefile = shift;
2306
2307         sysopen(my $self, $cachefile, O_WRONLY|O_CREAT|O_EXCL, 0664)
2308                 or return undef;
2309         $$self->{'cachefile'} = $cachefile;
2310         $$self->{'opened'} = 1;
2311         $$self->{'contents'} = '';
2312         return bless $self, $class;
2313 }
2314
2315 sub CLOSE {
2316         my $self = shift;
2317         if ($$self->{'opened'}) {
2318                 $$self->{'opened'} = 0;
2319                 my $result = close $self;
2320                 unlink $$self->{'cachefile'} unless $result;
2321                 return $result;
2322         }
2323         return 0;
2324 }
2325
2326 sub DESTROY {
2327         my $self = shift;
2328         if ($$self->{'opened'}) {
2329                 $self->CLOSE() and unlink $$self->{'cachefile'};
2330         }
2331 }
2332
2333 sub PRINT {
2334         my $self = shift;
2335         @_ = (map {my $x=$_; utf8::encode($x); $x} @_) unless $fcgi_raw_mode;
2336         print $self @_ if $$self->{'opened'};
2337         $$self->{'contents'} .= join('', @_);
2338         return 1;
2339 }
2340
2341 sub PRINTF {
2342         my $self = shift;
2343         my $template = shift;
2344         return $self->PRINT(sprintf $template, @_);
2345 }
2346
2347 sub contents {
2348         my $self = shift;
2349         return $$self->{'contents'};
2350 }
2351
2352 package main;
2353
2354 # Caller is responsible for preserving STDOUT beforehand if needed
2355 sub cached_action_start {
2356         my $action = shift;
2357
2358         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2359         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2360         return undef unless -d $htmlcd;
2361         if (-e "$htmlcd/changed") {
2362                 foreach my $cacheable (keys(%html_cache_actions)) {
2363                         next unless $supported_cache_actions{$cacheable} &&
2364                                     $html_cache_actions{$cacheable};
2365                         my $fd;
2366                         open $fd, '>', "$htmlcd/$cacheable.changed"
2367                         and close $fd;
2368                 }
2369                 unlink "$htmlcd/changed";
2370         }
2371         local *CACHEFILE;
2372         tie *CACHEFILE, 'Git::Gitweb::CacheFile', "$htmlcd/$action.lock"  or return undef;
2373         *STDOUT = *CACHEFILE;
2374         unlink "$htmlcd/$action", "$htmlcd/$action.changed";
2375         return 1;
2376 }
2377
2378 # Caller is responsible for restoring STDOUT afterward if needed
2379 sub cached_action_finish {
2380         my $action = shift;
2381
2382         use File::Spec;
2383
2384         my $obj = tied *STDOUT;
2385         return undef unless ref($obj) eq 'Git::Gitweb::CacheFile';
2386         my $cached_page = $obj->contents;
2387         (my $result = close(STDOUT)) or warn "couldn't close cache file on STDOUT: $!";
2388         # Do not leave STDOUT file descriptor invalid!
2389         local *NULL;
2390         open(NULL, '>', File::Spec->devnull) or die "couldn't open NULL to devnull: $!";
2391         *STDOUT = *NULL;
2392         return $cached_page unless $result;
2393         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2394         return $cached_page unless -d $htmlcd;
2395         unlink "$htmlcd/$action.lock" unless rename "$htmlcd/$action.lock", "$htmlcd/$action";
2396         return $cached_page;
2397 }
2398
2399 my %expand_pi_subs;
2400 BEGIN {%expand_pi_subs = (
2401         'age_string'               => \&age_string,
2402         'age_string_date'          => \&age_string_date,
2403         'age_string_age'           => \&age_string_age,
2404         'compute_timed_interval'   => \&compute_timed_interval,
2405         'compute_commands_count'   => \&compute_commands_count,
2406         'format_lastrefresh_row'   => \&format_lastrefresh_row,
2407         'compute_stylesheet_links' => \&compute_stylesheet_links,
2408 )}
2409
2410 # Expands any <?gitweb...> processing instructions and returns the result
2411 sub expand_gitweb_pi {
2412         my $page = shift;
2413         $page .= '';
2414         my @time_now = gettimeofday();
2415         $page =~ s{<\?gitweb(?:\s+([^\s>]+)([^>]*))?\s*\?>}
2416                   {defined($1) ?
2417                           (ref($expand_pi_subs{$1}) eq 'CODE' ?
2418                                   $expand_pi_subs{$1}->(split(' ',$2), @time_now) :
2419                                   '') :
2420                           '' }goes;
2421         return $page;
2422 }
2423
2424 ## ----------------------------------------------------------------------
2425 ## HTML aware string manipulation
2426
2427 # Try to chop given string on a word boundary between position
2428 # $len and $len+$add_len. If there is no word boundary there,
2429 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
2430 # (marking chopped part) would be longer than given string.
2431 sub chop_str {
2432         my $str = shift;
2433         my $len = shift;
2434         my $add_len = shift || 10;
2435         my $where = shift || 'right'; # 'left' | 'center' | 'right'
2436
2437         # Make sure perl knows it is utf8 encoded so we don't
2438         # cut in the middle of a utf8 multibyte char.
2439         $str = to_utf8($str);
2440
2441         # allow only $len chars, but don't cut a word if it would fit in $add_len
2442         # if it doesn't fit, cut it if it's still longer than the dots we would add
2443         # remove chopped character entities entirely
2444
2445         # when chopping in the middle, distribute $len into left and right part
2446         # return early if chopping wouldn't make string shorter
2447         if ($where eq 'center') {
2448                 return $str if ($len + 5 >= length($str)); # filler is length 5
2449                 $len = int($len/2);
2450         } else {
2451                 return $str if ($len + 4 >= length($str)); # filler is length 4
2452         }
2453
2454         # regexps: ending and beginning with word part up to $add_len
2455         my $endre = qr/.{$len}\w{0,$add_len}/;
2456         my $begre = qr/\w{0,$add_len}.{$len}/;
2457
2458         if ($where eq 'left') {
2459                 $str =~ m/^(.*?)($begre)$/;
2460                 my ($lead, $body) = ($1, $2);
2461                 if (length($lead) > 4) {
2462                         $lead = " ...";
2463                 }
2464                 return "$lead$body";
2465
2466         } elsif ($where eq 'center') {
2467                 $str =~ m/^($endre)(.*)$/;
2468                 my ($left, $str)  = ($1, $2);
2469                 $str =~ m/^(.*?)($begre)$/;
2470                 my ($mid, $right) = ($1, $2);
2471                 if (length($mid) > 5) {
2472                         $mid = " ... ";
2473                 }
2474                 return "$left$mid$right";
2475
2476         } else {
2477                 $str =~ m/^($endre)(.*)$/;
2478                 my $body = $1;
2479                 my $tail = $2;
2480                 if (length($tail) > 4) {
2481                         $tail = "... ";
2482                 }
2483                 return "$body$tail";
2484         }
2485 }
2486
2487 # pass-through email filter, obfuscating it when possible
2488 sub email_obfuscate {
2489         our $email;
2490         my ($str) = @_;
2491         if ($email) {
2492                 $str = $email->escape_html($str);
2493                 # Stock HTML::Email::Obfuscate version likes to produce
2494                 # invalid XHTML...
2495                 $str =~ s#<(/?)B>#<$1b>#g;
2496                 return $str;
2497         } else {
2498                 $str = esc_html($str);
2499                 $str =~ s/@/&#x40;/;
2500                 return $str;
2501         }
2502 }
2503
2504 # takes the same arguments as chop_str, but also wraps a <span> around the
2505 # result with a title attribute if it does get chopped. Additionally, the
2506 # string is HTML-escaped.
2507 sub chop_and_escape_str {
2508         my ($str) = @_;
2509
2510         my $chopped = chop_str(@_);
2511         $str = to_utf8($str);
2512         if ($chopped eq $str) {
2513                 return email_obfuscate($chopped);
2514         } else {
2515                 use bytes;
2516                 $str =~ s/[[:cntrl:]]/?/g;
2517                 return $cgi->span({-title=>$str}, email_obfuscate($chopped));
2518         }
2519 }
2520
2521 # Highlight selected fragments of string, using given CSS class,
2522 # and escape HTML.  It is assumed that fragments do not overlap.
2523 # Regions are passed as list of pairs (array references).
2524 #
2525 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
2526 # '<span class="mark">foo</span>bar'
2527 sub esc_html_hl_regions {
2528         my ($str, $css_class, @sel) = @_;
2529         my %opts = grep { ref($_) ne 'ARRAY' } @sel;
2530         @sel     = grep { ref($_) eq 'ARRAY' } @sel;
2531         return esc_html($str, %opts) unless @sel;
2532
2533         my $out = '';
2534         my $pos = 0;
2535
2536         for my $s (@sel) {
2537                 my ($begin, $end) = @$s;
2538
2539                 # Don't create empty <span> elements.
2540                 next if $end <= $begin;
2541
2542                 my $escaped = esc_html(substr($str, $begin, $end - $begin),
2543                                        %opts);
2544
2545                 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
2546                         if ($begin - $pos > 0);
2547                 $out .= $cgi->span({-class => $css_class}, $escaped);
2548
2549                 $pos = $end;
2550         }
2551         $out .= esc_html(substr($str, $pos), %opts)
2552                 if ($pos < length($str));
2553
2554         return $out;
2555 }
2556
2557 # return positions of beginning and end of each match
2558 sub matchpos_list {
2559         my ($str, $regexp) = @_;
2560         return unless (defined $str && defined $regexp);
2561
2562         my @matches;
2563         while ($str =~ /$regexp/g) {
2564                 push @matches, [$-[0], $+[0]];
2565         }
2566         return @matches;
2567 }
2568
2569 # highlight match (if any), and escape HTML
2570 sub esc_html_match_hl {
2571         my ($str, $regexp) = @_;
2572         return esc_html($str) unless defined $regexp;
2573
2574         my @matches = matchpos_list($str, $regexp);
2575         return esc_html($str) unless @matches;
2576
2577         return esc_html_hl_regions($str, 'match', @matches);
2578 }
2579
2580
2581 # highlight match (if any) of shortened string, and escape HTML
2582 sub esc_html_match_hl_chopped {
2583         my ($str, $chopped, $regexp) = @_;
2584         return esc_html_match_hl($str, $regexp) unless defined $chopped;
2585
2586         my @matches = matchpos_list($str, $regexp);
2587         return esc_html($chopped) unless @matches;
2588
2589         # filter matches so that we mark chopped string
2590         my $tail = "... "; # see chop_str
2591         unless ($chopped =~ s/\Q$tail\E$//) {
2592                 $tail = '';
2593         }
2594         my $chop_len = length($chopped);
2595         my $tail_len = length($tail);
2596         my @filtered;
2597
2598         for my $m (@matches) {
2599                 if ($m->[0] > $chop_len) {
2600                         push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
2601                         last;
2602                 } elsif ($m->[1] > $chop_len) {
2603                         push @filtered, [ $m->[0], $chop_len + $tail_len ];
2604                         last;
2605                 }
2606                 push @filtered, $m;
2607         }
2608
2609         return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
2610 }
2611
2612 ## ----------------------------------------------------------------------
2613 ## functions returning short strings
2614
2615 # CSS class for given age epoch value (in seconds)
2616 # and reference time (optional, defaults to now) as second value
2617 sub age_class {
2618         my ($age_epoch, $time_now) = @_;
2619         return "noage" unless defined $age_epoch;
2620         defined $time_now or $time_now = time;
2621         my $age = $time_now - $age_epoch;
2622
2623         if ($age < 60*60*2) {
2624                 return "age0";
2625         } elsif ($age < 60*60*24*2) {
2626                 return "age1";
2627         } else {
2628                 return "age2";
2629         }
2630 }
2631
2632 # convert age epoch in seconds to "nn units ago" string
2633 # reference time used is now unless second argument passed in
2634 # to get the old behavior, pass 0 as the first argument and
2635 # the time in seconds as the second
2636 sub age_string {
2637         my ($age_epoch, $time_now) = @_;
2638         return "unknown" unless defined $age_epoch;
2639         return "<?gitweb age_string $age_epoch?>" if $cache_mode_active;
2640         defined $time_now or $time_now = time;
2641         my $age = $time_now - $age_epoch;
2642         my $age_str;
2643
2644         if ($age > 60*60*24*365*2) {
2645                 $age_str = (int $age/60/60/24/365);
2646                 $age_str .= " years ago";
2647         } elsif ($age > 60*60*24*(365/12)*2) {
2648                 $age_str = int $age/60/60/24/(365/12);
2649                 $age_str .= " months ago";
2650         } elsif ($age > 60*60*24*7*2) {
2651                 $age_str = int $age/60/60/24/7;
2652                 $age_str .= " weeks ago";
2653         } elsif ($age > 60*60*24*2) {
2654                 $age_str = int $age/60/60/24;
2655                 $age_str .= " days ago";
2656         } elsif ($age > 60*60*2) {
2657                 $age_str = int $age/60/60;
2658                 $age_str .= " hours ago";
2659         } elsif ($age > 60*2) {
2660                 $age_str = int $age/60;
2661                 $age_str .= " min ago";
2662         } elsif ($age > 2) {
2663                 $age_str = int $age;
2664                 $age_str .= " sec ago";
2665         } else {
2666                 $age_str .= " right now";
2667         }
2668         return $age_str;
2669 }
2670
2671 # returns age_string if the age is <= 2 weeks otherwise an absolute date
2672 # this is typically shown to the user directly with the age_string_age as a title
2673 sub age_string_date {
2674         my ($age_epoch, $time_now) = @_;
2675         return "unknown" unless defined $age_epoch;
2676         return "<?gitweb age_string_date $age_epoch?>" if $cache_mode_active;
2677         defined $time_now or $time_now = time;
2678         my $age = $time_now - $age_epoch;
2679
2680         if ($age > 60*60*24*7*2) {
2681                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2682                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2683         } else {
2684                 return age_string($age_epoch, $time_now);
2685         }
2686 }
2687
2688 # returns an absolute date if the age is <= 2 weeks otherwise age_string
2689 # this is typically used for the 'title' attribute so it will show as a tooltip
2690 sub age_string_age {
2691         my ($age_epoch, $time_now) = @_;
2692         return "unknown" unless defined $age_epoch;
2693         return "<?gitweb age_string_age $age_epoch?>" if $cache_mode_active;
2694         defined $time_now or $time_now = time;
2695         my $age = $time_now - $age_epoch;
2696
2697         if ($age > 60*60*24*7*2) {
2698                 return age_string($age_epoch, $time_now);
2699         } else {
2700                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2701                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2702         }
2703 }
2704
2705 use constant {
2706         S_IFINVALID => 0030000,
2707         S_IFGITLINK => 0160000,
2708 };
2709
2710 # submodule/subproject, a commit object reference
2711 sub S_ISGITLINK {
2712         my $mode = shift;
2713
2714         return (($mode & S_IFMT) == S_IFGITLINK)
2715 }
2716
2717 # convert file mode in octal to symbolic file mode string
2718 sub mode_str {
2719         my $mode = oct shift;
2720
2721         if (S_ISGITLINK($mode)) {
2722                 return 'm---------';
2723         } elsif (S_ISDIR($mode & S_IFMT)) {
2724                 return 'drwxr-xr-x';
2725         } elsif (S_ISLNK($mode)) {
2726                 return 'lrwxrwxrwx';
2727         } elsif (S_ISREG($mode)) {
2728                 # git cares only about the executable bit
2729                 if ($mode & S_IXUSR) {
2730                         return '-rwxr-xr-x';
2731                 } else {
2732                         return '-rw-r--r--';
2733                 };
2734         } else {
2735                 return '----------';
2736         }
2737 }
2738
2739 # convert file mode in octal to file type string
2740 sub file_type {
2741         my $mode = shift;
2742
2743         if ($mode !~ m/^[0-7]+$/) {
2744                 return $mode;
2745         } else {
2746                 $mode = oct $mode;
2747         }
2748
2749         if (S_ISGITLINK($mode)) {
2750                 return "submodule";
2751         } elsif (S_ISDIR($mode & S_IFMT)) {
2752                 return "directory";
2753         } elsif (S_ISLNK($mode)) {
2754                 return "symlink";
2755         } elsif (S_ISREG($mode)) {
2756                 return "file";
2757         } else {
2758                 return "unknown";
2759         }
2760 }
2761
2762 # convert file mode in octal to file type description string
2763 sub file_type_long {
2764         my $mode = shift;
2765
2766         if ($mode !~ m/^[0-7]+$/) {
2767                 return $mode;
2768         } else {
2769                 $mode = oct $mode;
2770         }
2771
2772         if (S_ISGITLINK($mode)) {
2773                 return "submodule";
2774         } elsif (S_ISDIR($mode & S_IFMT)) {
2775                 return "directory";
2776         } elsif (S_ISLNK($mode)) {
2777                 return "symlink";
2778         } elsif (S_ISREG($mode)) {
2779                 if ($mode & S_IXUSR) {
2780                         return "executable";
2781                 } else {
2782                         return "file";
2783                 };
2784         } else {
2785                 return "unknown";
2786         }
2787 }
2788
2789
2790 ## ----------------------------------------------------------------------
2791 ## functions returning short HTML fragments, or transforming HTML fragments
2792 ## which don't belong to other sections
2793
2794 # format line of commit message.
2795 sub format_log_line_html {
2796         my $line = shift;
2797
2798         $line = esc_html($line, -nbsp=>1);
2799         $line =~ s{
2800         \b
2801         (
2802             # The output of "git describe", e.g. v2.10.0-297-gf6727b0
2803             # or hadoop-20160921-113441-20-g094fb7d
2804             (?<!-) # see strbuf_check_tag_ref(). Tags can't start with -
2805             [A-Za-z0-9.-]+
2806             (?!\.) # refs can't end with ".", see check_refname_format()
2807             -g[0-9a-fA-F]{7,40}
2808             |
2809             # Just a normal looking Git SHA1
2810             [0-9a-fA-F]{7,40}
2811         )
2812         \b
2813     }{
2814                 $cgi->a({-href => href(action=>"object", hash=>$1),
2815                                         -class => "text"}, $1);
2816         }egx unless $line =~ /^\s*git-svn-id:/;
2817
2818         return $line;
2819 }
2820
2821 # format marker of refs pointing to given object
2822
2823 # the destination action is chosen based on object type and current context:
2824 # - for annotated tags, we choose the tag view unless it's the current view
2825 #   already, in which case we go to shortlog view
2826 # - for other refs, we keep the current view if we're in history, shortlog or
2827 #   log view, and select shortlog otherwise
2828 sub format_ref_marker {
2829         my ($refs, $id) = @_;
2830         my $markers = '';
2831
2832         if (defined $refs->{$id}) {
2833                 foreach my $ref (@{$refs->{$id}}) {
2834                         # this code exploits the fact that non-lightweight tags are the
2835                         # only indirect objects, and that they are the only objects for which
2836                         # we want to use tag instead of shortlog as action
2837                         my ($type, $name) = qw();
2838                         my $indirect = ($ref =~ s/\^\{\}$//);
2839                         # e.g. tags/v2.6.11 or heads/next
2840                         if ($ref =~ m!^(.*?)s?/(.*)$!) {
2841                                 $type = $1;
2842                                 $name = $2;
2843                         } else {
2844                                 $type = "ref";
2845                                 $name = $ref;
2846                         }
2847
2848                         my $class = $type;
2849                         $class .= " indirect" if $indirect;
2850
2851                         my $dest_action = "shortlog";
2852
2853                         if ($indirect) {
2854                                 $dest_action = "tag" unless $action eq "tag";
2855                         } elsif ($action =~ /^(history|(short)?log)$/) {
2856                                 $dest_action = $action;
2857                         }
2858
2859                         my $dest = "";
2860                         $dest .= "refs/" unless $ref =~ m!^refs/!;
2861                         $dest .= $ref;
2862
2863                         my $link = $cgi->a({
2864                                 -href => href(
2865                                         action=>$dest_action,
2866                                         hash=>$dest
2867                                 )}, esc_html($name));
2868
2869                         $markers .= "<span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2870                                 $link . "</span>";
2871                 }
2872         }
2873
2874         if ($markers) {
2875                 return '<span class="refs">'. $markers . '</span>';
2876         } else {
2877                 return "";
2878         }
2879 }
2880
2881 # format, perhaps shortened and with markers, title line
2882 sub format_subject_html {
2883         my ($long, $short, $href, $extra) = @_;
2884         $extra = '' unless defined($extra);
2885
2886         if (length($short) < length($long)) {
2887                 use bytes;
2888                 $long =~ s/[[:cntrl:]]/?/g;
2889                 return $cgi->a({-href => $href, -class => "list subject",
2890                                 -title => to_utf8($long)},
2891                        esc_html($short)) . $extra;
2892         } else {
2893                 return $cgi->a({-href => $href, -class => "list subject"},
2894                        esc_html($long)) . $extra;
2895         }
2896 }
2897
2898 # Rather than recomputing the url for an email multiple times, we cache it
2899 # after the first hit. This gives a visible benefit in views where the avatar
2900 # for the same email is used repeatedly (e.g. shortlog).
2901 # The cache is shared by all avatar engines (currently gravatar only), which
2902 # are free to use it as preferred. Since only one avatar engine is used for any
2903 # given page, there's no risk for cache conflicts.
2904 our %avatar_cache = ();
2905
2906 # Compute the picon url for a given email, by using the picon search service over at
2907 # http://www.cs.indiana.edu/picons/search.html
2908 sub picon_url {
2909         my $email = lc shift;
2910         if (!$avatar_cache{$email}) {
2911                 my ($user, $domain) = split('@', $email);
2912                 $avatar_cache{$email} =
2913                         "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2914                         "$domain/$user/" .
2915                         "users+domains+unknown/up/single";
2916         }
2917         return $avatar_cache{$email};
2918 }
2919
2920 # Compute the gravatar url for a given email, if it's not in the cache already.
2921 # Gravatar stores only the part of the URL before the size, since that's the
2922 # one computationally more expensive. This also allows reuse of the cache for
2923 # different sizes (for this particular engine).
2924 sub gravatar_url {
2925         my $email = lc shift;
2926         my $size = shift;
2927         $avatar_cache{$email} ||=
2928                 "//www.gravatar.com/avatar/" .
2929                         Digest::MD5::md5_hex($email) . "?s=";
2930         return $avatar_cache{$email} . $size;
2931 }
2932
2933 # Insert an avatar for the given $email at the given $size if the feature
2934 # is enabled.
2935 sub git_get_avatar {
2936         my ($email, %opts) = @_;
2937         my $pre_white  = ($opts{-pad_before} ? "&#160;" : "");
2938         my $post_white = ($opts{-pad_after}  ? "&#160;" : "");
2939         $opts{-size} ||= 'default';
2940         my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2941         my $url = "";
2942         if ($git_avatar eq 'gravatar') {
2943                 $url = gravatar_url($email, $size);
2944         } elsif ($git_avatar eq 'picon') {
2945                 $url = picon_url($email);
2946         }
2947         # Other providers can be added by extending the if chain, defining $url
2948         # as needed. If no variant puts something in $url, we assume avatars
2949         # are completely disabled/unavailable.
2950         if ($url) {
2951                 return $pre_white .
2952                        "<img width=\"$size\" " .
2953                             "class=\"avatar\" " .
2954                             "src=\"".esc_url($url)."\" " .
2955                             "alt=\"\" " .
2956                        "/>" . $post_white;
2957         } else {
2958                 return "";
2959         }
2960 }
2961
2962 sub format_search_author {
2963         my ($author, $searchtype, $displaytext) = @_;
2964         my $have_search = gitweb_check_feature('search');
2965
2966         if ($have_search) {
2967                 my $performed = "";
2968                 if ($searchtype eq 'author') {
2969                         $performed = "authored";
2970                 } elsif ($searchtype eq 'committer') {
2971                         $performed = "committed";
2972                 }
2973
2974                 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2975                                 searchtext=>$author,
2976                                 searchtype=>$searchtype), class=>"list",
2977                                 title=>"Search for commits $performed by $author"},
2978                                 $displaytext);
2979
2980         } else {
2981                 return $displaytext;
2982         }
2983 }
2984
2985 # format the author name of the given commit with the given tag
2986 # the author name is chopped and escaped according to the other
2987 # optional parameters (see chop_str).
2988 sub format_author_html {
2989         my $tag = shift;
2990         my $co = shift;
2991         my $author = chop_and_escape_str($co->{'author_name'}, @_);
2992         return "<$tag class=\"author\">" .
2993                format_search_author($co->{'author_name'}, "author",
2994                        git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2995                        $author) .
2996                "</$tag>";
2997 }
2998
2999 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
3000 sub format_git_diff_header_line {
3001         my $line = shift;
3002         my $diffinfo = shift;
3003         my ($from, $to) = @_;
3004
3005         if ($diffinfo->{'nparents'}) {
3006                 # combined diff
3007                 $line =~ s!^(diff (.*?) )"?.*$!$1!;
3008                 if ($to->{'href'}) {
3009                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
3010                                          esc_path($to->{'file'}));
3011                 } else { # file was deleted (no href)
3012                         $line .= esc_path($to->{'file'});
3013                 }
3014         } else {
3015                 # "ordinary" diff
3016                 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
3017                 if ($from->{'href'}) {
3018                         $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
3019                                          'a/' . esc_path($from->{'file'}));
3020                 } else { # file was added (no href)
3021                         $line .= 'a/' . esc_path($from->{'file'});
3022                 }
3023                 $line .= ' ';
3024                 if ($to->{'href'}) {
3025                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
3026                                          'b/' . esc_path($to->{'file'}));
3027                 } else { # file was deleted
3028                         $line .= 'b/' . esc_path($to->{'file'});
3029                 }
3030         }
3031
3032         return "<div class=\"diff header\">$line</div>\n";
3033 }
3034
3035 # format extended diff header line, before patch itself
3036 sub format_extended_diff_header_line {
3037         my $line = shift;
3038         my $diffinfo = shift;
3039         my ($from, $to) = @_;
3040
3041         # match <path>
3042         if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
3043                 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
3044                                        esc_path($from->{'file'}));
3045         }
3046         if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
3047                 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3048                                  esc_path($to->{'file'}));
3049         }
3050         # match single <mode>
3051         if ($line =~ m/\s(\d{6})$/) {
3052                 $line .= '<span class="info"> (' .
3053                          file_type_long($1) .
3054                          ')</span>';
3055         }
3056         # match <hash>
3057         if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
3058                 # can match only for combined diff
3059                 $line = 'index ';
3060                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3061                         if ($from->{'href'}[$i]) {
3062                                 $line .= $cgi->a({-href=>$from->{'href'}[$i],
3063                                                   -class=>"hash"},
3064                                                  substr($diffinfo->{'from_id'}[$i],0,7));
3065                         } else {
3066                                 $line .= '0' x 7;
3067                         }
3068                         # separator
3069                         $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
3070                 }
3071                 $line .= '..';
3072                 if ($to->{'href'}) {
3073                         $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
3074                                          substr($diffinfo->{'to_id'},0,7));
3075                 } else {
3076                         $line .= '0' x 7;
3077                 }
3078
3079         } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
3080                 # can match only for ordinary diff
3081                 my ($from_link, $to_link);
3082                 if ($from->{'href'}) {
3083                         $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
3084                                              substr($diffinfo->{'from_id'},0,7));
3085                 } else {
3086                         $from_link = '0' x 7;
3087                 }
3088                 if ($to->{'href'}) {
3089                         $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
3090                                            substr($diffinfo->{'to_id'},0,7));
3091                 } else {
3092                         $to_link = '0' x 7;
3093                 }
3094                 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
3095                 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
3096         }
3097
3098         return $line . "<br/>\n";
3099 }
3100
3101 # format from-file/to-file diff header
3102 sub format_diff_from_to_header {
3103         my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
3104         my $line;
3105         my $result = '';
3106
3107         $line = $from_line;
3108         #assert($line =~ m/^---/) if DEBUG;
3109         # no extra formatting for "^--- /dev/null"
3110         if (! $diffinfo->{'nparents'}) {
3111                 # ordinary (single parent) diff
3112                 if ($line =~ m!^--- "?a/!) {
3113                         if ($from->{'href'}) {
3114                                 $line = '--- a/' .
3115                                         $cgi->a({-href=>$from->{'href'}, -class=>"path"},
3116                                                 esc_path($from->{'file'}));
3117                         } else {
3118                                 $line = '--- a/' .
3119                                         esc_path($from->{'file'});
3120                         }
3121                 }
3122                 $result .= qq!<div class="diff from_file">$line</div>\n!;
3123
3124         } else {
3125                 # combined diff (merge commit)
3126                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3127                         if ($from->{'href'}[$i]) {
3128                                 $line = '--- ' .
3129                                         $cgi->a({-href=>href(action=>"blobdiff",
3130                                                              hash_parent=>$diffinfo->{'from_id'}[$i],
3131                                                              hash_parent_base=>$parents[$i],
3132                                                              file_parent=>$from->{'file'}[$i],
3133                                                              hash=>$diffinfo->{'to_id'},
3134                                                              hash_base=>$hash,
3135                                                              file_name=>$to->{'file'}),
3136                                                  -class=>"path",
3137                                                  -title=>"diff" . ($i+1)},
3138                                                 $i+1) .
3139                                         '/' .
3140                                         $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
3141                                                 esc_path($from->{'file'}[$i]));
3142                         } else {
3143                                 $line = '--- /dev/null';
3144                         }
3145                         $result .= qq!<div class="diff from_file">$line</div>\n!;
3146                 }
3147         }
3148
3149         $line = $to_line;
3150         #assert($line =~ m/^\+\+\+/) if DEBUG;
3151         # no extra formatting for "^+++ /dev/null"
3152         if ($line =~ m!^\+\+\+ "?b/!) {
3153                 if ($to->{'href'}) {
3154                         $line = '+++ b/' .
3155                                 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3156                                         esc_path($to->{'file'}));
3157                 } else {
3158                         $line = '+++ b/' .
3159                                 esc_path($to->{'file'});
3160                 }
3161         }
3162         $result .= qq!<div class="diff to_file">$line</div>\n!;
3163
3164         return $result;
3165 }
3166
3167 # create note for patch simplified by combined diff
3168 sub format_diff_cc_simplified {
3169         my ($diffinfo, @parents) = @_;
3170         my $result = '';
3171
3172         $result .= "<div class=\"diff header\">" .
3173                    "diff --cc ";
3174         if (!is_deleted($diffinfo)) {
3175                 $result .= $cgi->a({-href => href(action=>"blob",
3176                                                   hash_base=>$hash,
3177                                                   hash=>$diffinfo->{'to_id'},
3178                                                   file_name=>$diffinfo->{'to_file'}),
3179                                     -class => "path"},
3180                                    esc_path($diffinfo->{'to_file'}));
3181         } else {
3182                 $result .= esc_path($diffinfo->{'to_file'});
3183         }
3184         $result .= "</div>\n" . # class="diff header"
3185                    "<div class=\"diff nodifferences\">" .
3186                    "Simple merge" .
3187                    "</div>\n"; # class="diff nodifferences"
3188
3189         return $result;
3190 }
3191
3192 sub diff_line_class {
3193         my ($line, $from, $to) = @_;
3194
3195         # ordinary diff
3196         my $num_sign = 1;
3197         # combined diff
3198         if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
3199                 $num_sign = scalar @{$from->{'href'}};
3200         }
3201
3202         my @diff_line_classifier = (
3203                 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
3204                 { regexp => qr/^\\/,               class => "incomplete"  },
3205                 { regexp => qr/^ {$num_sign}/,     class => "ctx" },
3206                 # classifier for context must come before classifier add/rem,
3207                 # or we would have to use more complicated regexp, for example
3208                 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
3209                 { regexp => qr/^[+ ]{$num_sign}/,   class => "add" },
3210                 { regexp => qr/^[- ]{$num_sign}/,   class => "rem" },
3211         );
3212         for my $clsfy (@diff_line_classifier) {
3213                 return $clsfy->{'class'}
3214                         if ($line =~ $clsfy->{'regexp'});
3215         }
3216
3217         # fallback
3218         return "";
3219 }
3220
3221 # assumes that $from and $to are defined and correctly filled,
3222 # and that $line holds a line of chunk header for unified diff
3223 sub format_unidiff_chunk_header {
3224         my ($line, $from, $to) = @_;
3225
3226         my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
3227                 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
3228
3229         $from_lines = 0 unless defined $from_lines;
3230         $to_lines   = 0 unless defined $to_lines;
3231
3232         if ($from->{'href'}) {
3233                 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
3234                                      -class=>"list"}, $from_text);
3235         }
3236         if ($to->{'href'}) {
3237                 $to_text   = $cgi->a({-href=>"$to->{'href'}#l$to_start",
3238                                      -class=>"list"}, $to_text);
3239         }
3240         $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
3241                 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3242         return $line;
3243 }
3244
3245 # assumes that $from and $to are defined and correctly filled,
3246 # and that $line holds a line of chunk header for combined diff
3247 sub format_cc_diff_chunk_header {
3248         my ($line, $from, $to) = @_;
3249
3250         my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
3251         my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
3252
3253         @from_text = split(' ', $ranges);
3254         for (my $i = 0; $i < @from_text; ++$i) {
3255                 ($from_start[$i], $from_nlines[$i]) =
3256                         (split(',', substr($from_text[$i], 1)), 0);
3257         }
3258
3259         $to_text   = pop @from_text;
3260         $to_start  = pop @from_start;
3261         $to_nlines = pop @from_nlines;
3262
3263         $line = "<span class=\"chunk_info\">$prefix ";
3264         for (my $i = 0; $i < @from_text; ++$i) {
3265                 if ($from->{'href'}[$i]) {
3266                         $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
3267                                           -class=>"list"}, $from_text[$i]);
3268                 } else {
3269                         $line .= $from_text[$i];
3270                 }
3271                 $line .= " ";
3272         }
3273         if ($to->{'href'}) {
3274                 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
3275                                   -class=>"list"}, $to_text);
3276         } else {
3277                 $line .= $to_text;
3278         }
3279         $line .= " $prefix</span>" .
3280                  "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3281         return $line;
3282 }
3283
3284 # process patch (diff) line (not to be used for diff headers),
3285 # returning HTML-formatted (but not wrapped) line.
3286 # If the line is passed as a reference, it is treated as HTML and not
3287 # esc_html()'ed.
3288 sub format_diff_line {
3289         my ($line, $diff_class, $from, $to) = @_;
3290
3291         if (ref($line)) {
3292                 $line = $$line;
3293         } else {
3294                 chomp $line;
3295                 $line = untabify($line);
3296
3297                 if ($from && $to && $line =~ m/^\@{2} /) {
3298                         $line = format_unidiff_chunk_header($line, $from, $to);
3299                 } elsif ($from && $to && $line =~ m/^\@{3}/) {
3300                         $line = format_cc_diff_chunk_header($line, $from, $to);
3301                 } else {
3302                         $line = esc_html($line, -nbsp=>1);
3303                 }
3304         }
3305
3306         my $diff_classes = "diff diff_body";
3307         $diff_classes .= " $diff_class" if ($diff_class);
3308         $line = "<div class=\"$diff_classes\">$line</div>\n";
3309
3310         return $line;
3311 }
3312
3313 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
3314 # linked.  Pass the hash of the tree/commit to snapshot.
3315 sub format_snapshot_links {
3316         my ($hash) = @_;
3317         my $num_fmts = @snapshot_fmts;
3318         if ($num_fmts > 1) {
3319                 # A parenthesized list of links bearing format names.
3320                 # e.g. "snapshot (_tar.gz_ _zip_)"
3321                 return "<span class=\"snapshots\">snapshot (" . join(' ', map
3322                         $cgi->a({
3323                                 -href => href(
3324                                         action=>"snapshot",
3325                                         hash=>$hash,
3326                                         snapshot_format=>$_
3327                                 )
3328                         }, $known_snapshot_formats{$_}{'display'})
3329                 , @snapshot_fmts) . ")</span>";
3330         } elsif ($num_fmts == 1) {
3331                 # A single "snapshot" link whose tooltip bears the format name.
3332                 # i.e. "_snapshot_"
3333                 my ($fmt) = @snapshot_fmts;
3334                 return "<span class=\"snapshots\">" .
3335                         $cgi->a({
3336                                 -href => href(
3337                                         action=>"snapshot",
3338                                         hash=>$hash,
3339                                         snapshot_format=>$fmt
3340                                 ),
3341                                 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
3342                         }, "snapshot") . "</span>";
3343         } else { # $num_fmts == 0
3344                 return undef;
3345         }
3346 }
3347
3348 ## ......................................................................
3349 ## functions returning values to be passed, perhaps after some
3350 ## transformation, to other functions; e.g. returning arguments to href()
3351
3352 # returns hash to be passed to href to generate gitweb URL
3353 # in -title key it returns description of link
3354 sub get_feed_info {
3355         my $format = shift || 'Atom';
3356         my %res = (action => lc($format));
3357         my $matched_ref = 0;
3358
3359         # feed links are possible only for project views
3360         return unless (defined $project);
3361         # some views should link to OPML, or to generic project feed,
3362         # or don't have specific feed yet (so they should use generic)
3363         return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
3364
3365         my $branch = undef;
3366         # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
3367         # (fullname) to differentiate from tag links; this also makes
3368         # possible to detect branch links
3369         for my $ref (get_branch_refs()) {
3370                 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
3371                     (defined $hash      && $hash      =~ m!^refs/\Q$ref\E/(.*)$!)) {
3372                         $branch = $1;
3373                         $matched_ref = $ref;
3374                         last;
3375                 }
3376         }
3377         # find log type for feed description (title)
3378         my $type = 'log';
3379         if (defined $file_name) {
3380                 $type  = "history of $file_name";
3381                 $type .= "/" if ($action eq 'tree');
3382                 $type .= " on '$branch'" if (defined $branch);
3383         } else {
3384                 $type = "log of $branch" if (defined $branch);
3385         }
3386
3387         $res{-title} = $type;
3388         $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
3389         $res{'file_name'} = $file_name;
3390
3391         return %res;
3392 }
3393
3394 ## ----------------------------------------------------------------------
3395 ## git utility subroutines, invoking git commands
3396
3397 # returns path to the core git executable and the --git-dir parameter as list
3398 sub git_cmd {
3399         $number_of_git_cmds++;
3400         return $GIT, '--git-dir='.$git_dir;
3401 }
3402
3403 # opens a "-|" cmd pipe handle with 2>/dev/null and returns it
3404 sub cmd_pipe {
3405
3406         # In order to be compatible with FCGI mode we must use POSIX
3407         # and access the STDERR_FILENO file descriptor directly
3408
3409         use POSIX qw(STDERR_FILENO dup dup2);
3410
3411         open(my $null, '>', File::Spec->devnull) or die "couldn't open devnull: $!";
3412         (my $saveerr = dup(STDERR_FILENO)) or die "couldn't dup STDERR: $!";
3413         my $dup2ok = dup2(fileno($null), STDERR_FILENO);
3414         close($null) or !$dup2ok or die "couldn't close NULL: $!";
3415         $dup2ok or POSIX::close($saveerr), die "couldn't dup NULL to STDERR: $!";
3416         my $result = open(my $fd, "-|", @_);
3417         $dup2ok = dup2($saveerr, STDERR_FILENO);
3418         POSIX::close($saveerr) or !$dup2ok or die "couldn't close SAVEERR: $!";
3419         $dup2ok or die "couldn't dup SAVERR to STDERR: $!";
3420
3421         return $result ? $fd : undef;
3422 }
3423
3424 # opens a "-|" git_cmd pipe handle with 2>/dev/null and returns it
3425 sub git_cmd_pipe {
3426         return cmd_pipe git_cmd(), @_;
3427 }
3428
3429 # quote the given arguments for passing them to the shell
3430 # quote_command("command", "arg 1", "arg with ' and ! characters")
3431 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
3432 # Try to avoid using this function wherever possible.
3433 sub quote_command {
3434         return join(' ',
3435                 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
3436 }
3437
3438 # get HEAD ref of given project as hash
3439 sub git_get_head_hash {
3440         return git_get_full_hash(shift, 'HEAD');
3441 }
3442
3443 sub git_get_full_hash {
3444         return git_get_hash(@_);
3445 }
3446
3447 sub git_get_short_hash {
3448         return git_get_hash(@_, '--short=7');
3449 }
3450
3451 sub git_get_hash {
3452         my ($project, $hash, @options) = @_;
3453         my $o_git_dir = $git_dir;
3454         my $retval = undef;
3455         $git_dir = "$projectroot/$project";
3456         if (defined(my $fd = git_cmd_pipe 'rev-parse',
3457             '--verify', '-q', @options, $hash)) {
3458                 $retval = <$fd>;
3459                 chomp $retval if defined $retval;
3460                 close $fd;
3461         }
3462         if (defined $o_git_dir) {
3463                 $git_dir = $o_git_dir;
3464         }
3465         return $retval;
3466 }
3467
3468 # get type of given object
3469 sub git_get_type {
3470         my $hash = shift;
3471
3472         defined(my $fd = git_cmd_pipe "cat-file", '-t', $hash) or return;
3473         my $type = <$fd>;
3474         close $fd or return;
3475         chomp $type;
3476         return $type;
3477 }
3478
3479 # repository configuration
3480 our $config_file = '';
3481 our %config;
3482
3483 # store multiple values for single key as anonymous array reference
3484 # single values stored directly in the hash, not as [ <value> ]
3485 sub hash_set_multi {
3486         my ($hash, $key, $value) = @_;
3487
3488         if (!exists $hash->{$key}) {
3489                 $hash->{$key} = $value;
3490         } elsif (!ref $hash->{$key}) {
3491                 $hash->{$key} = [ $hash->{$key}, $value ];
3492         } else {
3493                 push @{$hash->{$key}}, $value;
3494         }
3495 }
3496
3497 # return hash of git project configuration
3498 # optionally limited to some section, e.g. 'gitweb'
3499 sub git_parse_project_config {
3500         my $section_regexp = shift;
3501         my %config;
3502
3503         local $/ = "\0";
3504
3505         defined(my $fh = git_cmd_pipe "config", '-z', '-l')
3506                 or return;
3507
3508         while (my $keyval = to_utf8(scalar <$fh>)) {
3509                 chomp $keyval;
3510                 my ($key, $value) = split(/\n/, $keyval, 2);
3511
3512                 hash_set_multi(\%config, $key, $value)
3513                         if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
3514         }
3515         close $fh;
3516
3517         return %config;
3518 }
3519
3520 # convert config value to boolean: 'true' or 'false'
3521 # no value, number > 0, 'true' and 'yes' values are true
3522 # rest of values are treated as false (never as error)
3523 sub config_to_bool {
3524         my $val = shift;
3525
3526         return 1 if !defined $val;             # section.key
3527
3528         # strip leading and trailing whitespace
3529         $val =~ s/^\s+//;
3530         $val =~ s/\s+$//;
3531
3532         return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
3533                 ($val =~ /^(?:true|yes)$/i));  # section.key = true
3534 }
3535
3536 # convert config value to simple decimal number
3537 # an optional value suffix of 'k', 'm', or 'g' will cause the value
3538 # to be multiplied by 1024, 1048576, or 1073741824
3539 sub config_to_int {
3540         my $val = shift;
3541
3542         # strip leading and trailing whitespace
3543         $val =~ s/^\s+//;
3544         $val =~ s/\s+$//;
3545
3546         if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
3547                 $unit = lc($unit);
3548                 # unknown unit is treated as 1
3549                 return $num * ($unit eq 'g' ? 1073741824 :
3550                                $unit eq 'm' ?    1048576 :
3551                                $unit eq 'k' ?       1024 : 1);
3552         }
3553         return $val;
3554 }
3555
3556 # convert config value to array reference, if needed
3557 sub config_to_multi {
3558         my $val = shift;
3559
3560         return ref($val) ? $val : (defined($val) ? [ $val ] : []);
3561 }
3562
3563 sub git_get_project_config {
3564         my ($key, $type) = @_;
3565
3566         return unless defined $git_dir;
3567
3568         # key sanity check
3569         return unless ($key);
3570         # only subsection, if exists, is case sensitive,
3571         # and not lowercased by 'git config -z -l'
3572         if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
3573                 $lo =~ s/_//g;
3574                 $key = join(".", lc($hi), $mi, lc($lo));
3575                 return if ($lo =~ /\W/ || $hi =~ /\W/);
3576         } else {
3577                 $key = lc($key);
3578                 $key =~ s/_//g;
3579                 return if ($key =~ /\W/);
3580         }
3581         $key =~ s/^gitweb\.//;
3582
3583         # type sanity check
3584         if (defined $type) {
3585                 $type =~ s/^--//;
3586                 $type = undef
3587                         unless ($type eq 'bool' || $type eq 'int');
3588         }
3589
3590         # get config
3591         if (!defined $config_file ||
3592             $config_file ne "$git_dir/config") {
3593                 %config = git_parse_project_config('gitweb');
3594                 $config_file = "$git_dir/config";
3595         }
3596
3597         # check if config variable (key) exists
3598         return unless exists $config{"gitweb.$key"};
3599
3600         # ensure given type
3601         if (!defined $type) {
3602                 return $config{"gitweb.$key"};
3603         } elsif ($type eq 'bool') {
3604                 # backward compatibility: 'git config --bool' returns true/false
3605                 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
3606         } elsif ($type eq 'int') {
3607                 return config_to_int($config{"gitweb.$key"});
3608         }
3609         return $config{"gitweb.$key"};
3610 }
3611
3612 # get hash of given path at given ref
3613 sub git_get_hash_by_path {
3614         my $base = shift;
3615         my $path = shift || return undef;
3616         my $type = shift;
3617
3618         $path =~ s,/+$,,;
3619
3620         defined(my $fd = git_cmd_pipe "ls-tree", $base, "--", $path)
3621                 or die_error(500, "Open git-ls-tree failed");
3622         my $line = to_utf8(scalar <$fd>);
3623         close $fd or return undef;
3624
3625         if (!defined $line) {
3626                 # there is no tree or hash given by $path at $base
3627                 return undef;
3628         }
3629
3630         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3631         $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
3632         if (defined $type && $type ne $2) {
3633                 # type doesn't match
3634                 return undef;
3635         }
3636         return $3;
3637 }
3638
3639 # get path of entry with given hash at given tree-ish (ref)
3640 # used to get 'from' filename for combined diff (merge commit) for renames
3641 sub git_get_path_by_hash {
3642         my $base = shift || return;
3643         my $hash = shift || return;
3644
3645         local $/ = "\0";
3646
3647         defined(my $fd = git_cmd_pipe "ls-tree", '-r', '-t', '-z', $base)
3648                 or return undef;
3649         while (my $line = to_utf8(scalar <$fd>)) {
3650                 chomp $line;
3651
3652                 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423  gitweb'
3653                 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f  gitweb/README'
3654                 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
3655                         close $fd;
3656                         return $1;
3657                 }
3658         }
3659         close $fd;
3660         return undef;
3661 }
3662
3663 ## ......................................................................
3664 ## git utility functions, directly accessing git repository
3665
3666 # get the value of config variable either from file named as the variable
3667 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
3668 # configuration variable in the repository config file.
3669 sub git_get_file_or_project_config {
3670         my ($path, $name) = @_;
3671
3672         $git_dir = "$projectroot/$path";
3673         open my $fd, '<', "$git_dir/$name"
3674                 or return git_get_project_config($name);
3675         my $conf = to_utf8(scalar <$fd>);
3676         close $fd;
3677         if (defined $conf) {
3678                 chomp $conf;
3679         }
3680         return $conf;
3681 }
3682
3683 sub git_get_project_description {
3684         my $path = shift;
3685         return git_get_file_or_project_config($path, 'description');
3686 }
3687
3688 sub git_get_project_category {
3689         my $path = shift;
3690         return git_get_file_or_project_config($path, 'category');
3691 }
3692
3693
3694 # supported formats:
3695 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
3696 #   - if its contents is a number, use it as tag weight,
3697 #   - otherwise add a tag with weight 1
3698 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
3699 #   the same value multiple times increases tag weight
3700 # * `gitweb.ctag' multi-valued repo config variable
3701 sub git_get_project_ctags {
3702         my $project = shift;
3703         my $ctags = {};
3704
3705         $git_dir = "$projectroot/$project";
3706         if (opendir my $dh, "$git_dir/ctags") {
3707                 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
3708                 foreach my $tagfile (@files) {
3709                         open my $ct, '<', $tagfile
3710                                 or next;
3711                         my $val = <$ct>;
3712                         chomp $val if $val;
3713                         close $ct;
3714
3715                         (my $ctag = $tagfile) =~ s#.*/##;
3716                         $ctag = to_utf8($ctag);
3717                         if ($val =~ /^\d+$/) {
3718                                 $ctags->{$ctag} = $val;
3719                         } else {
3720                                 $ctags->{$ctag} = 1;
3721                         }
3722                 }
3723                 closedir $dh;
3724
3725         } elsif (open my $fh, '<', "$git_dir/ctags") {
3726                 while (my $line = to_utf8(scalar <$fh>)) {
3727                         chomp $line;
3728                         $ctags->{$line}++ if $line;
3729                 }
3730                 close $fh;
3731
3732         } else {
3733                 my $taglist = config_to_multi(git_get_project_config('ctag'));
3734                 foreach my $tag (@$taglist) {
3735                         $ctags->{$tag}++;
3736                 }
3737         }
3738
3739         return $ctags;
3740 }
3741
3742 # return hash, where keys are content tags ('ctags'),
3743 # and values are sum of weights of given tag in every project
3744 sub git_gather_all_ctags {
3745         my $projects = shift;
3746         my $ctags = {};
3747
3748         foreach my $p (@$projects) {
3749                 foreach my $ct (keys %{$p->{'ctags'}}) {
3750                         $ctags->{$ct} += $p->{'ctags'}->{$ct};
3751                 }
3752         }
3753
3754         return $ctags;
3755 }
3756
3757 sub git_populate_project_tagcloud {
3758         my ($ctags, $action) = @_;
3759
3760         # First, merge different-cased tags; tags vote on casing
3761         my %ctags_lc;
3762         foreach (keys %$ctags) {
3763                 $ctags_lc{lc $_}->{count} += $ctags->{$_};
3764                 if (not $ctags_lc{lc $_}->{topcount}
3765                     or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
3766                         $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
3767                         $ctags_lc{lc $_}->{topname} = $_;
3768                 }
3769         }
3770
3771         my $cloud;
3772         my $matched = $input_params{'ctag_filter'};
3773         if (eval { require HTML::TagCloud; 1; }) {
3774                 $cloud = HTML::TagCloud->new;
3775                 foreach my $ctag (sort keys %ctags_lc) {
3776                         # Pad the title with spaces so that the cloud looks
3777                         # less crammed.
3778                         my $title = esc_html($ctags_lc{$ctag}->{topname});
3779                         $title =~ s/ /&#160;/g;
3780                         $title =~ s/^/&#160;/g;
3781                         $title =~ s/$/&#160;/g;
3782                         if (defined $matched && $matched eq $ctag) {
3783                                 $title = qq(<span class="match">$title</span>);
3784                         }
3785                         $cloud->add($title, href(-replay=>1, action=>$action, ctag_filter=>$ctag),
3786                                     $ctags_lc{$ctag}->{count});
3787                 }
3788         } else {
3789                 $cloud = {};
3790                 foreach my $ctag (keys %ctags_lc) {
3791                         my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3792                         if (defined $matched && $matched eq $ctag) {
3793                                 $title = qq(<span class="match">$title</span>);
3794                         }
3795                         $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3796                         $cloud->{$ctag}{ctag} =
3797                                 $cgi->a({-href=>href(-replay=>1, action=>$action, ctag_filter=>$ctag)}, $title);
3798                 }
3799         }
3800         return $cloud;
3801 }
3802
3803 sub git_show_project_tagcloud {
3804         my ($cloud, $count) = @_;
3805         if (ref $cloud eq 'HTML::TagCloud') {
3806                 return $cloud->html_and_css($count);
3807         } else {
3808                 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3809                 return
3810                         '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3811                         join (', ', map {
3812                                 $cloud->{$_}->{'ctag'}
3813                         } splice(@tags, 0, $count)) .
3814                         '</div>';
3815         }
3816 }
3817
3818 sub git_get_project_url_list {
3819         my $path = shift;
3820
3821         $git_dir = "$projectroot/$path";
3822         open my $fd, '<', "$git_dir/cloneurl"
3823                 or return wantarray ?
3824                 @{ config_to_multi(git_get_project_config('url')) } :
3825                    config_to_multi(git_get_project_config('url'));
3826         my @git_project_url_list = map { chomp; to_utf8($_) } <$fd>;
3827         close $fd;
3828
3829         return wantarray ? @git_project_url_list : \@git_project_url_list;
3830 }
3831
3832 sub git_get_projects_list {
3833         my $filter = shift;
3834         my $paranoid = shift;
3835         my @list;
3836         defined($filter) or $filter = "";
3837
3838         if (-d $projects_list) {
3839                 # search in directory
3840                 my $dir = $projects_list;
3841                 # remove the trailing "/"
3842                 $dir =~ s!/+$!!;
3843                 my $pfxlen = length("$dir");
3844                 my $pfxdepth = ($dir =~ tr!/!!);
3845                 # when filtering, search only given subdirectory
3846                 if ($filter ne "" && !$paranoid) {
3847                         $dir .= "/$filter";
3848                         $dir =~ s!/+$!!;
3849                 }
3850
3851                 File::Find::find({
3852                         follow_fast => 1, # follow symbolic links
3853                         follow_skip => 2, # ignore duplicates
3854                         dangling_symlinks => 0, # ignore dangling symlinks, silently
3855                         wanted => sub {
3856                                 # global variables
3857                                 our $project_maxdepth;
3858                                 our $projectroot;
3859                                 # skip project-list toplevel, if we get it.
3860                                 return if (m!^[/.]$!);
3861                                 # only directories can be git repositories
3862                                 return unless (-d $_);
3863                                 # don't traverse too deep (Find is super slow on os x)
3864                                 # $project_maxdepth excludes depth of $projectroot
3865                                 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3866                                         $File::Find::prune = 1;
3867                                         return;
3868                                 }
3869
3870                                 my $path = substr($File::Find::name, $pfxlen + 1);
3871                                 # paranoidly only filter here
3872                                 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3873                                         next;
3874                                 }
3875                                 # we check related file in $projectroot
3876                                 if (check_export_ok("$projectroot/$path")) {
3877                                         push @list, { path => $path };
3878                                         $File::Find::prune = 1;
3879                                 }
3880                         },
3881                 }, "$dir");
3882
3883         } elsif (-f $projects_list) {
3884                 # read from file(url-encoded):
3885                 # 'git%2Fgit.git Linus+Torvalds'
3886                 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3887                 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3888                 open my $fd, '<', $projects_list or return;
3889         PROJECT:
3890                 while (my $line = <$fd>) {
3891                         chomp $line;
3892                         my ($path, $owner) = split ' ', $line;
3893                         $path = unescape($path);
3894                         $owner = unescape($owner);
3895                         if (!defined $path) {
3896                                 next;
3897                         }
3898                         # if $filter is rpovided, check if $path begins with $filter
3899                         if ($filter ne "" && $path !~ m!^\Q$filter\E/!) {
3900                                 next;
3901                         }
3902                         if (check_export_ok("$projectroot/$path")) {
3903                                 my $pr = {
3904                                         path => $path
3905                                 };
3906                                 if ($owner) {
3907                                         $pr->{'owner'} = to_utf8($owner);
3908                                 }
3909                                 push @list, $pr;
3910                         }
3911                 }
3912                 close $fd;
3913         }
3914         return @list;
3915 }
3916
3917 # written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
3918 # as side effects it sets 'forks' field to list of forks for forked projects
3919 sub filter_forks_from_projects_list {
3920         my $projects = shift;
3921
3922         my %trie; # prefix tree of directories (path components)
3923         # generate trie out of those directories that might contain forks
3924         foreach my $pr (@$projects) {
3925                 my $path = $pr->{'path'};
3926                 $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
3927                 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3928                 next if ($path eq "");    # skip '.git' repository: tests, git-instaweb
3929                 next unless (-d "$projectroot/$path"); # containing directory exists
3930                 $pr->{'forks'} = [];      # there can be 0 or more forks of project
3931
3932                 # add to trie
3933                 my @dirs = split('/', $path);
3934                 # walk the trie, until either runs out of components or out of trie
3935                 my $ref = \%trie;
3936                 while (scalar @dirs &&
3937                        exists($ref->{$dirs[0]})) {
3938                         $ref = $ref->{shift @dirs};
3939                 }
3940                 # create rest of trie structure from rest of components
3941                 foreach my $dir (@dirs) {
3942                         $ref = $ref->{$dir} = {};
3943                 }
3944                 # create end marker, store $pr as a data
3945                 $ref->{''} = $pr if (!exists $ref->{''});
3946         }
3947
3948         # filter out forks, by finding shortest prefix match for paths
3949         my @filtered;
3950  PROJECT:
3951         foreach my $pr (@$projects) {
3952                 # trie lookup
3953                 my $ref = \%trie;
3954         DIR:
3955                 foreach my $dir (split('/', $pr->{'path'})) {
3956                         if (exists $ref->{''}) {
3957                                 # found [shortest] prefix, is a fork - skip it
3958                                 push @{$ref->{''}{'forks'}}, $pr;
3959                                 next PROJECT;
3960                         }
3961                         if (!exists $ref->{$dir}) {
3962                                 # not in trie, cannot have prefix, not a fork
3963                                 push @filtered, $pr;
3964                                 next PROJECT;
3965                         }
3966                         # If the dir is there, we just walk one step down the trie.
3967                         $ref = $ref->{$dir};
3968                 }
3969                 # we ran out of trie
3970                 # (shouldn't happen: it's either no match, or end marker)
3971                 push @filtered, $pr;
3972         }
3973
3974         return @filtered;
3975 }
3976
3977 # note: fill_project_list_info must be run first,
3978 # for 'descr_long' and 'ctags' to be filled
3979 sub search_projects_list {
3980         my ($projlist, %opts) = @_;
3981         my $tagfilter  = $opts{'tagfilter'};
3982         my $search_re = $opts{'search_regexp'};
3983
3984         return @$projlist
3985                 unless ($tagfilter || $search_re);
3986
3987         # searching projects require filling to be run before it;
3988         fill_project_list_info($projlist,
3989                                $tagfilter  ? 'ctags' : (),
3990                                $search_re ? ('path', 'descr') : ());
3991         my @projects;
3992  PROJECT:
3993         foreach my $pr (@$projlist) {
3994
3995                 if ($tagfilter) {
3996                         next unless ref($pr->{'ctags'}) eq 'HASH';
3997                         next unless
3998                                 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3999                 }
4000
4001                 if ($search_re) {
4002                         my $path = $pr->{'path'};
4003                         $path =~ s/\.git$//; # should not be included in search
4004                         next unless
4005                                 $path =~ /$search_re/ ||
4006                                 $pr->{'descr_long'} =~ /$search_re/;
4007                 }
4008
4009                 push @projects, $pr;
4010         }
4011
4012         return @projects;
4013 }
4014
4015 our $gitweb_project_owner = undef;
4016 sub git_get_project_list_from_file {
4017
4018         return if (defined $gitweb_project_owner);
4019
4020         $gitweb_project_owner = {};
4021         # read from file (url-encoded):
4022         # 'git%2Fgit.git Linus+Torvalds'
4023         # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
4024         # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
4025         if (-f $projects_list) {
4026                 open(my $fd, '<', $projects_list);
4027                 while (my $line = <$fd>) {
4028                         chomp $line;
4029                         my ($pr, $ow) = split ' ', $line;
4030                         $pr = unescape($pr);
4031                         $ow = unescape($ow);
4032                         $gitweb_project_owner->{$pr} = to_utf8($ow);
4033                 }
4034                 close $fd;
4035         }
4036 }
4037
4038 sub git_get_project_owner {
4039         my $proj = shift;
4040         my $owner;
4041
4042         return undef unless $proj;
4043         $git_dir = "$projectroot/$proj";
4044
4045         if (defined $project && $proj eq $project) {
4046                 $owner = git_get_project_config('owner');
4047         }
4048         if (!defined $owner && !defined $gitweb_project_owner) {
4049                 git_get_project_list_from_file();
4050         }
4051         if (!defined $owner && exists $gitweb_project_owner->{$proj}) {
4052                 $owner = $gitweb_project_owner->{$proj};
4053         }
4054         if (!defined $owner && (!defined $project || $proj ne $project)) {
4055                 $owner = git_get_project_config('owner');
4056         }
4057         if (!defined $owner) {
4058                 $owner = get_file_owner("$git_dir");
4059         }
4060
4061         return $owner;
4062 }
4063
4064 sub parse_activity_date {
4065         my $dstr = shift;
4066
4067         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
4068                 # Unix timestamp
4069                 return 0 + $1;
4070         }
4071         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt _](\d{1,2}):(\d{2}):(\d{2})(?:[ _]?([Zz]|(?:[-+]\d{1,2}:?\d{2})))?\s*$/) {
4072                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
4073                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, $Y-1900);
4074                 defined($z) && $z ne '' or $z = 'Z';
4075                 $z =~ s/://;
4076                 substr($z,1,0) = '0' if length($z) == 4;
4077                 my $off = 0;
4078                 if (uc($z) ne 'Z') {
4079                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
4080                         $off = -$off if substr($z,0,1) eq '-';
4081                 }
4082                 return $seconds - $off;
4083         }
4084         return undef;
4085 }
4086
4087 # If $quick is true only look at $lastactivity_file
4088 sub git_get_last_activity {
4089         my ($path, $quick) = @_;
4090         my $fd;
4091
4092         $git_dir = "$projectroot/$path";
4093         if ($lastactivity_file && open($fd, "<", "$git_dir/$lastactivity_file")) {
4094                 my $activity = <$fd>;
4095                 close $fd;
4096                 return (undef) unless defined $activity;
4097                 chomp $activity;
4098                 return (undef) if $activity eq '';
4099                 if (my $timestamp = parse_activity_date($activity)) {
4100                         return ($timestamp);
4101                 }
4102         }
4103         return (undef) if $quick;
4104         defined($fd = git_cmd_pipe 'for-each-ref',
4105              '--format=%(committer)',
4106              '--sort=-committerdate',
4107              '--count=1',
4108              map { "refs/$_" } get_branch_refs ()) or return;
4109         my $most_recent = <$fd>;
4110         close $fd or return (undef);
4111         if (defined $most_recent &&
4112             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
4113                 my $timestamp = $1;
4114                 return ($timestamp);
4115         }
4116         return (undef);
4117 }
4118
4119 # Implementation note: when a single remote is wanted, we cannot use 'git
4120 # remote show -n' because that command always work (assuming it's a remote URL
4121 # if it's not defined), and we cannot use 'git remote show' because that would
4122 # try to make a network roundtrip. So the only way to find if that particular
4123 # remote is defined is to walk the list provided by 'git remote -v' and stop if
4124 # and when we find what we want.
4125 sub git_get_remotes_list {
4126         my $wanted = shift;
4127         my %remotes = ();
4128
4129         my $fd = git_cmd_pipe 'remote', '-v';
4130         return unless $fd;
4131         while (my $remote = to_utf8(scalar <$fd>)) {
4132                 chomp $remote;
4133                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
4134                 next if $wanted and not $remote eq $wanted;
4135                 my ($url, $key) = ($1, $2);
4136
4137                 $remotes{$remote} ||= { 'heads' => [] };
4138                 $remotes{$remote}{$key} = $url;
4139         }
4140         close $fd or return;
4141         return wantarray ? %remotes : \%remotes;
4142 }
4143
4144 # Takes a hash of remotes as first parameter and fills it by adding the
4145 # available remote heads for each of the indicated remotes.
4146 sub fill_remote_heads {
4147         my $remotes = shift;
4148         my @heads = map { "remotes/$_" } keys %$remotes;
4149         my @remoteheads = git_get_heads_list(undef, @heads);
4150         foreach my $remote (keys %$remotes) {
4151                 $remotes->{$remote}{'heads'} = [ grep {
4152                         $_->{'name'} =~ s!^$remote/!!
4153                         } @remoteheads ];
4154         }
4155 }
4156
4157 sub git_get_references {
4158         my $type = shift || "";
4159         my %refs;
4160         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
4161         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
4162         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
4163                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
4164                 or return;
4165
4166         while (my $line = to_utf8(scalar <$fd>)) {
4167                 chomp $line;
4168                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
4169                         if (defined $refs{$1}) {
4170                                 push @{$refs{$1}}, $2;
4171                         } else {
4172                                 $refs{$1} = [ $2 ];
4173                         }
4174                 }
4175         }
4176         close $fd or return;
4177         return \%refs;
4178 }
4179
4180 sub git_get_rev_name_tags {
4181         my $hash = shift || return undef;
4182
4183         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
4184                 or return;
4185         my $name_rev = to_utf8(scalar <$fd>);
4186         close $fd;
4187
4188         if ($name_rev =~ m|^$hash tags/(.*)$|) {
4189                 return $1;
4190         } else {
4191                 # catches also '$hash undefined' output
4192                 return undef;
4193         }
4194 }
4195
4196 ## ----------------------------------------------------------------------
4197 ## parse to hash functions
4198
4199 sub parse_date {
4200         my $epoch = shift;
4201         my $tz = shift || "-0000";
4202
4203         my %date;
4204         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
4205         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
4206         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
4207         $date{'hour'} = $hour;
4208         $date{'minute'} = $min;
4209         $date{'mday'} = $mday;
4210         $date{'day'} = $days[$wday];
4211         $date{'month'} = $months[$mon];
4212         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
4213                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
4214         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
4215                              $mday, $months[$mon], $hour ,$min;
4216         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
4217                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
4218
4219         my ($tz_sign, $tz_hour, $tz_min) =
4220                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
4221         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
4222         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
4223         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
4224         $date{'hour_local'} = $hour;
4225         $date{'minute_local'} = $min;
4226         $date{'mday_local'} = $mday;
4227         $date{'tz_local'} = $tz;
4228         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
4229                                   1900+$year, $mon+1, $mday,
4230                                   $hour, $min, $sec, $tz);
4231         return %date;
4232 }
4233
4234 sub parse_file_date {
4235         my $file = shift;
4236         my $mtime = (stat("$projectroot/$project/$file"))[9];
4237         return () unless defined $mtime;
4238         my $tzoffset = timegm((localtime($mtime))[0..5]) - $mtime;
4239         my $tzstring = '+';
4240         if ($tzoffset <= 0) {
4241                 $tzstring = '-';
4242                 $tzoffset *= -1;
4243         }
4244         $tzoffset = int($tzoffset/60);
4245         $tzstring .= sprintf("%02d%02d", int($tzoffset/60), $tzoffset%60);
4246         return parse_date($mtime, $tzstring);
4247 }
4248
4249 sub parse_tag {
4250         my $tag_id = shift;
4251         my %tag;
4252         my @comment;
4253
4254         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
4255         $tag{'id'} = $tag_id;
4256         while (my $line = to_utf8(scalar <$fd>)) {
4257                 chomp $line;
4258                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
4259                         $tag{'object'} = $1;
4260                 } elsif ($line =~ m/^type (.+)$/) {
4261                         $tag{'type'} = $1;
4262                 } elsif ($line =~ m/^tag (.+)$/) {
4263                         $tag{'name'} = $1;
4264                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
4265                         $tag{'author'} = $1;
4266                         $tag{'author_epoch'} = $2;
4267                         $tag{'author_tz'} = $3;
4268                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4269                                 $tag{'author_name'}  = $1;
4270                                 $tag{'author_email'} = $2;
4271                         } else {
4272                                 $tag{'author_name'} = $tag{'author'};
4273                         }
4274                 } elsif ($line =~ m/--BEGIN/) {
4275                         push @comment, $line;
4276                         last;
4277                 } elsif ($line eq "") {
4278                         last;
4279                 }
4280         }
4281         push @comment, map(to_utf8($_), <$fd>);
4282         $tag{'comment'} = \@comment;
4283         close $fd or return;
4284         if (!defined $tag{'name'}) {
4285                 return
4286         };
4287         return %tag
4288 }
4289
4290 sub parse_commit_text {
4291         my ($commit_text, $withparents) = @_;
4292         my @commit_lines = split '\n', $commit_text;
4293         my %co;
4294
4295         pop @commit_lines; # Remove '\0'
4296
4297         if (! @commit_lines) {
4298                 return;
4299         }
4300
4301         my $header = shift @commit_lines;
4302         if ($header !~ m/^[0-9a-fA-F]{40}/) {
4303                 return;
4304         }
4305         ($co{'id'}, my @parents) = split ' ', $header;
4306         while (my $line = shift @commit_lines) {
4307                 last if $line eq "\n";
4308                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
4309                         $co{'tree'} = $1;
4310                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
4311                         push @parents, $1;
4312                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
4313                         $co{'author'} = to_utf8($1);
4314                         $co{'author_epoch'} = $2;
4315                         $co{'author_tz'} = $3;
4316                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4317                                 $co{'author_name'}  = $1;
4318                                 $co{'author_email'} = $2;
4319                         } else {
4320                                 $co{'author_name'} = $co{'author'};
4321                         }
4322                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
4323                         $co{'committer'} = to_utf8($1);
4324                         $co{'committer_epoch'} = $2;
4325                         $co{'committer_tz'} = $3;
4326                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
4327                                 $co{'committer_name'}  = $1;
4328                                 $co{'committer_email'} = $2;
4329                         } else {
4330                                 $co{'committer_name'} = $co{'committer'};
4331                         }
4332                 }
4333         }
4334         if (!defined $co{'tree'}) {
4335                 return;
4336         };
4337         $co{'parents'} = \@parents;
4338         $co{'parent'} = $parents[0];
4339
4340         @commit_lines = map to_utf8($_), @commit_lines;
4341         foreach my $title (@commit_lines) {
4342                 $title =~ s/^    //;
4343                 if ($title ne "") {
4344                         $co{'title'} = chop_str($title, 80, 5);
4345                         # remove leading stuff of merges to make the interesting part visible
4346                         if (length($title) > 50) {
4347                                 $title =~ s/^Automatic //;
4348                                 $title =~ s/^merge (of|with) /Merge ... /i;
4349                                 if (length($title) > 50) {
4350                                         $title =~ s/(http|rsync):\/\///;
4351                                 }
4352                                 if (length($title) > 50) {
4353                                         $title =~ s/(master|www|rsync)\.//;
4354                                 }
4355                                 if (length($title) > 50) {
4356                                         $title =~ s/kernel.org:?//;
4357                                 }
4358                                 if (length($title) > 50) {
4359                                         $title =~ s/\/pub\/scm//;
4360                                 }
4361                         }
4362                         $co{'title_short'} = chop_str($title, 50, 5);
4363                         last;
4364                 }
4365         }
4366         if (! defined $co{'title'} || $co{'title'} eq "") {
4367                 $co{'title'} = $co{'title_short'} = '(no commit message)';
4368         }
4369         # remove added spaces
4370         foreach my $line (@commit_lines) {
4371                 $line =~ s/^    //;
4372         }
4373         $co{'comment'} = \@commit_lines;
4374
4375         my $age_epoch = $co{'committer_epoch'};
4376         $co{'age_epoch'} = $age_epoch;
4377         my $time_now = time;
4378         $co{'age_string'} = age_string($age_epoch, $time_now);
4379         $co{'age_string_date'} = age_string_date($age_epoch, $time_now);
4380         $co{'age_string_age'} = age_string_age($age_epoch, $time_now);
4381         return %co;
4382 }
4383
4384 sub parse_commit {
4385         my ($commit_id) = @_;
4386         my %co;
4387
4388         local $/ = "\0";
4389
4390         defined(my $fd = git_cmd_pipe "rev-list",
4391                 "--parents",
4392                 "--header",
4393                 "--max-count=1",
4394                 $commit_id,
4395                 "--")
4396                 or die_error(500, "Open git-rev-list failed");
4397         %co = parse_commit_text(<$fd>, 1);
4398         close $fd;
4399
4400         return %co;
4401 }
4402
4403 sub parse_commits {
4404         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
4405         my @cos;
4406
4407         $maxcount ||= 1;
4408         $skip ||= 0;
4409
4410         local $/ = "\0";
4411
4412         defined(my $fd = git_cmd_pipe "rev-list",
4413                 "--header",
4414                 @args,
4415                 ("--max-count=" . $maxcount),
4416                 ("--skip=" . $skip),
4417                 @extra_options,
4418                 $commit_id,
4419                 "--",
4420                 ($filename ? ($filename) : ()))
4421                 or die_error(500, "Open git-rev-list failed");
4422         while (my $line = <$fd>) {
4423                 my %co = parse_commit_text($line);
4424                 push @cos, \%co;
4425         }
4426         close $fd;
4427
4428         return wantarray ? @cos : \@cos;
4429 }
4430
4431 # parse line of git-diff-tree "raw" output
4432 sub parse_difftree_raw_line {
4433         my $line = shift;
4434         my %res;
4435
4436         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
4437         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
4438         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
4439                 $res{'from_mode'} = $1;
4440                 $res{'to_mode'} = $2;
4441                 $res{'from_id'} = $3;
4442                 $res{'to_id'} = $4;
4443                 $res{'status'} = $5;
4444                 $res{'similarity'} = $6;
4445                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
4446                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
4447                 } else {
4448                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
4449                 }
4450         }
4451         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
4452         # combined diff (for merge commit)
4453         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
4454                 $res{'nparents'}  = length($1);
4455                 $res{'from_mode'} = [ split(' ', $2) ];
4456                 $res{'to_mode'} = pop @{$res{'from_mode'}};
4457                 $res{'from_id'} = [ split(' ', $3) ];
4458                 $res{'to_id'} = pop @{$res{'from_id'}};
4459                 $res{'status'} = [ split('', $4) ];
4460                 $res{'to_file'} = unquote($5);
4461         }
4462         # 'c512b523472485aef4fff9e57b229d9d243c967f'
4463         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
4464                 $res{'commit'} = $1;
4465         }
4466
4467         return wantarray ? %res : \%res;
4468 }
4469
4470 # wrapper: return parsed line of git-diff-tree "raw" output
4471 # (the argument might be raw line, or parsed info)
4472 sub parsed_difftree_line {
4473         my $line_or_ref = shift;
4474
4475         if (ref($line_or_ref) eq "HASH") {
4476                 # pre-parsed (or generated by hand)
4477                 return $line_or_ref;
4478         } else {
4479                 return parse_difftree_raw_line($line_or_ref);
4480         }
4481 }
4482
4483 # parse line of git-ls-tree output
4484 sub parse_ls_tree_line {
4485         my $line = shift;
4486         my %opts = @_;
4487         my %res;
4488
4489         if ($opts{'-l'}) {
4490                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
4491                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
4492
4493                 $res{'mode'} = $1;
4494                 $res{'type'} = $2;
4495                 $res{'hash'} = $3;
4496                 $res{'size'} = $4;
4497                 if ($opts{'-z'}) {
4498                         $res{'name'} = $5;
4499                 } else {
4500                         $res{'name'} = unquote($5);
4501                 }
4502         } else {
4503                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
4504                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
4505
4506                 $res{'mode'} = $1;
4507                 $res{'type'} = $2;
4508                 $res{'hash'} = $3;
4509                 if ($opts{'-z'}) {
4510                         $res{'name'} = $4;
4511                 } else {
4512                         $res{'name'} = unquote($4);
4513                 }
4514         }
4515
4516         return wantarray ? %res : \%res;
4517 }
4518
4519 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4520 sub parse_from_to_diffinfo {
4521         my ($diffinfo, $from, $to, @parents) = @_;
4522
4523         if ($diffinfo->{'nparents'}) {
4524                 # combined diff
4525                 $from->{'file'} = [];
4526                 $from->{'href'} = [];
4527                 fill_from_file_info($diffinfo, @parents)
4528                         unless exists $diffinfo->{'from_file'};
4529                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4530                         $from->{'file'}[$i] =
4531                                 defined $diffinfo->{'from_file'}[$i] ?
4532                                         $diffinfo->{'from_file'}[$i] :
4533                                         $diffinfo->{'to_file'};
4534                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4535                                 $from->{'href'}[$i] = href(action=>"blob",
4536                                                            hash_base=>$parents[$i],
4537                                                            hash=>$diffinfo->{'from_id'}[$i],
4538                                                            file_name=>$from->{'file'}[$i]);
4539                         } else {
4540                                 $from->{'href'}[$i] = undef;
4541                         }
4542                 }
4543         } else {
4544                 # ordinary (not combined) diff
4545                 $from->{'file'} = $diffinfo->{'from_file'};
4546                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4547                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4548                                                hash=>$diffinfo->{'from_id'},
4549                                                file_name=>$from->{'file'});
4550                 } else {
4551                         delete $from->{'href'};
4552                 }
4553         }
4554
4555         $to->{'file'} = $diffinfo->{'to_file'};
4556         if (!is_deleted($diffinfo)) { # file exists in result
4557                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4558                                      hash=>$diffinfo->{'to_id'},
4559                                      file_name=>$to->{'file'});
4560         } else {
4561                 delete $to->{'href'};
4562         }
4563 }
4564
4565 ## ......................................................................
4566 ## parse to array of hashes functions
4567
4568 sub git_get_heads_list {
4569         my ($limit, @classes) = @_;
4570         @classes = get_branch_refs() unless @classes;
4571         my @patterns = map { "refs/$_" } @classes;
4572         my @headslist;
4573
4574         defined(my $fd = git_cmd_pipe 'for-each-ref',
4575                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4576                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4577                 @patterns)
4578                 or return;
4579         while (my $line = to_utf8(scalar <$fd>)) {
4580                 my %ref_item;
4581
4582                 chomp $line;
4583                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4584                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4585                 my ($committer, $epoch, $tz) =
4586                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4587                 $ref_item{'fullname'}  = $name;
4588                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4589                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4590                 $ref_item{'name'} = $name;
4591                 # for refs neither in 'heads' nor 'remotes' we want to
4592                 # show their ref dir
4593                 my $ref_dir = (defined $1) ? $1 : '';
4594                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4595                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4596                 }
4597
4598                 $ref_item{'id'}    = $hash;
4599                 $ref_item{'title'} = $title || '(no commit message)';
4600                 $ref_item{'epoch'} = $epoch;
4601                 if ($epoch) {
4602                         $ref_item{'age'} = age_string($ref_item{'epoch'});
4603                 } else {
4604                         $ref_item{'age'} = "unknown";
4605                 }
4606
4607                 push @headslist, \%ref_item;
4608         }
4609         close $fd;
4610
4611         return wantarray ? @headslist : \@headslist;
4612 }
4613
4614 sub git_get_tags_list {
4615         my $limit = shift;
4616         my @tagslist;
4617         my $all = shift || 0;
4618         my $order = shift || $default_refs_order;
4619         my $sortkey = $all && $order eq 'name' ? 'refname' : '-creatordate';
4620
4621         defined(my $fd = git_cmd_pipe 'for-each-ref',
4622                 ($limit ? '--count='.($limit+1) : ()), "--sort=$sortkey",
4623                 '--format=%(objectname) %(objecttype) %(refname) '.
4624                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4625                 ($all ? 'refs' : 'refs/tags'))
4626                 or return;
4627         while (my $line = to_utf8(scalar <$fd>)) {
4628                 my %ref_item;
4629
4630                 chomp $line;
4631                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4632                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4633                 my ($creator, $epoch, $tz) =
4634                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4635                 $ref_item{'fullname'} = $name;
4636                 $name =~ s!^refs/!! if $all;
4637                 $name =~ s!^refs/tags/!! unless $all;
4638
4639                 $ref_item{'type'} = $type;
4640                 $ref_item{'id'} = $id;
4641                 $ref_item{'name'} = $name;
4642                 if ($type eq "tag") {
4643                         $ref_item{'subject'} = $title;
4644                         $ref_item{'reftype'} = $reftype;
4645                         $ref_item{'refid'}   = $refid;
4646                 } else {
4647                         $ref_item{'reftype'} = $type;
4648                         $ref_item{'refid'}   = $id;
4649                 }
4650
4651                 if ($type eq "tag" || $type eq "commit") {
4652                         $ref_item{'epoch'} = $epoch;
4653                         if ($epoch) {
4654                                 $ref_item{'age'} = age_string($ref_item{'epoch'});
4655                         } else {
4656                                 $ref_item{'age'} = "unknown";
4657                         }
4658                 }
4659
4660                 push @tagslist, \%ref_item;
4661         }
4662         close $fd;
4663
4664         return wantarray ? @tagslist : \@tagslist;
4665 }
4666
4667 ## ----------------------------------------------------------------------
4668 ## filesystem-related functions
4669
4670 sub get_file_owner {
4671         my $path = shift;
4672
4673         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4674         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4675         if (!defined $gcos) {
4676                 return undef;
4677         }
4678         my $owner = $gcos;
4679         $owner =~ s/[,;].*$//;
4680         return to_utf8($owner);
4681 }
4682
4683 # assume that file exists
4684 sub insert_file {
4685         my $filename = shift;
4686
4687         open my $fd, '<', $filename;
4688         while (<$fd>) {
4689                 print to_utf8($_);
4690         }
4691         close $fd;
4692 }
4693
4694 # return undef on failure
4695 sub collect_output {
4696         defined(my $fd = cmd_pipe @_) or return undef;
4697         if (eof $fd) {
4698                 close $fd;
4699                 return undef;
4700         }
4701         my $result = join('', map({ to_utf8($_) } <$fd>));
4702         close $fd or return undef;
4703         return $result;
4704 }
4705
4706 # return undef on failure
4707 # return '' if only comments
4708 sub collect_html_file {
4709         my $filename = shift;
4710
4711         open my $fd, '<', $filename or return undef;
4712         my $result = join('', map({ to_utf8($_) } <$fd>));
4713         close $fd or return undef;
4714         return undef unless defined($result);
4715         my $test = $result;
4716         $test =~ s/<!--(?:[^-]|(?:-(?!-)))*-->//gs;
4717         $test =~ s/\s+//s;
4718         return $test eq '' ? '' : $result;
4719 }
4720
4721 ## ......................................................................
4722 ## mimetype related functions
4723
4724 sub mimetype_guess_file {
4725         my $filename = shift;
4726         my $mimemap = shift;
4727         my $rawmode = shift;
4728         -r $mimemap or return undef;
4729
4730         my %mimemap;
4731         open(my $mh, '<', $mimemap) or return undef;
4732         while (<$mh>) {
4733                 next if m/^#/; # skip comments
4734                 my ($mimetype, @exts) = split(/\s+/);
4735                 foreach my $ext (@exts) {
4736                         $mimemap{$ext} = $mimetype;
4737                 }
4738         }
4739         close($mh);
4740
4741         my ($ext, $ans);
4742         $ext = $1 if $filename =~ /\.([^.]*)$/;
4743         $ans = $mimemap{$ext} if $ext;
4744         if (defined $ans) {
4745                 my $l = lc($ans);
4746                 $ans = 'text/html' if $l eq 'application/xhtml+xml';
4747                 if (!$rawmode) {
4748                         $ans = 'text/xml' if $l =~ m!^application/[^\s:;,=]+\+xml$! ||
4749                                              $l eq 'image/svg+xml' ||
4750                                              $l eq 'application/xml-dtd' ||
4751                                              $l eq 'application/xml-external-parsed-entity';
4752                 }
4753         }
4754         return $ans;
4755 }
4756
4757 sub mimetype_guess {
4758         my $filename = shift;
4759         my $rawmode = shift;
4760         my $mime;
4761         $filename =~ /\./ or return undef;
4762
4763         if ($mimetypes_file) {
4764                 my $file = $mimetypes_file;
4765                 if ($file !~ m!^/!) { # if it is relative path
4766                         # it is relative to project
4767                         $file = "$projectroot/$project/$file";
4768                 }
4769                 $mime = mimetype_guess_file($filename, $file, $rawmode);
4770         }
4771         $mime ||= mimetype_guess_file($filename, '/etc/mime.types', $rawmode);
4772         return $mime;
4773 }
4774
4775 sub blob_mimetype {
4776         my $fd = shift;
4777         my $filename = shift;
4778         my $rawmode = shift;
4779         my $mime;
4780
4781         # The -T/-B file operators produce the wrong result unless a perlio
4782         # layer is present when the file handle is a pipe that delivers less
4783         # than 512 bytes of data before reaching EOF.
4784         #
4785         # If we are running in a Perl that uses the stdio layer rather than the
4786         # unix+perlio layers we will end up adding a perlio layer on top of the
4787         # stdio layer and get a second level of buffering.  This is harmless
4788         # and it makes the -T/-B file operators work properly in all cases.
4789
4790         binmode $fd, ":perlio" or die_error(500, "Adding perlio layer failed")
4791                 unless grep /^perlio$/, PerlIO::get_layers($fd);
4792
4793         $mime = mimetype_guess($filename, $rawmode) if defined $filename;
4794
4795         if (!$mime && $filename) {
4796                 if ($filename =~ m/\.html?$/i) {
4797                         $mime = 'text/html';
4798                 } elsif ($filename =~ m/\.xht(?:ml)?$/i) {
4799                         $mime = 'text/html';
4800                 } elsif ($filename =~ m/\.te?xt?$/i) {
4801                         $mime = 'text/plain';
4802                 } elsif ($filename =~ m/\.(?:markdown|md)$/i) {
4803                         $mime = 'text/plain';
4804                 } elsif ($filename =~ m/\.png$/i) {
4805                         $mime = 'image/png';
4806                 } elsif ($filename =~ m/\.gif$/i) {
4807                         $mime = 'image/gif';
4808                 } elsif ($filename =~ m/\.jpe?g$/i) {
4809                         $mime = 'image/jpeg';
4810                 } elsif ($filename =~ m/\.svgz?$/i) {
4811                         $mime = 'image/svg+xml';
4812                 }
4813         }
4814
4815         # just in case
4816         return $default_blob_plain_mimetype || 'application/octet-stream' unless $fd || $mime;
4817
4818         $mime = -T $fd ? 'text/plain' : 'application/octet-stream' unless $mime;
4819
4820         return $mime;
4821 }
4822
4823 sub is_ascii {
4824         use bytes;
4825         my $data = shift;
4826         return scalar($data =~ /^[\x00-\x7f]*$/);
4827 }
4828
4829 sub is_valid_utf8 {
4830         my $data = shift;
4831         return utf8::decode($data);
4832 }
4833
4834 sub extract_html_charset {
4835         return undef unless $_[0] && "$_[0]</head>" =~ m#<head(?:\s+[^>]*)?(?<!/)>(.*?)</head\s*>#is;
4836         my $head = $1;
4837         return $2 if $head =~ m#<meta\s+charset\s*=\s*(['"])\s*([a-z0-9(:)_.+-]+)\s*\1\s*/?>#is;
4838         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) {
4839                 my %kv = (lc($1) => $3, lc($4) => $6);
4840                 my ($he, $c) = (lc($kv{'http-equiv'}), $kv{'content'});
4841                 return $1 if $he && $c && $he eq 'content-type' &&
4842                         $c =~ m!\s*text/html\s*;\s*charset\s*=\s*([a-z0-9(:)_.+-]+)\s*$!is;
4843         }
4844         return undef;
4845 }
4846
4847 sub blob_contenttype {
4848         my ($fd, $file_name, $type) = @_;
4849
4850         $type ||= blob_mimetype($fd, $file_name, 1);
4851         return $type unless $type =~ m!^text/.+!i;
4852         my ($leader, $charset, $htmlcharset);
4853         if ($fd && read($fd, $leader, 32768)) {{
4854                 $charset='US-ASCII' if is_ascii($leader);
4855                 return ("$type; charset=UTF-8", $leader) if !$charset && is_valid_utf8($leader);
4856                 $charset='ISO-8859-1' unless $charset;
4857                 $htmlcharset = extract_html_charset($leader) if $type eq 'text/html';
4858                 if ($htmlcharset && $charset ne 'US-ASCII') {
4859                         $htmlcharset = undef if $htmlcharset =~ /^(?:utf-8|us-ascii)$/i
4860                 }
4861         }}
4862         return ("$type; charset=$htmlcharset", $leader) if $htmlcharset;
4863         my $defcharset = $default_text_plain_charset || '';
4864         $defcharset =~ s/^\s+//;
4865         $defcharset =~ s/\s+$//;
4866         $defcharset = '' if $charset && $charset ne 'US-ASCII' && $defcharset =~ /^(?:utf-8|us-ascii)$/i;
4867         return ("$type; charset=" . ($defcharset || 'ISO-8859-1'), $leader);
4868 }
4869
4870 # peek the first upto 128 bytes off a file handle
4871 sub peek128bytes {
4872         my $fd = shift;
4873
4874         use IO::Handle;
4875         use bytes;
4876
4877         my $prefix128;
4878         return '' unless $fd && read($fd, $prefix128, 128);
4879
4880         # In the general case, we're guaranteed only to be able to ungetc one
4881         # character (provided, of course, we actually got a character first).
4882         #
4883         # However, we know:
4884         #
4885         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4886         #    already been called at least once on the file handle before us
4887         #
4888         # 2) we have an $fd positioned at the start of the input stream and
4889         #    therefore know we were positioned at a buffer boundary before
4890         #    reading the initial upto 128 bytes
4891         #
4892         # 3) the buffer size is at least 512 bytes
4893         #
4894         # 4) we are careful to only unget raw bytes
4895         #
4896         # 5) we are attempting to unget exactly the same number of bytes we got
4897         #
4898         # Given the above conditions we will ALWAYS be able to safely unget
4899         # the $prefix128 value we just got.
4900         #
4901         # In fact, we could read up to 511 bytes and still be sure.
4902         # (Reading 512 might pop us into the next internal buffer, but probably
4903         # not since that could break the always able to unget at least the one
4904         # you just got guarantee.)
4905
4906         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4907
4908         return $prefix128;
4909 }
4910
4911 # guess file syntax for syntax highlighting; return undef if no highlighting
4912 # the name of syntax can (in the future) depend on syntax highlighter used
4913 sub guess_file_syntax {
4914         my ($fd, $mimetype, $file_name) = @_;
4915         return undef unless $fd && defined $file_name &&
4916                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4917         my $basename = basename($file_name, '.in');
4918         return $highlight_basename{$basename}
4919                 if exists $highlight_basename{$basename};
4920
4921         # Peek to see if there's a shebang or xml line.
4922         # We always operate on bytes when testing this.
4923         {
4924                 use bytes;
4925                 my $shebang = peek128bytes($fd);
4926                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4927                         foreach my $key (keys %highlight_shebang) {
4928                                 my $ar = ref($highlight_shebang{$key}) ?
4929                                         $highlight_shebang{$key} :
4930                                         [$highlight_shebang{key}];
4931                                 map {return $key if $shebang =~ /$_/} @$ar;
4932                         }
4933                 }
4934                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4935         }
4936
4937         $basename =~ /\.([^.]*)$/;
4938         my $ext = $1 or return undef;
4939         return $highlight_ext{$ext}
4940                 if exists $highlight_ext{$ext};
4941
4942         return undef;
4943 }
4944
4945 # run highlighter and return FD of its output,
4946 # or return original FD if no highlighting
4947 sub run_highlighter {
4948         my ($fd, $syntax) = @_;
4949         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4950
4951         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4952                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4953                 $to_utf8_pipe_command.
4954                 quote_command($highlight_bin).
4955                 " --replace-tabs=8 --fragment --syntax $syntax")
4956                 or die_error(500, "Couldn't open file or run syntax highlighter");
4957         if (eof $hifd) {
4958                 # just in case, should not happen as we tested !eof($fd) above
4959                 return $fd if close($hifd);
4960
4961                 # should not happen
4962                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4963
4964                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4965                 # instead of dying horribly on this, just skip the highlighting
4966                 # but do output a message about it to STDERR that will end up in the log
4967                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4968                         sprintf("child exit status 0x%x\n", $?);
4969                 return $fd
4970         }
4971         close $fd;
4972         return ($hifd, 1);
4973 }
4974
4975 ## ======================================================================
4976 ## functions printing HTML: header, footer, error page
4977
4978 sub get_page_title {
4979         my $title = to_utf8($site_name);
4980
4981         unless (defined $project) {
4982                 if (defined $project_filter) {
4983                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4984                 }
4985                 return $title;
4986         }
4987         $title .= " - " . to_utf8($project);
4988
4989         return $title unless (defined $action);
4990         my $action_print = $action eq 'blame_incremental' ? 'blame' : $action;
4991         $title .= "/$action_print"; # $action is US-ASCII (7bit ASCII)
4992
4993         return $title unless (defined $file_name);
4994         $title .= " - " . esc_path($file_name);
4995         if ($action eq "tree" && $file_name !~ m|/$|) {
4996                 $title .= "/";
4997         }
4998
4999         return $title;
5000 }
5001
5002 sub get_content_type_html {
5003         # We do not ever emit application/xhtml+xml since that gives us
5004         # no benefits and it makes many browsers (e.g. Firefox) exceedingly
5005         # strict, which is troublesome for example when showing user-supplied
5006         # README.html files.
5007         return 'text/html';
5008 }
5009
5010 sub print_feed_meta {
5011         if (defined $project) {
5012                 my %href_params = get_feed_info();
5013                 if (!exists $href_params{'-title'}) {
5014                         $href_params{'-title'} = 'log';
5015                 }
5016
5017                 foreach my $format (qw(RSS Atom)) {
5018                         my $type = lc($format);
5019                         my %link_attr = (
5020                                 '-rel' => 'alternate',
5021                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
5022                                 '-type' => "application/$type+xml"
5023                         );
5024
5025                         $href_params{'extra_options'} = undef;
5026                         $href_params{'action'} = $type;
5027                         $link_attr{'-href'} = href(%href_params);
5028                         print "<link ".
5029                               "rel=\"$link_attr{'-rel'}\" ".
5030                               "title=\"$link_attr{'-title'}\" ".
5031                               "href=\"$link_attr{'-href'}\" ".
5032                               "type=\"$link_attr{'-type'}\" ".
5033                               "/>\n";
5034
5035                         $href_params{'extra_options'} = '--no-merges';
5036                         $link_attr{'-href'} = href(%href_params);
5037                         $link_attr{'-title'} .= ' (no merges)';
5038                         print "<link ".
5039                               "rel=\"$link_attr{'-rel'}\" ".
5040                               "title=\"$link_attr{'-title'}\" ".
5041                               "href=\"$link_attr{'-href'}\" ".
5042                               "type=\"$link_attr{'-type'}\" ".
5043                               "/>\n";
5044                 }
5045
5046         } else {
5047                 printf('<link rel="alternate" title="%s projects list" '.
5048                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
5049                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
5050                 printf('<link rel="alternate" title="%s projects feeds" '.
5051                        'href="%s" type="text/x-opml" />'."\n",
5052                        esc_attr($site_name), href(project=>undef, action=>"opml"));
5053         }
5054 }
5055
5056 sub compute_stylesheet_links {
5057         return "<?gitweb compute_stylesheet_links?>" if $cache_mode_active;
5058
5059         # include each stylesheet that exists, providing backwards capability
5060         # for those people who defined $stylesheet in a config file
5061         if (defined $stylesheet) {
5062                 return '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
5063         } else {
5064                 my $sheets = '';
5065                 foreach my $stylesheet (@stylesheets) {
5066                         next unless $stylesheet;
5067                         $sheets .= '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
5068                 }
5069                 return $sheets;
5070         }
5071 }
5072
5073 sub print_header_links {
5074         my $status = shift;
5075
5076         print compute_stylesheet_links();
5077         print_feed_meta()
5078                 if ($status eq '200 OK');
5079         if (defined $favicon) {
5080                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
5081         }
5082 }
5083
5084 sub print_nav_breadcrumbs_path {
5085         my $dirprefix = undef;
5086         while (my $part = shift) {
5087                 $dirprefix .= "/" if defined $dirprefix;
5088                 $dirprefix .= $part;
5089                 print $cgi->a({-href => href(project => undef,
5090                                              project_filter => $dirprefix,
5091                                              action => "project_list")},
5092                               esc_html($part)) . " / ";
5093         }
5094 }
5095
5096 sub print_nav_breadcrumbs {
5097         my %opts = @_;
5098
5099         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
5100                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
5101         }
5102         if (defined $project) {
5103                 my @dirname = split '/', $project;
5104                 my $projectbasename = pop @dirname;
5105                 print_nav_breadcrumbs_path(@dirname);
5106                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
5107                 if (defined $action) {
5108                         my $action_print = $action ;
5109                         $action_print = 'blame' if $action_print eq 'blame_incremental';
5110                         if (defined $opts{-action_extra}) {
5111                                 $action_print = $cgi->a({-href => href(action=>$action)},
5112                                         $action);
5113                         }
5114                         print " / $action_print";
5115                 }
5116                 if (defined $opts{-action_extra}) {
5117                         print " / $opts{-action_extra}";
5118                 }
5119                 print "\n";
5120         } elsif (defined $project_filter) {
5121                 print_nav_breadcrumbs_path(split '/', $project_filter);
5122         }
5123 }
5124
5125 sub print_search_form {
5126         if (!defined $searchtext) {
5127                 $searchtext = "";
5128         }
5129         my $search_hash;
5130         if (defined $hash_base) {
5131                 $search_hash = $hash_base;
5132         } elsif (defined $hash) {
5133                 $search_hash = $hash;
5134         } else {
5135                 $search_hash = "HEAD";
5136         }
5137         # We can't use href() here because we need to encode the
5138         # URL parameters into the form, not into the action link.
5139         my $action = $my_uri;
5140         my $use_pathinfo = gitweb_check_feature('pathinfo');
5141         if ($use_pathinfo) {
5142                 # See notes about doubled / in href()
5143                 $action =~ s,/$,,;
5144                 $action .= "/".esc_path_info($project);
5145         }
5146         print $cgi->start_form(-method => "get", -action => $action) .
5147               "<div class=\"search\">\n" .
5148               (!$use_pathinfo &&
5149               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
5150               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
5151               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
5152               $cgi->popup_menu(-name => 'st', -default => 'commit',
5153                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
5154               $cgi->sup($cgi->a({-href => href(action=>"search_help"),
5155                                  -title => "search help" },
5156                                 "<span style=\"padding-bottom:1em\">?&#160;</span>")) . " search:\n",
5157               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
5158               "<span title=\"Extended regular expression\">" .
5159               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5160                              -checked => $search_use_regexp) .
5161               "</span>" .
5162               "</div>" .
5163               $cgi->end_form() . "\n";
5164 }
5165
5166 sub git_header_html {
5167         my $status = shift || "200 OK";
5168         my $expires = shift;
5169         my %opts = @_;
5170
5171         my $title = get_page_title();
5172         my $content_type = get_content_type_html();
5173         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
5174                            -status=> $status, -expires => $expires)
5175                 unless ($opts{'-no_http_header'});
5176         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
5177         print <<EOF;
5178 <?xml version="1.0" encoding="utf-8"?>
5179 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
5180 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
5181 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
5182 <!-- git core binaries version $git_version -->
5183 <head>
5184 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
5185 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
5186 <meta name="robots" content="index, nofollow"/>
5187 <title>$title</title>
5188 <script type="text/javascript">/* <![CDATA[ */
5189 function fixBlameLinks() {
5190         var allLinks = document.getElementsByTagName("a");
5191         for (var i = 0; i < allLinks.length; i++) {
5192                 var link = allLinks.item(i);
5193                 if (link.className == 'blamelink')
5194                         link.href = link.href.replace("/blame/", "/blame_incremental/");
5195         }
5196 }
5197 /* ]]> */</script>
5198 EOF
5199         # the stylesheet, favicon etc urls won't work correctly with path_info
5200         # unless we set the appropriate base URL
5201         if ($ENV{'PATH_INFO'}) {
5202                 print "<base href=\"".esc_url($base_url)."\" />\n";
5203         }
5204         print_header_links($status);
5205
5206         if (defined $site_html_head_string) {
5207                 print to_utf8($site_html_head_string);
5208         }
5209
5210         print "</head>\n" .
5211               "<body><span class=\"body\">\n";
5212
5213         if (defined $site_header && -f $site_header) {
5214                 insert_file($site_header);
5215         }
5216
5217         print "<div class=\"page_header\">\n";
5218         print "<span class=\"logo-container\"><span class=\"logo-default\">";
5219         if (defined $logo) {
5220                 print $cgi->a({-href => esc_url($logo_url),
5221                                -title => $logo_label,
5222                                -class => "logo-link"},
5223                               $cgi->img({-src => esc_url($logo),
5224                                          -width => 72, -height => 27,
5225                                          -alt => "git",
5226                                          -class => "logo"}));
5227         }
5228         print "</span></span><span class=\"banner-container\">";
5229         print_nav_breadcrumbs(%opts);
5230         print "</span></div>\n";
5231
5232         my $have_search = gitweb_check_feature('search');
5233         if (defined $project && $have_search) {
5234                 print_search_form();
5235         }
5236 }
5237
5238 sub compute_timed_interval {
5239         return "<?gitweb compute_timed_interval?>" if $cache_mode_active;
5240         return tv_interval($t0, [ gettimeofday() ]);
5241 }
5242
5243 sub compute_commands_count {
5244         return "<?gitweb compute_commands_count?>" if $cache_mode_active;
5245         my $s = $number_of_git_cmds == 1 ? '' : 's';
5246         return '<span id="generating_cmd">'.
5247                 $number_of_git_cmds.
5248                 "</span> git command$s";
5249 }
5250
5251 sub git_footer_html {
5252         my $feed_class = 'rss_logo';
5253
5254         print "<div class=\"page_footer\">\n";
5255         if (defined $project) {
5256                 my $descr = git_get_project_description($project);
5257                 if (defined $descr) {
5258                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
5259                 }
5260
5261                 my %href_params = get_feed_info();
5262                 if (!%href_params) {
5263                         $feed_class .= ' generic';
5264                 }
5265                 $href_params{'-title'} ||= 'log';
5266
5267                 foreach my $format (qw(RSS Atom)) {
5268                         $href_params{'action'} = lc($format);
5269                         print $cgi->a({-href => href(%href_params),
5270                                       -title => "$href_params{'-title'} $format feed",
5271                                       -class => $feed_class}, $format)."\n";
5272                 }
5273
5274         } else {
5275                 print $cgi->a({-href => href(project=>undef, action=>"opml",
5276                                              project_filter => $project_filter),
5277                               -class => $feed_class}, "OPML") . " ";
5278                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
5279                                              project_filter => $project_filter),
5280                               -class => $feed_class}, "TXT") . "\n";
5281         }
5282         print "</div>\n"; # class="page_footer"
5283
5284         if (defined $t0 && gitweb_check_feature('timed')) {
5285                 print "<div id=\"generating_info\">\n";
5286                 print 'This page took '.
5287                       '<span id="generating_time" class="time_span">'.
5288                       compute_timed_interval().
5289                       ' seconds </span>'.
5290                       ' and '.
5291                       compute_commands_count().
5292                       " to generate.\n";
5293                 print "</div>\n"; # class="page_footer"
5294         }
5295
5296         if (defined $site_footer && -f $site_footer) {
5297                 insert_file($site_footer);
5298         }
5299
5300         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
5301         if (defined $action &&
5302             $action eq 'blame_incremental') {
5303                 print qq!<script type="text/javascript">\n!.
5304                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
5305                       qq!           "!. href() .qq!");\n!.
5306                       qq!</script>\n!;
5307         } else {
5308                 my ($jstimezone, $tz_cookie, $datetime_class) =
5309                         gitweb_get_feature('javascript-timezone');
5310
5311                 print qq!<script type="text/javascript">\n!.
5312                       qq!window.onload = function () {\n!;
5313                 if (gitweb_check_feature('blame_incremental')) {
5314                         print qq!       fixBlameLinks();\n!;
5315                 }
5316                 if (gitweb_check_feature('javascript-actions')) {
5317                         print qq!       fixLinks();\n!;
5318                 }
5319                 if ($jstimezone && $tz_cookie && $datetime_class) {
5320                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
5321                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
5322                 }
5323                 print qq!};\n!.
5324                       qq!</script>\n!;
5325         }
5326
5327         print "</span></body>\n" .
5328               "</html>";
5329 }
5330
5331 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
5332 # Example: die_error(404, 'Hash not found')
5333 # By convention, use the following status codes (as defined in RFC 2616):
5334 # 400: Invalid or missing CGI parameters, or
5335 #      requested object exists but has wrong type.
5336 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
5337 #      this server or project.
5338 # 404: Requested object/revision/project doesn't exist.
5339 # 500: The server isn't configured properly, or
5340 #      an internal error occurred (e.g. failed assertions caused by bugs), or
5341 #      an unknown error occurred (e.g. the git binary died unexpectedly).
5342 # 503: The server is currently unavailable (because it is overloaded,
5343 #      or down for maintenance).  Generally, this is a temporary state.
5344 sub die_error {
5345         my $status = shift || 500;
5346         my $error = esc_html(shift) || "Internal Server Error";
5347         my $extra = shift;
5348         my %opts = @_;
5349
5350         my %http_responses = (
5351                 400 => '400 Bad Request',
5352                 403 => '403 Forbidden',
5353                 404 => '404 Not Found',
5354                 500 => '500 Internal Server Error',
5355                 503 => '503 Service Unavailable',
5356         );
5357         git_header_html($http_responses{$status}, undef, %opts);
5358         print <<EOF;
5359 <div class="page_body">
5360 <br /><br />
5361 $status - $error
5362 <br />
5363 EOF
5364         if (defined $extra) {
5365                 print "<hr />\n" .
5366                       "$extra\n";
5367         }
5368         print "</div>\n";
5369
5370         git_footer_html();
5371         CORE::die
5372                 unless ($opts{'-error_handler'});
5373 }
5374
5375 ## ----------------------------------------------------------------------
5376 ## functions printing or outputting HTML: navigation
5377
5378 # $content is wrapped in a span with class 'tab'
5379 # If $selected is true it also has class 'selected'
5380 # If $disabled is true it also has class 'disabled'
5381 # Whether or not a tab can be disabled and selected at the same time
5382 # is up to the caller
5383 # If $extra_classes is non-empty, it is a whitespace-separated list of
5384 # additional class names to include
5385 # Note that $content MUST already be html-escaped as needed because
5386 # it is included verbatim.  And so are any extra class names.
5387 sub tabspan {
5388         my ($content, $selected, $disabled, $extra_classes) = @_;
5389         my @classes = ("tab");
5390         push(@classes, "selected") if $selected;
5391         push(@classes, "disabled") if $disabled;
5392         push(@classes, split(' ', $extra_classes)) if $extra_classes;
5393         return "<span class=\"" . join(" ", @classes) . "\">". $content . "</span>";
5394 }
5395
5396 sub git_print_page_nav {
5397         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
5398         $extra = '' if !defined $extra; # pager or formats
5399         $extra = "<span class=\"page_nav_sub\">".$extra."</span>" if $extra ne '';
5400
5401         my @navs = qw(summary log commit commitdiff tree refs);
5402         if ($suppress) {
5403                 my %omit;
5404                 if (ref($suppress) eq 'ARRAY') {
5405                         %omit = map { ($_ => 1) } @$suppress;
5406                 } else {
5407                         %omit = ($suppress => 1);
5408                 }
5409                 @navs = grep { !$omit{$_} } @navs;
5410         }
5411
5412         my %arg = map { $_ => {action=>$_} } @navs;
5413         if (defined $head) {
5414                 for (qw(commit commitdiff)) {
5415                         $arg{$_}{'hash'} = $head;
5416                 }
5417                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
5418                         $arg{'log'}{'hash'} = $head;
5419                 }
5420         }
5421
5422         $arg{'log'}{'action'} = 'shortlog';
5423         if ($current eq 'log') {
5424                 $current = 'shortlog';
5425         } elsif ($current eq 'shortlog') {
5426                 $current = 'log';
5427         }
5428         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
5429         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
5430
5431         my @actions = gitweb_get_feature('actions');
5432         my $escname = $project;
5433         $escname =~ s/[+]/%2B/g;
5434         my %repl = (
5435                 '%' => '%',
5436                 'n' => $project,         # project name
5437                 'f' => $git_dir,         # project path within filesystem
5438                 'h' => $treehead || '',  # current hash ('h' parameter)
5439                 'b' => $treebase || '',  # hash base ('hb' parameter)
5440                 'e' => $escname,         # project name with '+' escaped
5441         );
5442         while (@actions) {
5443                 my ($label, $link, $pos) = splice(@actions,0,3);
5444                 # insert
5445                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
5446                 # munch munch
5447                 $link =~ s/%([%nfhbe])/$repl{$1}/g;
5448                 $arg{$label}{'_href'} = $link;
5449         }
5450
5451         print "<div class=\"page_nav\">\n" .
5452                 (join $barsep,
5453                  map { $_ eq $current ?
5454                        tabspan($_, 1) :
5455                        tabspan($cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_"))
5456                  } @navs);
5457         print "<br/>\n$extra<br/>\n" .
5458               "</div>\n";
5459 }
5460
5461 # returns a submenu for the nagivation of the refs views (tags, heads,
5462 # remotes) with the current view disabled and the remotes view only
5463 # available if the feature is enabled
5464 sub format_ref_views {
5465         my ($current) = @_;
5466         my @ref_views = qw{tags heads};
5467         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
5468         return join $barsep, map {
5469                 $_ eq $current ? tabspan($_, 1) :
5470                 tabspan($cgi->a({-href => href(action=>$_)}, $_))
5471         } @ref_views
5472 }
5473
5474 sub format_paging_nav {
5475         my ($action, $page, $has_next_link) = @_;
5476         my $paging_nav = "<span class=\"paging_nav\">";
5477
5478         if ($page > 0) {
5479                 $paging_nav .= tabspan(
5480                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first")) .
5481                         $mdotsep . tabspan(
5482                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
5483                                  -accesskey => "p", -title => "Alt-p"}, "prev"));
5484         } else {
5485                 $paging_nav .= tabspan("first", 1).${mdotsep}.tabspan("prev", 0, 1);
5486         }
5487
5488         if ($has_next_link) {
5489                 $paging_nav .= $mdotsep . tabspan(
5490                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
5491                                  -accesskey => "n", -title => "Alt-n"}, "next"));
5492         } else {
5493                 $paging_nav .= ${mdotsep}.tabspan("next", 0, 1);
5494         }
5495
5496         return $paging_nav."</span>";
5497 }
5498
5499 sub format_log_nav {
5500         my ($action, $page, $has_next_link, $extra) = @_;
5501         my $paging_nav;
5502         defined $extra or $extra = '';
5503         $extra eq '' or $extra .= $barsep;
5504
5505         if ($action eq 'shortlog') {
5506                 $paging_nav .= tabspan('shortlog', 1);
5507         } else {
5508                 $paging_nav .= tabspan($cgi->a({-href => href(action=>'shortlog', -replay=>1)}, 'shortlog'));
5509         }
5510         $paging_nav .= $barsep;
5511         if ($action eq 'log') {
5512                 $paging_nav .= tabspan('fulllog', 1);
5513         } else {
5514                 $paging_nav .= tabspan($cgi->a({-href => href(action=>'log', -replay=>1)}, 'fulllog'));
5515         }
5516
5517         $paging_nav .= $barsep . $extra . format_paging_nav($action, $page, $has_next_link);
5518         return $paging_nav;
5519 }
5520
5521 ## ......................................................................
5522 ## functions printing or outputting HTML: div
5523
5524 sub git_print_header_div {
5525         my ($action, $title, $hash, $hash_base, $extra) = @_;
5526         my %args = ();
5527         defined $extra or $extra = '';
5528
5529         $args{'action'} = $action;
5530         $args{'hash'} = $hash if $hash;
5531         $args{'hash_base'} = $hash_base if $hash_base;
5532
5533         my $link1 = $cgi->a({-href => href(%args), -class => "title"},
5534                             $title ? $title : $action);
5535         my $link2 = $cgi->a({-href => href(%args), -class => "cover"}, "");
5536         print "<div class=\"header\">\n" . '<span class="title">' .
5537               $link1 . $extra . $link2 . '</span>' . "\n</div>\n";
5538 }
5539
5540 sub format_repo_url {
5541         my ($name, $url) = @_;
5542         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
5543 }
5544
5545 # Group output by placing it in a DIV element and adding a header.
5546 # Options for start_div() can be provided by passing a hash reference as the
5547 # first parameter to the function.
5548 # Options to git_print_header_div() can be provided by passing an array
5549 # reference. This must follow the options to start_div if they are present.
5550 # The content can be a scalar, which is output as-is, a scalar reference, which
5551 # is output after html escaping, an IO handle passed either as *handle or
5552 # *handle{IO}, or a function reference. In the latter case all following
5553 # parameters will be taken as argument to the content function call.
5554 sub git_print_section {
5555         my ($div_args, $header_args, $content);
5556         my $arg = shift;
5557         if (ref($arg) eq 'HASH') {
5558                 $div_args = $arg;
5559                 $arg = shift;
5560         }
5561         if (ref($arg) eq 'ARRAY') {
5562                 $header_args = $arg;
5563                 $arg = shift;
5564         }
5565         $content = $arg;
5566
5567         print $cgi->start_div($div_args);
5568         git_print_header_div(@$header_args);
5569
5570         if (ref($content) eq 'CODE') {
5571                 $content->(@_);
5572         } elsif (ref($content) eq 'SCALAR') {
5573                 print esc_html($$content);
5574         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
5575                 while (<$content>) {
5576                         print to_utf8($_);
5577                 }
5578         } elsif (!ref($content) && defined($content)) {
5579                 print $content;
5580         }
5581
5582         print $cgi->end_div;
5583 }
5584
5585 sub format_timestamp_html {
5586         my $date = shift;
5587         my $useatnight = shift;
5588         defined($useatnight) or $useatnight = 1;
5589         my $strtime = $date->{'rfc2822'};
5590
5591         my (undef, undef, $datetime_class) =
5592                 gitweb_get_feature('javascript-timezone');
5593         if ($datetime_class) {
5594                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
5595         }
5596
5597         my $localtime_format = '(%d %02d:%02d %s)';
5598         if ($useatnight && $date->{'hour_local'} < 6) {
5599                 $localtime_format = '(%d <span class="atnight">%02d:%02d</span> %s)';
5600         }
5601         $strtime .= ' ' .
5602                     sprintf($localtime_format, $date->{'mday_local'},
5603                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
5604
5605         return $strtime;
5606 }
5607
5608 sub format_lastrefresh_row {
5609         return "<?gitweb format_lastrefresh_row?>" if $cache_mode_active;
5610         my %rd = parse_file_date('.last_refresh');
5611         if (defined $rd{'rfc2822'}) {
5612                 return "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td>" .
5613                        "<td>".format_timestamp_html(\%rd,0)."</td></tr>";
5614         }
5615         return "";
5616 }
5617
5618 # Outputs the author name and date in long form
5619 sub git_print_authorship {
5620         my $co = shift;
5621         my %opts = @_;
5622         my $tag = $opts{-tag} || 'div';
5623         my $author = $co->{'author_name'};
5624
5625         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
5626         print "<$tag class=\"author_date\">" .
5627               format_search_author($author, "author", esc_html($author)) .
5628               " [".format_timestamp_html(\%ad)."]".
5629               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
5630               "</$tag>\n";
5631 }
5632
5633 # Outputs table rows containing the full author or committer information,
5634 # in the format expected for 'commit' view (& similar).
5635 # Parameters are a commit hash reference, followed by the list of people
5636 # to output information for. If the list is empty it defaults to both
5637 # author and committer.
5638 sub git_print_authorship_rows {
5639         my $co = shift;
5640         # too bad we can't use @people = @_ || ('author', 'committer')
5641         my @people = @_;
5642         @people = ('author', 'committer') unless @people;
5643         foreach my $who (@people) {
5644                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
5645                 print "<tr><td>$who</td><td>" .
5646                       format_search_author($co->{"${who}_name"}, $who,
5647                                            esc_html($co->{"${who}_name"})) . " " .
5648                       format_search_author($co->{"${who}_email"}, $who,
5649                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
5650                       "</td><td rowspan=\"2\">" .
5651                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
5652                       "</td></tr>\n" .
5653                       "<tr>" .
5654                       "<td></td><td>" .
5655                       format_timestamp_html(\%wd) .
5656                       "</td>" .
5657                       "</tr>\n";
5658         }
5659 }
5660
5661 sub git_print_page_path {
5662         my $name = shift;
5663         my $type = shift;
5664         my $hb = shift;
5665
5666
5667         print "<div class=\"page_path\">";
5668         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
5669                       -title => 'tree root'}, to_utf8("[$project]"));
5670         print " / ";
5671         if (defined $name) {
5672                 my @dirname = split '/', $name;
5673                 my $basename = pop @dirname;
5674                 my $fullname = '';
5675
5676                 foreach my $dir (@dirname) {
5677                         $fullname .= ($fullname ? '/' : '') . $dir;
5678                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
5679                                                      hash_base=>$hb),
5680                                       -title => $fullname}, esc_path($dir));
5681                         print " / ";
5682                 }
5683                 if (defined $type && $type eq 'blob') {
5684                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
5685                                                      hash_base=>$hb),
5686                                       -title => $name}, esc_path($basename));
5687                 } elsif (defined $type && $type eq 'tree') {
5688                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
5689                                                      hash_base=>$hb),
5690                                       -title => $name}, esc_path($basename));
5691                         print " / ";
5692                 } else {
5693                         print esc_path($basename);
5694                 }
5695         }
5696         print "<br/></div>\n";
5697 }
5698
5699 sub git_print_log {
5700         my $log = shift;
5701         my %opts = @_;
5702
5703         if ($opts{'-remove_title'}) {
5704                 # remove title, i.e. first line of log
5705                 shift @$log;
5706         }
5707         # remove leading empty lines
5708         while (defined $log->[0] && $log->[0] eq "") {
5709                 shift @$log;
5710         }
5711
5712         # print log
5713         my $skip_blank_line = 0;
5714         foreach my $line (@$log) {
5715                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5716                         if (! $opts{'-remove_signoff'}) {
5717                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5718                                 $skip_blank_line = 1;
5719                         }
5720                         next;
5721                 }
5722
5723                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5724                         if (! $opts{'-remove_signoff'}) {
5725                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5726                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5727                                         "</span><br/>\n";
5728                                 $skip_blank_line = 1;
5729                         }
5730                         next;
5731                 }
5732
5733                 # print only one empty line
5734                 # do not print empty line after signoff
5735                 if ($line eq "") {
5736                         next if ($skip_blank_line);
5737                         $skip_blank_line = 1;
5738                 } else {
5739                         $skip_blank_line = 0;
5740                 }
5741
5742                 print format_log_line_html($line) . "<br/>\n";
5743         }
5744
5745         if ($opts{'-final_empty_line'}) {
5746                 # end with single empty line
5747                 print "<br/>\n" unless $skip_blank_line;
5748         }
5749 }
5750
5751 # return link target (what link points to)
5752 sub git_get_link_target {
5753         my $hash = shift;
5754         my $link_target;
5755
5756         # read link
5757         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5758                 or return;
5759         {
5760                 local $/ = undef;
5761                 $link_target = to_utf8(scalar <$fd>);
5762         }
5763         close $fd
5764                 or return;
5765
5766         return $link_target;
5767 }
5768
5769 # given link target, and the directory (basedir) the link is in,
5770 # return target of link relative to top directory (top tree);
5771 # return undef if it is not possible (including absolute links).
5772 sub normalize_link_target {
5773         my ($link_target, $basedir) = @_;
5774
5775         # absolute symlinks (beginning with '/') cannot be normalized
5776         return if (substr($link_target, 0, 1) eq '/');
5777
5778         # normalize link target to path from top (root) tree (dir)
5779         my $path;
5780         if ($basedir) {
5781                 $path = $basedir . '/' . $link_target;
5782         } else {
5783                 # we are in top (root) tree (dir)
5784                 $path = $link_target;
5785         }
5786
5787         # remove //, /./, and /../
5788         my @path_parts;
5789         foreach my $part (split('/', $path)) {
5790                 # discard '.' and ''
5791                 next if (!$part || $part eq '.');
5792                 # handle '..'
5793                 if ($part eq '..') {
5794                         if (@path_parts) {
5795                                 pop @path_parts;
5796                         } else {
5797                                 # link leads outside repository (outside top dir)
5798                                 return;
5799                         }
5800                 } else {
5801                         push @path_parts, $part;
5802                 }
5803         }
5804         $path = join('/', @path_parts);
5805
5806         return $path;
5807 }
5808
5809 # print tree entry (row of git_tree), but without encompassing <tr> element
5810 sub git_print_tree_entry {
5811         my ($t, $basedir, $hash_base, $have_blame) = @_;
5812
5813         my %base_key = ();
5814         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5815
5816         # The format of a table row is: mode list link.  Where mode is
5817         # the mode of the entry, list is the name of the entry, an href,
5818         # and link is the action links of the entry.
5819
5820         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5821         if (exists $t->{'size'}) {
5822                 print "<td class=\"size\">$t->{'size'}</td>\n";
5823         }
5824         if ($t->{'type'} eq "blob") {
5825                 print "<td class=\"list\">" .
5826                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5827                                                file_name=>"$basedir$t->{'name'}", %base_key),
5828                                 -class => "list"}, esc_path($t->{'name'}));
5829                 if (S_ISLNK(oct $t->{'mode'})) {
5830                         my $link_target = git_get_link_target($t->{'hash'});
5831                         if ($link_target) {
5832                                 my $norm_target = normalize_link_target($link_target, $basedir);
5833                                 if (defined $norm_target) {
5834                                         print " -> " .
5835                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5836                                                                      file_name=>$norm_target),
5837                                                        -title => $norm_target}, esc_path($link_target));
5838                                 } else {
5839                                         print " -> " . esc_path($link_target);
5840                                 }
5841                         }
5842                 }
5843                 print "</td>\n";
5844                 print "<td class=\"link\">";
5845                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5846                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5847                               "blob");
5848                 if ($have_blame) {
5849                         print $barsep .
5850                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5851                                                      file_name=>"$basedir$t->{'name'}", %base_key),
5852                                       -class => "blamelink"},
5853                                       "blame");
5854                 }
5855                 if (defined $hash_base) {
5856                         print $barsep .
5857                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5858                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5859                                       "history");
5860                 }
5861                 print $barsep .
5862                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5863                                                file_name=>"$basedir$t->{'name'}")},
5864                                 "raw");
5865                 print "</td>\n";
5866
5867         } elsif ($t->{'type'} eq "tree") {
5868                 print "<td class=\"list\">";
5869                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5870                                              file_name=>"$basedir$t->{'name'}",
5871                                              %base_key)},
5872                               esc_path($t->{'name'}));
5873                 print "</td>\n";
5874                 print "<td class=\"link\">";
5875                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5876                                              file_name=>"$basedir$t->{'name'}",
5877                                              %base_key)},
5878                               "tree");
5879                 if (defined $hash_base) {
5880                         print $barsep .
5881                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5882                                                      file_name=>"$basedir$t->{'name'}")},
5883                                       "history");
5884                 }
5885                 print "</td>\n";
5886         } else {
5887                 # unknown object: we can only present history for it
5888                 # (this includes 'commit' object, i.e. submodule support)
5889                 print "<td class=\"list\">" .
5890                       esc_path($t->{'name'}) .
5891                       "</td>\n";
5892                 print "<td class=\"link\">";
5893                 if (defined $hash_base) {
5894                         print $cgi->a({-href => href(action=>"history",
5895                                                      hash_base=>$hash_base,
5896                                                      file_name=>"$basedir$t->{'name'}")},
5897                                       "history");
5898                 }
5899                 print "</td>\n";
5900         }
5901 }
5902
5903 ## ......................................................................
5904 ## functions printing large fragments of HTML
5905
5906 # get pre-image filenames for merge (combined) diff
5907 sub fill_from_file_info {
5908         my ($diff, @parents) = @_;
5909
5910         $diff->{'from_file'} = [ ];
5911         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5912         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5913                 if ($diff->{'status'}[$i] eq 'R' ||
5914                     $diff->{'status'}[$i] eq 'C') {
5915                         $diff->{'from_file'}[$i] =
5916                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5917                 }
5918         }
5919
5920         return $diff;
5921 }
5922
5923 # is current raw difftree line of file deletion
5924 sub is_deleted {
5925         my $diffinfo = shift;
5926
5927         return $diffinfo->{'to_id'} eq ('0' x 40);
5928 }
5929
5930 # does patch correspond to [previous] difftree raw line
5931 # $diffinfo  - hashref of parsed raw diff format
5932 # $patchinfo - hashref of parsed patch diff format
5933 #              (the same keys as in $diffinfo)
5934 sub is_patch_split {
5935         my ($diffinfo, $patchinfo) = @_;
5936
5937         return defined $diffinfo && defined $patchinfo
5938                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5939 }
5940
5941
5942 sub git_difftree_body {
5943         my ($difftree, $hash, @parents) = @_;
5944         my ($parent) = $parents[0];
5945         my $have_blame = gitweb_check_feature('blame');
5946         print "<div class=\"list_head\">\n";
5947         if ($#{$difftree} > 10) {
5948                 print(($#{$difftree} + 1) . " files changed:\n");
5949         }
5950         print "</div>\n";
5951
5952         print "<table class=\"" .
5953               (@parents > 1 ? "combined " : "") .
5954               "diff_tree\">\n";
5955
5956         # header only for combined diff in 'commitdiff' view
5957         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5958         if ($has_header) {
5959                 # table header
5960                 print "<thead><tr>\n" .
5961                        "<th></th><th></th>\n"; # filename, patchN link
5962                 for (my $i = 0; $i < @parents; $i++) {
5963                         my $par = $parents[$i];
5964                         print "<th>" .
5965                               $cgi->a({-href => href(action=>"commitdiff",
5966                                                      hash=>$hash, hash_parent=>$par),
5967                                        -title => 'commitdiff to parent number ' .
5968                                                   ($i+1) . ': ' . substr($par,0,7)},
5969                                       $i+1) .
5970                               "&#160;</th>\n";
5971                 }
5972                 print "</tr></thead>\n<tbody>\n";
5973         }
5974
5975         my $alternate = 1;
5976         my $patchno = 0;
5977         foreach my $line (@{$difftree}) {
5978                 my $diff = parsed_difftree_line($line);
5979
5980                 if ($alternate) {
5981                         print "<tr class=\"dark\">\n";
5982                 } else {
5983                         print "<tr class=\"light\">\n";
5984                 }
5985                 $alternate ^= 1;
5986
5987                 if (exists $diff->{'nparents'}) { # combined diff
5988
5989                         fill_from_file_info($diff, @parents)
5990                                 unless exists $diff->{'from_file'};
5991
5992                         if (!is_deleted($diff)) {
5993                                 # file exists in the result (child) commit
5994                                 print "<td>" .
5995                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5996                                                              file_name=>$diff->{'to_file'},
5997                                                              hash_base=>$hash),
5998                                               -class => "list"}, esc_path($diff->{'to_file'})) .
5999                                       "</td>\n";
6000                         } else {
6001                                 print "<td>" .
6002                                       esc_path($diff->{'to_file'}) .
6003                                       "</td>\n";
6004                         }
6005
6006                         if ($action eq 'commitdiff') {
6007                                 # link to patch
6008                                 $patchno++;
6009                                 print "<td class=\"link\">" .
6010                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
6011                                               "patch") .
6012                                       $barsep .
6013                                       "</td>\n";
6014                         }
6015
6016                         my $has_history = 0;
6017                         my $not_deleted = 0;
6018                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
6019                                 my $hash_parent = $parents[$i];
6020                                 my $from_hash = $diff->{'from_id'}[$i];
6021                                 my $from_path = $diff->{'from_file'}[$i];
6022                                 my $status = $diff->{'status'}[$i];
6023
6024                                 $has_history ||= ($status ne 'A');
6025                                 $not_deleted ||= ($status ne 'D');
6026
6027                                 if ($status eq 'A') {
6028                                         print "<td  class=\"link\" align=\"right\">$barsep</td>\n";
6029                                 } elsif ($status eq 'D') {
6030                                         print "<td class=\"link\">" .
6031                                               $cgi->a({-href => href(action=>"blob",
6032                                                                      hash_base=>$hash,
6033                                                                      hash=>$from_hash,
6034                                                                      file_name=>$from_path)},
6035                                                       "blob" . ($i+1)) .
6036                                               "$barsep</td>\n";
6037                                 } else {
6038                                         if ($diff->{'to_id'} eq $from_hash) {
6039                                                 print "<td class=\"link nochange\">";
6040                                         } else {
6041                                                 print "<td class=\"link\">";
6042                                         }
6043                                         print $cgi->a({-href => href(action=>"blobdiff",
6044                                                                      hash=>$diff->{'to_id'},
6045                                                                      hash_parent=>$from_hash,
6046                                                                      hash_base=>$hash,
6047                                                                      hash_parent_base=>$hash_parent,
6048                                                                      file_name=>$diff->{'to_file'},
6049                                                                      file_parent=>$from_path)},
6050                                                       "diff" . ($i+1)) .
6051                                               "$barsep</td>\n";
6052                                 }
6053                         }
6054
6055                         print "<td class=\"link\">";
6056                         if ($not_deleted) {
6057                                 print $cgi->a({-href => href(action=>"blob",
6058                                                              hash=>$diff->{'to_id'},
6059                                                              file_name=>$diff->{'to_file'},
6060                                                              hash_base=>$hash)},
6061                                               "blob");
6062                                 print $barsep if ($has_history);
6063                         }
6064                         if ($has_history) {
6065                                 print $cgi->a({-href => href(action=>"history",
6066                                                              file_name=>$diff->{'to_file'},
6067                                                              hash_base=>$hash)},
6068                                               "history");
6069                         }
6070                         print "</td>\n";
6071
6072                         print "</tr>\n";
6073                         next; # instead of 'else' clause, to avoid extra indent
6074                 }
6075                 # else ordinary diff
6076
6077                 my ($to_mode_oct, $to_mode_str, $to_file_type);
6078                 my ($from_mode_oct, $from_mode_str, $from_file_type);
6079                 if ($diff->{'to_mode'} ne ('0' x 6)) {
6080                         $to_mode_oct = oct $diff->{'to_mode'};
6081                         if (S_ISREG($to_mode_oct)) { # only for regular file
6082                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
6083                         }
6084                         $to_file_type = file_type($diff->{'to_mode'});
6085                 }
6086                 if ($diff->{'from_mode'} ne ('0' x 6)) {
6087                         $from_mode_oct = oct $diff->{'from_mode'};
6088                         if (S_ISREG($from_mode_oct)) { # only for regular file
6089                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
6090                         }
6091                         $from_file_type = file_type($diff->{'from_mode'});
6092                 }
6093
6094                 if ($diff->{'status'} eq "A") { # created
6095                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
6096                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
6097                         $mode_chng   .= "]</span>";
6098                         print "<td>";
6099                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6100                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6101                                       -class => "list"}, esc_path($diff->{'file'}));
6102                         print "</td>\n";
6103                         print "<td>$mode_chng</td>\n";
6104                         print "<td class=\"link\">";
6105                         if ($action eq 'commitdiff') {
6106                                 # link to patch
6107                                 $patchno++;
6108                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6109                                               "patch") .
6110                                       $barsep;
6111                         }
6112                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6113                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6114                                       "blob");
6115                         print "</td>\n";
6116
6117                 } elsif ($diff->{'status'} eq "D") { # deleted
6118                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
6119                         print "<td>";
6120                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
6121                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
6122                                        -class => "list"}, esc_path($diff->{'file'}));
6123                         print "</td>\n";
6124                         print "<td>$mode_chng</td>\n";
6125                         print "<td class=\"link\">";
6126                         if ($action eq 'commitdiff') {
6127                                 # link to patch
6128                                 $patchno++;
6129                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6130                                               "patch") .
6131                                       $barsep;
6132                         }
6133                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
6134                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
6135                                       "blob") . $barsep;
6136                         if ($have_blame) {
6137                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
6138                                                              file_name=>$diff->{'file'}),
6139                                               -class => "blamelink"},
6140                                               "blame") . $barsep;
6141                         }
6142                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
6143                                                      file_name=>$diff->{'file'})},
6144                                       "history");
6145                         print "</td>\n";
6146
6147                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
6148                         my $mode_chnge = "";
6149                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6150                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
6151                                 if ($from_file_type ne $to_file_type) {
6152                                         $mode_chnge .= " from $from_file_type to $to_file_type";
6153                                 }
6154                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
6155                                         if ($from_mode_str && $to_mode_str) {
6156                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
6157                                         } elsif ($to_mode_str) {
6158                                                 $mode_chnge .= " mode: $to_mode_str";
6159                                         }
6160                                 }
6161                                 $mode_chnge .= "]</span>\n";
6162                         }
6163                         print "<td>";
6164                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6165                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6166                                       -class => "list"}, esc_path($diff->{'file'}));
6167                         print "</td>\n";
6168                         print "<td>$mode_chnge</td>\n";
6169                         print "<td class=\"link\">";
6170                         if ($action eq 'commitdiff') {
6171                                 # link to patch
6172                                 $patchno++;
6173                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6174                                               "patch") .
6175                                       $barsep;
6176                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6177                                 # "commit" view and modified file (not onlu mode changed)
6178                                 print $cgi->a({-href => href(action=>"blobdiff",
6179                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6180                                                              hash_base=>$hash, hash_parent_base=>$parent,
6181                                                              file_name=>$diff->{'file'})},
6182                                               "diff") .
6183                                       $barsep;
6184                         }
6185                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6186                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6187                                        "blob") . $barsep;
6188                         if ($have_blame) {
6189                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6190                                                              file_name=>$diff->{'file'}),
6191                                               -class => "blamelink"},
6192                                               "blame") . $barsep;
6193                         }
6194                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6195                                                      file_name=>$diff->{'file'})},
6196                                       "history");
6197                         print "</td>\n";
6198
6199                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
6200                         my %status_name = ('R' => 'moved', 'C' => 'copied');
6201                         my $nstatus = $status_name{$diff->{'status'}};
6202                         my $mode_chng = "";
6203                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6204                                 # mode also for directories, so we cannot use $to_mode_str
6205                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
6206                         }
6207                         print "<td>" .
6208                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
6209                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
6210                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
6211                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
6212                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
6213                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
6214                                       -class => "list"}, esc_path($diff->{'from_file'})) .
6215                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
6216                               "<td class=\"link\">";
6217                         if ($action eq 'commitdiff') {
6218                                 # link to patch
6219                                 $patchno++;
6220                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6221                                               "patch") .
6222                                       $barsep;
6223                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6224                                 # "commit" view and modified file (not only pure rename or copy)
6225                                 print $cgi->a({-href => href(action=>"blobdiff",
6226                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6227                                                              hash_base=>$hash, hash_parent_base=>$parent,
6228                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
6229                                               "diff") .
6230                                       $barsep;
6231                         }
6232                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6233                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
6234                                       "blob") . $barsep;
6235                         if ($have_blame) {
6236                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6237                                                              file_name=>$diff->{'to_file'}),
6238                                               -class => "blamelink"},
6239                                               "blame") . $barsep;
6240                         }
6241                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6242                                                     file_name=>$diff->{'to_file'})},
6243                                       "history");
6244                         print "</td>\n";
6245
6246                 } # we should not encounter Unmerged (U) or Unknown (X) status
6247                 print "</tr>\n";
6248         }
6249         print "</tbody>" if $has_header;
6250         print "</table>\n";
6251 }
6252
6253 # Print context lines and then rem/add lines in a side-by-side manner.
6254 sub print_sidebyside_diff_lines {
6255         my ($ctx, $rem, $add) = @_;
6256
6257         # print context block before add/rem block
6258         if (@$ctx) {
6259                 print join '',
6260                         '<div class="chunk_block ctx">',
6261                                 '<div class="old">',
6262                                 @$ctx,
6263                                 '</div>',
6264                                 '<div class="new">',
6265                                 @$ctx,
6266                                 '</div>',
6267                         '</div>';
6268         }
6269
6270         if (!@$add) {
6271                 # pure removal
6272                 print join '',
6273                         '<div class="chunk_block rem">',
6274                                 '<div class="old">',
6275                                 @$rem,
6276                                 '</div>',
6277                         '</div>';
6278         } elsif (!@$rem) {
6279                 # pure addition
6280                 print join '',
6281                         '<div class="chunk_block add">',
6282                                 '<div class="new">',
6283                                 @$add,
6284                                 '</div>',
6285                         '</div>';
6286         } else {
6287                 print join '',
6288                         '<div class="chunk_block chg">',
6289                                 '<div class="old">',
6290                                 @$rem,
6291                                 '</div>',
6292                                 '<div class="new">',
6293                                 @$add,
6294                                 '</div>',
6295                         '</div>';
6296         }
6297 }
6298
6299 # Print context lines and then rem/add lines in inline manner.
6300 sub print_inline_diff_lines {
6301         my ($ctx, $rem, $add) = @_;
6302
6303         print @$ctx, @$rem, @$add;
6304 }
6305
6306 # Format removed and added line, mark changed part and HTML-format them.
6307 # Implementation is based on contrib/diff-highlight
6308 sub format_rem_add_lines_pair {
6309         my ($rem, $add, $num_parents) = @_;
6310
6311         # We need to untabify lines before split()'ing them;
6312         # otherwise offsets would be invalid.
6313         chomp $rem;
6314         chomp $add;
6315         $rem = untabify($rem);
6316         $add = untabify($add);
6317
6318         my @rem = split(//, $rem);
6319         my @add = split(//, $add);
6320         my ($esc_rem, $esc_add);
6321         # Ignore leading +/- characters for each parent.
6322         my ($prefix_len, $suffix_len) = ($num_parents, 0);
6323         my ($prefix_has_nonspace, $suffix_has_nonspace);
6324
6325         my $shorter = (@rem < @add) ? @rem : @add;
6326         while ($prefix_len < $shorter) {
6327                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
6328
6329                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
6330                 $prefix_len++;
6331         }
6332
6333         while ($prefix_len + $suffix_len < $shorter) {
6334                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
6335
6336                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
6337                 $suffix_len++;
6338         }
6339
6340         # Mark lines that are different from each other, but have some common
6341         # part that isn't whitespace.  If lines are completely different, don't
6342         # mark them because that would make output unreadable, especially if
6343         # diff consists of multiple lines.
6344         if ($prefix_has_nonspace || $suffix_has_nonspace) {
6345                 $esc_rem = esc_html_hl_regions($rem, 'marked',
6346                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
6347                 $esc_add = esc_html_hl_regions($add, 'marked',
6348                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
6349         } else {
6350                 $esc_rem = esc_html($rem, -nbsp=>1);
6351                 $esc_add = esc_html($add, -nbsp=>1);
6352         }
6353
6354         return format_diff_line(\$esc_rem, 'rem'),
6355                format_diff_line(\$esc_add, 'add');
6356 }
6357
6358 # HTML-format diff context, removed and added lines.
6359 sub format_ctx_rem_add_lines {
6360         my ($ctx, $rem, $add, $num_parents) = @_;
6361         my (@new_ctx, @new_rem, @new_add);
6362         my $can_highlight = 0;
6363         my $is_combined = ($num_parents > 1);
6364
6365         # Highlight if every removed line has a corresponding added line.
6366         if (@$add > 0 && @$add == @$rem) {
6367                 $can_highlight = 1;
6368
6369                 # Highlight lines in combined diff only if the chunk contains
6370                 # diff between the same version, e.g.
6371                 #
6372                 #    - a
6373                 #   -  b
6374                 #    + c
6375                 #   +  d
6376                 #
6377                 # Otherwise the highlightling would be confusing.
6378                 if ($is_combined) {
6379                         for (my $i = 0; $i < @$add; $i++) {
6380                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
6381                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
6382
6383                                 $prefix_rem =~ s/-/+/g;
6384
6385                                 if ($prefix_rem ne $prefix_add) {
6386                                         $can_highlight = 0;
6387                                         last;
6388                                 }
6389                         }
6390                 }
6391         }
6392
6393         if ($can_highlight) {
6394                 for (my $i = 0; $i < @$add; $i++) {
6395                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
6396                                 $rem->[$i], $add->[$i], $num_parents);
6397                         push @new_rem, $line_rem;
6398                         push @new_add, $line_add;
6399                 }
6400         } else {
6401                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
6402                 @new_add = map { format_diff_line($_, 'add') } @$add;
6403         }
6404
6405         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
6406
6407         return (\@new_ctx, \@new_rem, \@new_add);
6408 }
6409
6410 # Print context lines and then rem/add lines.
6411 sub print_diff_lines {
6412         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
6413         my $is_combined = $num_parents > 1;
6414
6415         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
6416                 $num_parents);
6417
6418         if ($diff_style eq 'sidebyside' && !$is_combined) {
6419                 print_sidebyside_diff_lines($ctx, $rem, $add);
6420         } else {
6421                 # default 'inline' style and unknown styles
6422                 print_inline_diff_lines($ctx, $rem, $add);
6423         }
6424 }
6425
6426 sub print_diff_chunk {
6427         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
6428         my (@ctx, @rem, @add);
6429
6430         # The class of the previous line.
6431         my $prev_class = '';
6432
6433         return unless @chunk;
6434
6435         # incomplete last line might be among removed or added lines,
6436         # or both, or among context lines: find which
6437         for (my $i = 1; $i < @chunk; $i++) {
6438                 if ($chunk[$i][0] eq 'incomplete') {
6439                         $chunk[$i][0] = $chunk[$i-1][0];
6440                 }
6441         }
6442
6443         # guardian
6444         push @chunk, ["", ""];
6445
6446         foreach my $line_info (@chunk) {
6447                 my ($class, $line) = @$line_info;
6448
6449                 # print chunk headers
6450                 if ($class && $class eq 'chunk_header') {
6451                         print format_diff_line($line, $class, $from, $to);
6452                         next;
6453                 }
6454
6455                 ## print from accumulator when have some add/rem lines or end
6456                 # of chunk (flush context lines), or when have add and rem
6457                 # lines and new block is reached (otherwise add/rem lines could
6458                 # be reordered)
6459                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
6460                     (@rem && @add && $class ne $prev_class)) {
6461                         print_diff_lines(\@ctx, \@rem, \@add,
6462                                          $diff_style, $num_parents);
6463                         @ctx = @rem = @add = ();
6464                 }
6465
6466                 ## adding lines to accumulator
6467                 # guardian value
6468                 last unless $line;
6469                 # rem, add or change
6470                 if ($class eq 'rem') {
6471                         push @rem, $line;
6472                 } elsif ($class eq 'add') {
6473                         push @add, $line;
6474                 }
6475                 # context line
6476                 if ($class eq 'ctx') {
6477                         push @ctx, $line;
6478                 }
6479
6480                 $prev_class = $class;
6481         }
6482 }
6483
6484 sub git_patchset_body {
6485         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
6486         my ($hash_parent) = $hash_parents[0];
6487
6488         my $is_combined = (@hash_parents > 1);
6489         my $patch_idx = 0;
6490         my $patch_number = 0;
6491         my $patch_line;
6492         my $diffinfo;
6493         my $to_name;
6494         my (%from, %to);
6495         my @chunk; # for side-by-side diff
6496
6497         print "<div class=\"patchset\">\n";
6498
6499         # skip to first patch
6500         while ($patch_line = to_utf8(scalar <$fd>)) {
6501                 chomp $patch_line;
6502
6503                 last if ($patch_line =~ m/^diff /);
6504         }
6505
6506  PATCH:
6507         while ($patch_line) {
6508
6509                 # parse "git diff" header line
6510                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
6511                         # $1 is from_name, which we do not use
6512                         $to_name = unquote($2);
6513                         $to_name =~ s!^b/!!;
6514                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
6515                         # $1 is 'cc' or 'combined', which we do not use
6516                         $to_name = unquote($2);
6517                 } else {
6518                         $to_name = undef;
6519                 }
6520
6521                 # check if current patch belong to current raw line
6522                 # and parse raw git-diff line if needed
6523                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
6524                         # this is continuation of a split patch
6525                         print "<div class=\"patch cont\">\n";
6526                 } else {
6527                         # advance raw git-diff output if needed
6528                         $patch_idx++ if defined $diffinfo;
6529
6530                         # read and prepare patch information
6531                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6532
6533                         # compact combined diff output can have some patches skipped
6534                         # find which patch (using pathname of result) we are at now;
6535                         if ($is_combined) {
6536                                 while ($to_name ne $diffinfo->{'to_file'}) {
6537                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6538                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
6539                                               "</div>\n";  # class="patch"
6540
6541                                         $patch_idx++;
6542                                         $patch_number++;
6543
6544                                         last if $patch_idx > $#$difftree;
6545                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6546                                 }
6547                         }
6548
6549                         # modifies %from, %to hashes
6550                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
6551
6552                         # this is first patch for raw difftree line with $patch_idx index
6553                         # we index @$difftree array from 0, but number patches from 1
6554                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
6555                 }
6556
6557                 # git diff header
6558                 #assert($patch_line =~ m/^diff /) if DEBUG;
6559                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
6560                 $patch_number++;
6561                 # print "git diff" header
6562                 print format_git_diff_header_line($patch_line, $diffinfo,
6563                                                   \%from, \%to);
6564
6565                 # print extended diff header
6566                 print "<div class=\"diff extended_header\">\n";
6567         EXTENDED_HEADER:
6568                 while ($patch_line = to_utf8(scalar<$fd>)) {
6569                         chomp $patch_line;
6570
6571                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
6572
6573                         print format_extended_diff_header_line($patch_line, $diffinfo,
6574                                                                \%from, \%to);
6575                 }
6576                 print "</div>\n"; # class="diff extended_header"
6577
6578                 # from-file/to-file diff header
6579                 if (! $patch_line) {
6580                         print "</div>\n"; # class="patch"
6581                         last PATCH;
6582                 }
6583                 next PATCH if ($patch_line =~ m/^diff /);
6584                 #assert($patch_line =~ m/^---/) if DEBUG;
6585
6586                 my $last_patch_line = $patch_line;
6587                 $patch_line = to_utf8(scalar <$fd>);
6588                 chomp $patch_line;
6589                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
6590
6591                 print format_diff_from_to_header($last_patch_line, $patch_line,
6592                                                  $diffinfo, \%from, \%to,
6593                                                  @hash_parents);
6594
6595                 # the patch itself
6596         LINE:
6597                 while ($patch_line = to_utf8(scalar <$fd>)) {
6598                         chomp $patch_line;
6599
6600                         next PATCH if ($patch_line =~ m/^diff /);
6601
6602                         my $class = diff_line_class($patch_line, \%from, \%to);
6603
6604                         if ($class eq 'chunk_header') {
6605                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6606                                 @chunk = ();
6607                         }
6608
6609                         push @chunk, [ $class, $patch_line ];
6610                 }
6611
6612         } continue {
6613                 if (@chunk) {
6614                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6615                         @chunk = ();
6616                 }
6617                 print "</div>\n"; # class="patch"
6618         }
6619
6620         # for compact combined (--cc) format, with chunk and patch simplification
6621         # the patchset might be empty, but there might be unprocessed raw lines
6622         for (++$patch_idx if $patch_number > 0;
6623              $patch_idx < @$difftree;
6624              ++$patch_idx) {
6625                 # read and prepare patch information
6626                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6627
6628                 # generate anchor for "patch" links in difftree / whatchanged part
6629                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6630                       format_diff_cc_simplified($diffinfo, @hash_parents) .
6631                       "</div>\n";  # class="patch"
6632
6633                 $patch_number++;
6634         }
6635
6636         if ($patch_number == 0) {
6637                 if (@hash_parents > 1) {
6638                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
6639                 } else {
6640                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
6641                 }
6642         }
6643
6644         print "</div>\n"; # class="patchset"
6645 }
6646
6647 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6648
6649 sub git_project_search_form {
6650         my ($searchtext, $search_use_regexp) = @_;
6651
6652         my $limit = '';
6653         if ($project_filter) {
6654                 $limit = " in '$project_filter'";
6655         }
6656
6657         print "<div class=\"projsearch\">\n";
6658         print $cgi->start_form(-method => 'get', -action => $my_uri) .
6659               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
6660         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
6661                 if (defined $project_filter);
6662         print $cgi->textfield(-name => 's', -value => $searchtext,
6663                               -title => "Search project by name and description$limit",
6664                               -size => 60) . "\n" .
6665               "<span title=\"Extended regular expression\">" .
6666               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
6667                              -checked => $search_use_regexp) .
6668               "</span>\n" .
6669               $cgi->submit(-name => 'btnS', -value => 'Search') .
6670               $cgi->end_form() . "\n" .
6671               "<span class=\"projectlist_link\">" .
6672               $cgi->a({-href => href(project => undef, searchtext => undef,
6673                                      action => 'project_list',
6674                                      project_filter => $project_filter)},
6675                       esc_html("List all projects$limit")) . "</span><br />\n";
6676         print "<span class=\"projectlist_link\">" .
6677               $cgi->a({-href => href(project => undef, searchtext => undef,
6678                                      action => 'project_list',
6679                                      project_filter => undef)},
6680                       esc_html("List all projects")) . "</span>\n" if $project_filter;
6681         print "</div>\n";
6682 }
6683
6684 # entry for given @keys needs filling if at least one of keys in list
6685 # is not present in %$project_info
6686 sub project_info_needs_filling {
6687         my ($project_info, @keys) = @_;
6688
6689         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
6690         foreach my $key (@keys) {
6691                 if (!exists $project_info->{$key}) {
6692                         return 1;
6693                 }
6694         }
6695         return;
6696 }
6697
6698 sub git_cache_file_format {
6699         return GITWEB_CACHE_FORMAT .
6700                 (gitweb_check_feature('forks') ? " (forks)" : "");
6701 }
6702
6703 sub git_retrieve_cache_file {
6704         my $cache_file = shift;
6705
6706         use Storable qw(retrieve);
6707
6708         if ((my $dump = eval { retrieve($cache_file) })) {
6709                 return $$dump[1] if
6710                         ref($dump) eq 'ARRAY' &&
6711                         @$dump == 2 &&
6712                         ref($$dump[1]) eq 'ARRAY' &&
6713                         @{$$dump[1]} == 2 &&
6714                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
6715                         ref(${$$dump[1]}[1]) eq 'HASH' &&
6716                         $$dump[0] eq git_cache_file_format();
6717         }
6718
6719         return undef;
6720 }
6721
6722 sub git_store_cache_file {
6723         my ($cache_file, $cachedata) = @_;
6724
6725         use File::Basename qw(dirname);
6726         use File::stat;
6727         use POSIX qw(:fcntl_h);
6728         use Storable qw(store_fd);
6729
6730         my $result = undef;
6731         my $cache_d = dirname($cache_file);
6732         my $mask = umask();
6733         umask($mask & ~0070) if $cache_grpshared;
6734         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6735             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6736                 store_fd([git_cache_file_format(), $cachedata], $fd);
6737                 close $fd;
6738                 rename "$cache_file.lock", $cache_file;
6739                 $result = stat($cache_file)->mtime;
6740         }
6741         umask($mask) if $cache_grpshared;
6742         return $result;
6743 }
6744
6745 sub verify_cached_project {
6746         my ($hashref, $path) = @_;
6747         return undef unless $path;
6748         delete $$hashref{$path}, return undef unless is_valid_project($path);
6749         return $$hashref{$path} if exists $$hashref{$path};
6750
6751         # A valid project was requested but it's not yet in the cache
6752         # Manufacture a minimal project entry (path, name, description)
6753         # Also provide age, but only if it's available via $lastactivity_file
6754
6755         my %proj = ('path' => $path);
6756         my $val = git_get_project_description($path);
6757         defined $val or $val = '';
6758         $proj{'descr_long'} = $val;
6759         $proj{'descr'} = chop_str($val, $projects_list_description_width, 5);
6760         unless ($omit_owner) {
6761                 $val = git_get_project_owner($path);
6762                 defined $val or $val = '';
6763                 $proj{'owner'} = $val;
6764         }
6765         unless ($omit_age_column) {
6766                 ($val) = git_get_last_activity($path, 1);
6767                 $proj{'age_epoch'} = $val if defined $val;
6768         }
6769         $$hashref{$path} = \%proj;
6770         return \%proj;
6771 }
6772
6773 sub git_filter_cached_projects {
6774         my ($cache, $projlist, $verify) = @_;
6775         my $hashref = $$cache[1];
6776         my $sub = $verify ?
6777                 sub {verify_cached_project($hashref, $_[0])} :
6778                 sub {$$hashref{$_[0]}};
6779         return map {
6780                 my $c = &$sub($_->{'path'});
6781                 defined $c ? ($_ = $c) : ()
6782         } @$projlist;
6783 }
6784
6785 # fills project list info (age, description, owner, category, forks, etc.)
6786 # for each project in the list, removing invalid projects from
6787 # returned list, or fill only specified info.
6788 #
6789 # Invalid projects are removed from the returned list if and only if you
6790 # ask 'age_epoch' to be filled, because they are the only fields
6791 # that run unconditionally git command that requires repository, and
6792 # therefore do always check if project repository is invalid.
6793 #
6794 # USAGE:
6795 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6796 #   ensures that 'descr_long' and 'ctags' fields are filled
6797 # * @project_list = fill_project_list_info(\@project_list)
6798 #   ensures that all fields are filled (and invalid projects removed)
6799 #
6800 # NOTE: modifies $projlist, but does not remove entries from it
6801 sub fill_project_list_info {
6802         my ($projlist, @wanted_keys) = @_;
6803
6804         my $rebuild = @wanted_keys && $wanted_keys[0] eq 'rebuild-cache' && shift @wanted_keys;
6805         return fill_project_list_info_uncached($projlist, @wanted_keys)
6806                 unless $projlist_cache_lifetime && $projlist_cache_lifetime > 0;
6807
6808         use File::stat;
6809
6810         my $cache_lifetime = $rebuild ? 0 : $projlist_cache_lifetime;
6811         my $cache_file = "$cache_dir/$projlist_cache_name";
6812
6813         my @projects;
6814         my $stale = 0;
6815         my $now = time();
6816         my $cache_mtime;
6817         if ($cache_lifetime && -f $cache_file) {
6818                 $cache_mtime = stat($cache_file)->mtime;
6819                 $cache_dump = undef if $cache_mtime &&
6820                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6821         }
6822         if (defined $cache_mtime && # caching is on and $cache_file exists
6823             $cache_mtime + $cache_lifetime*60 > $now &&
6824             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6825                 # Cache hit.
6826                 $cache_dump_mtime = $cache_mtime;
6827                 $stale = $now - $cache_mtime;
6828                 my $verify = ($action eq 'summary' || $action eq 'forks') &&
6829                         gitweb_check_feature('forks');
6830                 @projects = git_filter_cached_projects($cache_dump, $projlist, $verify);
6831
6832         } else { # Cache miss.
6833                 if (defined $cache_mtime) {
6834                         # Postpone timeout by two minutes so that we get
6835                         # enough time to do our job, or to be more exact
6836                         # make cache expire after two minutes from now.
6837                         my $time = $now - $cache_lifetime*60 + 120;
6838                         utime $time, $time, $cache_file;
6839                 }
6840                 my @all_projects = git_get_projects_list();
6841                 my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6842                         fill_project_list_info_uncached(\@all_projects);
6843                 map { $all_projects_filled{$_->{'path'}} = $_ }
6844                         filter_forks_from_projects_list([values(%all_projects_filled)])
6845                         if gitweb_check_feature('forks');
6846                 $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6847                                \%all_projects_filled];
6848                 $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6849                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6850         }
6851
6852         if ($cache_lifetime && $stale > 0) {
6853                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6854                         unless $shown_stale_message;
6855                 $shown_stale_message = 1;
6856         }
6857
6858         return @projects;
6859 }
6860
6861 sub fill_project_list_info_uncached {
6862         my ($projlist, @wanted_keys) = @_;
6863         my @projects;
6864         my $filter_set = sub { return @_; };
6865         if (@wanted_keys) {
6866                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6867                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6868         }
6869
6870         my $show_ctags = gitweb_check_feature('ctags');
6871  PROJECT:
6872         foreach my $pr (@$projlist) {
6873                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6874                         my (@activity) = git_get_last_activity($pr->{'path'});
6875                         unless (@activity) {
6876                                 next PROJECT;
6877                         }
6878                         ($pr->{'age_epoch'}) = @activity;
6879                 }
6880                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6881                         my $descr = git_get_project_description($pr->{'path'}) || "";
6882                         $descr = to_utf8($descr);
6883                         $pr->{'descr_long'} = $descr;
6884                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6885                 }
6886                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6887                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6888                 }
6889                 if ($show_ctags &&
6890                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6891                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6892                 }
6893                 if ($projects_list_group_categories &&
6894                     project_info_needs_filling($pr, $filter_set->('category'))) {
6895                         my $cat = git_get_project_category($pr->{'path'}) ||
6896                                                            $project_list_default_category;
6897                         $pr->{'category'} = to_utf8($cat);
6898                 }
6899
6900                 push @projects, $pr;
6901         }
6902
6903         return @projects;
6904 }
6905
6906 sub sort_projects_list {
6907         my ($projlist, $order) = @_;
6908
6909         sub order_str {
6910                 my $key = shift;
6911                 return sub { lc($a->{$key}) cmp lc($b->{$key}) };
6912         }
6913
6914         sub order_reverse_num_then_undef {
6915                 my $key = shift;
6916                 return sub {
6917                         defined $a->{$key} ?
6918                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6919                                 (defined $b->{$key} ? 1 : 0)
6920                 };
6921         }
6922
6923         my %orderings = (
6924                 project => order_str('path'),
6925                 descr => order_str('descr_long'),
6926                 owner => order_str('owner'),
6927                 age => order_reverse_num_then_undef('age_epoch'),
6928         );
6929
6930         my $ordering = $orderings{$order};
6931         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6932 }
6933
6934 # returns a hash of categories, containing the list of project
6935 # belonging to each category
6936 sub build_projlist_by_category {
6937         my ($projlist, $from, $to) = @_;
6938         my %categories;
6939
6940         $from = 0 unless defined $from;
6941         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6942
6943         for (my $i = $from; $i <= $to; $i++) {
6944                 my $pr = $projlist->[$i];
6945                 push @{$categories{ $pr->{'category'} }}, $pr;
6946         }
6947
6948         return wantarray ? %categories : \%categories;
6949 }
6950
6951 # print 'sort by' <th> element, generating 'sort by $name' replay link
6952 # if that order is not selected
6953 sub print_sort_th {
6954         print format_sort_th(@_);
6955 }
6956
6957 sub format_sort_th {
6958         my ($name, $order, $header) = @_;
6959         my $sort_th = "";
6960         $header ||= ucfirst($name);
6961
6962         if ($order eq $name) {
6963                 $sort_th .= "<th>$header</th>\n";
6964         } else {
6965                 $sort_th .= "<th>" .
6966                             $cgi->a({-href => href(-replay=>1, order=>$name),
6967                                      -class => "header"}, $header) .
6968                             "</th>\n";
6969         }
6970
6971         return $sort_th;
6972 }
6973
6974 sub git_project_list_rows {
6975         my ($projlist, $from, $to, $check_forks) = @_;
6976
6977         $from = 0 unless defined $from;
6978         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6979
6980         my $now = time;
6981         my $alternate = 1;
6982         for (my $i = $from; $i <= $to; $i++) {
6983                 my $pr = $projlist->[$i];
6984
6985                 if ($alternate) {
6986                         print "<tr class=\"dark\">\n";
6987                 } else {
6988                         print "<tr class=\"light\">\n";
6989                 }
6990                 $alternate ^= 1;
6991
6992                 if ($check_forks) {
6993                         print "<td>";
6994                         if ($pr->{'forks'}) {
6995                                 my $nforks = scalar @{$pr->{'forks'}};
6996                                 my $s = $nforks == 1 ? '' : 's';
6997                                 if ($nforks > 0) {
6998                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
6999                                                        -title => "$nforks fork$s"}, "+");
7000                                 } else {
7001                                         print $cgi->span({-title => "$nforks fork$s"}, "+");
7002                                 }
7003                         }
7004                         print "</td>\n";
7005                 }
7006                 my $path = $pr->{'path'};
7007                 my $dotgit = $path =~ s/\.git$// ? '.git' : '';
7008                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
7009                                         -class => "list"},
7010                                        esc_html_match_hl($path, $search_regexp).$dotgit) .
7011                       "</td>\n" .
7012                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
7013                                         -class => "list",
7014                                         -title => $pr->{'descr_long'}},
7015                                         $search_regexp
7016                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
7017                                                                     $pr->{'descr'}, $search_regexp)
7018                                         : esc_html($pr->{'descr'})) .
7019                       "</td>\n";
7020                 unless ($omit_owner) {
7021                         print "<td><i>" . ($owner_link_hook
7022                                           ? $cgi->a({-href => $owner_link_hook->($pr->{'owner'}), -class => "list"},
7023                                                     chop_and_escape_str($pr->{'owner'}, 15))
7024                                           : chop_and_escape_str($pr->{'owner'}, 15)) . "</i></td>\n";
7025                 }
7026                 unless ($omit_age_column) {
7027                         my ($age_epoch, $age_string) = ($pr->{'age_epoch'});
7028                         $age_string = defined $age_epoch ? age_string($age_epoch, $now) : "No commits";
7029                         print "<td class=\"". age_class($age_epoch, $now) . "\">" . $age_string . "</td>\n";
7030                 }
7031                 print"<td class=\"link\">" .
7032                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . $barsep .
7033                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "log") . $barsep .
7034                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
7035                       ($pr->{'forks'} ? $barsep . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
7036                       "</td>\n" .
7037                       "</tr>\n";
7038         }
7039 }
7040
7041 sub git_project_list_body {
7042         # actually uses global variable $project
7043         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action, $keep_top) = @_;
7044         my @projects = @$projlist;
7045
7046         my $check_forks = gitweb_check_feature('forks');
7047         my $show_ctags  = gitweb_check_feature('ctags');
7048         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
7049         $check_forks = undef
7050                 if ($tagfilter || $search_regexp);
7051
7052         # filtering out forks before filling info allows us to do less work
7053         if ($check_forks) {
7054                 @projects = filter_forks_from_projects_list(\@projects);
7055                 push @projects, { 'path' => "$project_filter.git" }
7056                         if $project_filter && $keep_top && is_valid_project("$project_filter.git");
7057         }
7058         # search_projects_list pre-fills required info
7059         @projects = search_projects_list(\@projects,
7060                                          'search_regexp' => $search_regexp,
7061                                          'tagfilter'  => $tagfilter)
7062                 if ($tagfilter || $search_regexp);
7063         # fill the rest
7064         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
7065         push @all_fields, 'age_epoch' unless($omit_age_column);
7066         push @all_fields, 'owner' unless($omit_owner);
7067         @projects = fill_project_list_info(\@projects, @all_fields);
7068
7069         $order ||= $default_projects_order;
7070         $from = 0 unless defined $from;
7071         $to = $#projects if (!defined $to || $#projects < $to);
7072
7073         # short circuit
7074         if ($from > $to) {
7075                 print "<center>\n".
7076                       "<b>No such projects found</b><br />\n".
7077                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
7078                       "</center>\n<br />\n";
7079                 return;
7080         }
7081
7082         @projects = sort_projects_list(\@projects, $order);
7083
7084         if ($show_ctags) {
7085                 my $ctags = git_gather_all_ctags(\@projects);
7086                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
7087                 print git_show_project_tagcloud($cloud, 64);
7088         }
7089
7090         print "<table class=\"project_list\">\n";
7091         unless ($no_header) {
7092                 print "<tr>\n";
7093                 if ($check_forks) {
7094                         print "<th></th>\n";
7095                 }
7096                 print_sort_th('project', $order, 'Project');
7097                 print_sort_th('descr', $order, 'Description');
7098                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
7099                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
7100                 print "<th></th>\n" . # for links
7101                       "</tr>\n";
7102         }
7103
7104         if ($projects_list_group_categories) {
7105                 # only display categories with projects in the $from-$to window
7106                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
7107                 my %categories = build_projlist_by_category(\@projects, $from, $to);
7108                 foreach my $cat (sort keys %categories) {
7109                         unless ($cat eq "") {
7110                                 print "<tr>\n";
7111                                 if ($check_forks) {
7112                                         print "<td></td>\n";
7113                                 }
7114                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
7115                                 print "</tr>\n";
7116                         }
7117
7118                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
7119                 }
7120         } else {
7121                 git_project_list_rows(\@projects, $from, $to, $check_forks);
7122         }
7123
7124         if (defined $extra) {
7125                 print "<tr class=\"extra\">\n";
7126                 if ($check_forks) {
7127                         print "<td></td>\n";
7128                 }
7129                 print "<td colspan=\"5\" class=\"extra\">$extra</td>\n" .
7130                       "</tr>\n";
7131         }
7132         print "</table>\n";
7133 }
7134
7135 sub git_log_body {
7136         # uses global variable $project
7137         my ($commitlist, $from, $to, $refs, $extra) = @_;
7138
7139         $from = 0 unless defined $from;
7140         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7141
7142         for (my $i = 0; $i <= $to; $i++) {
7143                 my %co = %{$commitlist->[$i]};
7144                 next if !%co;
7145                 my $commit = $co{'id'};
7146                 my $ref = format_ref_marker($refs, $commit);
7147                 git_print_header_div('commit',
7148                                "<span class=\"age\">$co{'age_string'}</span>" .
7149                                esc_html($co{'title'}),
7150                                $commit, undef, $ref);
7151                 print "<div class=\"title_text\">\n" .
7152                       "<div class=\"log_link\">\n" .
7153                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
7154                       $barsep .
7155                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
7156                       $barsep .
7157                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
7158                       "<br/>\n" .
7159                       "</div>\n";
7160                       git_print_authorship(\%co, -tag => 'span');
7161                       print "<br/>\n</div>\n";
7162
7163                 print "<div class=\"log_body\">\n";
7164                 git_print_log($co{'comment'}, -final_empty_line=> 1);
7165                 print "</div>\n";
7166         }
7167         if ($extra) {
7168                 print "<div class=\"page_nav_trailer\">\n";
7169                 print "$extra\n";
7170                 print "</div>\n";
7171         }
7172 }
7173
7174 sub git_shortlog_body {
7175         # uses global variable $project
7176         my ($commitlist, $from, $to, $refs, $extra) = @_;
7177
7178         $from = 0 unless defined $from;
7179         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7180
7181         print "<table class=\"shortlog\">\n";
7182         my $alternate = 1;
7183         for (my $i = $from; $i <= $to; $i++) {
7184                 my %co = %{$commitlist->[$i]};
7185                 my $commit = $co{'id'};
7186                 my $ref = format_ref_marker($refs, $commit);
7187                 if ($alternate) {
7188                         print "<tr class=\"dark\">\n";
7189                 } else {
7190                         print "<tr class=\"light\">\n";
7191                 }
7192                 $alternate ^= 1;
7193                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
7194                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7195                       format_author_html('td', \%co, 10) . "<td>";
7196                 print format_subject_html($co{'title'}, $co{'title_short'},
7197                                           href(action=>"commit", hash=>$commit), $ref);
7198                 print "</td>\n" .
7199                       "<td class=\"link\">" .
7200                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . $barsep .
7201                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . $barsep .
7202                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
7203                 my $snapshot_links = format_snapshot_links($commit);
7204                 if (defined $snapshot_links) {
7205                         print $barsep . $snapshot_links;
7206                 }
7207                 print "</td>\n" .
7208                       "</tr>\n";
7209         }
7210         if (defined $extra) {
7211                 print "<tr class=\"extra\">\n" .
7212                       "<td colspan=\"4\" class=\"extra\">$extra</td>\n" .
7213                       "</tr>\n";
7214         }
7215         print "</table>\n";
7216 }
7217
7218 sub git_history_body {
7219         # Warning: assumes constant type (blob or tree) during history
7220         my ($commitlist, $from, $to, $refs, $extra,
7221             $file_name, $file_hash, $ftype) = @_;
7222
7223         $from = 0 unless defined $from;
7224         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
7225
7226         print "<table class=\"history\">\n";
7227         my $alternate = 1;
7228         for (my $i = $from; $i <= $to; $i++) {
7229                 my %co = %{$commitlist->[$i]};
7230                 if (!%co) {
7231                         next;
7232                 }
7233                 my $commit = $co{'id'};
7234
7235                 my $ref = format_ref_marker($refs, $commit);
7236
7237                 if ($alternate) {
7238                         print "<tr class=\"dark\">\n";
7239                 } else {
7240                         print "<tr class=\"light\">\n";
7241                 }
7242                 $alternate ^= 1;
7243                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7244         # shortlog:   format_author_html('td', \%co, 10)
7245                       format_author_html('td', \%co, 15, 3) . "<td>";
7246                 # originally git_history used chop_str($co{'title'}, 50)
7247                 print format_subject_html($co{'title'}, $co{'title_short'},
7248                                           href(action=>"commit", hash=>$commit), $ref);
7249                 print "</td>\n" .
7250                       "<td class=\"link\">" .
7251                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . $barsep .
7252                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
7253
7254                 if ($ftype eq 'blob') {
7255                         my $blob_current = $file_hash;
7256                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
7257                         if (defined $blob_current && defined $blob_parent &&
7258                                         $blob_current ne $blob_parent) {
7259                                 print $barsep .
7260                                         $cgi->a({-href => href(action=>"blobdiff",
7261                                                                hash=>$blob_current, hash_parent=>$blob_parent,
7262                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
7263                                                                file_name=>$file_name)},
7264                                                 "diff to current");
7265                         }
7266                 }
7267                 print "</td>\n" .
7268                       "</tr>\n";
7269         }
7270         if (defined $extra) {
7271                 print "<tr class=\"extra\">\n" .
7272                       "<td colspan=\"4\" class=\"extra\">$extra</td>\n" .
7273                       "</tr>\n";
7274         }
7275         print "</table>\n";
7276 }
7277
7278 sub git_tags_body {
7279         # uses global variable $project
7280         my ($taglist, $from, $to, $extra, $head_at, $full, $order) = @_;
7281         $from = 0 unless defined $from;
7282         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
7283         $order ||= $default_refs_order;
7284
7285         print "<table class=\"tags\">\n";
7286         if ($full) {
7287                 print "<tr class=\"tags_header\">\n";
7288                 print_sort_th('age', $order, 'Last Change');
7289                 print_sort_th('name', $order, 'Name');
7290                 print "<th></th>\n" . # for comment
7291                       "<th></th>\n" . # for tag
7292                       "<th></th>\n" . # for links
7293                       "</tr>\n";
7294         }
7295         my $alternate = 1;
7296         for (my $i = $from; $i <= $to; $i++) {
7297                 my $entry = $taglist->[$i];
7298                 my %tag = %$entry;
7299                 my $comment = $tag{'subject'};
7300                 my $comment_short;
7301                 if (defined $comment) {
7302                         $comment_short = chop_str($comment, 30, 5);
7303                 }
7304                 my $curr = defined $head_at && $tag{'id'} eq $head_at;
7305                 if ($alternate) {
7306                         print "<tr class=\"dark\">\n";
7307                 } else {
7308                         print "<tr class=\"light\">\n";
7309                 }
7310                 $alternate ^= 1;
7311                 if (defined $tag{'age'}) {
7312                         print "<td><i>$tag{'age'}</i></td>\n";
7313                 } else {
7314                         print "<td></td>\n";
7315                 }
7316                 print(($curr ? "<td class=\"current_head\">" : "<td>") .
7317                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
7318                                -class => "list name"}, esc_html($tag{'name'})) .
7319                       "</td>\n" .
7320                       "<td>");
7321                 if (defined $comment) {
7322                         print format_subject_html($comment, $comment_short,
7323                                                   href(action=>"tag", hash=>$tag{'id'}));
7324                 }
7325                 print "</td>\n" .
7326                       "<td class=\"selflink\">";
7327                 if ($tag{'type'} eq "tag") {
7328                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
7329                 } else {
7330                         print "&#160;";
7331                 }
7332                 print "</td>\n" .
7333                       "<td class=\"link\">" . $barsep .
7334                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
7335                 if ($tag{'reftype'} eq "commit") {
7336                         print $barsep . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "log");
7337                         print $barsep . $cgi->a({-href => href(action=>"tree", hash=>$tag{'fullname'})}, "tree") if $full;
7338                 } elsif ($tag{'reftype'} eq "blob") {
7339                         print $barsep . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
7340                 }
7341                 print "</td>\n" .
7342                       "</tr>";
7343         }
7344         if (defined $extra) {
7345                 print "<tr class=\"extra\">\n" .
7346                       "<td colspan=\"5\" class=\"extra\">$extra</td>\n" .
7347                       "</tr>\n";
7348         }
7349         print "</table>\n";
7350 }
7351
7352 sub git_heads_body {
7353         # uses global variable $project
7354         my ($headlist, $head_at, $from, $to, $extra) = @_;
7355         $from = 0 unless defined $from;
7356         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
7357
7358         print "<table class=\"heads\">\n";
7359         my $alternate = 1;
7360         for (my $i = $from; $i <= $to; $i++) {
7361                 my $entry = $headlist->[$i];
7362                 my %ref = %$entry;
7363                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
7364                 if ($alternate) {
7365                         print "<tr class=\"dark\">\n";
7366                 } else {
7367                         print "<tr class=\"light\">\n";
7368                 }
7369                 $alternate ^= 1;
7370                 print "<td><i>$ref{'age'}</i></td>\n" .
7371                       ($curr ? "<td class=\"current_head\">" : "<td>") .
7372                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
7373                                -class => "list name"},esc_html($ref{'name'})) .
7374                       "</td>\n" .
7375                       "<td class=\"link\">" .
7376                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "log") . $barsep .
7377                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
7378                       "</td>\n" .
7379                       "</tr>";
7380         }
7381         if (defined $extra) {
7382                 print "<tr class=\"extra\">\n" .
7383                       "<td colspan=\"3\" class=\"extra\">$extra</td>\n" .
7384                       "</tr>\n";
7385         }
7386         print "</table>\n";
7387 }
7388
7389 # Display a single remote block
7390 sub git_remote_block {
7391         my ($remote, $rdata, $limit, $head) = @_;
7392
7393         my $heads = $rdata->{'heads'};
7394         my $fetch = $rdata->{'fetch'};
7395         my $push = $rdata->{'push'};
7396
7397         my $urls_table = "<table class=\"projects_list\">\n" ;
7398
7399         if (defined $fetch) {
7400                 if ($fetch eq $push) {
7401                         $urls_table .= format_repo_url("URL", $fetch);
7402                 } else {
7403                         $urls_table .= format_repo_url("Fetch&#160;URL", $fetch);
7404                         $urls_table .= format_repo_url("Push&#160;URL", $push) if defined $push;
7405                 }
7406         } elsif (defined $push) {
7407                 $urls_table .= format_repo_url("Push&#160;URL", $push);
7408         } else {
7409                 $urls_table .= format_repo_url("", "No remote URL");
7410         }
7411
7412         $urls_table .= "</table>\n";
7413
7414         my $dots;
7415         if (defined $limit && $limit < @$heads) {
7416                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
7417         }
7418
7419         print $urls_table;
7420         git_heads_body($heads, $head, 0, $limit, $dots);
7421 }
7422
7423 # Display a list of remote names with the respective fetch and push URLs
7424 sub git_remotes_list {
7425         my ($remotedata, $limit) = @_;
7426         print "<table class=\"heads\">\n";
7427         my $alternate = 1;
7428         my @remotes = sort keys %$remotedata;
7429
7430         my $limited = $limit && $limit < @remotes;
7431
7432         $#remotes = $limit - 1 if $limited;
7433
7434         while (my $remote = shift @remotes) {
7435                 my $rdata = $remotedata->{$remote};
7436                 my $fetch = $rdata->{'fetch'};
7437                 my $push = $rdata->{'push'};
7438                 if ($alternate) {
7439                         print "<tr class=\"dark\">\n";
7440                 } else {
7441                         print "<tr class=\"light\">\n";
7442                 }
7443                 $alternate ^= 1;
7444                 print "<td>" .
7445                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
7446                                -class=> "list name"},esc_html($remote)) .
7447                       "</td>";
7448                 print "<td class=\"link\">" .
7449                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
7450                       $barsep .
7451                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
7452                       "</td>";
7453
7454                 print "</tr>\n";
7455         }
7456
7457         if ($limited) {
7458                 print "<tr>\n" .
7459                       "<td colspan=\"3\">" .
7460                       $cgi->a({-href => href(action=>"remotes")}, "...") .
7461                       "</td>\n" . "</tr>\n";
7462         }
7463
7464         print "</table>";
7465 }
7466
7467 # Display remote heads grouped by remote, unless there are too many
7468 # remotes, in which case we only display the remote names
7469 sub git_remotes_body {
7470         my ($remotedata, $limit, $head) = @_;
7471         if ($limit and $limit < keys %$remotedata) {
7472                 git_remotes_list($remotedata, $limit);
7473         } else {
7474                 fill_remote_heads($remotedata);
7475                 while (my ($remote, $rdata) = each %$remotedata) {
7476                         git_print_section({-class=>"remote", -id=>$remote},
7477                                 ["remotes", $remote, $remote], sub {
7478                                         git_remote_block($remote, $rdata, $limit, $head);
7479                                 });
7480                 }
7481         }
7482 }
7483
7484 sub git_search_message {
7485         my %co = @_;
7486
7487         my $greptype;
7488         if ($searchtype eq 'commit') {
7489                 $greptype = "--grep=";
7490         } elsif ($searchtype eq 'author') {
7491                 $greptype = "--author=";
7492         } elsif ($searchtype eq 'committer') {
7493                 $greptype = "--committer=";
7494         }
7495         $greptype .= $searchtext;
7496         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
7497                                        $greptype, '--regexp-ignore-case',
7498                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
7499
7500         my $paging_nav = "<span class=\"paging_nav\">";
7501         if ($page > 0) {
7502                 $paging_nav .= tabspan(
7503                         $cgi->a({-href => href(-replay=>1, page=>undef)},
7504                                 "first")) .
7505                         $mdotsep . tabspan(
7506                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
7507                                  -accesskey => "p", -title => "Alt-p"}, "prev"));
7508         } else {
7509                 $paging_nav .= tabspan("first", 1, 0).${mdotsep}.tabspan("prev", 0, 1);
7510         }
7511         my $next_link = '';
7512         if ($#commitlist >= 100) {
7513                 $next_link = tabspan(
7514                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7515                                  -accesskey => "n", -title => "Alt-n"}, "next"));
7516                 $paging_nav .= "${mdotsep}$next_link";
7517         } else {
7518                 $paging_nav .= ${mdotsep}.tabspan("next", 0, 1);
7519         }
7520
7521         git_header_html();
7522
7523         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav."</span>");
7524         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7525         if ($page == 0 && !@commitlist) {
7526                 print "<p>No match.</p>\n";
7527         } else {
7528                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
7529         }
7530
7531         git_footer_html();
7532 }
7533
7534 sub git_search_changes {
7535         my %co = @_;
7536
7537         local $/ = "\n";
7538         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
7539                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
7540                 ($search_use_regexp ? '--pickaxe-regex' : ()))
7541                         or die_error(500, "Open git-log failed");
7542
7543         git_header_html();
7544
7545         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7546         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7547
7548         print "<table class=\"pickaxe search\">\n";
7549         my $alternate = 1;
7550         undef %co;
7551         my @files;
7552         while (my $line = to_utf8(scalar <$fd>)) {
7553                 chomp $line;
7554                 next unless $line;
7555
7556                 my %set = parse_difftree_raw_line($line);
7557                 if (defined $set{'commit'}) {
7558                         # finish previous commit
7559                         if (%co) {
7560                                 print "</td>\n" .
7561                                       "<td class=\"link\">" .
7562                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7563                                               "commit") .
7564                                       $barsep .
7565                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7566                                                              hash_base=>$co{'id'})},
7567                                               "tree") .
7568                                       "</td>\n" .
7569                                       "</tr>\n";
7570                         }
7571
7572                         if ($alternate) {
7573                                 print "<tr class=\"dark\">\n";
7574                         } else {
7575                                 print "<tr class=\"light\">\n";
7576                         }
7577                         $alternate ^= 1;
7578                         %co = parse_commit($set{'commit'});
7579                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
7580                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7581                               "<td><i>$author</i></td>\n" .
7582                               "<td>" .
7583                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7584                                       -class => "list subject"},
7585                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
7586                 } elsif (defined $set{'to_id'}) {
7587                         next if ($set{'to_id'} =~ m/^0{40}$/);
7588
7589                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
7590                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
7591                                       -class => "list"},
7592                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
7593                               "<br/>\n";
7594                 }
7595         }
7596         close $fd;
7597
7598         # finish last commit (warning: repetition!)
7599         if (%co) {
7600                 print "</td>\n" .
7601                       "<td class=\"link\">" .
7602                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7603                               "commit") .
7604                       $barsep .
7605                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7606                                              hash_base=>$co{'id'})},
7607                               "tree") .
7608                       "</td>\n" .
7609                       "</tr>\n";
7610         }
7611
7612         print "</table>\n";
7613
7614         git_footer_html();
7615 }
7616
7617 sub git_search_files {
7618         my %co = @_;
7619
7620         local $/ = "\n";
7621         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
7622                 $search_use_regexp ? ('-E', '-i') : '-F',
7623                 $searchtext, $co{'tree'})
7624                         or die_error(500, "Open git-grep failed");
7625
7626         git_header_html();
7627
7628         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7629         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7630
7631         print "<table class=\"grep_search\">\n";
7632         my $alternate = 1;
7633         my $matches = 0;
7634         my $lastfile = '';
7635         my $file_href;
7636         while (my $line = to_utf8(scalar <$fd>)) {
7637                 chomp $line;
7638                 my ($file, $lno, $ltext, $binary);
7639                 last if ($matches++ > 1000);
7640                 if ($line =~ /^Binary file (.+) matches$/) {
7641                         $file = $1;
7642                         $binary = 1;
7643                 } else {
7644                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
7645                         $file =~ s/^$co{'tree'}://;
7646                 }
7647                 if ($file ne $lastfile) {
7648                         $lastfile and print "</td></tr>\n";
7649                         if ($alternate++) {
7650                                 print "<tr class=\"dark\">\n";
7651                         } else {
7652                                 print "<tr class=\"light\">\n";
7653                         }
7654                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
7655                                           file_name=>$file);
7656                         print "<td class=\"list\">".
7657                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
7658                         print "</td><td>\n";
7659                         $lastfile = $file;
7660                 }
7661                 if ($binary) {
7662                         print "<div class=\"binary\">Binary file</div>\n";
7663                 } else {
7664                         $ltext = untabify($ltext);
7665                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
7666                                 $ltext = esc_html($1, -nbsp=>1);
7667                                 $ltext .= '<span class="match">';
7668                                 $ltext .= esc_html($2, -nbsp=>1);
7669                                 $ltext .= '</span>';
7670                                 $ltext .= esc_html($3, -nbsp=>1);
7671                         } else {
7672                                 $ltext = esc_html($ltext, -nbsp=>1);
7673                         }
7674                         print "<div class=\"pre\">" .
7675                                 $cgi->a({-href => $file_href.'#l'.$lno,
7676                                         -class => "linenr"}, sprintf('%4i ', $lno)) .
7677                                 $ltext . "</div>\n";
7678                 }
7679         }
7680         if ($lastfile) {
7681                 print "</td></tr>\n";
7682                 if ($matches > 1000) {
7683                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
7684                 }
7685         } else {
7686                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
7687         }
7688         close $fd;
7689
7690         print "</table>\n";
7691
7692         git_footer_html();
7693 }
7694
7695 sub git_search_grep_body {
7696         my ($commitlist, $from, $to, $extra) = @_;
7697         $from = 0 unless defined $from;
7698         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7699
7700         print "<table class=\"commit_search\">\n";
7701         my $alternate = 1;
7702         for (my $i = $from; $i <= $to; $i++) {
7703                 my %co = %{$commitlist->[$i]};
7704                 if (!%co) {
7705                         next;
7706                 }
7707                 my $commit = $co{'id'};
7708                 if ($alternate) {
7709                         print "<tr class=\"dark\">\n";
7710                 } else {
7711                         print "<tr class=\"light\">\n";
7712                 }
7713                 $alternate ^= 1;
7714                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7715                       format_author_html('td', \%co, 15, 5) .
7716                       "<td>" .
7717                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7718                                -class => "list subject"},
7719                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
7720                 my $comment = $co{'comment'};
7721                 foreach my $line (@$comment) {
7722                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
7723                                 my ($lead, $match, $trail) = ($1, $2, $3);
7724                                 $match = chop_str($match, 70, 5, 'center');
7725                                 my $contextlen = int((80 - length($match))/2);
7726                                 $contextlen = 30 if ($contextlen > 30);
7727                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
7728                                 $trail = chop_str($trail, $contextlen, 10, 'right');
7729
7730                                 $lead  = esc_html($lead);
7731                                 $match = esc_html($match);
7732                                 $trail = esc_html($trail);
7733
7734                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
7735                         }
7736                 }
7737                 print "</td>\n" .
7738                       "<td class=\"link\">" .
7739                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7740                       $barsep .
7741                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7742                       $barsep .
7743                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7744                 print "</td>\n" .
7745                       "</tr>\n";
7746         }
7747         if (defined $extra) {
7748                 print "<tr class=\"extra\">\n" .
7749                       "<td colspan=\"3\" class=\"extra\">$extra</td>\n" .
7750                       "</tr>\n";
7751         }
7752         print "</table>\n";
7753 }
7754
7755 ## ======================================================================
7756 ## ======================================================================
7757 ## actions
7758
7759 sub git_project_list_load {
7760         my $empty_list_ok = shift;
7761         my $order = $input_params{'order'};
7762         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7763                 die_error(400, "Unknown order parameter");
7764         }
7765
7766         my @list = git_get_projects_list($project_filter, $strict_export);
7767         if ($project_filter && (!@list || !gitweb_check_feature('forks'))) {
7768                 push @list, { 'path' => "$project_filter.git" }
7769                         if is_valid_project("$project_filter.git");
7770         }
7771         if (!@list) {
7772                 die_error(404, "No projects found") unless $empty_list_ok;
7773         }
7774
7775         return (\@list, $order);
7776 }
7777
7778 sub git_frontpage {
7779         my ($projlist, $order);
7780
7781         if ($frontpage_no_project_list) {
7782                 $project = undef;
7783                 $project_filter = undef;
7784         } else {
7785                 ($projlist, $order) = git_project_list_load(1);
7786         }
7787         git_header_html();
7788         if (defined $home_text && -f $home_text) {
7789                 print "<div class=\"index_include\">\n";
7790                 insert_file($home_text);
7791                 print "</div>\n";
7792         }
7793         git_project_search_form($searchtext, $search_use_regexp);
7794         if ($frontpage_no_project_list) {
7795                 my $show_ctags = gitweb_check_feature('ctags');
7796                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7797                         my @projects = git_get_projects_list($project_filter, $strict_export);
7798                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7799                         @projects = fill_project_list_info(\@projects, 'ctags');
7800                         my $ctags = git_gather_all_ctags(\@projects);
7801                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7802                         print git_show_project_tagcloud($cloud, 64);
7803                 }
7804         } else {
7805                 git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7806         }
7807         git_footer_html();
7808 }
7809
7810 sub git_project_list {
7811         my ($projlist, $order) = git_project_list_load();
7812         git_header_html();
7813         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7814                 print "<div class=\"index_include\">\n";
7815                 insert_file($home_text);
7816                 print "</div>\n";
7817         }
7818         git_project_search_form();
7819         git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7820         git_footer_html();
7821 }
7822
7823 sub git_forks {
7824         my $order = $input_params{'order'};
7825         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7826                 die_error(400, "Unknown order parameter");
7827         }
7828
7829         my $filter = $project;
7830         $filter =~ s/\.git$//;
7831         my @list = git_get_projects_list($filter);
7832         if (!@list) {
7833                 die_error(404, "No forks found");
7834         }
7835
7836         git_header_html();
7837         git_print_page_nav('','');
7838         git_print_header_div('summary', "$project forks");
7839         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7840         git_footer_html();
7841 }
7842
7843 sub git_project_index {
7844         my @projects = git_get_projects_list($project_filter, $strict_export);
7845         if (!@projects) {
7846                 die_error(404, "No projects found");
7847         }
7848
7849         print $cgi->header(
7850                 -type => 'text/plain',
7851                 -charset => 'utf-8',
7852                 -content_disposition => 'inline; filename="index.aux"');
7853
7854         foreach my $pr (@projects) {
7855                 if (!exists $pr->{'owner'}) {
7856                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7857                 }
7858
7859                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7860                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7861                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7862                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7863                 $path  =~ s/ /\+/g;
7864                 $owner =~ s/ /\+/g;
7865
7866                 print "$path $owner\n";
7867         }
7868 }
7869
7870 sub git_summary {
7871         my $descr = git_get_project_description($project) || "none";
7872         my %co = parse_commit("HEAD");
7873         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7874         my $head = $co{'id'};
7875         my $remote_heads = gitweb_check_feature('remote_heads');
7876
7877         my $owner = git_get_project_owner($project);
7878         my $homepage = git_get_project_config('homepage');
7879         my $base_url = git_get_project_config('baseurl');
7880
7881         my $refs = git_get_references();
7882         # These get_*_list functions return one more to allow us to see if
7883         # there are more ...
7884         my @taglist  = git_get_tags_list(16);
7885         my @headlist = git_get_heads_list(16);
7886         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7887         my @forklist;
7888         my $check_forks = gitweb_check_feature('forks');
7889
7890         if ($check_forks) {
7891                 # find forks of a project
7892                 my $filter = $project;
7893                 $filter =~ s/\.git$//;
7894                 @forklist = git_get_projects_list($filter);
7895                 # filter out forks of forks
7896                 @forklist = filter_forks_from_projects_list(\@forklist)
7897                         if (@forklist);
7898         }
7899
7900         git_header_html();
7901         git_print_page_nav('summary','', $head);
7902
7903         if ($check_forks and $project =~ m#/#) {
7904                 my $xproject = $project; $xproject =~ s#/[^/]+$#.git#; #
7905                 if (is_valid_project($xproject)) {
7906                         my $r = $cgi->a({-href=> href(project => $xproject, action => 'summary')}, $xproject);
7907                         print <<EOT;
7908 <div class="forkinfo">
7909 This project is a fork of the $r project. If you have that one
7910 already cloned locally, you can use
7911 <pre>git clone --reference /path/to/your/$xproject/incarnation mirror_URL</pre>
7912 to save bandwidth during cloning.
7913 </div>
7914 EOT
7915                 }
7916         }
7917
7918         print "<div class=\"title\">&#160;</div>\n";
7919         print "<table class=\"projects_list\">\n" .
7920               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7921         if ($homepage) {
7922                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7923         }
7924         if ($base_url) {
7925                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7926         }
7927         if ($owner and not $omit_owner) {
7928                 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . ($owner_link_hook
7929                         ? $cgi->a({-href => $owner_link_hook->($owner)}, email_obfuscate($owner))
7930                         : email_obfuscate($owner)) . "</td></tr>\n";
7931         }
7932         if (defined $cd{'rfc2822'}) {
7933                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7934                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7935         }
7936         print format_lastrefresh_row(), "\n";
7937
7938         # use per project git URL list in $projectroot/$project/cloneurl
7939         # or make project git URL from git base URL and project name
7940         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7941         my $url_class = "metadata_url";
7942         my @url_list = git_get_project_url_list($project);
7943         unless (@url_list) {
7944                 @url_list = @git_base_url_list;
7945                 if ((git_get_project_config("showpush", '--bool')||'false') eq "true" ||
7946                     -f "$projectroot/$project/.nofetch") {
7947                         my $pushidx = @url_list;
7948                         foreach (@git_base_push_urls) {
7949                                 if ($https_hint_html && !ref($_) && $_ =~ /^https:/i) {
7950                                         push(@url_list, [$_, $https_hint_html]);
7951                                 } else {
7952                                         push(@url_list, $_);
7953                                 }
7954                         }
7955                         if ($#url_list >= $pushidx) {
7956                                 my $pushtag = "push&#160;URL";
7957                                 my $classtag = "metadata_pushurl";
7958                                 if (ref($url_list[$pushidx])) {
7959                                         $url_list[$pushidx] = [
7960                                                 ${$url_list[$pushidx]}[0],
7961                                                 ${$url_list[$pushidx]}[1],
7962                                                 $pushtag,
7963                                                 $classtag];
7964                                 } else {
7965                                         $url_list[$pushidx] = [
7966                                                 $url_list[$pushidx],
7967                                                 undef,
7968                                                 $pushtag,
7969                                                 $classtag];
7970                                 }
7971                         }
7972                 } else {
7973                         push(@url_list, @git_base_mirror_urls);
7974                 }
7975                 for (my $i=0; $i<=$#url_list; ++$i) {
7976                         if (ref($url_list[$i])) {
7977                                 $url_list[$i] = [
7978                                         ${$url_list[$i]}[0] . "/$project",
7979                                         ${$url_list[$i]}[1],
7980                                         ${$url_list[$i]}[2],
7981                                         ${$url_list[$i]}[3]];
7982                         } else {
7983                                 $url_list[$i] .= "/$project";
7984                         }
7985                 }
7986         }
7987         foreach (@url_list) {
7988                 next unless $_;
7989                 my $git_url;
7990                 my $html_hint = "";
7991                 my $next_tag = undef;
7992                 my $next_class = undef;
7993                 if (ref($_)) {
7994                         $git_url = $$_[0];
7995                         $html_hint = "&#160;" . $$_[1] if defined($$_[1]);
7996                         $next_tag = $$_[2];
7997                         $next_class = $$_[3];
7998                 } else {
7999                         $git_url = $_;
8000                 }
8001                 next unless $git_url;
8002                 $url_class = $next_class if $next_class;
8003                 $url_tag = $next_tag if $next_tag;
8004                 print "<tr class=\"$url_class\"><td>$url_tag</td><td>$git_url$html_hint</td></tr>\n";
8005                 $url_tag = "";
8006         }
8007
8008         if (defined($git_base_bundles_url) && -d "$projectroot/$project/bundles") {
8009                 my $projname = $project;
8010                 $projname =~ s|^.*/||;
8011                 my $url = "$git_base_bundles_url/$project/bundles";
8012                 print format_repo_url(
8013                         "bundle&#160;info",
8014                         "<a rel='nofollow' href='$url'>$projname downloadable bundles</a>");
8015         }
8016
8017         # Tag cloud
8018         my $show_ctags = gitweb_check_feature('ctags');
8019         if ($show_ctags) {
8020                 my $ctags = git_get_project_ctags($project);
8021                 if (%$ctags || $show_ctags !~ /^\d+$/) {
8022                         # without ability to add tags, don't show if there are none
8023                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
8024                         print "<tr id=\"metadata_ctags\">" .
8025                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
8026                         print "</td>\n<td>" unless %$ctags;
8027                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
8028                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
8029                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
8030                               unless $show_ctags =~ /^\d+$/;
8031                         print "</td>\n<td>" if %$ctags;
8032                         print git_show_project_tagcloud($cloud, 48)."</td>" .
8033                               "</tr>\n";
8034                 }
8035         }
8036
8037         print "</table>\n";
8038
8039         # If XSS prevention is on, we don't include README.html.
8040         # TODO: Allow a readme in some safe format.
8041         if (!$prevent_xss) {
8042                 my $readme_name = "readme";
8043                 my $readme;
8044                 if (-s "$projectroot/$project/README.html") {
8045                         $readme = collect_html_file("$projectroot/$project/README.html");
8046                 } else {
8047                         $readme = collect_output($git_automatic_readme_html, "$projectroot/$project");
8048                         if ($readme && $readme =~ /^<!-- README NAME: ((?:[^-]|(?:-(?!-)))+) -->/) {
8049                                 $readme_name = $1;
8050                                 $readme =~ s/^<!--(?:[^-]|(?:-(?!-)))*-->\n?//;
8051                         }
8052                 }
8053                 if (defined($readme)) {
8054                         $readme =~ s/^\s+//s;
8055                         $readme =~ s/\s+$//s;
8056                         print "<div class=\"title\">$readme_name</div>\n",
8057                               "<div id=\"readme\" class=\"readme\">\n",
8058                               $readme,
8059                               "\n</div>\n"
8060                         if $readme ne '';
8061                 }
8062         }
8063
8064         # we need to request one more than 16 (0..15) to check if
8065         # those 16 are all
8066         my @commitlist = $head ? parse_commits($head, 17) : ();
8067         if (@commitlist) {
8068                 git_print_header_div('shortlog');
8069                 git_shortlog_body(\@commitlist, 0, 15, $refs,
8070                                   $#commitlist <=  15 ? undef :
8071                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
8072         }
8073
8074         if (@taglist) {
8075                 git_print_header_div('tags');
8076                 git_tags_body(\@taglist, 0, 15,
8077                               $#taglist <=  15 ? undef :
8078                               $cgi->a({-href => href(action=>"tags")}, "..."));
8079         }
8080
8081         if (@headlist) {
8082                 git_print_header_div('heads');
8083                 git_heads_body(\@headlist, $head, 0, 15,
8084                                $#headlist <= 15 ? undef :
8085                                $cgi->a({-href => href(action=>"heads")}, "..."));
8086         }
8087
8088         if (%remotedata) {
8089                 git_print_header_div('remotes');
8090                 git_remotes_body(\%remotedata, 15, $head);
8091         }
8092
8093         if (@forklist) {
8094                 git_print_header_div('forks');
8095                 git_project_list_body(\@forklist, 'age', 0, 15,
8096                                       $#forklist <= 15 ? undef :
8097                                       $cgi->a({-href => href(action=>"forks")}, "..."),
8098                                       'no_header', 'forks');
8099         }
8100
8101         git_footer_html();
8102 }
8103
8104 sub git_tag {
8105         my %tag = parse_tag($hash);
8106
8107         if (! %tag) {
8108                 die_error(404, "Unknown tag object");
8109         }
8110
8111         my $fullhash;
8112         $fullhash = $hash if $hash =~ m/^[0-9a-fA-F]{40}$/;
8113         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8114
8115         my $obj = $tag{'object'};
8116         git_header_html();
8117         if ($tag{'type'} eq 'commit') {
8118                 git_print_page_nav('','', $obj,undef,$obj);
8119                 git_print_header_div('commit', esc_html($tag{'name'}), $hash);
8120         } else {
8121                 if ($tag{'type'} eq 'tree') {
8122                         git_print_page_nav('',['commit','commitdiff'], undef,undef,$obj);
8123                 } else {
8124                         git_print_page_nav('',['commit','commitdiff','tree'], undef,undef,undef);
8125                 }
8126                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8127         }
8128         print "<div class=\"title_text\">\n" .
8129               "<table class=\"object_header\">\n" .
8130               "<tr><td>tag</td><td class=\"sha1\">$fullhash</td></tr>\n" .
8131               "<tr>\n" .
8132               "<td>object</td>\n" .
8133               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
8134                                $tag{'object'}) . "</td>\n" .
8135               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
8136                                               $tag{'type'}) . "</td>\n" .
8137               "</tr>\n";
8138         if (defined($tag{'author'})) {
8139                 git_print_authorship_rows(\%tag, 'author');
8140         }
8141         print "</table>\n\n" .
8142               "</div>\n";
8143         print "<div class=\"page_body\">";
8144         my $comment = $tag{'comment'};
8145         foreach my $line (@$comment) {
8146                 chomp $line;
8147                 print esc_html($line, -nbsp=>1) . "<br/>\n";
8148         }
8149         print "</div>\n";
8150         git_footer_html();
8151 }
8152
8153 sub git_blame_common {
8154         my $format = shift || 'porcelain';
8155         if ($format eq 'porcelain' && $input_params{'javascript'}) {
8156                 $format = 'incremental';
8157                 $action = 'blame_incremental'; # for page title etc
8158         }
8159
8160         # permissions
8161         gitweb_check_feature('blame')
8162                 or die_error(403, "Blame view not allowed");
8163
8164         # error checking
8165         die_error(400, "No file name given") unless $file_name;
8166         $hash_base ||= git_get_head_hash($project);
8167         die_error(404, "Couldn't find base commit") unless $hash_base;
8168         my %co = parse_commit($hash_base)
8169                 or die_error(404, "Commit not found");
8170         my $ftype = "blob";
8171         if (!defined $hash) {
8172                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
8173                         or die_error(404, "Error looking up file");
8174         } else {
8175                 $ftype = git_get_type($hash);
8176                 if ($ftype !~ "blob") {
8177                         die_error(400, "Object is not a blob");
8178                 }
8179         }
8180
8181         my $fd;
8182         if ($format eq 'incremental') {
8183                 # get file contents (as base)
8184                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
8185                         or die_error(500, "Open git-cat-file failed");
8186         } elsif ($format eq 'data') {
8187                 # run git-blame --incremental
8188                 defined($fd = git_cmd_pipe "blame", "--incremental",
8189                         $hash_base, "--", $file_name)
8190                         or die_error(500, "Open git-blame --incremental failed");
8191         } else {
8192                 # run git-blame --porcelain
8193                 defined($fd = git_cmd_pipe "blame", '-p',
8194                         $hash_base, '--', $file_name)
8195                         or die_error(500, "Open git-blame --porcelain failed");
8196         }
8197
8198         # incremental blame data returns early
8199         if ($format eq 'data') {
8200                 print $cgi->header(
8201                         -type=>"text/plain", -charset => "utf-8",
8202                         -status=> "200 OK");
8203                 local $| = 1; # output autoflush
8204                 while (<$fd>) {
8205                         print to_utf8($_);
8206                 }
8207                 close $fd
8208                         or print "ERROR $!\n";
8209
8210                 print 'END';
8211                 if (defined $t0 && gitweb_check_feature('timed')) {
8212                         print ' '.
8213                               tv_interval($t0, [ gettimeofday() ]).
8214                               ' '.$number_of_git_cmds;
8215                 }
8216                 print "\n";
8217
8218                 return;
8219         }
8220
8221         # page header
8222         git_header_html();
8223         my $formats_nav = tabspan(
8224                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
8225                         "blob"));
8226         $formats_nav .=
8227                 $barsep . tabspan(
8228                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8229                         "history")) .
8230                 $barsep . tabspan(
8231                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
8232                         "HEAD"));
8233         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8234         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8235         git_print_page_path($file_name, $ftype, $hash_base);
8236
8237         # page body
8238         if ($format eq 'incremental') {
8239                 print "<noscript>\n<div class=\"error\"><center><b>\n".
8240                       "This page requires JavaScript to run.\n Use ".
8241                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
8242                               'this page').
8243                       " instead.\n".
8244                       "</b></center></div>\n</noscript>\n";
8245
8246                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
8247         }
8248
8249         print qq!<div class="page_body">\n!;
8250         print qq!<div id="progress_info">... / ...</div>\n!
8251                 if ($format eq 'incremental');
8252         print qq!<table id="blame_table" class="blame" width="100%">\n!.
8253               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
8254               qq!<thead>\n!.
8255               qq!<tr><th nowrap="nowrap" style="white-space:nowrap">!.
8256               qq!Commit&#160;<a href="javascript:extra_blame_columns()" id="columns_expander" !.
8257               qq!title="toggles blame author information display">[+]</a></th>!.
8258               qq!<th class="extra_column">Author</th><th class="extra_column">Date</th>!.
8259               qq!<th>Line</th><th width="100%">Data</th></tr>\n!.
8260               qq!</thead>\n!.
8261               qq!<tbody>\n!;
8262
8263         my @rev_color = qw(light dark);
8264         my $num_colors = scalar(@rev_color);
8265         my $current_color = 0;
8266
8267         if ($format eq 'incremental') {
8268                 my $color_class = $rev_color[$current_color];
8269
8270                 #contents of a file
8271                 my $linenr = 0;
8272         LINE:
8273                 while (my $line = to_utf8(scalar <$fd>)) {
8274                         chomp $line;
8275                         $linenr++;
8276
8277                         print qq!<tr id="l$linenr" class="$color_class">!.
8278                               qq!<td class="sha1"><a href=""> </a></td>!.
8279                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8280                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8281                               qq!<td class="linenr">!.
8282                               qq!<a class="linenr" href="">$linenr</a></td>!;
8283                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
8284                         print qq!</tr>\n!;
8285                 }
8286
8287         } else { # porcelain, i.e. ordinary blame
8288                 my %metainfo = (); # saves information about commits
8289
8290                 # blame data
8291         LINE:
8292                 while (my $line = to_utf8(scalar <$fd>)) {
8293                         chomp $line;
8294                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
8295                         # no <lines in group> for subsequent lines in group of lines
8296                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
8297                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
8298                         if (!exists $metainfo{$full_rev}) {
8299                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
8300                         }
8301                         my $meta = $metainfo{$full_rev};
8302                         my $data;
8303                         while ($data = to_utf8(scalar <$fd>)) {
8304                                 chomp $data;
8305                                 last if ($data =~ s/^\t//); # contents of line
8306                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
8307                                         $meta->{$1} = $2 unless exists $meta->{$1};
8308                                 }
8309                                 if ($data =~ /^previous /) {
8310                                         $meta->{'nprevious'}++;
8311                                 }
8312                         }
8313                         my $short_rev = substr($full_rev, 0, 8);
8314                         my $author = $meta->{'author'};
8315                         my %date =
8316                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
8317                         my $date = $date{'iso-tz'};
8318                         if ($group_size) {
8319                                 $current_color = ($current_color + 1) % $num_colors;
8320                         }
8321                         my $tr_class = $rev_color[$current_color];
8322                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
8323                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
8324                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
8325                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
8326                         if ($group_size) {
8327                                 my $rowspan = $group_size > 1 ? " rowspan=\"$group_size\"" : "";
8328                                 print "<td class=\"sha1\"";
8329                                 print " title=\"". esc_html($author) . ", $date\"";
8330                                 print "$rowspan>";
8331                                 print $cgi->a({-href => href(action=>"commit",
8332                                                              hash=>$full_rev,
8333                                                              file_name=>$file_name)},
8334                                               esc_html($short_rev));
8335                                 if ($group_size >= 2) {
8336                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
8337                                         if (@author_initials) {
8338                                                 print "<br />" .
8339                                                       esc_html(join('', @author_initials));
8340                                                 #           or join('.', ...)
8341                                         }
8342                                 }
8343                                 print "</td>\n";
8344                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". esc_html($author) . "</td>";
8345                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". $date . "</td>";
8346                         }
8347                         # 'previous' <sha1 of parent commit> <filename at commit>
8348                         if (exists $meta->{'previous'} &&
8349                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
8350                                 $meta->{'parent'} = $1;
8351                                 $meta->{'file_parent'} = unquote($2);
8352                         }
8353                         my $linenr_commit =
8354                                 exists($meta->{'parent'}) ?
8355                                 $meta->{'parent'} : $full_rev;
8356                         my $linenr_filename =
8357                                 exists($meta->{'file_parent'}) ?
8358                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
8359                         my $blamed = href(action => 'blame',
8360                                           file_name => $linenr_filename,
8361                                           hash_base => $linenr_commit);
8362                         print "<td class=\"linenr\">";
8363                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
8364                                         -class => "linenr" },
8365                                       esc_html($lineno));
8366                         print "</td>";
8367                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
8368                         print "</tr>\n";
8369                 } # end while
8370
8371         }
8372
8373         # footer
8374         print "</tbody>\n".
8375               "</table>\n"; # class="blame"
8376         print "</div>\n";   # class="blame_body"
8377         close $fd
8378                 or print "Reading blob failed\n";
8379
8380         git_footer_html();
8381 }
8382
8383 sub git_blame {
8384         git_blame_common();
8385 }
8386
8387 sub git_blame_incremental {
8388         git_blame_common('incremental');
8389 }
8390
8391 sub git_blame_data {
8392         git_blame_common('data');
8393 }
8394
8395 sub git_tags {
8396         my $head = git_get_head_hash($project);
8397         git_header_html();
8398         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
8399         git_print_header_div('summary', $project);
8400
8401         my @tagslist = git_get_tags_list();
8402         if (@tagslist) {
8403                 git_tags_body(\@tagslist);
8404         }
8405         git_footer_html();
8406 }
8407
8408 sub git_refs {
8409         my $order = $input_params{'order'};
8410         if (defined $order && $order !~ m/age|name/) {
8411                 die_error(400, "Unknown order parameter");
8412         }
8413
8414         my $head = git_get_head_hash($project);
8415         git_header_html();
8416         git_print_page_nav('','', $head,undef,$head,format_ref_views('refs'));
8417         git_print_header_div('summary', $project);
8418
8419         my @refslist = git_get_tags_list(undef, 1, $order);
8420         if (@refslist) {
8421                 git_tags_body(\@refslist, undef, undef, undef, $head, 1, $order);
8422         }
8423         git_footer_html();
8424 }
8425
8426 sub git_heads {
8427         my $head = git_get_head_hash($project);
8428         git_header_html();
8429         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
8430         git_print_header_div('summary', $project);
8431
8432         my @headslist = git_get_heads_list();
8433         if (@headslist) {
8434                 git_heads_body(\@headslist, $head);
8435         }
8436         git_footer_html();
8437 }
8438
8439 # used both for single remote view and for list of all the remotes
8440 sub git_remotes {
8441         gitweb_check_feature('remote_heads')
8442                 or die_error(403, "Remote heads view is disabled");
8443
8444         my $head = git_get_head_hash($project);
8445         my $remote = $input_params{'hash'};
8446
8447         my $remotedata = git_get_remotes_list($remote);
8448         die_error(500, "Unable to get remote information") unless defined $remotedata;
8449
8450         unless (%$remotedata) {
8451                 die_error(404, defined $remote ?
8452                         "Remote $remote not found" :
8453                         "No remotes found");
8454         }
8455
8456         git_header_html(undef, undef, -action_extra => $remote);
8457         git_print_page_nav('', '',  $head, undef, $head,
8458                 format_ref_views($remote ? '' : 'remotes'));
8459
8460         fill_remote_heads($remotedata);
8461         if (defined $remote) {
8462                 git_print_header_div('remotes', "$remote remote for $project");
8463                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
8464         } else {
8465                 git_print_header_div('summary', "$project remotes");
8466                 git_remotes_body($remotedata, undef, $head);
8467         }
8468
8469         git_footer_html();
8470 }
8471
8472 sub git_blob_plain {
8473         my $type = shift;
8474         my $expires;
8475
8476         if (!defined $hash) {
8477                 if (defined $file_name) {
8478                         my $base = $hash_base || git_get_head_hash($project);
8479                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8480                                 or die_error(404, "Cannot find file");
8481                 } else {
8482                         die_error(400, "No file name defined");
8483                 }
8484         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8485                 # blobs defined by non-textual hash id's can be cached
8486                 $expires = "+1d";
8487         }
8488
8489         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8490                 or die_error(500, "Open git-cat-file blob '$hash' failed");
8491         binmode($fd);
8492
8493         # content-type (can include charset)
8494         my $leader;
8495         ($type, $leader) = blob_contenttype($fd, $file_name, $type);
8496
8497         # "save as" filename, even when no $file_name is given
8498         my $save_as = "$hash";
8499         if (defined $file_name) {
8500                 $save_as = $file_name;
8501         } elsif ($type =~ m/^text\//) {
8502                 $save_as .= '.txt';
8503         }
8504
8505         # With XSS prevention on, blobs of all types except a few known safe
8506         # ones are served with "Content-Disposition: attachment" to make sure
8507         # they don't run in our security domain.  For certain image types,
8508         # blob view writes an <img> tag referring to blob_plain view, and we
8509         # want to be sure not to break that by serving the image as an
8510         # attachment (though Firefox 3 doesn't seem to care).
8511         my $sandbox = $prevent_xss &&
8512                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
8513
8514         # serve text/* as text/plain
8515         if ($prevent_xss &&
8516             ($type =~ m!^text/[a-z]+\b(.*)$! ||
8517              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
8518                 my $rest = $1;
8519                 $rest = defined $rest ? $rest : '';
8520                 $type = "text/plain$rest";
8521         }
8522
8523         print $cgi->header(
8524                 -type => $type,
8525                 -expires => $expires,
8526                 -content_disposition =>
8527                         ($sandbox ? 'attachment' : 'inline')
8528                         . '; filename="' . $save_as . '"');
8529         binmode STDOUT, ':raw';
8530         $fcgi_raw_mode = 1;
8531         print $leader if defined $leader;
8532         my $buf;
8533         while (read($fd, $buf, 32768)) {
8534                 print $buf;
8535         }
8536         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8537         $fcgi_raw_mode = 0;
8538         close $fd;
8539 }
8540
8541 sub git_blob {
8542         my $expires;
8543
8544         if (!defined $hash) {
8545                 if (defined $file_name) {
8546                         my $base = $hash_base || git_get_head_hash($project);
8547                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8548                                 or die_error(404, "Cannot find file");
8549                 } else {
8550                         die_error(400, "No file name defined");
8551                 }
8552         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8553                 # blobs defined by non-textual hash id's can be cached
8554                 $expires = "+1d";
8555         }
8556         my $fullhash = git_get_full_hash($project, "$hash^{blob}");
8557         die_error(404, "No such blob") unless defined($fullhash);
8558
8559         my $have_blame = gitweb_check_feature('blame');
8560         defined(my $fd = git_cmd_pipe "cat-file", "blob", $fullhash)
8561                 or die_error(500, "Couldn't cat $file_name, $hash");
8562         binmode($fd);
8563         my $mimetype = blob_mimetype($fd, $file_name);
8564         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
8565         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
8566                 close $fd;
8567                 return git_blob_plain($mimetype);
8568         }
8569         # we can have blame only for text/* mimetype
8570         $have_blame &&= ($mimetype =~ m!^text/!);
8571
8572         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
8573         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
8574         my $highlight_mode_active;
8575         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
8576
8577         git_header_html(undef, $expires);
8578         my $formats_nav = '';
8579         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8580                 if (defined $file_name) {
8581                         if ($have_blame) {
8582                                 $formats_nav .= tabspan(
8583                                         $cgi->a({-href => href(action=>"blame", -replay=>1),
8584                                                 -class => "blamelink"},
8585                                                 "blame")) .
8586                                         $barsep;
8587                         }
8588                         $formats_nav .= tabspan(
8589                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8590                                         "history")) .
8591                                 $barsep . tabspan(
8592                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8593                                         "raw")) .
8594                                 $barsep . tabspan(
8595                                 $cgi->a({-href => href(action=>"blob",
8596                                                        hash_base=>"HEAD", file_name=>$file_name)},
8597                                         "HEAD"));
8598                 } else {
8599                         $formats_nav .= tabspan(
8600                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8601                                         "raw"));
8602                 }
8603                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8604                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8605         } else {
8606                 git_print_page_nav('',['commit','commitdiff','tree'], undef,undef,undef);
8607                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8608         }
8609         git_print_page_path($file_name, "blob", $hash_base);
8610         print "<div class=\"title_text\">\n" .
8611               "<table class=\"object_header\">\n";
8612         print "<tr><td>blob</td><td class=\"sha1\">$fullhash</td></tr>\n";
8613         print "</table>".
8614               "</div>\n";
8615         print "<div class=\"page_body\">\n";
8616         if ($mimetype =~ m!^image/!) {
8617                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
8618                 if ($file_name) {
8619                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
8620                 }
8621                 print qq! src="! .
8622                       href(action=>"blob_plain", hash=>$hash,
8623                            hash_base=>$hash_base, file_name=>$file_name) .
8624                       qq!" />\n!;
8625                 close $fd; # ignore likely EPIPE error from child
8626         } else {
8627                 my $nr;
8628                 while (my $line = to_utf8(scalar <$fd>)) {
8629                         chomp $line;
8630                         $nr++;
8631                         $line = untabify($line);
8632                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i </a>%s</div>\n!,
8633                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
8634                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
8635                 }
8636                 close $fd
8637                         or print "Reading blob failed.\n";
8638         }
8639         print "</div>";
8640         git_footer_html();
8641 }
8642
8643 sub git_tree {
8644         if (!defined $hash_base) {
8645                 $hash_base = "HEAD";
8646         }
8647         if (!defined $hash) {
8648                 if (defined $file_name) {
8649                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
8650                 } else {
8651                         $hash = $hash_base;
8652                 }
8653         }
8654         die_error(404, "No such tree") unless defined($hash);
8655         my $fullhash = git_get_full_hash($project, "$hash^{tree}");
8656         die_error(404, "No such tree") unless defined($fullhash);
8657
8658         my $show_sizes = gitweb_check_feature('show-sizes');
8659         my $have_blame = gitweb_check_feature('blame');
8660
8661         my @entries = ();
8662         {
8663                 local $/ = "\0";
8664                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
8665                         ($show_sizes ? '-l' : ()), @extra_options, $fullhash)
8666                         or die_error(500, "Open git-ls-tree failed");
8667                 @entries = map { chomp; to_utf8($_) } <$fd>;
8668                 close $fd
8669                         or die_error(404, "Reading tree failed");
8670         }
8671
8672         git_header_html();
8673         my $basedir = '';
8674         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8675                 my $refs = git_get_references();
8676                 my $ref = format_ref_marker($refs, $co{'id'});
8677                 my @views_nav = ();
8678                 if (defined $file_name) {
8679                         push @views_nav,
8680                                 tabspan($cgi->a({-href => href(action=>"history", -replay=>1)},
8681                                                 "history")),
8682                                 tabspan($cgi->a({-href => href(action=>"tree",
8683                                                                hash_base=>"HEAD", file_name=>$file_name)},
8684                                                  "HEAD")),
8685                 }
8686                 my $snapshot_links = format_snapshot_links($hash);
8687                 if (defined $snapshot_links) {
8688                         # FIXME: Should be available when we have no hash base as well.
8689                         push @views_nav, $snapshot_links;
8690                 }
8691                 git_print_page_nav('tree','', $hash_base, undef, undef,
8692                                    join($barsep, @views_nav));
8693                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base, undef, $ref);
8694         } else {
8695                 git_print_page_nav('tree',['commit','commitdiff'], undef,undef,$hash_base);
8696                 undef $hash_base;
8697                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8698         }
8699         if (defined $file_name) {
8700                 $basedir = $file_name;
8701                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
8702                         $basedir .= '/';
8703                 }
8704                 git_print_page_path($file_name, 'tree', $hash_base);
8705         }
8706         print "<div class=\"title_text\">\n" .
8707               "<table class=\"object_header\">\n";
8708         print "<tr><td>tree</td><td class=\"sha1\">$fullhash</td></tr>\n";
8709         print "</table>".
8710               "</div>\n";
8711         print "<div class=\"page_body\">\n";
8712         print "<table class=\"tree\">\n";
8713         my $alternate = 1;
8714         # '..' (top directory) link if possible
8715         if (defined $hash_base &&
8716             defined $file_name && $file_name =~ m![^/]+$!) {
8717                 if ($alternate) {
8718                         print "<tr class=\"dark\">\n";
8719                 } else {
8720                         print "<tr class=\"light\">\n";
8721                 }
8722                 $alternate ^= 1;
8723
8724                 my $up = $file_name;
8725                 $up =~ s!/?[^/]+$!!;
8726                 undef $up unless $up;
8727                 # based on git_print_tree_entry
8728                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
8729                 print '<td class="size">&#160;</td>'."\n" if $show_sizes;
8730                 print '<td class="list">';
8731                 print $cgi->a({-href => href(action=>"tree",
8732                                              hash_base=>$hash_base,
8733                                              file_name=>$up)},
8734                               "..");
8735                 print "</td>\n";
8736                 print "<td class=\"link\"></td>\n";
8737
8738                 print "</tr>\n";
8739         }
8740         foreach my $line (@entries) {
8741                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
8742
8743                 if ($alternate) {
8744                         print "<tr class=\"dark\">\n";
8745                 } else {
8746                         print "<tr class=\"light\">\n";
8747                 }
8748                 $alternate ^= 1;
8749
8750                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
8751
8752                 print "</tr>\n";
8753         }
8754         print "</table>\n" .
8755               "</div>";
8756         git_footer_html();
8757 }
8758
8759 sub sanitize_for_filename {
8760     my $name = shift;
8761
8762     $name =~ s!/!-!g;
8763     $name =~ s/[^[:alnum:]_.-]//g;
8764
8765     return $name;
8766 }
8767
8768 sub snapshot_name {
8769         my ($project, $hash) = @_;
8770
8771         # path/to/project.git  -> project
8772         # path/to/project/.git -> project
8773         my $name = to_utf8($project);
8774         $name =~ s,([^/])/*\.git$,$1,;
8775         $name = sanitize_for_filename(basename($name));
8776
8777         my $ver = $hash;
8778         if ($hash =~ /^[0-9a-fA-F]+$/) {
8779                 # shorten SHA-1 hash
8780                 my $full_hash = git_get_full_hash($project, $hash);
8781                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
8782                         $ver = git_get_short_hash($project, $hash);
8783                 }
8784         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
8785                 # tags don't need shortened SHA-1 hash
8786                 $ver = $1;
8787         } else {
8788                 # branches and other need shortened SHA-1 hash
8789                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
8790                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
8791                         my $ref_dir = (defined $1) ? $1 : '';
8792                         $ver = $2;
8793
8794                         $ref_dir = sanitize_for_filename($ref_dir);
8795                         # for refs neither in heads nor remotes we want to
8796                         # add a ref dir to archive name
8797                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
8798                                 $ver = $ref_dir . '-' . $ver;
8799                         }
8800                 }
8801                 $ver .= '-' . git_get_short_hash($project, $hash);
8802         }
8803         # special case of sanitization for filename - we change
8804         # slashes to dots instead of dashes
8805         # in case of hierarchical branch names
8806         $ver =~ s!/!.!g;
8807         $ver =~ s/[^[:alnum:]_.-]//g;
8808
8809         # name = project-version_string
8810         $name = "$name-$ver";
8811
8812         return wantarray ? ($name, $name) : $name;
8813 }
8814
8815 sub exit_if_unmodified_since {
8816         my ($latest_epoch) = @_;
8817         our $cgi;
8818
8819         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
8820         if (defined $if_modified) {
8821                 my $since;
8822                 if (eval { require HTTP::Date; 1; }) {
8823                         $since = HTTP::Date::str2time($if_modified);
8824                 } elsif (eval { require Time::ParseDate; 1; }) {
8825                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
8826                 }
8827                 if (defined $since && $latest_epoch <= $since) {
8828                         my %latest_date = parse_date($latest_epoch);
8829                         print $cgi->header(
8830                                 -last_modified => $latest_date{'rfc2822'},
8831                                 -status => '304 Not Modified');
8832                         CORE::die;
8833                 }
8834         }
8835 }
8836
8837 sub git_snapshot {
8838         my $format = $input_params{'snapshot_format'};
8839         if (!@snapshot_fmts) {
8840                 die_error(403, "Snapshots not allowed");
8841         }
8842         # default to first supported snapshot format
8843         $format ||= $snapshot_fmts[0];
8844         if ($format !~ m/^[a-z0-9]+$/) {
8845                 die_error(400, "Invalid snapshot format parameter");
8846         } elsif (!exists($known_snapshot_formats{$format})) {
8847                 die_error(400, "Unknown snapshot format");
8848         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
8849                 die_error(403, "Snapshot format not allowed");
8850         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
8851                 die_error(403, "Unsupported snapshot format");
8852         }
8853
8854         my $type = git_get_type("$hash^{}");
8855         if (!$type) {
8856                 die_error(404, 'Object does not exist');
8857         }  elsif ($type eq 'blob') {
8858                 die_error(400, 'Object is not a tree-ish');
8859         }
8860
8861         my ($name, $prefix) = snapshot_name($project, $hash);
8862         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
8863
8864         my %co = parse_commit($hash);
8865         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
8866
8867         my @cmd = (
8868                 git_cmd(), 'archive',
8869                 "--format=$known_snapshot_formats{$format}{'format'}",
8870                 "--prefix=$prefix/", $hash);
8871         if (exists $known_snapshot_formats{$format}{'compressor'}) {
8872                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
8873                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
8874         }
8875
8876         $filename =~ s/(["\\])/\\$1/g;
8877         my %latest_date;
8878         if (%co) {
8879                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
8880         }
8881
8882         print $cgi->header(
8883                 -type => $known_snapshot_formats{$format}{'type'},
8884                 -content_disposition => 'inline; filename="' . $filename . '"',
8885                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8886                 -status => '200 OK');
8887
8888         defined(my $fd = cmd_pipe @cmd)
8889                 or die_error(500, "Execute git-archive failed");
8890         binmode($fd);
8891         binmode STDOUT, ':raw';
8892         $fcgi_raw_mode = 1;
8893         my $buf;
8894         while (read($fd, $buf, 32768)) {
8895                 print $buf;
8896         }
8897         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8898         $fcgi_raw_mode = 0;
8899         close $fd;
8900 }
8901
8902 sub git_log_generic {
8903         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8904
8905         my $head = git_get_head_hash($project);
8906         if (!defined $base) {
8907                 $base = $head;
8908         }
8909         if (!defined $page) {
8910                 $page = 0;
8911         }
8912         my $refs = git_get_references();
8913
8914         my $commit_hash = $base;
8915         if (defined $parent) {
8916                 $commit_hash = "$parent..$base";
8917         }
8918         my @commitlist =
8919                 parse_commits($commit_hash, 101, (100 * $page),
8920                               defined $file_name ? ($file_name, "--full-history") : ());
8921
8922         my $ftype;
8923         if (!defined $file_hash && defined $file_name) {
8924                 # some commits could have deleted file in question,
8925                 # and not have it in tree, but one of them has to have it
8926                 for (my $i = 0; $i < @commitlist; $i++) {
8927                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8928                         last if defined $file_hash;
8929                 }
8930         }
8931         if (defined $file_hash) {
8932                 $ftype = git_get_type($file_hash);
8933         }
8934         if (defined $file_name && !defined $ftype) {
8935                 die_error(500, "Unknown type of object");
8936         }
8937         my %co;
8938         if (defined $file_name) {
8939                 %co = parse_commit($base)
8940                         or die_error(404, "Unknown commit object");
8941         }
8942
8943
8944         my $next_link = '';
8945         if ($#commitlist >= 100) {
8946                 $next_link =
8947                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8948                                  -accesskey => "n", -title => "Alt-n"}, "next");
8949         }
8950         my $extra = '';
8951         my ($patch_max) = gitweb_get_feature('patches');
8952         if ($patch_max && !defined $file_name) {
8953                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8954                         $extra = $cgi->a({-href => href(action=>"patches", -replay=>1)},
8955                                         "patches");
8956                 }
8957         }
8958         my $paging_nav = format_log_nav($fmt_name, $page, $#commitlist >= 100, $extra);
8959
8960         {
8961                 local $action = 'log';
8962                 git_header_html();
8963         }
8964         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8965         if (defined $file_name) {
8966                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8967         } else {
8968                 git_print_header_div('summary', $project)
8969         }
8970         git_print_page_path($file_name, $ftype, $hash_base)
8971                 if (defined $file_name);
8972
8973         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8974                      $file_name, $file_hash, $ftype);
8975
8976         git_footer_html();
8977 }
8978
8979 sub git_log {
8980         git_log_generic('log', \&git_log_body,
8981                         $hash, $hash_parent);
8982 }
8983
8984 sub git_commit {
8985         $hash ||= $hash_base || "HEAD";
8986         my %co = parse_commit($hash)
8987             or die_error(404, "Unknown commit object");
8988
8989         my $parent  = $co{'parent'};
8990         my $parents = $co{'parents'}; # listref
8991
8992         # we need to prepare $formats_nav before any parameter munging
8993         my $formats_nav;
8994         if (!defined $parent) {
8995                 # --root commitdiff
8996                 $formats_nav .= '<span class="parents none">(initial)</span>';
8997         } elsif (@$parents == 1) {
8998                 # single parent commit
8999                 $formats_nav .=
9000                         '<span class="parents single">(parent:&#160;' .
9001                         $cgi->a({-href => href(action=>"commit",
9002                                                hash=>$parent)},
9003                                 esc_html(substr($parent, 0, 7))) .
9004                         ')</span>';
9005         } else {
9006                 # merge commit
9007                 $formats_nav .=
9008                         '<span class="parents multiple">(merge:&#160;' .
9009                         join(' ', map {
9010                                 $cgi->a({-href => href(action=>"commit",
9011                                                        hash=>$_)},
9012                                         esc_html(substr($_, 0, 7)));
9013                         } @$parents ) .
9014                         ')</span>';
9015         }
9016         if (gitweb_check_feature('patches') && @$parents <= 1) {
9017                 $formats_nav .= $barsep . tabspan(
9018                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
9019                                 "patch"));
9020         }
9021
9022         if (!defined $parent) {
9023                 $parent = "--root";
9024         }
9025         my @difftree;
9026         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
9027                 @diff_opts,
9028                 (@$parents <= 1 ? $parent : '-c'),
9029                 $hash, "--")
9030                 or die_error(500, "Open git-diff-tree failed");
9031         @difftree = map { chomp; to_utf8($_) } <$fd>;
9032         close $fd or die_error(404, "Reading git-diff-tree failed");
9033
9034         # non-textual hash id's can be cached
9035         my $expires;
9036         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9037                 $expires = "+1d";
9038         }
9039         my $refs = git_get_references();
9040         my $ref = format_ref_marker($refs, $co{'id'});
9041
9042         git_header_html(undef, $expires);
9043         git_print_page_nav('commit', '',
9044                            $hash, $co{'tree'}, $hash,
9045                            $formats_nav);
9046
9047         if (defined $co{'parent'}) {
9048                 git_print_header_div('commitdiff', esc_html($co{'title'}), $hash, undef, $ref);
9049         } else {
9050                 git_print_header_div('tree', esc_html($co{'title'}), $co{'tree'}, $hash, $ref);
9051         }
9052         print "<div class=\"title_text\">\n" .
9053               "<table class=\"object_header\">\n";
9054         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
9055         git_print_authorship_rows(\%co);
9056         print "<tr>" .
9057               "<td>tree</td>" .
9058               "<td class=\"sha1\">" .
9059               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
9060                        class => "list"}, $co{'tree'}) .
9061               "</td>" .
9062               "<td class=\"link\">" .
9063               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
9064                       "tree");
9065         my $snapshot_links = format_snapshot_links($hash);
9066         if (defined $snapshot_links) {
9067                 print $barsep . $snapshot_links;
9068         }
9069         print "</td>" .
9070               "</tr>\n";
9071
9072         foreach my $par (@$parents) {
9073                 print "<tr>" .
9074                       "<td>parent</td>" .
9075                       "<td class=\"sha1\">" .
9076                       $cgi->a({-href => href(action=>"commit", hash=>$par),
9077                                class => "list"}, $par) .
9078                       "</td>" .
9079                       "<td class=\"link\">" .
9080                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
9081                       $barsep .
9082                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
9083                       "</td>" .
9084                       "</tr>\n";
9085         }
9086         print "</table>".
9087               "</div>\n";
9088
9089         print "<div class=\"page_body\">\n";
9090         git_print_log($co{'comment'});
9091         print "</div>\n";
9092
9093         git_difftree_body(\@difftree, $hash, @$parents);
9094
9095         git_footer_html();
9096 }
9097
9098 sub git_object {
9099         # object is defined by:
9100         # - hash or hash_base alone
9101         # - hash_base and file_name
9102         my $type;
9103
9104         # - hash or hash_base alone
9105         if ($hash || ($hash_base && !defined $file_name)) {
9106                 my $object_id = $hash || $hash_base;
9107
9108                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
9109                         or die_error(404, "Object does not exist");
9110                 $type = <$fd>;
9111                 defined $type && chomp $type;
9112                 close $fd
9113                         or die_error(404, "Object does not exist");
9114
9115         # - hash_base and file_name
9116         } elsif ($hash_base && defined $file_name) {
9117                 $file_name =~ s,/+$,,;
9118
9119                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
9120                         or die_error(404, "Base object does not exist");
9121
9122                 # here errors should not happen
9123                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
9124                         or die_error(500, "Open git-ls-tree failed");
9125                 my $line = to_utf8(scalar <$fd>);
9126                 close $fd;
9127
9128                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
9129                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
9130                         die_error(404, "File or directory for given base does not exist");
9131                 }
9132                 $type = $2;
9133                 $hash = $3;
9134         } else {
9135                 die_error(400, "Not enough information to find object");
9136         }
9137
9138         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
9139                                           hash=>$hash, hash_base=>$hash_base,
9140                                           file_name=>$file_name),
9141                              -status => '302 Found');
9142 }
9143
9144 sub git_blobdiff {
9145         my $format = shift || 'html';
9146         my $diff_style = $input_params{'diff_style'} || 'inline';
9147
9148         my $fd;
9149         my @difftree;
9150         my %diffinfo;
9151         my $expires;
9152
9153         # preparing $fd and %diffinfo for git_patchset_body
9154         # new style URI
9155         if (defined $hash_base && defined $hash_parent_base) {
9156                 if (defined $file_name) {
9157                         # read raw output
9158                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9159                                 $hash_parent_base, $hash_base,
9160                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
9161                                 or die_error(500, "Open git-diff-tree failed");
9162                         @difftree = map { chomp; to_utf8($_) } <$fd>;
9163                         close $fd
9164                                 or die_error(404, "Reading git-diff-tree failed");
9165                         @difftree
9166                                 or die_error(404, "Blob diff not found");
9167
9168                 } elsif (defined $hash &&
9169                          $hash =~ /[0-9a-fA-F]{40}/) {
9170                         # try to find filename from $hash
9171
9172                         # read filtered raw output
9173                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9174                                 $hash_parent_base, $hash_base, "--")
9175                                 or die_error(500, "Open git-diff-tree failed");
9176                         @difftree =
9177                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
9178                                 # $hash == to_id
9179                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
9180                                 map { chomp; to_utf8($_) } <$fd>;
9181                         close $fd
9182                                 or die_error(404, "Reading git-diff-tree failed");
9183                         @difftree
9184                                 or die_error(404, "Blob diff not found");
9185
9186                 } else {
9187                         die_error(400, "Missing one of the blob diff parameters");
9188                 }
9189
9190                 if (@difftree > 1) {
9191                         die_error(400, "Ambiguous blob diff specification");
9192                 }
9193
9194                 %diffinfo = parse_difftree_raw_line($difftree[0]);
9195                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
9196                 $file_name   ||= $diffinfo{'to_file'};
9197
9198                 $hash_parent ||= $diffinfo{'from_id'};
9199                 $hash        ||= $diffinfo{'to_id'};
9200
9201                 # non-textual hash id's can be cached
9202                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
9203                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
9204                         $expires = '+1d';
9205                 }
9206
9207                 # open patch output
9208                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9209                         '-p', ($format eq 'html' ? "--full-index" : ()),
9210                         $hash_parent_base, $hash_base,
9211                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
9212                         or die_error(500, "Open git-diff-tree failed");
9213         }
9214
9215         # old/legacy style URI -- not generated anymore since 1.4.3.
9216         if (!%diffinfo) {
9217                 die_error('404 Not Found', "Missing one of the blob diff parameters")
9218         }
9219
9220         # header
9221         if ($format eq 'html') {
9222                 my $formats_nav =
9223                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
9224                                 "raw");
9225                 $formats_nav .= diff_style_nav($diff_style);
9226                 git_header_html(undef, $expires);
9227                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
9228                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
9229                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
9230                 } else {
9231                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
9232                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
9233                 }
9234                 if (defined $file_name) {
9235                         git_print_page_path($file_name, "blob", $hash_base);
9236                 } else {
9237                         print "<div class=\"page_path\"></div>\n";
9238                 }
9239
9240         } elsif ($format eq 'plain') {
9241                 print $cgi->header(
9242                         -type => 'text/plain',
9243                         -charset => 'utf-8',
9244                         -expires => $expires,
9245                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
9246
9247                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9248
9249         } else {
9250                 die_error(400, "Unknown blobdiff format");
9251         }
9252
9253         # patch
9254         if ($format eq 'html') {
9255                 print "<div class=\"page_body\">\n";
9256
9257                 git_patchset_body($fd, $diff_style,
9258                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
9259                 close $fd;
9260
9261                 print "</div>\n"; # class="page_body"
9262                 git_footer_html();
9263
9264         } else {
9265                 while (my $line = to_utf8(scalar <$fd>)) {
9266                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
9267                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
9268
9269                         print $line;
9270
9271                         last if $line =~ m!^\+\+\+!;
9272                 }
9273                 while (<$fd>) {
9274                         print to_utf8($_);
9275                 }
9276                 close $fd;
9277         }
9278 }
9279
9280 sub git_blobdiff_plain {
9281         git_blobdiff('plain');
9282 }
9283
9284 # assumes that it is added as later part of already existing navigation,
9285 # so it returns "| foo | bar" rather than just "foo | bar"
9286 sub diff_style_nav {
9287         my ($diff_style, $is_combined) = @_;
9288         $diff_style ||= 'inline';
9289
9290         return "" if ($is_combined);
9291
9292         my @styles = (inline => 'inline', 'sidebyside' => 'side&#160;by&#160;side');
9293         my %styles = @styles;
9294         @styles =
9295                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
9296
9297         return $barsep . '<span class="diffstyles">' . join($barsep,
9298                 map {
9299                         $_ eq $diff_style ?
9300                         '<span class="diffstyle selected">' . $styles{$_} . '</span>' :
9301                         '<span class="diffstyle">' .
9302                                 $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_}) .
9303                                 '</span>'
9304                 } @styles) . '</span>';
9305 }
9306
9307 sub git_commitdiff {
9308         my %params = @_;
9309         my $format = $params{-format} || 'html';
9310         my $diff_style = $input_params{'diff_style'} || 'inline';
9311
9312         my ($patch_max) = gitweb_get_feature('patches');
9313         if ($format eq 'patch') {
9314                 die_error(403, "Patch view not allowed") unless $patch_max;
9315         }
9316
9317         $hash ||= $hash_base || "HEAD";
9318         my %co = parse_commit($hash)
9319             or die_error(404, "Unknown commit object");
9320
9321         # choose format for commitdiff for merge
9322         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
9323                 $hash_parent = '--cc';
9324         }
9325         # we need to prepare $formats_nav before almost any parameter munging
9326         my $formats_nav;
9327         if ($format eq 'html') {
9328                 $formats_nav = tabspan(
9329                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
9330                                 "raw"));
9331                 if ($patch_max && @{$co{'parents'}} <= 1) {
9332                         $formats_nav .= $barsep . tabspan(
9333                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
9334                                         "patch"));
9335                 }
9336                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
9337
9338                 if (defined $hash_parent &&
9339                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
9340                         # commitdiff with two commits given
9341                         my $hash_parent_short = $hash_parent;
9342                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
9343                                 $hash_parent_short = substr($hash_parent, 0, 7);
9344                         }
9345                         $formats_nav .= $spcsep . '<span class="parents multiple">' .
9346                                 '(from';
9347                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
9348                                 if ($co{'parents'}[$i] eq $hash_parent) {
9349                                         $formats_nav .= '&#160;parent&#160;' . ($i+1);
9350                                         last;
9351                                 }
9352                         }
9353                         $formats_nav .= ':&#160;' .
9354                                 $cgi->a({-href => href(-replay=>1,
9355                                                        hash=>$hash_parent, hash_base=>undef)},
9356                                         esc_html($hash_parent_short)) .
9357                                 ')</span>';
9358                 } elsif (!$co{'parent'}) {
9359                         # --root commitdiff
9360                         $formats_nav .= $spcsep . '<span class="parents none">(initial)</span>';
9361                 } elsif (scalar @{$co{'parents'}} == 1) {
9362                         # single parent commit
9363                         $formats_nav .= $spcsep .
9364                                 '<span class="parents single">(parent:&#160;' .
9365                                 $cgi->a({-href => href(-replay=>1,
9366                                                        hash=>$co{'parent'}, hash_base=>undef)},
9367                                         esc_html(substr($co{'parent'}, 0, 7))) .
9368                                 ')</span>';
9369                 } else {
9370                         # merge commit
9371                         if ($hash_parent eq '--cc') {
9372                                 $formats_nav .= $barsep . tabspan(
9373                                         $cgi->a({-href => href(-replay=>1,
9374                                                                hash=>$hash, hash_parent=>'-c')},
9375                                                 'combined'));
9376                         } else { # $hash_parent eq '-c'
9377                                 $formats_nav .= $barsep . tabspan(
9378                                         $cgi->a({-href => href(-replay=>1,
9379                                                                hash=>$hash, hash_parent=>'--cc')},
9380                                                 'compact'));
9381                         }
9382                         $formats_nav .= $spcsep .
9383                                 '<span class="parents multiple">(merge:&#160;' .
9384                                 join(' ', map {
9385                                         $cgi->a({-href => href(-replay=>1,
9386                                                                hash=>$_, hash_base=>undef)},
9387                                                 esc_html(substr($_, 0, 7)));
9388                                 } @{$co{'parents'}} ) .
9389                                 ')</span>';
9390                 }
9391         }
9392
9393         my $hash_parent_param = $hash_parent;
9394         if (!defined $hash_parent_param) {
9395                 # --cc for multiple parents, --root for parentless
9396                 $hash_parent_param =
9397                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
9398         }
9399
9400         # read commitdiff
9401         my $fd;
9402         my @difftree;
9403         if ($format eq 'html') {
9404                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9405                         "--no-commit-id", "--patch-with-raw", "--full-index",
9406                         $hash_parent_param, $hash, "--")
9407                         or die_error(500, "Open git-diff-tree failed");
9408
9409                 while (my $line = to_utf8(scalar <$fd>)) {
9410                         chomp $line;
9411                         # empty line ends raw part of diff-tree output
9412                         last unless $line;
9413                         push @difftree, scalar parse_difftree_raw_line($line);
9414                 }
9415
9416         } elsif ($format eq 'plain') {
9417                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9418                         '-p', $hash_parent_param, $hash, "--")
9419                         or die_error(500, "Open git-diff-tree failed");
9420         } elsif ($format eq 'patch') {
9421                 # For commit ranges, we limit the output to the number of
9422                 # patches specified in the 'patches' feature.
9423                 # For single commits, we limit the output to a single patch,
9424                 # diverging from the git-format-patch default.
9425                 my @commit_spec = ();
9426                 if ($hash_parent) {
9427                         if ($patch_max > 0) {
9428                                 push @commit_spec, "-$patch_max";
9429                         }
9430                         push @commit_spec, '-n', "$hash_parent..$hash";
9431                 } else {
9432                         if ($params{-single}) {
9433                                 push @commit_spec, '-1';
9434                         } else {
9435                                 if ($patch_max > 0) {
9436                                         push @commit_spec, "-$patch_max";
9437                                 }
9438                                 push @commit_spec, "-n";
9439                         }
9440                         push @commit_spec, '--root', $hash;
9441                 }
9442                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
9443                         '--encoding=utf8', '--stdout', @commit_spec)
9444                         or die_error(500, "Open git-format-patch failed");
9445         } else {
9446                 die_error(400, "Unknown commitdiff format");
9447         }
9448
9449         # non-textual hash id's can be cached
9450         my $expires;
9451         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9452                 $expires = "+1d";
9453         }
9454
9455         # write commit message
9456         if ($format eq 'html') {
9457                 my $refs = git_get_references();
9458                 my $ref = format_ref_marker($refs, $co{'id'});
9459
9460                 git_header_html(undef, $expires);
9461                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
9462                 git_print_header_div('commit', esc_html($co{'title'}), $hash, undef, $ref);
9463                 print "<div class=\"title_text\">\n" .
9464                       "<table class=\"object_header\">\n";
9465                 git_print_authorship_rows(\%co);
9466                 print "</table>".
9467                       "</div>\n";
9468                 print "<div class=\"page_body\">\n";
9469                 if (@{$co{'comment'}} > 1) {
9470                         print "<div class=\"log\">\n";
9471                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
9472                         print "</div>\n"; # class="log"
9473                 }
9474
9475         } elsif ($format eq 'plain') {
9476                 my $refs = git_get_references("tags");
9477                 my $tagname = git_get_rev_name_tags($hash);
9478                 my $filename = basename($project) . "-$hash.patch";
9479
9480                 print $cgi->header(
9481                         -type => 'text/plain',
9482                         -charset => 'utf-8',
9483                         -expires => $expires,
9484                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9485                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
9486                 print "From: " . to_utf8($co{'author'}) . "\n";
9487                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
9488                 print "Subject: " . to_utf8($co{'title'}) . "\n";
9489
9490                 print "X-Git-Tag: $tagname\n" if $tagname;
9491                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9492
9493                 foreach my $line (@{$co{'comment'}}) {
9494                         print to_utf8($line) . "\n";
9495                 }
9496                 print "---\n\n";
9497         } elsif ($format eq 'patch') {
9498                 my $filename = basename($project) . "-$hash.patch";
9499
9500                 print $cgi->header(
9501                         -type => 'text/plain',
9502                         -charset => 'utf-8',
9503                         -expires => $expires,
9504                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9505         }
9506
9507         # write patch
9508         if ($format eq 'html') {
9509                 my $use_parents = !defined $hash_parent ||
9510                         $hash_parent eq '-c' || $hash_parent eq '--cc';
9511                 git_difftree_body(\@difftree, $hash,
9512                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9513                 print "<br/>\n";
9514
9515                 git_patchset_body($fd, $diff_style,
9516                                   \@difftree, $hash,
9517                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9518                 close $fd;
9519                 print "</div>\n"; # class="page_body"
9520                 git_footer_html();
9521
9522         } elsif ($format eq 'plain') {
9523                 while (<$fd>) {
9524                         print to_utf8($_);
9525                 }
9526                 close $fd
9527                         or print "Reading git-diff-tree failed\n";
9528         } elsif ($format eq 'patch') {
9529                 while (<$fd>) {
9530                         print to_utf8($_);
9531                 }
9532                 close $fd
9533                         or print "Reading git-format-patch failed\n";
9534         }
9535 }
9536
9537 sub git_commitdiff_plain {
9538         git_commitdiff(-format => 'plain');
9539 }
9540
9541 # format-patch-style patches
9542 sub git_patch {
9543         git_commitdiff(-format => 'patch', -single => 1);
9544 }
9545
9546 sub git_patches {
9547         git_commitdiff(-format => 'patch');
9548 }
9549
9550 sub git_history {
9551         git_log_generic('history', \&git_history_body,
9552                         $hash_base, $hash_parent_base,
9553                         $file_name, $hash);
9554 }
9555
9556 sub git_search {
9557         $searchtype ||= 'commit';
9558
9559         # check if appropriate features are enabled
9560         gitweb_check_feature('search')
9561                 or die_error(403, "Search is disabled");
9562         if ($searchtype eq 'pickaxe') {
9563                 # pickaxe may take all resources of your box and run for several minutes
9564                 # with every query - so decide by yourself how public you make this feature
9565                 gitweb_check_feature('pickaxe')
9566                         or die_error(403, "Pickaxe search is disabled");
9567         }
9568         if ($searchtype eq 'grep') {
9569                 # grep search might be potentially CPU-intensive, too
9570                 gitweb_check_feature('grep')
9571                         or die_error(403, "Grep search is disabled");
9572         }
9573         if ($search_use_regexp) {
9574                 # regular expression search can be disabled to avoid potentially
9575                 # malicious regular expressions
9576                 gitweb_check_feature('regexp')
9577                         or die_error(403, "Regular expression search is disabled");
9578         }
9579
9580         if (!defined $searchtext) {
9581                 die_error(400, "Text field is empty");
9582         }
9583         if (!defined $hash) {
9584                 $hash = git_get_head_hash($project);
9585         }
9586         my %co = parse_commit($hash);
9587         if (!%co) {
9588                 die_error(404, "Unknown commit object");
9589         }
9590         if (!defined $page) {
9591                 $page = 0;
9592         }
9593
9594         if ($searchtype eq 'commit' ||
9595             $searchtype eq 'author' ||
9596             $searchtype eq 'committer') {
9597                 git_search_message(%co);
9598         } elsif ($searchtype eq 'pickaxe') {
9599                 git_search_changes(%co);
9600         } elsif ($searchtype eq 'grep') {
9601                 git_search_files(%co);
9602         } else {
9603                 die_error(400, "Unknown search type");
9604         }
9605 }
9606
9607 sub git_search_help {
9608         git_header_html();
9609         git_print_page_nav('','', $hash,$hash,$hash);
9610         print <<EOT;
9611 <div class="search_help">
9612 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
9613 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
9614 the pattern entered is recognized as the POSIX extended
9615 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
9616 insensitive).</p>
9617 <dl>
9618 <dt><b>commit</b></dt>
9619 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
9620 EOT
9621         my $have_grep = gitweb_check_feature('grep');
9622         if ($have_grep) {
9623                 print <<EOT;
9624 <dt><b>grep</b></dt>
9625 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
9626     a different one) are searched for the given pattern. On large trees, this search can take
9627 a while and put some strain on the server, so please use it with some consideration. Note that
9628 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
9629 case-sensitive.</dd>
9630 EOT
9631         }
9632         print <<EOT;
9633 <dt><b>author</b></dt>
9634 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
9635 <dt><b>committer</b></dt>
9636 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
9637 EOT
9638         my $have_pickaxe = gitweb_check_feature('pickaxe');
9639         if ($have_pickaxe) {
9640                 print <<EOT;
9641 <dt><b>pickaxe</b></dt>
9642 <dd>All commits that caused the string to appear or disappear from any file (changes that
9643 added, removed or "modified" the string) will be listed. This search can take a while and
9644 takes a lot of strain on the server, so please use it wisely. Note that since you may be
9645 interested even in changes just changing the case as well, this search is case sensitive.</dd>
9646 EOT
9647         }
9648         print "</dl>\n</div>\n";
9649         git_footer_html();
9650 }
9651
9652 sub git_shortlog {
9653         git_log_generic('shortlog', \&git_shortlog_body,
9654                         $hash, $hash_parent);
9655 }
9656
9657 ## ......................................................................
9658 ## feeds (RSS, Atom; OPML)
9659
9660 sub git_feed {
9661         my $format = shift || 'atom';
9662         my $have_blame = gitweb_check_feature('blame');
9663
9664         # Atom: http://www.atomenabled.org/developers/syndication/
9665         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
9666         if ($format ne 'rss' && $format ne 'atom') {
9667                 die_error(400, "Unknown web feed format");
9668         }
9669
9670         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
9671         my $head = $hash || 'HEAD';
9672         my @commitlist = parse_commits($head, 150, 0, $file_name);
9673
9674         my %latest_commit;
9675         my %latest_date;
9676         my $content_type = "application/$format+xml";
9677         if (defined $cgi->http('HTTP_ACCEPT') &&
9678                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
9679                 # browser (feed reader) prefers text/xml
9680                 $content_type = 'text/xml';
9681         }
9682         if (defined($commitlist[0])) {
9683                 %latest_commit = %{$commitlist[0]};
9684                 my $latest_epoch = $latest_commit{'committer_epoch'};
9685                 exit_if_unmodified_since($latest_epoch);
9686                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
9687         }
9688         print $cgi->header(
9689                 -type => $content_type,
9690                 -charset => 'utf-8',
9691                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
9692                 -status => '200 OK');
9693
9694         # Optimization: skip generating the body if client asks only
9695         # for Last-Modified date.
9696         return if ($cgi->request_method() eq 'HEAD');
9697
9698         # header variables
9699         my $title = "$site_name - $project/$action";
9700         my $feed_type = 'log';
9701         if (defined $hash) {
9702                 $title .= " - '$hash'";
9703                 $feed_type = 'branch log';
9704                 if (defined $file_name) {
9705                         $title .= " :: $file_name";
9706                         $feed_type = 'history';
9707                 }
9708         } elsif (defined $file_name) {
9709                 $title .= " - $file_name";
9710                 $feed_type = 'history';
9711         }
9712         $title .= " $feed_type";
9713         $title = esc_html($title);
9714         my $descr = git_get_project_description($project);
9715         if (defined $descr) {
9716                 $descr = esc_html($descr);
9717         } else {
9718                 $descr = "$project " .
9719                          ($format eq 'rss' ? 'RSS' : 'Atom') .
9720                          " feed";
9721         }
9722         my $owner = git_get_project_owner($project);
9723         $owner = esc_html($owner);
9724
9725         #header
9726         my $alt_url;
9727         if (defined $file_name) {
9728                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
9729         } elsif (defined $hash) {
9730                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
9731         } else {
9732                 $alt_url = href(-full=>1, action=>"summary");
9733         }
9734         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
9735         if ($format eq 'rss') {
9736                 print <<XML;
9737 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
9738 <channel>
9739 XML
9740                 print "<title>$title</title>\n" .
9741                       "<link>$alt_url</link>\n" .
9742                       "<description>$descr</description>\n" .
9743                       "<language>en</language>\n" .
9744                       # project owner is responsible for 'editorial' content
9745                       "<managingEditor>$owner</managingEditor>\n";
9746                 if (defined $logo || defined $favicon) {
9747                         # prefer the logo to the favicon, since RSS
9748                         # doesn't allow both
9749                         my $img = esc_url($logo || $favicon);
9750                         print "<image>\n" .
9751                               "<url>$img</url>\n" .
9752                               "<title>$title</title>\n" .
9753                               "<link>$alt_url</link>\n" .
9754                               "</image>\n";
9755                 }
9756                 if (%latest_date) {
9757                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
9758                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
9759                 }
9760                 print "<generator>gitweb v.$version/$git_version</generator>\n";
9761         } elsif ($format eq 'atom') {
9762                 print <<XML;
9763 <feed xmlns="http://www.w3.org/2005/Atom">
9764 XML
9765                 print "<title>$title</title>\n" .
9766                       "<subtitle>$descr</subtitle>\n" .
9767                       '<link rel="alternate" type="text/html" href="' .
9768                       $alt_url . '" />' . "\n" .
9769                       '<link rel="self" type="' . $content_type . '" href="' .
9770                       $cgi->self_url() . '" />' . "\n" .
9771                       "<id>" . href(-full=>1) . "</id>\n" .
9772                       # use project owner for feed author
9773                       '<author><name>'. email_obfuscate($owner) . '</name></author>\n';
9774                 if (defined $favicon) {
9775                         print "<icon>" . esc_url($favicon) . "</icon>\n";
9776                 }
9777                 if (defined $logo) {
9778                         # not twice as wide as tall: 72 x 27 pixels
9779                         print "<logo>" . esc_url($logo) . "</logo>\n";
9780                 }
9781                 if (! %latest_date) {
9782                         # dummy date to keep the feed valid until commits trickle in:
9783                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
9784                 } else {
9785                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
9786                 }
9787                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
9788         }
9789
9790         # contents
9791         for (my $i = 0; $i <= $#commitlist; $i++) {
9792                 my %co = %{$commitlist[$i]};
9793                 my $commit = $co{'id'};
9794                 # we read 150, we always show 30 and the ones more recent than 48 hours
9795                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
9796                         last;
9797                 }
9798                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
9799
9800                 # get list of changed files
9801                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9802                         $co{'parent'} || "--root",
9803                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
9804                         or next;
9805                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
9806                 close $fd
9807                         or next;
9808
9809                 # print element (entry, item)
9810                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
9811                 if ($format eq 'rss') {
9812                         print "<item>\n" .
9813                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
9814                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
9815                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
9816                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
9817                               "<link>$co_url</link>\n" .
9818                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
9819                               "<content:encoded>" .
9820                               "<![CDATA[\n";
9821                 } elsif ($format eq 'atom') {
9822                         print "<entry>\n" .
9823                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
9824                               "<updated>$cd{'iso-8601'}</updated>\n" .
9825                               "<author>\n" .
9826                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
9827                         if ($co{'author_email'}) {
9828                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
9829                         }
9830                         print "</author>\n" .
9831                               # use committer for contributor
9832                               "<contributor>\n" .
9833                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
9834                         if ($co{'committer_email'}) {
9835                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
9836                         }
9837                         print "</contributor>\n" .
9838                               "<published>$cd{'iso-8601'}</published>\n" .
9839                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
9840                               "<id>$co_url</id>\n" .
9841                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
9842                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
9843                 }
9844                 my $comment = $co{'comment'};
9845                 print "<pre>\n";
9846                 foreach my $line (@$comment) {
9847                         $line = esc_html($line);
9848                         print "$line\n";
9849                 }
9850                 print "</pre><ul>\n";
9851                 foreach my $difftree_line (@difftree) {
9852                         my %difftree = parse_difftree_raw_line($difftree_line);
9853                         next if !$difftree{'from_id'};
9854
9855                         my $file = $difftree{'file'} || $difftree{'to_file'};
9856
9857                         print "<li>" .
9858                               "[" .
9859                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
9860                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
9861                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
9862                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
9863                                       -title => "diff"}, 'D');
9864                         if ($have_blame) {
9865                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
9866                                                              file_name=>$file, hash_base=>$commit),
9867                                               -class => "blamelink",
9868                                               -title => "blame"}, 'B');
9869                         }
9870                         # if this is not a feed of a file history
9871                         if (!defined $file_name || $file_name ne $file) {
9872                                 print $cgi->a({-href => href(-full=>1, action=>"history",
9873                                                              file_name=>$file, hash=>$commit),
9874                                               -title => "history"}, 'H');
9875                         }
9876                         $file = esc_path($file);
9877                         print "] ".
9878                               "$file</li>\n";
9879                 }
9880                 if ($format eq 'rss') {
9881                         print "</ul>]]>\n" .
9882                               "</content:encoded>\n" .
9883                               "</item>\n";
9884                 } elsif ($format eq 'atom') {
9885                         print "</ul>\n</div>\n" .
9886                               "</content>\n" .
9887                               "</entry>\n";
9888                 }
9889         }
9890
9891         # end of feed
9892         if ($format eq 'rss') {
9893                 print "</channel>\n</rss>\n";
9894         } elsif ($format eq 'atom') {
9895                 print "</feed>\n";
9896         }
9897 }
9898
9899 sub git_rss {
9900         git_feed('rss');
9901 }
9902
9903 sub git_atom {
9904         git_feed('atom');
9905 }
9906
9907 sub git_opml {
9908         my @list = git_get_projects_list($project_filter, $strict_export);
9909         if (!@list) {
9910                 die_error(404, "No projects found");
9911         }
9912
9913         print $cgi->header(
9914                 -type => 'text/xml',
9915                 -charset => 'utf-8',
9916                 -content_disposition => 'inline; filename="opml.xml"');
9917
9918         my $title = esc_html($site_name);
9919         my $filter = " within subdirectory ";
9920         if (defined $project_filter) {
9921                 $filter .= esc_html($project_filter);
9922         } else {
9923                 $filter = "";
9924         }
9925         print <<XML;
9926 <?xml version="1.0" encoding="utf-8"?>
9927 <opml version="1.0">
9928 <head>
9929   <title>$title OPML Export$filter</title>
9930 </head>
9931 <body>
9932 <outline text="git RSS feeds">
9933 XML
9934
9935         foreach my $pr (@list) {
9936                 my %proj = %$pr;
9937                 my $head = git_get_head_hash($proj{'path'});
9938                 if (!defined $head) {
9939                         next;
9940                 }
9941                 $git_dir = "$projectroot/$proj{'path'}";
9942                 my %co = parse_commit($head);
9943                 if (!%co) {
9944                         next;
9945                 }
9946
9947                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9948                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9949                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9950                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9951         }
9952         print <<XML;
9953 </outline>
9954 </body>
9955 </opml>
9956 XML
9957 }