gitweb/gitweb.perl

   1 #!/usr/bin/perl
   2
   3 # gitweb - simple web interface to track changes in git repositories
   4 #
   5 # (C) 2005-2006, Kay Sievers <kay.sievers@vrfy.org>
   6 # (C) 2005, Christian Gierke
   7 #
   8 # This program is licensed under the GPLv2
   9
  10 use 5.008;
  11 use strict;
  12 use warnings;
  13 use CGI qw(:standard :escapeHTML -nosticky);
  14 use CGI::Util qw(unescape);
  15 use CGI::Carp qw(fatalsToBrowser set_message);
  16 use Encode;
  17 use Fcntl ':mode';
  18 use File::Find qw();
  19 use File::Basename qw(basename);
  20 use File::Spec;
  21 use Time::HiRes qw(gettimeofday tv_interval);
  22 use Time::Local;
  23 use constant GITWEB_CACHE_FORMAT => "Gitweb Cache Format 3";
  24 binmode STDOUT, ':utf8';
  25
  26 if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
  27         eval 'sub CGI::multi_param { CGI::param(@_) }'
  28 }
  29
  30 our $t0 = [ gettimeofday() ];
  31 our $number_of_git_cmds = 0;
  32 our ($mdotsep, $barsep, $slssep, $spcsep, $spctxt);
  33
  34 BEGIN {
  35         *mdotsep = \'<span class="mdotsep">&#160;&#183;&#160;</span>';
  36         *barsep = \'<span class="barsep">&#160;|&#160;</span>';
  37         *slssep = \'<span class="slssep">&#160;/&#160;</span>';
  38         *spcsep = \'<span class="spcsep">&#160;</span>';
  39         *spctxt = \'<span style="display:none">&#160;</span>';
  40         CGI->compile() if $ENV{'MOD_PERL'};
  41 }
  42
  43 our $version = "++GIT_VERSION++";
  44
  45 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
  46 sub evaluate_uri {
  47         our $cgi;
  48
  49         our $my_url = $cgi->url();
  50         our $my_uri = $cgi->url(-absolute => 1);
  51
  52         # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
  53         # needed and used only for URLs with nonempty PATH_INFO
  54         # This must be an absolute URL (i.e. no scheme, host or port), NOT a full one
  55         our $base_url = $my_uri || '/';
  56
  57         # When the script is used as DirectoryIndex, the URL does not contain the name
  58         # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
  59         # have to do it ourselves. We make $path_info global because it's also used
  60         # later on.
  61         #
  62         # Another issue with the script being the DirectoryIndex is that the resulting
  63         # $my_url data is not the full script URL: this is good, because we want
  64         # generated links to keep implying the script name if it wasn't explicitly
  65         # indicated in the URL we're handling, but it means that $my_url cannot be used
  66         # as base URL.
  67         # Therefore, if we needed to strip PATH_INFO, then we know that we have
  68         # to build the base URL ourselves:
  69         our $path_info = decode_utf8($ENV{"PATH_INFO"});
  70         if ($path_info) {
  71                 # $path_info has already been URL-decoded by the web server, but
  72                 # $my_url and $my_uri have not. URL-decode them so we can properly
  73                 # strip $path_info.
  74                 $my_url = unescape($my_url);
  75                 $my_uri = unescape($my_uri);
  76                 if ($my_url =~ s,\Q$path_info\E$,, &&
  77                     $my_uri =~ s,\Q$path_info\E$,, &&
  78                     defined $ENV{'SCRIPT_NAME'}) {
  79                         $base_url = $ENV{'SCRIPT_NAME'} || '/';
  80                 }
  81         }
  82
  83         # target of the home link on top of all pages
  84         our $home_link = $my_uri || "/";
  85 }
  86
  87 # core git executable to use
  88 # this can just be "git" if your webserver has a sensible PATH
  89 our $GIT = "++GIT_BINDIR++/git";
  90
  91 # absolute fs-path which will be prepended to the project path
  92 #our $projectroot = "/pub/scm";
  93 our $projectroot = "++GITWEB_PROJECTROOT++";
  94
  95 # fs traversing limit for getting project list
  96 # the number is relative to the projectroot
  97 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
  98
  99 # string of the home link on top of all pages
 100 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
 101
 102 # extra breadcrumbs preceding the home link
 103 our @extra_breadcrumbs = ();
 104
 105 # name of your site or organization to appear in page titles
 106 # replace this with something more descriptive for clearer bookmarks
 107 our $site_name = "++GITWEB_SITENAME++"
 108                  || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
 109
 110 # html snippet to include in the <head> section of each page
 111 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
 112 # filename of html text to include at top of each page
 113 our $site_header = "++GITWEB_SITE_HEADER++";
 114 # html text to include at home page
 115 our $home_text = "++GITWEB_HOMETEXT++";
 116 # filename of html text to include at bottom of each page
 117 our $site_footer = "++GITWEB_SITE_FOOTER++";
 118
 119 # URI of stylesheets
 120 our @stylesheets = ("++GITWEB_CSS++");
 121 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
 122 our $stylesheet = undef;
 123 # URI of GIT logo (72x27 size)
 124 our $logo = "++GITWEB_LOGO++";
 125 # URI of GIT favicon, assumed to be image/png type
 126 our $favicon = "++GITWEB_FAVICON++";
 127 # URI of gitweb.js (JavaScript code for gitweb)
 128 our $javascript = "++GITWEB_JS++";
 129
 130 # URI and label (title) of GIT logo link
 131 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
 132 #our $logo_label = "git documentation";
 133 our $logo_url = "http://git-scm.com/";
 134 our $logo_label = "git homepage";
 135
 136 # source of projects list
 137 our $projects_list = "++GITWEB_LIST++";
 138
 139 # the width (in characters) of the projects list "Description" column
 140 our $projects_list_description_width = 25;
 141
 142 # group projects by category on the projects list
 143 # (enabled if this variable evaluates to true)
 144 our $projects_list_group_categories = 0;
 145
 146 # default category if none specified
 147 # (leave the empty string for no category)
 148 our $project_list_default_category = "";
 149
 150 # default order of projects list
 151 # valid values are none, project, descr, owner, and age
 152 our $default_projects_order = "project";
 153
 154 # default order of refs list
 155 # valid values are age and name
 156 our $default_refs_order = "age";
 157
 158 # show repository only if this file exists
 159 # (only effective if this variable evaluates to true)
 160 our $export_ok = "++GITWEB_EXPORT_OK++";
 161
 162 # don't generate age column on the projects list page
 163 our $omit_age_column = 0;
 164
 165 # use contents of this file (in iso, iso-strict or raw format) as
 166 # the last activity data if it exists and is a valid date
 167 our $lastactivity_file = undef;
 168
 169 # don't generate information about owners of repositories
 170 our $omit_owner=0;
 171
 172 # owner link hook given owner name (full and NOT obfuscated)
 173 # should return full URL-escaped link to attach to owner, for example:
 174 #    sub { return "/showowner.cgi?owner=".CGI::Util::escape($_[0]); }
 175 our $owner_link_hook = undef;
 176
 177 # show repository only if this subroutine returns true
 178 # when given the path to the project, for example:
 179 #    sub { return -e "$_[0]/git-daemon-export-ok"; }
 180 our $export_auth_hook = undef;
 181
 182 # only allow viewing of repositories also shown on the overview page
 183 our $strict_export = "++GITWEB_STRICT_EXPORT++";
 184
 185 # base URL for bundle info link shown on summary page, but only if
 186 # this config item is defined AND a 'bundles' subdirectory exists
 187 # in the project's repository.
 188 # i.e. full URL is "git_base_bundles_url/$project/bundles"
 189 our $git_base_bundles_url = undef;
 190
 191 ## URL Hints
 192 ##
 193 ## Any of the urls in @git_base_url_list, @git_base_mirror_urls or
 194 ## @git_base_push_urls may be an array ref instead of a scalar in which
 195 ## case ${}[0] is the url and ${}[1] is an html fragment "hint" to display
 196 ## right after the URL.
 197
 198 # list of git base URLs used for URL to where fetch project from,
 199 # i.e. full URL is "$git_base_url/$project"
 200 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
 201
 202 ## For push projects (a .nofetch file exists OR gitweb.showpush is true)
 203 ## @git_base_url_list entries are shown as "URL" and @git_base_push_urls
 204 ## are shown as "push URL" and @git_base_mirror_urls are ignored.
 205 ## For non-push projects, @git_base_url_list and @git_base_mirror_urls are shown
 206 ## as "URL" and @git_base_push_urls are ignored.
 207
 208 # URLs shown for mirrors but not for push projects in addition to base_url_list,
 209 # extended by the project name (i.e. full URL is "$git_mirror_url/$project")
 210 our @git_base_mirror_urls = ();
 211
 212 # URLs designated for pushing new changes, extended by the
 213 # project name (i.e. "$git_base_push_url[0]/$project")
 214 our @git_base_push_urls = ();
 215
 216 # https hint html inserted right after any https push URL (undef for none)
 217 # ignored if the url already has its own hint
 218 # this is supported for backwards compatibility but is now deprecated in favor
 219 # of using an array ref in the @git_base_push_urls list instead
 220 our $https_hint_html = undef;
 221
 222 # default blob_plain mimetype and default charset for text/plain blob
 223 our $default_blob_plain_mimetype = 'application/octet-stream';
 224 our $default_text_plain_charset  = undef;
 225
 226 # file to use for guessing MIME types before trying /etc/mime.types
 227 # (relative to the current git repository)
 228 our $mimetypes_file = undef;
 229
 230 # assume this charset if line contains non-UTF-8 characters;
 231 # it should be valid encoding (see Encoding::Supported(3pm) for list),
 232 # for which encoding all byte sequences are valid, for example
 233 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
 234 # could be even 'utf-8' for the old behavior)
 235 our $fallback_encoding = 'latin1';
 236
 237 # rename detection options for git-diff and git-diff-tree
 238 # - default is '-M', with the cost proportional to
 239 #   (number of removed files) * (number of new files).
 240 # - more costly is '-C' (which implies '-M'), with the cost proportional to
 241 #   (number of changed files + number of removed files) * (number of new files)
 242 # - even more costly is '-C', '--find-copies-harder' with cost
 243 #   (number of files in the original tree) * (number of new files)
 244 # - one might want to include '-B' option, e.g. '-B', '-M'
 245 our @diff_opts = ('-M'); # taken from git_commit
 246
 247 # cache directory (relative to $GIT_DIR) for project-specific html page caches.
 248 # the directory must exist and be writable by the process running gitweb.
 249 # additionally some actions must be selected for caching in %html_cache_actions
 250 # - default is 'htmlcache'
 251 our $html_cache_dir = 'htmlcache';
 252
 253 # which actions to cache in $html_cache_dir
 254 # if $html_cache_dir exists (relative to $GIT_DIR) and is writable by the
 255 # process running gitweb, then any actions selected here will have their output
 256 # cached and the cache file will be returned instead of regenerating the page
 257 # if it exists.  For this to be useful, an external process must create the
 258 # 'changed' file (if it does not already exist) in the $html_cache_dir whenever
 259 # the project information has been changed.  Alternatively it may create a
 260 # "$action.changed" file (if it does not exist) instead to limit the changes
 261 # to just "$action" instead of any action.  If 'changed' or "$action.changed"
 262 # exist, then the cached version will never be used for "$action" and a new
 263 # cache page will be regenerated (and the "changed" files removed as appropriate).
 264 #
 265 # Additionally if $projlist_cache_lifetime is > 0 AND the forks feature has been
 266 # enabled ('$feature{'forks'}{'default'} = [1];') then additionally an external
 267 # process must create the 'forkchange' file or update its timestamp if it already
 268 # exists whenever a fork is added to or removed from the project (as well as
 269 # create the 'changed' or "$action.changed" file).  Otherwise the "forks"
 270 # section on the summary page may remain out-of-date indefinately.
 271 #
 272 # - default is none
 273 #   currently only caching of the summary page is supported
 274 # - to enable caching of the summary page use:
 275 #   $html_cache_actions{'summary'} = 1;
 276 our %html_cache_actions = ();
 277
 278 # utility to automatically produce a default README.html if README.html is
 279 # enabled and it does not exist or is 0 bytes in length.  If this is set to an
 280 # executable utility that takes an absolute path to a .git directory as its
 281 # first argument and outputs an HTML fragment to use for README.html, then
 282 # it will be called when README.html is enabled but empty or missing.
 283 our $git_automatic_readme_html = undef;
 284
 285 # Disables features that would allow repository owners to inject script into
 286 # the gitweb domain.
 287 our $prevent_xss = 0;
 288
 289 # Path to a POSIX shell.  Needed to run $highlight_bin and a snapshot compressor.
 290 # Only used when highlight is enabled or snapshots with compressors are enabled.
 291 our $posix_shell_bin = "++POSIX_SHELL_BIN++";
 292
 293 # Path to the highlight executable to use (must be the one from
 294 # http://www.andre-simon.de due to assumptions about parameters and output).
 295 # Useful if highlight is not installed on your webserver's PATH.
 296 # [Default: highlight]
 297 our $highlight_bin = "++HIGHLIGHT_BIN++";
 298
 299 # Whether to include project list on the gitweb front page; 0 means yes,
 300 # 1 means no list but show tag cloud if enabled (all projects still need
 301 # to be scanned, unless the info is cached), 2 means no list and no tag cloud
 302 # (very fast)
 303 our $frontpage_no_project_list = 0;
 304
 305 # projects list cache for busy sites with many projects;
 306 # if you set this to non-zero, it will be used as the cached
 307 # index lifetime in minutes
 308 #
 309 # the cached list version is stored in $cache_dir/$cache_name and can
 310 # be tweaked by other scripts running with the same uid as gitweb -
 311 # use this ONLY at secure installations; only single gitweb project
 312 # root per system is supported, unless you tweak configuration!
 313 our $projlist_cache_lifetime = 0; # in minutes
 314 # FHS compliant $cache_dir would be "/var/cache/gitweb"
 315 our $cache_dir =
 316         (defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp').'/gitweb';
 317 our $projlist_cache_name = 'gitweb.index.cache';
 318 our $cache_grpshared = 0;
 319
 320 # information about snapshot formats that gitweb is capable of serving
 321 our %known_snapshot_formats = (
 322         # name => {
 323         #       'display' => display name,
 324         #       'type' => mime type,
 325         #       'suffix' => filename suffix,
 326         #       'format' => --format for git-archive,
 327         #       'compressor' => [compressor command and arguments]
 328         #                       (array reference, optional)
 329         #       'disabled' => boolean (optional)}
 330         #
 331         'tgz' => {
 332                 'display' => 'tar.gz',
 333                 'type' => 'application/x-gzip',
 334                 'suffix' => '.tar.gz',
 335                 'format' => 'tar',
 336                 'compressor' => ['gzip', '-n']},
 337
 338         'tbz2' => {
 339                 'display' => 'tar.bz2',
 340                 'type' => 'application/x-bzip2',
 341                 'suffix' => '.tar.bz2',
 342                 'format' => 'tar',
 343                 'compressor' => ['bzip2']},
 344
 345         'txz' => {
 346                 'display' => 'tar.xz',
 347                 'type' => 'application/x-xz',
 348                 'suffix' => '.tar.xz',
 349                 'format' => 'tar',
 350                 'compressor' => ['xz'],
 351                 'disabled' => 1},
 352
 353         'zip' => {
 354                 'display' => 'zip',
 355                 'type' => 'application/x-zip',
 356                 'suffix' => '.zip',
 357                 'format' => 'zip'},
 358 );
 359
 360 # Aliases so we understand old gitweb.snapshot values in repository
 361 # configuration.
 362 our %known_snapshot_format_aliases = (
 363         'gzip'  => 'tgz',
 364         'bzip2' => 'tbz2',
 365         'xz'    => 'txz',
 366
 367         # backward compatibility: legacy gitweb config support
 368         'x-gzip' => undef, 'gz' => undef,
 369         'x-bzip2' => undef, 'bz2' => undef,
 370         'x-zip' => undef, '' => undef,
 371 );
 372
 373 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
 374 # are changed, it may be appropriate to change these values too via
 375 # $GITWEB_CONFIG.
 376 our %avatar_size = (
 377         'default' => 16,
 378         'double'  => 32
 379 );
 380
 381 # Used to set the maximum load that we will still respond to gitweb queries.
 382 # If server load exceed this value then return "503 server busy" error.
 383 # If gitweb cannot determined server load, it is taken to be 0.
 384 # Leave it undefined (or set to 'undef') to turn off load checking.
 385 our $maxload = 300;
 386
 387 # configuration for 'highlight' (http://www.andre-simon.de/)
 388 # match by basename
 389 our %highlight_basename = (
 390         #'Program' => 'py',
 391         #'Library' => 'py',
 392         'SConstruct' => 'py', # SCons equivalent of Makefile
 393         'Makefile' => 'make',
 394         'makefile' => 'make',
 395         'GNUmakefile' => 'make',
 396         'BSDmakefile' => 'make',
 397 );
 398 # match by shebang regex
 399 our %highlight_shebang = (
 400         # Each entry has a key which is the syntax to use and
 401         # a value which is either a qr regex or an array of qr regexs to match
 402         # against the first 128 (less if the blob is shorter) BYTES of the blob.
 403         # We match /usr/bin/env items separately to require "/usr/bin/env" and
 404         # allow a limited subset of NAME=value items to appear.
 405         'awk'    => [ qr,^#!\s*/(?:\w+/)*(?:[gnm]?awk)(?:\s|$),mo,
 406                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[gnm]?awk)(?:\s|$),mo ],
 407         'make'   => [ qr,^#!\s*/(?:\w+/)*(?:g?make)(?:\s|$),mo,
 408                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:g?make)(?:\s|$),mo ],
 409         'php'    => [ qr,^#!\s*/(?:\w+/)*(?:php)(?:\s|$),mo,
 410                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:php)(?:\s|$),mo ],
 411         'pl'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 412                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 413         'py'     => [ qr,^#!\s*/(?:\w+/)*(?:python)(?:\s|$),mo,
 414                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:python)(?:\s|$),mo ],
 415         'sh'     => [ qr,^#!\s*/(?:\w+/)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo,
 416                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo ],
 417         'rb'     => [ qr,^#!\s*/(?:\w+/)*(?:ruby)(?:\s|$),mo,
 418                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:ruby)(?:\s|$),mo ],
 419 );
 420 # match by extension
 421 our %highlight_ext = (
 422         # main extensions, defining name of syntax;
 423         # see files in /usr/share/highlight/langDefs/ directory
 424         (map { $_ => $_ } qw(
 425                 4gl a4c abnf abp ada agda ahk ampl amtrix applescript arc
 426                 arm as asm asp aspect ats au3 avenue awk bat bb bbcode bib
 427                 bms bnf boo c cb cfc chl clipper clojure clp cob cs css d
 428                 diff dot dylan e ebnf erl euphoria exp f90 flx for frink fs
 429                 go haskell hcl html httpd hx icl icn idl idlang ili
 430                 inc_luatex ini inp io iss j java js jsp lbn ldif lgt lhs
 431                 lisp lotos ls lsl lua ly make mel mercury mib miranda ml mo
 432                 mod2 mod3 mpl ms mssql n nas nbc nice nrx nsi nut nxc oberon
 433                 objc octave oorexx os oz pas php pike pl pl1 pov pro
 434                 progress ps ps1 psl pure py pyx q qmake qu r rb rebol rexx
 435                 rnc s sas sc scala scilab sh sma smalltalk sml sno spec spn
 436                 sql sybase tcl tcsh tex ttcn3 vala vb verilog vhd xml xpp y
 437                 yaiff znn)),
 438         # alternate extensions, see /etc/highlight/filetypes.conf
 439         (map { $_ => '4gl' } qw(informix)),
 440         (map { $_ => 'a4c' } qw(ascend)),
 441         (map { $_ => 'abp' } qw(abp4)),
 442         (map { $_ => 'ada' } qw(a adb ads gnad)),
 443         (map { $_ => 'ahk' } qw(autohotkey)),
 444         (map { $_ => 'ampl' } qw(dat run)),
 445         (map { $_ => 'amtrix' } qw(hnd s4 s4h s4t t4)),
 446         (map { $_ => 'as' } qw(actionscript)),
 447         (map { $_ => 'asm' } qw(29k 68s 68x a51 assembler x68 x86)),
 448         (map { $_ => 'asp' } qw(asa)),
 449         (map { $_ => 'aspect' } qw(was wud)),
 450         (map { $_ => 'ats' } qw(dats)),
 451         (map { $_ => 'au3' } qw(autoit)),
 452         (map { $_ => 'bat' } qw(cmd)),
 453         (map { $_ => 'bb' } qw(blitzbasic)),
 454         (map { $_ => 'bib' } qw(bibtex)),
 455         (map { $_ => 'c' } qw(c++ cc cpp cu cxx h hh hpp hxx)),
 456         (map { $_ => 'cb' } qw(clearbasic)),
 457         (map { $_ => 'cfc' } qw(cfm coldfusion)),
 458         (map { $_ => 'chl' } qw(chill)),
 459         (map { $_ => 'cob' } qw(cbl cobol)),
 460         (map { $_ => 'cs' } qw(csharp)),
 461         (map { $_ => 'diff' } qw(patch)),
 462         (map { $_ => 'dot' } qw(graphviz)),
 463         (map { $_ => 'e' } qw(eiffel se)),
 464         (map { $_ => 'erl' } qw(erlang hrl)),
 465         (map { $_ => 'euphoria' } qw(eu ew ex exu exw wxu)),
 466         (map { $_ => 'exp' } qw(express)),
 467         (map { $_ => 'f90' } qw(f95)),
 468         (map { $_ => 'flx' } qw(felix)),
 469         (map { $_ => 'for' } qw(f f77 ftn)),
 470         (map { $_ => 'fs' } qw(fsharp fsx)),
 471         (map { $_ => 'haskell' } qw(hs)),
 472         (map { $_ => 'html' } qw(htm xhtml)),
 473         (map { $_ => 'hx' } qw(haxe)),
 474         (map { $_ => 'icl' } qw(clean)),
 475         (map { $_ => 'icn' } qw(icon)),
 476         (map { $_ => 'ili' } qw(interlis)),
 477         (map { $_ => 'inp' } qw(fame)),
 478         (map { $_ => 'iss' } qw(innosetup)),
 479         (map { $_ => 'j' } qw(jasmin)),
 480         (map { $_ => 'java' } qw(groovy grv)),
 481         (map { $_ => 'lbn' } qw(luban)),
 482         (map { $_ => 'lgt' } qw(logtalk)),
 483         (map { $_ => 'lisp' } qw(cl clisp el lsp sbcl scom)),
 484         (map { $_ => 'ls' } qw(lotus)),
 485         (map { $_ => 'lsl' } qw(lindenscript)),
 486         (map { $_ => 'ly' } qw(lilypond)),
 487         (map { $_ => 'make' } qw(mak mk kmk)),
 488         (map { $_ => 'mel' } qw(maya)),
 489         (map { $_ => 'mib' } qw(smi snmp)),
 490         (map { $_ => 'ml' } qw(mli ocaml)),
 491         (map { $_ => 'mo' } qw(modelica)),
 492         (map { $_ => 'mod2' } qw(def mod)),
 493         (map { $_ => 'mod3' } qw(i3 m3)),
 494         (map { $_ => 'mpl' } qw(maple)),
 495         (map { $_ => 'n' } qw(nemerle)),
 496         (map { $_ => 'nas' } qw(nasal)),
 497         (map { $_ => 'nrx' } qw(netrexx)),
 498         (map { $_ => 'nsi' } qw(nsis)),
 499         (map { $_ => 'nut' } qw(squirrel)),
 500         (map { $_ => 'oberon' } qw(ooc)),
 501         (map { $_ => 'objc' } qw(M m mm)),
 502         (map { $_ => 'php' } qw(php3 php4 php5 php6)),
 503         (map { $_ => 'pike' } qw(pmod)),
 504         (map { $_ => 'pl' } qw(perl plex plx pm)),
 505         (map { $_ => 'pl1' } qw(bdy ff fp fpp rpp sf sp spb spe spp sps wf wp wpb wpp wps)),
 506         (map { $_ => 'progress' } qw(i p w)),
 507         (map { $_ => 'py' } qw(python)),
 508         (map { $_ => 'pyx' } qw(pyrex)),
 509         (map { $_ => 'rb' } qw(pp rjs ruby)),
 510         (map { $_ => 'rexx' } qw(rex rx the)),
 511         (map { $_ => 'sc' } qw(paradox)),
 512         (map { $_ => 'scilab' } qw(sce sci)),
 513         (map { $_ => 'sh' } qw(bash ebuild eclass ksh zsh)),
 514         (map { $_ => 'sma' } qw(small)),
 515         (map { $_ => 'smalltalk' } qw(gst sq st)),
 516         (map { $_ => 'sno' } qw(snobal)),
 517         (map { $_ => 'sybase' } qw(sp)),
 518         (map { $_ => 'tcl' } qw(itcl wish)),
 519         (map { $_ => 'tex' } qw(cls sty)),
 520         (map { $_ => 'vb' } qw(bas basic bi vbs)),
 521         (map { $_ => 'verilog' } qw(v)),
 522         (map { $_ => 'xml' } qw(dtd ecf ent hdr hub jnlp nrm plist resx sgm sgml svg tld vxml wml xsd xsl)),
 523         (map { $_ => 'y' } qw(bison)),
 524 );
 525
 526 # You define site-wide feature defaults here; override them with
 527 # $GITWEB_CONFIG as necessary.
 528 our %feature = (
 529         # feature => {
 530         #       'sub' => feature-sub (subroutine),
 531         #       'override' => allow-override (boolean),
 532         #       'default' => [ default options...] (array reference)}
 533         #
 534         # if feature is overridable (it means that allow-override has true value),
 535         # then feature-sub will be called with default options as parameters;
 536         # return value of feature-sub indicates if to enable specified feature
 537         #
 538         # if there is no 'sub' key (no feature-sub), then feature cannot be
 539         # overridden
 540         #
 541         # use gitweb_get_feature(<feature>) to retrieve the <feature> value
 542         # (an array) or gitweb_check_feature(<feature>) to check if <feature>
 543         # is enabled
 544
 545         # Enable the 'blame' blob view, showing the last commit that modified
 546         # each line in the file. This can be very CPU-intensive.
 547
 548         # To enable system wide have in $GITWEB_CONFIG
 549         # $feature{'blame'}{'default'} = [1];
 550         # To have project specific config enable override in $GITWEB_CONFIG
 551         # $feature{'blame'}{'override'} = 1;
 552         # and in project config gitweb.blame = 0|1;
 553         'blame' => {
 554                 'sub' => sub { feature_bool('blame', @_) },
 555                 'override' => 0,
 556                 'default' => [0]},
 557
 558         # Enable the 'incremental blame' blob view, which uses javascript to
 559         # incrementally show the revisions of lines as they are discovered
 560         # in the history. It is better for large histories, files and slow
 561         # servers, but requires javascript in the client and can slow down the
 562         # browser on large files.
 563
 564         # To enable system wide have in $GITWEB_CONFIG
 565         # $feature{'blame_incremental'}{'default'} = [1];
 566         # To have project specific config enable override in $GITWEB_CONFIG
 567         # $feature{'blame_incremental'}{'override'} = 1;
 568         # and in project config gitweb.blame_incremental = 0|1;
 569         'blame_incremental' => {
 570                 'sub' => sub { feature_bool('blame_incremental', @_) },
 571                 'override' => 0,
 572                 'default' => [0]},
 573
 574         # Enable the 'snapshot' link, providing a compressed archive of any
 575         # tree. This can potentially generate high traffic if you have large
 576         # project.
 577
 578         # Value is a list of formats defined in %known_snapshot_formats that
 579         # you wish to offer.
 580         # To disable system wide have in $GITWEB_CONFIG
 581         # $feature{'snapshot'}{'default'} = [];
 582         # To have project specific config enable override in $GITWEB_CONFIG
 583         # $feature{'snapshot'}{'override'} = 1;
 584         # and in project config, a comma-separated list of formats or "none"
 585         # to disable.  Example: gitweb.snapshot = tbz2,zip;
 586         'snapshot' => {
 587                 'sub' => \&feature_snapshot,
 588                 'override' => 0,
 589                 'default' => ['tgz']},
 590
 591         # Enable text search, which will list the commits which match author,
 592         # committer or commit text to a given string.  Enabled by default.
 593         # Project specific override is not supported.
 594         #
 595         # Note that this controls all search features, which means that if
 596         # it is disabled, then 'grep' and 'pickaxe' search would also be
 597         # disabled.
 598         'search' => {
 599                 'override' => 0,
 600                 'default' => [1]},
 601
 602         # Enable regular expression search.  Enabled by default.
 603         # Note that you need to have 'search' feature enabled too.
 604         #
 605         # Note that this affects all git search features, which means that if
 606         # it is disabled, none of the git search options will allow a regular
 607         # expression (the "RE" checkbox) to be used.  However, the project
 608         # list search is unaffected by this setting (it uses Perl to do the
 609         # matching not Git) and will always allow a regular expression to
 610         # be used (by checking the box) regardless of this setting.
 611         'regexp' => {
 612                 'sub' => sub { feature_bool('regexp', @_) },
 613                 'override' => 0,
 614                 'default' => [1]},
 615
 616         # Enable grep search, which will list the files in currently selected
 617         # tree containing the given string. Enabled by default. This can be
 618         # potentially CPU-intensive, of course.
 619         # Note that you need to have 'search' feature enabled too.
 620
 621         # To enable system wide have in $GITWEB_CONFIG
 622         # $feature{'grep'}{'default'} = [1];
 623         # To have project specific config enable override in $GITWEB_CONFIG
 624         # $feature{'grep'}{'override'} = 1;
 625         # and in project config gitweb.grep = 0|1;
 626         'grep' => {
 627                 'sub' => sub { feature_bool('grep', @_) },
 628                 'override' => 0,
 629                 'default' => [1]},
 630
 631         # Enable the pickaxe search, which will list the commits that modified
 632         # a given string in a file. This can be practical and quite faster
 633         # alternative to 'blame', but still potentially CPU-intensive.
 634         # Note that you need to have 'search' feature enabled too.
 635
 636         # To enable system wide have in $GITWEB_CONFIG
 637         # $feature{'pickaxe'}{'default'} = [1];
 638         # To have project specific config enable override in $GITWEB_CONFIG
 639         # $feature{'pickaxe'}{'override'} = 1;
 640         # and in project config gitweb.pickaxe = 0|1;
 641         'pickaxe' => {
 642                 'sub' => sub { feature_bool('pickaxe', @_) },
 643                 'override' => 0,
 644                 'default' => [1]},
 645
 646         # Enable showing size of blobs in a 'tree' view, in a separate
 647         # column, similar to what 'ls -l' does.  This cost a bit of IO.
 648
 649         # To disable system wide have in $GITWEB_CONFIG
 650         # $feature{'show-sizes'}{'default'} = [0];
 651         # To have project specific config enable override in $GITWEB_CONFIG
 652         # $feature{'show-sizes'}{'override'} = 1;
 653         # and in project config gitweb.showsizes = 0|1;
 654         'show-sizes' => {
 655                 'sub' => sub { feature_bool('showsizes', @_) },
 656                 'override' => 0,
 657                 'default' => [1]},
 658
 659         # Make gitweb use an alternative format of the URLs which can be
 660         # more readable and natural-looking: project name is embedded
 661         # directly in the path and the query string contains other
 662         # auxiliary information. All gitweb installations recognize
 663         # URL in either format; this configures in which formats gitweb
 664         # generates links.
 665
 666         # To enable system wide have in $GITWEB_CONFIG
 667         # $feature{'pathinfo'}{'default'} = [1];
 668         # Project specific override is not supported.
 669
 670         # Note that you will need to change the default location of CSS,
 671         # favicon, logo and possibly other files to an absolute URL. Also,
 672         # if gitweb.cgi serves as your indexfile, you will need to force
 673         # $my_uri to contain the script name in your $GITWEB_CONFIG (and you
 674         # will also likely want to set $home_link if you're setting $my_uri).
 675         'pathinfo' => {
 676                 'override' => 0,
 677                 'default' => [0]},
 678
 679         # Make gitweb consider projects in project root subdirectories
 680         # to be forks of existing projects. Given project $projname.git,
 681         # projects matching $projname/*.git will not be shown in the main
 682         # projects list, instead a '+' mark will be added to $projname
 683         # there and a 'forks' view will be enabled for the project, listing
 684         # all the forks. If project list is taken from a file, forks have
 685         # to be listed after the main project.
 686
 687         # To enable system wide have in $GITWEB_CONFIG
 688         # $feature{'forks'}{'default'} = [1];
 689         # Project specific override is not supported.
 690         'forks' => {
 691                 'override' => 0,
 692                 'default' => [0]},
 693
 694         # Insert custom links to the action bar of all project pages.
 695         # This enables you mainly to link to third-party scripts integrating
 696         # into gitweb; e.g. git-browser for graphical history representation
 697         # or custom web-based repository administration interface.
 698
 699         # The 'default' value consists of a list of triplets in the form
 700         # (label, link, position) where position is the label after which
 701         # to insert the link and link is a format string where %n expands
 702         # to the project name, %f to the project path within the filesystem,
 703         # %h to the current hash (h gitweb parameter) and %b to the current
 704         # hash base (hb gitweb parameter); %% expands to %.  %e expands to the
 705         # project name where all '+' characters have been replaced with '%2B'.
 706
 707         # To enable system wide have in $GITWEB_CONFIG e.g.
 708         # $feature{'actions'}{'default'} = [('graphiclog',
 709         #       '/git-browser/by-commit.html?r=%n', 'summary')];
 710         # Project specific override is not supported.
 711         'actions' => {
 712                 'override' => 0,
 713                 'default' => []},
 714
 715         # Allow gitweb scan project content tags of project repository,
 716         # and display the popular Web 2.0-ish "tag cloud" near the projects
 717         # list.  Note that this is something COMPLETELY different from the
 718         # normal Git tags.
 719
 720         # gitweb by itself can show existing tags, but it does not handle
 721         # tagging itself; you need to do it externally, outside gitweb.
 722         # The format is described in git_get_project_ctags() subroutine.
 723         # You may want to install the HTML::TagCloud Perl module to get
 724         # a pretty tag cloud instead of just a list of tags.
 725
 726         # To enable system wide have in $GITWEB_CONFIG
 727         # $feature{'ctags'}{'default'} = [1];
 728         # Project specific override is not supported.
 729
 730         # A value of 0 means no ctags display or editing.  A value of
 731         # 1 enables ctags display but never editing.  A non-empty value
 732         # that is not a string of digits enables ctags display AND the
 733         # ability to add tags using a form that uses method POST and
 734         # an action value set to the configured 'ctags' value.
 735         'ctags' => {
 736                 'override' => 0,
 737                 'default' => [0]},
 738
 739         # The maximum number of patches in a patchset generated in patch
 740         # view. Set this to 0 or undef to disable patch view, or to a
 741         # negative number to remove any limit.
 742
 743         # To disable system wide have in $GITWEB_CONFIG
 744         # $feature{'patches'}{'default'} = [0];
 745         # To have project specific config enable override in $GITWEB_CONFIG
 746         # $feature{'patches'}{'override'} = 1;
 747         # and in project config gitweb.patches = 0|n;
 748         # where n is the maximum number of patches allowed in a patchset.
 749         'patches' => {
 750                 'sub' => \&feature_patches,
 751                 'override' => 0,
 752                 'default' => [16]},
 753
 754         # Avatar support. When this feature is enabled, views such as
 755         # shortlog or commit will display an avatar associated with
 756         # the email of the committer(s) and/or author(s).
 757
 758         # Currently available providers are gravatar and picon.
 759         # If an unknown provider is specified, the feature is disabled.
 760
 761         # Gravatar depends on Digest::MD5.
 762         # Picon currently relies on the indiana.edu database.
 763
 764         # To enable system wide have in $GITWEB_CONFIG
 765         # $feature{'avatar'}{'default'} = ['<provider>'];
 766         # where <provider> is either gravatar or picon.
 767         # To have project specific config enable override in $GITWEB_CONFIG
 768         # $feature{'avatar'}{'override'} = 1;
 769         # and in project config gitweb.avatar = <provider>;
 770         'avatar' => {
 771                 'sub' => \&feature_avatar,
 772                 'override' => 0,
 773                 'default' => ['']},
 774
 775         # Enable displaying how much time and how many git commands
 776         # it took to generate and display page.  Disabled by default.
 777         # Project specific override is not supported.
 778         'timed' => {
 779                 'override' => 0,
 780                 'default' => [0]},
 781
 782         # Enable turning some links into links to actions which require
 783         # JavaScript to run (like 'blame_incremental').  Not enabled by
 784         # default.  Project specific override is currently not supported.
 785         'javascript-actions' => {
 786                 'override' => 0,
 787                 'default' => [0]},
 788
 789         # Enable and configure ability to change common timezone for dates
 790         # in gitweb output via JavaScript.  Enabled by default.
 791         # Project specific override is not supported.
 792         'javascript-timezone' => {
 793                 'override' => 0,
 794                 'default' => [
 795                         'local',     # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
 796                                      # or undef to turn off this feature
 797                         'gitweb_tz', # name of cookie where to store selected timezone
 798                         'datetime',  # CSS class used to mark up dates for manipulation
 799                 ]},
 800
 801         # Syntax highlighting support. This is based on Daniel Svensson's
 802         # and Sham Chukoury's work in gitweb-xmms2.git.
 803         # It requires the 'highlight' program present in $PATH,
 804         # and therefore is disabled by default.
 805
 806         # To enable system wide have in $GITWEB_CONFIG
 807         # $feature{'highlight'}{'default'} = [1];
 808
 809         'highlight' => {
 810                 'sub' => sub { feature_bool('highlight', @_) },
 811                 'override' => 0,
 812                 'default' => [0]},
 813
 814         # Enable displaying of remote heads in the heads list
 815
 816         # To enable system wide have in $GITWEB_CONFIG
 817         # $feature{'remote_heads'}{'default'} = [1];
 818         # To have project specific config enable override in $GITWEB_CONFIG
 819         # $feature{'remote_heads'}{'override'} = 1;
 820         # and in project config gitweb.remoteheads = 0|1;
 821         'remote_heads' => {
 822                 'sub' => sub { feature_bool('remote_heads', @_) },
 823                 'override' => 0,
 824                 'default' => [0]},
 825
 826         # Enable showing branches under other refs in addition to heads
 827
 828         # To set system wide extra branch refs have in $GITWEB_CONFIG
 829         # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
 830         # To have project specific config enable override in $GITWEB_CONFIG
 831         # $feature{'extra-branch-refs'}{'override'} = 1;
 832         # and in project config gitweb.extrabranchrefs = dirs of choice
 833         # Every directory is separated with whitespace.
 834
 835         'extra-branch-refs' => {
 836                 'sub' => \&feature_extra_branch_refs,
 837                 'override' => 0,
 838                 'default' => []},
 839 );
 840
 841 sub gitweb_get_feature {
 842         my ($name) = @_;
 843         return unless exists $feature{$name};
 844         my ($sub, $override, @defaults) = (
 845                 $feature{$name}{'sub'},
 846                 $feature{$name}{'override'},
 847                 @{$feature{$name}{'default'}});
 848         # project specific override is possible only if we have project
 849         our $git_dir; # global variable, declared later
 850         if (!$override || !defined $git_dir) {
 851                 return @defaults;
 852         }
 853         if (!defined $sub) {
 854                 warn "feature $name is not overridable";
 855                 return @defaults;
 856         }
 857         return $sub->(@defaults);
 858 }
 859
 860 # A wrapper to check if a given feature is enabled.
 861 # With this, you can say
 862 #
 863 #   my $bool_feat = gitweb_check_feature('bool_feat');
 864 #   gitweb_check_feature('bool_feat') or somecode;
 865 #
 866 # instead of
 867 #
 868 #   my ($bool_feat) = gitweb_get_feature('bool_feat');
 869 #   (gitweb_get_feature('bool_feat'))[0] or somecode;
 870 #
 871 sub gitweb_check_feature {
 872         return (gitweb_get_feature(@_))[0];
 873 }
 874
 875
 876 sub feature_bool {
 877         my $key = shift;
 878         my ($val) = git_get_project_config($key, '--bool');
 879
 880         if (!defined $val) {
 881                 return ($_[0]);
 882         } elsif ($val eq 'true') {
 883                 return (1);
 884         } elsif ($val eq 'false') {
 885                 return (0);
 886         }
 887 }
 888
 889 sub feature_snapshot {
 890         my (@fmts) = @_;
 891
 892         my ($val) = git_get_project_config('snapshot');
 893
 894         if ($val) {
 895                 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
 896         }
 897
 898         return @fmts;
 899 }
 900
 901 sub feature_patches {
 902         my @val = (git_get_project_config('patches', '--int'));
 903
 904         if (@val) {
 905                 return @val;
 906         }
 907
 908         return ($_[0]);
 909 }
 910
 911 sub feature_avatar {
 912         my @val = (git_get_project_config('avatar'));
 913
 914         return @val ? @val : @_;
 915 }
 916
 917 sub feature_extra_branch_refs {
 918         my (@branch_refs) = @_;
 919         my $values = git_get_project_config('extrabranchrefs');
 920
 921         if ($values) {
 922                 $values = config_to_multi ($values);
 923                 @branch_refs = ();
 924                 foreach my $value (@{$values}) {
 925                         push @branch_refs, split /\s+/, $value;
 926                 }
 927         }
 928
 929         return @branch_refs;
 930 }
 931
 932 # checking HEAD file with -e is fragile if the repository was
 933 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
 934 # and then pruned.
 935 sub check_head_link {
 936         my ($dir) = @_;
 937         return 0 unless -d "$dir/objects" && -x _;
 938         return 0 unless -d "$dir/refs" && -x _;
 939         my $headfile = "$dir/HEAD";
 940         return -l $headfile ?
 941                 readlink($headfile) =~ /^refs\/heads\// : -f $headfile;
 942 }
 943
 944 sub check_export_ok {
 945         my ($dir) = @_;
 946         return (check_head_link($dir) &&
 947                 (!$export_ok || -e "$dir/$export_ok") &&
 948                 (!$export_auth_hook || $export_auth_hook->($dir)));
 949 }
 950
 951 # process alternate names for backward compatibility
 952 # filter out unsupported (unknown) snapshot formats
 953 sub filter_snapshot_fmts {
 954         my @fmts = @_;
 955
 956         @fmts = map {
 957                 exists $known_snapshot_format_aliases{$_} ?
 958                        $known_snapshot_format_aliases{$_} : $_} @fmts;
 959         @fmts = grep {
 960                 exists $known_snapshot_formats{$_} &&
 961                 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
 962 }
 963
 964 sub filter_and_validate_refs {
 965         my @refs = @_;
 966         my %unique_refs = ();
 967
 968         foreach my $ref (@refs) {
 969                 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
 970                 # 'heads' are added implicitly in get_branch_refs().
 971                 $unique_refs{$ref} = 1 if ($ref ne 'heads');
 972         }
 973         return sort keys %unique_refs;
 974 }
 975
 976 # If it is set to code reference, it is code that it is to be run once per
 977 # request, allowing updating configurations that change with each request,
 978 # while running other code in config file only once.
 979 #
 980 # Otherwise, if it is false then gitweb would process config file only once;
 981 # if it is true then gitweb config would be run for each request.
 982 our $per_request_config = 1;
 983
 984 # If true and fileno STDIN is 0 and getsockname succeeds and getpeername fails
 985 # with ENOTCONN, then FCGI mode will be activated automatically in just the
 986 # same way as though the --fcgi option had been given instead.
 987 our $auto_fcgi = 0;
 988
 989 # read and parse gitweb config file given by its parameter.
 990 # returns true on success, false on recoverable error, allowing
 991 # to chain this subroutine, using first file that exists.
 992 # dies on errors during parsing config file, as it is unrecoverable.
 993 sub read_config_file {
 994         my $filename = shift;
 995         return unless defined $filename;
 996         # die if there are errors parsing config file
 997         if (-e $filename) {
 998                 do $filename;
 999                 die $@ if $@;
1000                 return 1;
1001         }
1002         return;
1003 }
1004
1005 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
1006 sub evaluate_gitweb_config {
1007         our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
1008         our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
1009         our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
1010
1011         # Protect against duplications of file names, to not read config twice.
1012         # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
1013         # there possibility of duplication of filename there doesn't matter.
1014         $GITWEB_CONFIG = ""        if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
1015         $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
1016
1017         # Common system-wide settings for convenience.
1018         # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
1019         read_config_file($GITWEB_CONFIG_COMMON);
1020
1021         # Use first config file that exists.  This means use the per-instance
1022         # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
1023         read_config_file($GITWEB_CONFIG) and return;
1024         read_config_file($GITWEB_CONFIG_SYSTEM);
1025 }
1026
1027 our $encode_object;
1028 our $to_utf8_pipe_command = '';
1029
1030 sub evaluate_encoding {
1031         my $requested = $fallback_encoding || 'ISO-8859-1';
1032         my $obj = Encode::find_encoding($requested) or
1033                 die_error(400, "Requested fallback encoding not found");
1034         if ($obj->name eq 'iso-8859-1') {
1035                 # Use Windows-1252 instead as required by the HTML 5 standard
1036                 my $altobj = Encode::find_encoding('Windows-1252');
1037                 $obj = $altobj if $altobj;
1038         }
1039         $encode_object = $obj;
1040         my $nm = lc($encode_object->name);
1041         unless ($nm eq 'cp1252' || $nm eq 'ascii' || $nm eq 'utf8' ||
1042                 $nm =~ /^utf-8/ || $nm =~ /^iso-8859-/) {
1043                 $to_utf8_pipe_command =
1044                   quote_command($^X, '-CO', '-MEncode=decode,FB_DEFAULT', '-pse',
1045                     '$_ = decode($fe, $_, FB_DEFAULT) if !utf8::decode($_);',
1046                     '--', "-fe=$fallback_encoding")." | ";
1047         }
1048 }
1049
1050 sub evaluate_email_obfuscate {
1051         # email obfuscation
1052         our $email;
1053         if (!$email && eval { require HTML::Email::Obfuscate; 1 }) {
1054                 $email = HTML::Email::Obfuscate->new(lite => 1);
1055         }
1056 }
1057
1058 # Get loadavg of system, to compare against $maxload.
1059 # Currently it requires '/proc/loadavg' present to get loadavg;
1060 # if it is not present it returns 0, which means no load checking.
1061 sub get_loadavg {
1062         if( -e '/proc/loadavg' ){
1063                 open my $fd, '<', '/proc/loadavg'
1064                         or return 0;
1065                 my @load = split(/\s+/, scalar <$fd>);
1066                 close $fd;
1067
1068                 # The first three columns measure CPU and IO utilization of the last one,
1069                 # five, and 10 minute periods.  The fourth column shows the number of
1070                 # currently running processes and the total number of processes in the m/n
1071                 # format.  The last column displays the last process ID used.
1072                 return $load[0] || 0;
1073         }
1074         # additional checks for load average should go here for things that don't export
1075         # /proc/loadavg
1076
1077         return 0;
1078 }
1079
1080 # version of the core git binary
1081 our $git_version;
1082 our $git_vernum = "0"; # guaranteed to always match /^\d+(\.\d+)*$/
1083 sub evaluate_git_version {
1084         $git_version = $version; # don't leak system information to attackers
1085         $git_vernum eq "0" or return; # don't run it again
1086         sub cmd_pipe;
1087         my $vers;
1088         if (defined(my $fd = cmd_pipe $GIT, '--version')) {
1089                 $vers = <$fd>;
1090                 close $fd;
1091                 $number_of_git_cmds++;
1092         }
1093         $git_vernum = $1 if defined($vers) && $vers =~ /git\s+version\s+(\d+(?:\.\d+)*)$/io;
1094 }
1095
1096 sub check_loadavg {
1097         if (defined $maxload && get_loadavg() > $maxload) {
1098                 die_error(503, "The load average on the server is too high");
1099         }
1100 }
1101
1102 # ======================================================================
1103 # input validation and dispatch
1104
1105 # input parameters can be collected from a variety of sources (presently, CGI
1106 # and PATH_INFO), so we define an %input_params hash that collects them all
1107 # together during validation: this allows subsequent uses (e.g. href()) to be
1108 # agnostic of the parameter origin
1109
1110 our %input_params = ();
1111
1112 # input parameters are stored with the long parameter name as key. This will
1113 # also be used in the href subroutine to convert parameters to their CGI
1114 # equivalent, and since the href() usage is the most frequent one, we store
1115 # the name -> CGI key mapping here, instead of the reverse.
1116 #
1117 # XXX: Warning: If you touch this, check the search form for updating,
1118 # too.
1119
1120 our @cgi_param_mapping = (
1121         project => "p",
1122         action => "a",
1123         file_name => "f",
1124         file_parent => "fp",
1125         hash => "h",
1126         hash_parent => "hp",
1127         hash_base => "hb",
1128         hash_parent_base => "hpb",
1129         page => "pg",
1130         order => "o",
1131         searchtext => "s",
1132         searchtype => "st",
1133         snapshot_format => "sf",
1134         ctag_filter => 't',
1135         extra_options => "opt",
1136         search_use_regexp => "sr",
1137         ctag => "by_tag",
1138         diff_style => "ds",
1139         project_filter => "pf",
1140         # this must be last entry (for manipulation from JavaScript)
1141         javascript => "js"
1142 );
1143 our %cgi_param_mapping = @cgi_param_mapping;
1144
1145 # we will also need to know the possible actions, for validation
1146 our %actions = (
1147         "blame" => \&git_blame,
1148         "blame_incremental" => \&git_blame_incremental,
1149         "blame_data" => \&git_blame_data,
1150         "blobdiff" => \&git_blobdiff,
1151         "blobdiff_plain" => \&git_blobdiff_plain,
1152         "blob" => \&git_blob,
1153         "blob_plain" => \&git_blob_plain,
1154         "commitdiff" => \&git_commitdiff,
1155         "commitdiff_plain" => \&git_commitdiff_plain,
1156         "commit" => \&git_commit,
1157         "forks" => \&git_forks,
1158         "heads" => \&git_heads,
1159         "history" => \&git_history,
1160         "log" => \&git_log,
1161         "patch" => \&git_patch,
1162         "patches" => \&git_patches,
1163         "refs" => \&git_refs,
1164         "remotes" => \&git_remotes,
1165         "rss" => \&git_rss,
1166         "atom" => \&git_atom,
1167         "search" => \&git_search,
1168         "search_help" => \&git_search_help,
1169         "shortlog" => \&git_shortlog,
1170         "summary" => \&git_summary,
1171         "tag" => \&git_tag,
1172         "tags" => \&git_tags,
1173         "tree" => \&git_tree,
1174         "snapshot" => \&git_snapshot,
1175         "object" => \&git_object,
1176         # those below don't need $project
1177         "opml" => \&git_opml,
1178         "frontpage" => \&git_frontpage,
1179         "project_list" => \&git_project_list,
1180         "project_index" => \&git_project_index,
1181 );
1182
1183 # the only actions we will allow to be cached
1184 my %supported_cache_actions;
1185 BEGIN {%supported_cache_actions = map {( $_ => 1 )} qw(summary)}
1186
1187 # finally, we have the hash of allowed extra_options for the commands that
1188 # allow them
1189 our %allowed_options = (
1190         "--no-merges" => [ qw(rss atom log shortlog history) ],
1191 );
1192
1193 # fill %input_params with the CGI parameters. All values except for 'opt'
1194 # should be single values, but opt can be an array. We should probably
1195 # build an array of parameters that can be multi-valued, but since for the time
1196 # being it's only this one, we just single it out
1197 sub evaluate_query_params {
1198         our $cgi;
1199
1200         while (my ($name, $symbol) = each %cgi_param_mapping) {
1201                 if ($symbol eq 'opt') {
1202                         $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
1203                 } else {
1204                         $input_params{$name} = decode_utf8($cgi->param($symbol));
1205                 }
1206         }
1207
1208         # Backwards compatibility - by_tag= <=> t=
1209         if ($input_params{'ctag'}) {
1210                 $input_params{'ctag_filter'} = $input_params{'ctag'};
1211         }
1212 }
1213
1214 # now read PATH_INFO and update the parameter list for missing parameters
1215 sub evaluate_path_info {
1216         return if defined $input_params{'project'};
1217         return if !$path_info;
1218         $path_info =~ s,^/+,,;
1219         return if !$path_info;
1220
1221         # find which part of PATH_INFO is project
1222         my $project = $path_info;
1223         $project =~ s,/+$,,;
1224         while ($project && !check_head_link("$projectroot/$project")) {
1225                 $project =~ s,/*[^/]*$,,;
1226         }
1227         return unless $project;
1228         $input_params{'project'} = $project;
1229
1230         # do not change any parameters if an action is given using the query string
1231         return if $input_params{'action'};
1232         $path_info =~ s,^\Q$project\E/*,,;
1233
1234         # next, check if we have an action
1235         my $action = $path_info;
1236         $action =~ s,/.*$,,;
1237         if (exists $actions{$action}) {
1238                 $path_info =~ s,^$action/*,,;
1239                 $input_params{'action'} = $action;
1240         }
1241
1242         # list of actions that want hash_base instead of hash, but can have no
1243         # pathname (f) parameter
1244         my @wants_base = (
1245                 'tree',
1246                 'history',
1247         );
1248
1249         # we want to catch, among others
1250         # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
1251         my ($parentrefname, $parentpathname, $refname, $pathname) =
1252                 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
1253
1254         # first, analyze the 'current' part
1255         if (defined $pathname) {
1256                 # we got "branch:filename" or "branch:dir/"
1257                 # we could use git_get_type(branch:pathname), but:
1258                 # - it needs $git_dir
1259                 # - it does a git() call
1260                 # - the convention of terminating directories with a slash
1261                 #   makes it superfluous
1262                 # - embedding the action in the PATH_INFO would make it even
1263                 #   more superfluous
1264                 $pathname =~ s,^/+,,;
1265                 if (!$pathname || substr($pathname, -1) eq "/") {
1266                         $input_params{'action'} ||= "tree";
1267                         $pathname =~ s,/$,,;
1268                 } else {
1269                         # the default action depends on whether we had parent info
1270                         # or not
1271                         if ($parentrefname) {
1272                                 $input_params{'action'} ||= "blobdiff_plain";
1273                         } else {
1274                                 $input_params{'action'} ||= "blob_plain";
1275                         }
1276                 }
1277                 $input_params{'hash_base'} ||= $refname;
1278                 $input_params{'file_name'} ||= $pathname;
1279         } elsif (defined $refname) {
1280                 # we got "branch". In this case we have to choose if we have to
1281                 # set hash or hash_base.
1282                 #
1283                 # Most of the actions without a pathname only want hash to be
1284                 # set, except for the ones specified in @wants_base that want
1285                 # hash_base instead. It should also be noted that hand-crafted
1286                 # links having 'history' as an action and no pathname or hash
1287                 # set will fail, but that happens regardless of PATH_INFO.
1288                 if (defined $parentrefname) {
1289                         # if there is parent let the default be 'shortlog' action
1290                         # (for http://git.example.com/repo.git/A..B links); if there
1291                         # is no parent, dispatch will detect type of object and set
1292                         # action appropriately if required (if action is not set)
1293                         $input_params{'action'} ||= "shortlog";
1294                 }
1295                 if ($input_params{'action'} &&
1296                     grep { $_ eq $input_params{'action'} } @wants_base) {
1297                         $input_params{'hash_base'} ||= $refname;
1298                 } else {
1299                         $input_params{'hash'} ||= $refname;
1300                 }
1301         }
1302
1303         # next, handle the 'parent' part, if present
1304         if (defined $parentrefname) {
1305                 # a missing pathspec defaults to the 'current' filename, allowing e.g.
1306                 # someproject/blobdiff/oldrev..newrev:/filename
1307                 if ($parentpathname) {
1308                         $parentpathname =~ s,^/+,,;
1309                         $parentpathname =~ s,/$,,;
1310                         $input_params{'file_parent'} ||= $parentpathname;
1311                 } else {
1312                         $input_params{'file_parent'} ||= $input_params{'file_name'};
1313                 }
1314                 # we assume that hash_parent_base is wanted if a path was specified,
1315                 # or if the action wants hash_base instead of hash
1316                 if (defined $input_params{'file_parent'} ||
1317                         grep { $_ eq $input_params{'action'} } @wants_base) {
1318                         $input_params{'hash_parent_base'} ||= $parentrefname;
1319                 } else {
1320                         $input_params{'hash_parent'} ||= $parentrefname;
1321                 }
1322         }
1323
1324         # for the snapshot action, we allow URLs in the form
1325         # $project/snapshot/$hash.ext
1326         # where .ext determines the snapshot and gets removed from the
1327         # passed $refname to provide the $hash.
1328         #
1329         # To be able to tell that $refname includes the format extension, we
1330         # require the following two conditions to be satisfied:
1331         # - the hash input parameter MUST have been set from the $refname part
1332         #   of the URL (i.e. they must be equal)
1333         # - the snapshot format MUST NOT have been defined already (e.g. from
1334         #   CGI parameter sf)
1335         # It's also useless to try any matching unless $refname has a dot,
1336         # so we check for that too
1337         if (defined $input_params{'action'} &&
1338                 $input_params{'action'} eq 'snapshot' &&
1339                 defined $refname && index($refname, '.') != -1 &&
1340                 $refname eq $input_params{'hash'} &&
1341                 !defined $input_params{'snapshot_format'}) {
1342                 # We loop over the known snapshot formats, checking for
1343                 # extensions. Allowed extensions are both the defined suffix
1344                 # (which includes the initial dot already) and the snapshot
1345                 # format key itself, with a prepended dot
1346                 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1347                         my $hash = $refname;
1348                         unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1349                                 next;
1350                         }
1351                         my $sfx = $1;
1352                         # a valid suffix was found, so set the snapshot format
1353                         # and reset the hash parameter
1354                         $input_params{'snapshot_format'} = $fmt;
1355                         $input_params{'hash'} = $hash;
1356                         # we also set the format suffix to the one requested
1357                         # in the URL: this way a request for e.g. .tgz returns
1358                         # a .tgz instead of a .tar.gz
1359                         $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1360                         last;
1361                 }
1362         }
1363 }
1364
1365 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1366      $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1367      $searchtext, $search_regexp, $project_filter);
1368 sub evaluate_and_validate_params {
1369         our $action = $input_params{'action'};
1370         if (defined $action) {
1371                 if (!is_valid_action($action)) {
1372                         die_error(400, "Invalid action parameter");
1373                 }
1374         }
1375
1376         # parameters which are pathnames
1377         our $project = $input_params{'project'};
1378         if (defined $project) {
1379                 if (!is_valid_project($project)) {
1380                         undef $project;
1381                         die_error(404, "No such project");
1382                 }
1383         }
1384
1385         our $project_filter = $input_params{'project_filter'};
1386         if (defined $project_filter) {
1387                 if (!is_valid_pathname($project_filter)) {
1388                         die_error(404, "Invalid project_filter parameter");
1389                 }
1390         }
1391
1392         our $file_name = $input_params{'file_name'};
1393         if (defined $file_name) {
1394                 if (!is_valid_pathname($file_name)) {
1395                         die_error(400, "Invalid file parameter");
1396                 }
1397         }
1398
1399         our $file_parent = $input_params{'file_parent'};
1400         if (defined $file_parent) {
1401                 if (!is_valid_pathname($file_parent)) {
1402                         die_error(400, "Invalid file parent parameter");
1403                 }
1404         }
1405
1406         # parameters which are refnames
1407         our $hash = $input_params{'hash'};
1408         if (defined $hash) {
1409                 if (!is_valid_refname($hash)) {
1410                         die_error(400, "Invalid hash parameter");
1411                 }
1412         }
1413
1414         our $hash_parent = $input_params{'hash_parent'};
1415         if (defined $hash_parent) {
1416                 if (!is_valid_refname($hash_parent)) {
1417                         die_error(400, "Invalid hash parent parameter");
1418                 }
1419         }
1420
1421         our $hash_base = $input_params{'hash_base'};
1422         if (defined $hash_base) {
1423                 if (!is_valid_refname($hash_base)) {
1424                         die_error(400, "Invalid hash base parameter");
1425                 }
1426         }
1427
1428         our @extra_options = @{$input_params{'extra_options'}};
1429         # @extra_options is always defined, since it can only be (currently) set from
1430         # CGI, and $cgi->param() returns the empty array in array context if the param
1431         # is not set
1432         foreach my $opt (@extra_options) {
1433                 if (not exists $allowed_options{$opt}) {
1434                         die_error(400, "Invalid option parameter");
1435                 }
1436                 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1437                         die_error(400, "Invalid option parameter for this action");
1438                 }
1439         }
1440
1441         our $hash_parent_base = $input_params{'hash_parent_base'};
1442         if (defined $hash_parent_base) {
1443                 if (!is_valid_refname($hash_parent_base)) {
1444                         die_error(400, "Invalid hash parent base parameter");
1445                 }
1446         }
1447
1448         # other parameters
1449         our $page = $input_params{'page'};
1450         if (defined $page) {
1451                 if ($page =~ m/[^0-9]/) {
1452                         die_error(400, "Invalid page parameter");
1453                 }
1454         }
1455
1456         our $searchtype = $input_params{'searchtype'};
1457         if (defined $searchtype) {
1458                 if ($searchtype =~ m/[^a-z]/) {
1459                         die_error(400, "Invalid searchtype parameter");
1460                 }
1461         }
1462
1463         our $search_use_regexp = $input_params{'search_use_regexp'};
1464
1465         our $searchtext = $input_params{'searchtext'};
1466         our $search_regexp = undef;
1467         if (defined $searchtext) {
1468                 if (length($searchtext) < 2) {
1469                         die_error(403, "At least two characters are required for search parameter");
1470                 }
1471                 if ($search_use_regexp) {
1472                         $search_regexp = $searchtext;
1473                         if (!eval { qr/$search_regexp/; 1; }) {
1474                                 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1475                                 die_error(400, "Invalid search regexp '$search_regexp'",
1476                                           esc_html($error));
1477                         }
1478                 } else {
1479                         $search_regexp = quotemeta $searchtext;
1480                 }
1481         }
1482 }
1483
1484 # path to the current git repository
1485 our $git_dir;
1486 sub evaluate_git_dir {
1487         our $git_dir = $project ? "$projectroot/$project" : undef;
1488 }
1489
1490 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1491 sub configure_gitweb_features {
1492         # list of supported snapshot formats
1493         our @snapshot_fmts = gitweb_get_feature('snapshot');
1494         @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1495
1496         # check that the avatar feature is set to a known provider name,
1497         # and for each provider check if the dependencies are satisfied.
1498         # if the provider name is invalid or the dependencies are not met,
1499         # reset $git_avatar to the empty string.
1500         our ($git_avatar) = gitweb_get_feature('avatar');
1501         if ($git_avatar eq 'gravatar') {
1502                 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1503         } elsif ($git_avatar eq 'picon') {
1504                 # no dependencies
1505         } else {
1506                 $git_avatar = '';
1507         }
1508
1509         our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1510         @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1511 }
1512
1513 sub get_branch_refs {
1514         return ('heads', @extra_branch_refs);
1515 }
1516
1517 # custom error handler: 'die <message>' is Internal Server Error
1518 sub handle_errors_html {
1519         my $msg = shift; # it is already HTML escaped
1520
1521         # to avoid infinite loop where error occurs in die_error,
1522         # change handler to default handler, disabling handle_errors_html
1523         set_message("Error occurred when inside die_error:\n$msg");
1524
1525         # you cannot jump out of die_error when called as error handler;
1526         # the subroutine set via CGI::Carp::set_message is called _after_
1527         # HTTP headers are already written, so it cannot write them itself
1528         die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1529 }
1530 set_message(\&handle_errors_html);
1531
1532 our $shown_stale_message = 0;
1533 our $cache_dump = undef;
1534 our $cache_dump_mtime = undef;
1535
1536 # dispatch
1537 my $cache_mode_active;
1538 sub dispatch {
1539         if (!defined $action) {
1540                 if (defined $hash) {
1541                         $action = git_get_type($hash);
1542                         $action or die_error(404, "Object does not exist");
1543                 } elsif (defined $hash_base && defined $file_name) {
1544                         $action = git_get_type("$hash_base:$file_name");
1545                         $action or die_error(404, "File or directory does not exist");
1546                 } elsif (defined $project) {
1547                         $action = 'summary';
1548                 } else {
1549                         $action = 'frontpage';
1550                 }
1551         }
1552         if (!defined($actions{$action})) {
1553                 die_error(400, "Unknown action");
1554         }
1555         if ($action !~ m/^(?:opml|frontpage|project_list|project_index)$/ &&
1556             !$project) {
1557                 die_error(400, "Project needed");
1558         }
1559
1560         my $defstyle = $stylesheet;
1561         local $stylesheet = $defstyle;
1562         if ($ENV{'HTTP_COOKIE'} && ";$ENV{'HTTP_COOKIE'};" =~ /;\s*style\s*=\s*([a-z][a-z0-9_-]*)\s*;/) {{
1563                 my $stylename = $1;
1564                 last unless $ENV{'DOCUMENT_ROOT'} && -r "$ENV{'DOCUMENT_ROOT'}/style/$stylename.css";
1565                 $stylesheet = "/style/$stylename.css";
1566         }}
1567
1568         my $cached_page = $supported_cache_actions{$action}
1569                 ? cached_action_page($action)
1570                 : undef;
1571         goto DUMPCACHE if $cached_page;
1572         local *SAVEOUT = *STDOUT;
1573         $cache_mode_active = $supported_cache_actions{$action}
1574                 ? cached_action_start($action)
1575                 : undef;
1576
1577         configure_gitweb_features();
1578         $actions{$action}->();
1579
1580         return unless $cache_mode_active;
1581
1582         $cached_page = cached_action_finish($action);
1583         *STDOUT = *SAVEOUT;
1584
1585         DUMPCACHE:
1586
1587         $cache_mode_active = 0;
1588         # Avoid any extra unwanted encoding steps as $cached_page is raw bytes
1589         binmode STDOUT, ':raw';
1590         our $fcgi_raw_mode = 1;
1591         print expand_gitweb_pi($cached_page, time);
1592         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
1593         $fcgi_raw_mode = 0;
1594 }
1595
1596 sub reset_timer {
1597         our $t0 = [ gettimeofday() ]
1598                 if defined $t0;
1599         our $number_of_git_cmds = 0;
1600 }
1601
1602 our $first_request = 1;
1603 our $evaluate_uri_force = undef;
1604 sub run_request {
1605         reset_timer();
1606
1607         # Only allow GET and HEAD methods
1608         if (!$ENV{'REQUEST_METHOD'} || ($ENV{'REQUEST_METHOD'} ne 'GET' && $ENV{'REQUEST_METHOD'} ne 'HEAD')) {
1609                 print <<EOT;
1610 Status: 405 Method Not Allowed
1611 Content-Type: text/plain
1612 Allow: GET,HEAD
1613
1614 405 Method Not Allowed
1615 EOT
1616                 return;
1617         }
1618
1619         evaluate_uri();
1620         &$evaluate_uri_force() if $evaluate_uri_force;
1621         if ($per_request_config) {
1622                 if (ref($per_request_config) eq 'CODE') {
1623                         $per_request_config->();
1624                 } elsif (!$first_request) {
1625                         evaluate_gitweb_config();
1626                         evaluate_email_obfuscate();
1627                 }
1628         }
1629         check_loadavg();
1630
1631         # $projectroot and $projects_list might be set in gitweb config file
1632         $projects_list ||= $projectroot;
1633
1634         evaluate_query_params();
1635         evaluate_path_info();
1636         evaluate_and_validate_params();
1637         evaluate_git_dir();
1638
1639         dispatch();
1640 }
1641
1642 our $is_last_request = sub { 1 };
1643 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1644 our $CGI = 'CGI';
1645 our $cgi;
1646 our $fcgi_mode = 0;
1647 our $fcgi_nproc_active = 0;
1648 our $fcgi_raw_mode = 0;
1649 sub is_fcgi {
1650         use Errno;
1651         my $stdinfno = fileno STDIN;
1652         return 0 unless defined $stdinfno && $stdinfno == 0;
1653         return 0 unless getsockname STDIN;
1654         return 0 if getpeername STDIN;
1655         return $!{ENOTCONN}?1:0;
1656 }
1657 sub configure_as_fcgi {
1658         return if $fcgi_mode;
1659
1660         require FCGI;
1661         require CGI::Fast;
1662
1663         # We have gone to great effort to make sure that all incoming data has
1664         # been converted from whatever format it was in into UTF-8.  We have
1665         # even taken care to make sure the output handle is in ':utf8' mode.
1666         # Now along comes FCGI and blows it with:
1667         #
1668         #     Use of wide characters in FCGI::Stream::PRINT is deprecated
1669         #      and will stop wprking[sic] in a future version of FCGI
1670         #
1671         # To fix this we replace FCGI::Stream::PRINT with our own routine that
1672         # first encodes everything and then calls the original routine, but
1673         # not if $fcgi_raw_mode is true (then we just call the original routine).
1674         #
1675         # Note that we could do this by using utf8::is_utf8 to check instead
1676         # of having a $fcgi_raw_mode global, but that would be slower to run
1677         # the test on each element and much slower than skipping the conversion
1678         # entirely when we know we're outputting raw bytes.
1679         my $orig = \&FCGI::Stream::PRINT;
1680         undef *FCGI::Stream::PRINT;
1681         *FCGI::Stream::PRINT = sub {
1682                 @_ = (shift, map {my $x=$_; utf8::encode($x); $x} @_)
1683                         unless $fcgi_raw_mode;
1684                 goto $orig;
1685         };
1686
1687         our $CGI = 'CGI::Fast';
1688
1689         $fcgi_mode = 1;
1690         $first_request = 0;
1691         my $request_number = 0;
1692         # let each child service 100 requests
1693         our $is_last_request = sub { ++$request_number >= 100 };
1694 }
1695 sub evaluate_argv {
1696         my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1697         configure_as_fcgi()
1698                 if $script_name =~ /\.fcgi$/ || ($auto_fcgi && is_fcgi());
1699
1700         my $nproc_sub = sub {
1701                 my ($arg, $val) = @_;
1702                 return unless eval { require FCGI::ProcManager; 1; };
1703                 $fcgi_nproc_active = 1;
1704                 my $proc_manager = FCGI::ProcManager->new({
1705                         n_processes => $val,
1706                 });
1707                 our $pre_listen_hook    = sub { $proc_manager->pm_manage()        };
1708                 our $pre_dispatch_hook  = sub { $proc_manager->pm_pre_dispatch()  };
1709                 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1710         };
1711         if (@ARGV) {
1712                 require Getopt::Long;
1713                 Getopt::Long::GetOptions(
1714                         'fastcgi|fcgi|f' => \&configure_as_fcgi,
1715                         'nproc|n=i' => $nproc_sub,
1716                 );
1717         };
1718         if (!$fcgi_nproc_active && defined $ENV{'GITWEB_FCGI_NPROC'} && $ENV{'GITWEB_FCGI_NPROC'} =~ /^\d+$/) {
1719                 &$nproc_sub('nproc', $ENV{'GITWEB_FCGI_NPROC'});
1720         }
1721 }
1722
1723 # Any "our" variable that could possibly influence correct handling of
1724 # a CGI request MUST be reset in this subroutine
1725 sub _reset_globals {
1726         # Note that $t0 and $number_of_git_commands are handled by reset_timer
1727         our %input_params = ();
1728         our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1729              $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1730              $searchtext, $search_regexp, $project_filter) = ();
1731         our $git_dir = undef;
1732         our (@snapshot_fmts, $git_avatar, @extra_branch_refs) = ();
1733         our %avatar_cache = ();
1734         our $config_file = '';
1735         our %config = ();
1736         our $gitweb_project_owner = undef;
1737         our $shown_stale_message = 0;
1738         our $fcgi_raw_mode = 0;
1739         keys %known_snapshot_formats; # reset 'each' iterator
1740 }
1741
1742 sub run {
1743         evaluate_gitweb_config();
1744         evaluate_encoding();
1745         evaluate_email_obfuscate();
1746         evaluate_git_version();
1747         my ($ml, $mi, $bu, $hl, $subroutine) = ($my_url, $my_uri, $base_url, $home_link, '');
1748         $subroutine .= '$my_url = $ml;' if defined $my_url && $my_url ne '';
1749         $subroutine .= '$my_uri = $mi;' if defined $my_uri; # this one can be ""
1750         $subroutine .= '$base_url = $bu;' if defined $base_url && $base_url ne '';
1751         $subroutine .= '$home_link = $hl;' if defined $home_link && $home_link ne '';
1752         $evaluate_uri_force = eval "sub {$subroutine}" if $subroutine;
1753         $first_request = 1;
1754         evaluate_argv();
1755
1756         $pre_listen_hook->()
1757                 if $pre_listen_hook;
1758
1759  REQUEST:
1760         while ($cgi = $CGI->new()) {
1761                 $pre_dispatch_hook->()
1762                         if $pre_dispatch_hook;
1763                 {
1764                         # most globals can simply be reset
1765                         _reset_globals;
1766
1767                         # evaluate_path_info corrupts %known_snapshot_formats
1768                         # so we need a deepish copy of it -- note that
1769                         # _reset_globals already took care of resetting its
1770                         # hash iterator that evaluate_path_info also leaves
1771                         # in an indeterminate state
1772                         my %formats = ();
1773                         while (my ($k,$v) = each(%known_snapshot_formats)) {
1774                                 $formats{$k} = {%{$known_snapshot_formats{$k}}};
1775                         }
1776                         local *known_snapshot_formats = \%formats;
1777
1778                         eval {run_request()};
1779                 }
1780                 $post_dispatch_hook->()
1781                         if $post_dispatch_hook;
1782                 $first_request = 0;
1783
1784                 last REQUEST if ($is_last_request->());
1785         }
1786
1787         1;
1788 }
1789
1790 run();
1791
1792 if (defined caller) {
1793         # wrapped in a subroutine processing requests,
1794         # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1795         return;
1796 } else {
1797         # pure CGI script, serving single request
1798         exit;
1799 }
1800
1801 ## ======================================================================
1802 ## action links
1803
1804 # possible values of extra options
1805 # -full => 0|1      - use absolute/full URL ($my_uri/$my_url as base)
1806 # -replay => 1      - start from a current view (replay with modifications)
1807 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1808 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1809 sub href {
1810         my %params = @_;
1811         # default is to use -absolute url() i.e. $my_uri
1812         my $href = $params{-full} ? $my_url : $my_uri;
1813
1814         # implicit -replay, must be first of implicit params
1815         $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1816
1817         $params{'project'} = $project unless exists $params{'project'};
1818
1819         if ($params{-replay}) {
1820                 while (my ($name, $symbol) = each %cgi_param_mapping) {
1821                         if (!exists $params{$name}) {
1822                                 $params{$name} = $input_params{$name};
1823                         }
1824                 }
1825         }
1826
1827         my $use_pathinfo = gitweb_check_feature('pathinfo');
1828         if (defined $params{'project'} &&
1829             (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1830                 # try to put as many parameters as possible in PATH_INFO:
1831                 #   - project name
1832                 #   - action
1833                 #   - hash_parent or hash_parent_base:/file_parent
1834                 #   - hash or hash_base:/filename
1835                 #   - the snapshot_format as an appropriate suffix
1836
1837                 # When the script is the root DirectoryIndex for the domain,
1838                 # $href here would be something like http://gitweb.example.com/
1839                 # Thus, we strip any trailing / from $href, to spare us double
1840                 # slashes in the final URL
1841                 $href =~ s,/$,,;
1842
1843                 # Then add the project name, if present
1844                 $href .= "/".esc_path_info($params{'project'});
1845                 delete $params{'project'};
1846
1847                 # since we destructively absorb parameters, we keep this
1848                 # boolean that remembers if we're handling a snapshot
1849                 my $is_snapshot = $params{'action'} eq 'snapshot';
1850
1851                 # Summary just uses the project path URL, any other action is
1852                 # added to the URL
1853                 if (defined $params{'action'}) {
1854                         $href .= "/".esc_path_info($params{'action'})
1855                                 unless $params{'action'} eq 'summary';
1856                         delete $params{'action'};
1857                 }
1858
1859                 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1860                 # stripping nonexistent or useless pieces
1861                 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1862                         || $params{'hash_parent'} || $params{'hash'});
1863                 if (defined $params{'hash_base'}) {
1864                         if (defined $params{'hash_parent_base'}) {
1865                                 $href .= esc_path_info($params{'hash_parent_base'});
1866                                 # skip the file_parent if it's the same as the file_name
1867                                 if (defined $params{'file_parent'}) {
1868                                         if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1869                                                 delete $params{'file_parent'};
1870                                         } elsif ($params{'file_parent'} !~ /\.\./) {
1871                                                 $href .= ":/".esc_path_info($params{'file_parent'});
1872                                                 delete $params{'file_parent'};
1873                                         }
1874                                 }
1875                                 $href .= "..";
1876                                 delete $params{'hash_parent'};
1877                                 delete $params{'hash_parent_base'};
1878                         } elsif (defined $params{'hash_parent'}) {
1879                                 $href .= esc_path_info($params{'hash_parent'}). "..";
1880                                 delete $params{'hash_parent'};
1881                         }
1882
1883                         $href .= esc_path_info($params{'hash_base'});
1884                         if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1885                                 $href .= ":/".esc_path_info($params{'file_name'});
1886                                 delete $params{'file_name'};
1887                         }
1888                         delete $params{'hash'};
1889                         delete $params{'hash_base'};
1890                 } elsif (defined $params{'hash'}) {
1891                         $href .= esc_path_info($params{'hash'});
1892                         delete $params{'hash'};
1893                 }
1894
1895                 # If the action was a snapshot, we can absorb the
1896                 # snapshot_format parameter too
1897                 if ($is_snapshot) {
1898                         my $fmt = $params{'snapshot_format'};
1899                         # snapshot_format should always be defined when href()
1900                         # is called, but just in case some code forgets, we
1901                         # fall back to the default
1902                         $fmt ||= $snapshot_fmts[0];
1903                         $href .= $known_snapshot_formats{$fmt}{'suffix'};
1904                         delete $params{'snapshot_format'};
1905                 }
1906         }
1907
1908         # now encode the parameters explicitly
1909         my @result = ();
1910         for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1911                 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1912                 if (defined $params{$name}) {
1913                         if (ref($params{$name}) eq "ARRAY") {
1914                                 foreach my $par (@{$params{$name}}) {
1915                                         push @result, $symbol . "=" . esc_param($par);
1916                                 }
1917                         } else {
1918                                 push @result, $symbol . "=" . esc_param($params{$name});
1919                         }
1920                 }
1921         }
1922         $href .= "?" . join(';', @result) if scalar @result;
1923
1924         # final transformation: trailing spaces must be escaped (URI-encoded)
1925         $href =~ s/(\s+)$/CGI::escape($1)/e;
1926
1927         if ($params{-anchor}) {
1928                 $href .= "#".esc_param($params{-anchor});
1929         }
1930
1931         return $href;
1932 }
1933
1934
1935 ## ======================================================================
1936 ## validation, quoting/unquoting and escaping
1937
1938 sub is_valid_action {
1939         my $input = shift;
1940         return undef unless exists $actions{$input};
1941         return 1;
1942 }
1943
1944 sub is_valid_project {
1945         my $input = shift;
1946
1947         return unless defined $input;
1948         if (!is_valid_pathname($input) ||
1949                 !(-d "$projectroot/$input") ||
1950                 !check_export_ok("$projectroot/$input") ||
1951                 ($strict_export && !project_in_list($input))) {
1952                 return undef;
1953         } else {
1954                 return 1;
1955         }
1956 }
1957
1958 sub is_valid_pathname {
1959         my $input = shift;
1960
1961         return undef unless defined $input;
1962         # no '.' or '..' as elements of path, i.e. no '.' or '..'
1963         # at the beginning, at the end, and between slashes.
1964         # also this catches doubled slashes
1965         if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1966                 return undef;
1967         }
1968         # no null characters
1969         if ($input =~ m!\0!) {
1970                 return undef;
1971         }
1972         return 1;
1973 }
1974
1975 sub is_valid_ref_format {
1976         my $input = shift;
1977
1978         return undef unless defined $input;
1979         # restrictions on ref name according to git-check-ref-format
1980         if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1981                 return undef;
1982         }
1983         return 1;
1984 }
1985
1986 sub is_valid_refname {
1987         my $input = shift;
1988
1989         return undef unless defined $input;
1990         # textual hashes are O.K.
1991         if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1992                 return 1;
1993         }
1994         # allow repeated trailing '[~^]n*' suffix(es)
1995         $input =~ s/^([^~^]+)(?:[~^]\d*)+$/$1/;
1996         # it must be correct pathname
1997         is_valid_pathname($input) or return undef;
1998         # check git-check-ref-format restrictions
1999         is_valid_ref_format($input) or return undef;
2000         return 1;
2001 }
2002
2003 # decode sequences of octets in utf8 into Perl's internal form,
2004 # which is utf-8 with utf8 flag set if needed.  gitweb writes out
2005 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
2006 sub to_utf8 {
2007         my $str = shift;
2008         return undef unless defined $str;
2009
2010         if (utf8::is_utf8($str) || utf8::decode($str)) {
2011                 return $str;
2012         } else {
2013                 return $encode_object->decode($str, Encode::FB_DEFAULT);
2014         }
2015 }
2016
2017 # quote unsafe chars, but keep the slash, even when it's not
2018 # correct, but quoted slashes look too horrible in bookmarks
2019 sub esc_param {
2020         my $str = shift;
2021         return undef unless defined $str;
2022         $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
2023         $str =~ s/ /\+/g;
2024         return $str;
2025 }
2026
2027 # the quoting rules for path_info fragment are slightly different
2028 sub esc_path_info {
2029         my $str = shift;
2030         return undef unless defined $str;
2031
2032         # path_info doesn't treat '+' as space (specially), but '?' must be escaped
2033         $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
2034
2035         return $str;
2036 }
2037
2038 # quote unsafe chars in whole URL, so some characters cannot be quoted
2039 sub esc_url {
2040         my $str = shift;
2041         return undef unless defined $str;
2042         $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
2043         $str =~ s/ /\+/g;
2044         return $str;
2045 }
2046
2047 # quote unsafe characters in HTML attributes
2048 sub esc_attr {
2049
2050         # for XHTML conformance escaping '"' to '&quot;' is not enough
2051         return esc_html(@_);
2052 }
2053
2054 # replace invalid utf8 character with SUBSTITUTION sequence
2055 sub esc_html {
2056         my $str = shift;
2057         my %opts = @_;
2058
2059         return undef unless defined $str;
2060
2061         $str = to_utf8($str);
2062         $str = $cgi->escapeHTML($str);
2063         if ($opts{'-nbsp'}) {
2064                 $str =~ s/ /&#160;/g;
2065         }
2066         use bytes;
2067         $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
2068         return $str;
2069 }
2070
2071 # quote control characters and escape filename to HTML
2072 sub esc_path {
2073         my $str = shift;
2074         my %opts = @_;
2075
2076         return undef unless defined $str;
2077
2078         $str = to_utf8($str);
2079         $str = $cgi->escapeHTML($str);
2080         if ($opts{'-nbsp'}) {
2081                 $str =~ s/ /&#160;/g;
2082         }
2083         use bytes;
2084         $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
2085         return $str;
2086 }
2087
2088 # Sanitize for use in XHTML + application/xml+xhtml (valid XML 1.0)
2089 sub sanitize {
2090         my $str = shift;
2091
2092         return undef unless defined $str;
2093
2094         $str = to_utf8($str);
2095         use bytes;
2096         $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
2097         return $str;
2098 }
2099
2100 # Make control characters "printable", using character escape codes (CEC)
2101 sub quot_cec {
2102         my $cntrl = shift;
2103         my %opts = @_;
2104         my %es = ( # character escape codes, aka escape sequences
2105                 "\t" => '\t',   # tab            (HT)
2106                 "\n" => '\n',   # line feed      (LF)
2107                 "\r" => '\r',   # carrige return (CR)
2108                 "\f" => '\f',   # form feed      (FF)
2109                 "\b" => '\b',   # backspace      (BS)
2110                 "\a" => '\a',   # alarm (bell)   (BEL)
2111                 "\e" => '\e',   # escape         (ESC)
2112                 "\013" => '\v', # vertical tab   (VT)
2113                 "\000" => '\0', # nul character  (NUL)
2114         );
2115         my $chr = ( (exists $es{$cntrl})
2116                     ? $es{$cntrl}
2117                     : sprintf('\x%02x', ord($cntrl)) );
2118         if ($opts{-nohtml}) {
2119                 return $chr;
2120         } else {
2121                 return "<span class=\"cntrl\">$chr</span>";
2122         }
2123 }
2124
2125 # Alternatively use unicode control pictures codepoints,
2126 # Unicode "printable representation" (PR)
2127 sub quot_upr {
2128         my $cntrl = shift;
2129         my %opts = @_;
2130
2131         my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
2132         if ($opts{-nohtml}) {
2133                 return $chr;
2134         } else {
2135                 return "<span class=\"cntrl\">$chr</span>";
2136         }
2137 }
2138
2139 # git may return quoted and escaped filenames
2140 sub unquote {
2141         my $str = shift;
2142
2143         sub unq {
2144                 my $seq = shift;
2145                 my %es = ( # character escape codes, aka escape sequences
2146                         't' => "\t",   # tab            (HT, TAB)
2147                         'n' => "\n",   # newline        (NL)
2148                         'r' => "\r",   # return         (CR)
2149                         'f' => "\f",   # form feed      (FF)
2150                         'b' => "\b",   # backspace      (BS)
2151                         'a' => "\a",   # alarm (bell)   (BEL)
2152                         'e' => "\e",   # escape         (ESC)
2153                         'v' => "\013", # vertical tab   (VT)
2154                 );
2155
2156                 if ($seq =~ m/^[0-7]{1,3}$/) {
2157                         # octal char sequence
2158                         return chr(oct($seq));
2159                 } elsif (exists $es{$seq}) {
2160                         # C escape sequence, aka character escape code
2161                         return $es{$seq};
2162                 }
2163                 # quoted ordinary character
2164                 return $seq;
2165         }
2166
2167         if ($str =~ m/^"(.*)"$/) {
2168                 # needs unquoting
2169                 $str = $1;
2170                 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
2171         }
2172         return $str;
2173 }
2174
2175 # escape tabs (convert tabs to spaces)
2176 sub untabify {
2177         my $line = shift;
2178
2179         while ((my $pos = index($line, "\t")) != -1) {
2180                 if (my $count = (8 - ($pos % 8))) {
2181                         my $spaces = ' ' x $count;
2182                         $line =~ s/\t/$spaces/;
2183                 }
2184         }
2185
2186         return $line;
2187 }
2188
2189 sub project_in_list {
2190         my $project = shift;
2191         my @list = git_get_projects_list();
2192         return @list && scalar(grep { $_->{'path'} eq $project } @list);
2193 }
2194
2195 sub cached_page_precondition_check {
2196         my $action = shift;
2197         return 1 unless
2198                 $action eq 'summary' &&
2199                 $projlist_cache_lifetime > 0 &&
2200                 gitweb_check_feature('forks');
2201
2202         # Note that ALL the 'forkchange' logic is in this function.
2203         # It does NOT belong in cached_action_page NOR in cached_action_start
2204         # NOR in cached_action_finish.  None of those functions should know anything
2205         # about nor do anything to any of the 'forkchange'/"$action.forkchange" files.
2206
2207         # besides the basic 'changed' "$action.changed" check, we may only use
2208         # a summary cache if:
2209         #
2210         #   1) we are not using a project list cache file
2211         #   -OR-
2212         #   2) we are not using the 'forks' feature
2213         #   -OR-
2214         #   3) there is no 'forkchange' nor "$action.forkchange" file in $html_cache_dir
2215         #   -OR-
2216         #   4) there is no cache file ("$cache_dir/$projlist_cache_name")
2217         #   -OR-
2218         #   5) the OLDER of 'forkchange'/"$action.forkchange" is NEWER than the cache file
2219         #
2220         # Otherwise we must re-generate the cache because we've had a fork change
2221         # (either a fork was added or a fork was removed) AND the change has been
2222         # picked up in the cache file AND we've not got that in our cached copy
2223         #
2224         # For (5) regenerating the cached page wouldn't get us anything if the project
2225         # cache file is older than the 'forkchange'/"$action.forkchange" because the
2226         # forks information comes from the project cache file and it's clearly not
2227         # picked up the changes yet so we may continue to use a cached page until it does.
2228
2229         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2230         my $fc_mt = (stat("$htmlcd/forkchange"))[9];
2231         my $afc_mt = (stat("$htmlcd/$action.forkchange"))[9];
2232         return 1 unless defined($fc_mt) || defined($afc_mt);
2233         my $prj_mt = (stat("$cache_dir/$projlist_cache_name"))[9];
2234         return 1 unless $prj_mt;
2235         my $old_mt = $fc_mt;
2236         $old_mt = $afc_mt if !defined($old_mt) || (defined($afc_mt) && $afc_mt < $old_mt);
2237         return 1 if $old_mt > $prj_mt;
2238
2239         # We're going to regenerate the cached page because we know the project cache
2240         # has new fork information that we cannot possibly have in our cached copy.
2241         #
2242         # However, if both 'forkchange' and "$action.forkchange" exist and one of
2243         # them is older than the project cache and one of them is newer, we still
2244         # need to regenerate the page cache, but we will also need to do it again
2245         # in the future because there's yet another fork update not yet in the cache.
2246         #
2247         # So we make sure to touch "$action.changed" to force a cache regeneration
2248         # and then we remove either or both of 'forkchange'/"$action.forkchange" if
2249         # they're older than the project cache (they've served their purpose, we're
2250         # forcing a page regeneration by touching "$action.changed" but the project
2251         # cache was rebuilt since then so there are no more pending fork updates to
2252         # pick up in the future and they need to go).
2253
2254         # For best results, the external code that touches 'forkchange' should always
2255         # touch 'forkchange' and additionally touch 'summary.forkchange' but only
2256         # if it does not already exist.  That way the cached page will be regenerated
2257         # each time it's requested and ANY fork updates are available in the proj
2258         # cache rather than waiting until they all are before updating.
2259
2260         # Note that we take a shortcut here and will zap 'forkchange' since we know
2261         # that it only affects the 'summary' cache.  If, in the future, it affects
2262         # other cache types, it will first need to be propogated down to
2263         # "$action.forkchange" for those types before we zap it.
2264
2265         my $fd;
2266         open $fd, '>', "$htmlcd/$action.changed" and close $fd;
2267         $fc_mt=undef, unlink "$htmlcd/forkchange" if defined $fc_mt && $fc_mt < $prj_mt;
2268         $afc_mt=undef, unlink "$htmlcd/$action.forkchange" if defined $afc_mt && $afc_mt < $prj_mt;
2269
2270         # Now we propagate 'forkchange' to "$action.forkchange" if we have the
2271         # one and not the other.
2272
2273         if (defined $fc_mt && ! defined $afc_mt) {
2274                 open $fd, '>', "$htmlcd/$action.forkchange" and close $fd;
2275                 -e "$htmlcd/$action.forkchange" and
2276                 utime($fc_mt, $fc_mt, "$htmlcd/$action.forkchange") and
2277                 unlink "$htmlcd/forkchange";
2278         }
2279
2280         return 0;
2281 }
2282
2283 sub cached_action_page {
2284         my $action = shift;
2285
2286         return undef unless $action && $html_cache_actions{$action} && $html_cache_dir;
2287         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2288         return undef if -e "$htmlcd/changed" || -e "$htmlcd/$action.changed";
2289         return undef unless cached_page_precondition_check($action);
2290         open my $fd, '<', "$htmlcd/$action" or return undef;
2291         binmode $fd;
2292         local $/;
2293         my $cached_page = <$fd>;
2294         close $fd or return undef;
2295         return $cached_page;
2296 }
2297
2298 package Git::Gitweb::CacheFile;
2299
2300 sub TIEHANDLE {
2301         use POSIX qw(:fcntl_h);
2302         my $class = shift;
2303         my $cachefile = shift;
2304
2305         sysopen(my $self, $cachefile, O_WRONLY|O_CREAT|O_EXCL, 0664)
2306                 or return undef;
2307         $$self->{'cachefile'} = $cachefile;
2308         $$self->{'opened'} = 1;
2309         $$self->{'contents'} = '';
2310         return bless $self, $class;
2311 }
2312
2313 sub CLOSE {
2314         my $self = shift;
2315         if ($$self->{'opened'}) {
2316                 $$self->{'opened'} = 0;
2317                 my $result = close $self;
2318                 unlink $$self->{'cachefile'} unless $result;
2319                 return $result;
2320         }
2321         return 0;
2322 }
2323
2324 sub DESTROY {
2325         my $self = shift;
2326         if ($$self->{'opened'}) {
2327                 $self->CLOSE() and unlink $$self->{'cachefile'};
2328         }
2329 }
2330
2331 sub PRINT {
2332         my $self = shift;
2333         @_ = (map {my $x=$_; utf8::encode($x); $x} @_) unless $fcgi_raw_mode;
2334         print $self @_ if $$self->{'opened'};
2335         $$self->{'contents'} .= join('', @_);
2336         return 1;
2337 }
2338
2339 sub PRINTF {
2340         my $self = shift;
2341         my $template = shift;
2342         return $self->PRINT(sprintf $template, @_);
2343 }
2344
2345 sub contents {
2346         my $self = shift;
2347         return $$self->{'contents'};
2348 }
2349
2350 package main;
2351
2352 # Caller is responsible for preserving STDOUT beforehand if needed
2353 sub cached_action_start {
2354         my $action = shift;
2355
2356         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2357         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2358         return undef unless -d $htmlcd;
2359         if (-e "$htmlcd/changed") {
2360                 foreach my $cacheable (keys(%html_cache_actions)) {
2361                         next unless $supported_cache_actions{$cacheable} &&
2362                                     $html_cache_actions{$cacheable};
2363                         my $fd;
2364                         open $fd, '>', "$htmlcd/$cacheable.changed"
2365                         and close $fd;
2366                 }
2367                 unlink "$htmlcd/changed";
2368         }
2369         local *CACHEFILE;
2370         tie *CACHEFILE, 'Git::Gitweb::CacheFile', "$htmlcd/$action.lock"  or return undef;
2371         *STDOUT = *CACHEFILE;
2372         unlink "$htmlcd/$action", "$htmlcd/$action.changed";
2373         return 1;
2374 }
2375
2376 # Caller is responsible for restoring STDOUT afterward if needed
2377 sub cached_action_finish {
2378         my $action = shift;
2379
2380         use File::Spec;
2381
2382         my $obj = tied *STDOUT;
2383         return undef unless ref($obj) eq 'Git::Gitweb::CacheFile';
2384         my $cached_page = $obj->contents;
2385         (my $result = close(STDOUT)) or warn "couldn't close cache file on STDOUT: $!";
2386         # Do not leave STDOUT file descriptor invalid!
2387         local *NULL;
2388         open(NULL, '>', File::Spec->devnull) or die "couldn't open NULL to devnull: $!";
2389         *STDOUT = *NULL;
2390         return $cached_page unless $result;
2391         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2392         return $cached_page unless -d $htmlcd;
2393         unlink "$htmlcd/$action.lock" unless rename "$htmlcd/$action.lock", "$htmlcd/$action";
2394         return $cached_page;
2395 }
2396
2397 my %expand_pi_subs;
2398 BEGIN {%expand_pi_subs = (
2399         'age_string'               => \&age_string,
2400         'age_string_date'          => \&age_string_date,
2401         'age_string_age'           => \&age_string_age,
2402         'compute_timed_interval'   => \&compute_timed_interval,
2403         'compute_commands_count'   => \&compute_commands_count,
2404         'format_lastrefresh_row'   => \&format_lastrefresh_row,
2405         'compute_stylesheet_links' => \&compute_stylesheet_links,
2406 )}
2407
2408 # Expands any <?gitweb...> processing instructions and returns the result
2409 sub expand_gitweb_pi {
2410         my $page = shift;
2411         $page .= '';
2412         my @time_now = gettimeofday();
2413         $page =~ s{<\?gitweb(?:\s+([^\s>]+)([^>]*))?\s*\?>}
2414                   {defined($1) ?
2415                           (ref($expand_pi_subs{$1}) eq 'CODE' ?
2416                                   $expand_pi_subs{$1}->(split(' ',$2), @time_now) :
2417                                   '') :
2418                           '' }goes;
2419         return $page;
2420 }
2421
2422 ## ----------------------------------------------------------------------
2423 ## HTML aware string manipulation
2424
2425 # Try to chop given string on a word boundary between position
2426 # $len and $len+$add_len. If there is no word boundary there,
2427 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
2428 # (marking chopped part) would be longer than given string.
2429 sub chop_str {
2430         my $str = shift;
2431         my $len = shift;
2432         my $add_len = shift || 10;
2433         my $where = shift || 'right'; # 'left' | 'center' | 'right'
2434
2435         # Make sure perl knows it is utf8 encoded so we don't
2436         # cut in the middle of a utf8 multibyte char.
2437         $str = to_utf8($str);
2438
2439         # allow only $len chars, but don't cut a word if it would fit in $add_len
2440         # if it doesn't fit, cut it if it's still longer than the dots we would add
2441         # remove chopped character entities entirely
2442
2443         # when chopping in the middle, distribute $len into left and right part
2444         # return early if chopping wouldn't make string shorter
2445         if ($where eq 'center') {
2446                 return $str if ($len + 5 >= length($str)); # filler is length 5
2447                 $len = int($len/2);
2448         } else {
2449                 return $str if ($len + 4 >= length($str)); # filler is length 4
2450         }
2451
2452         # regexps: ending and beginning with word part up to $add_len
2453         my $endre = qr/.{$len}\w{0,$add_len}/;
2454         my $begre = qr/\w{0,$add_len}.{$len}/;
2455
2456         if ($where eq 'left') {
2457                 $str =~ m/^(.*?)($begre)$/;
2458                 my ($lead, $body) = ($1, $2);
2459                 if (length($lead) > 4) {
2460                         $lead = " ...";
2461                 }
2462                 return "$lead$body";
2463
2464         } elsif ($where eq 'center') {
2465                 $str =~ m/^($endre)(.*)$/;
2466                 my ($left, $str)  = ($1, $2);
2467                 $str =~ m/^(.*?)($begre)$/;
2468                 my ($mid, $right) = ($1, $2);
2469                 if (length($mid) > 5) {
2470                         $mid = " ... ";
2471                 }
2472                 return "$left$mid$right";
2473
2474         } else {
2475                 $str =~ m/^($endre)(.*)$/;
2476                 my $body = $1;
2477                 my $tail = $2;
2478                 if (length($tail) > 4) {
2479                         $tail = "... ";
2480                 }
2481                 return "$body$tail";
2482         }
2483 }
2484
2485 # pass-through email filter, obfuscating it when possible
2486 sub email_obfuscate {
2487         our $email;
2488         my ($str) = @_;
2489         if ($email) {
2490                 $str = $email->escape_html($str);
2491                 # Stock HTML::Email::Obfuscate version likes to produce
2492                 # invalid XHTML...
2493                 $str =~ s#<(/?)B>#<$1b>#g;
2494                 return $str;
2495         } else {
2496                 $str = esc_html($str);
2497                 $str =~ s/@/&#x40;/;
2498                 return $str;
2499         }
2500 }
2501
2502 # takes the same arguments as chop_str, but also wraps a <span> around the
2503 # result with a title attribute if it does get chopped. Additionally, the
2504 # string is HTML-escaped.
2505 sub chop_and_escape_str {
2506         my ($str) = @_;
2507
2508         my $chopped = chop_str(@_);
2509         $str = to_utf8($str);
2510         if ($chopped eq $str) {
2511                 return email_obfuscate($chopped);
2512         } else {
2513                 use bytes;
2514                 $str =~ s/[[:cntrl:]]/?/g;
2515                 return $cgi->span({-title=>$str}, email_obfuscate($chopped));
2516         }
2517 }
2518
2519 # Highlight selected fragments of string, using given CSS class,
2520 # and escape HTML.  It is assumed that fragments do not overlap.
2521 # Regions are passed as list of pairs (array references).
2522 #
2523 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
2524 # '<span class="mark">foo</span>bar'
2525 sub esc_html_hl_regions {
2526         my ($str, $css_class, @sel) = @_;
2527         my %opts = grep { ref($_) ne 'ARRAY' } @sel;
2528         @sel     = grep { ref($_) eq 'ARRAY' } @sel;
2529         return esc_html($str, %opts) unless @sel;
2530
2531         my $out = '';
2532         my $pos = 0;
2533
2534         for my $s (@sel) {
2535                 my ($begin, $end) = @$s;
2536
2537                 # Don't create empty <span> elements.
2538                 next if $end <= $begin;
2539
2540                 my $escaped = esc_html(substr($str, $begin, $end - $begin),
2541                                        %opts);
2542
2543                 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
2544                         if ($begin - $pos > 0);
2545                 $out .= $cgi->span({-class => $css_class}, $escaped);
2546
2547                 $pos = $end;
2548         }
2549         $out .= esc_html(substr($str, $pos), %opts)
2550                 if ($pos < length($str));
2551
2552         return $out;
2553 }
2554
2555 # return positions of beginning and end of each match
2556 sub matchpos_list {
2557         my ($str, $regexp) = @_;
2558         return unless (defined $str && defined $regexp);
2559
2560         my @matches;
2561         while ($str =~ /$regexp/g) {
2562                 push @matches, [$-[0], $+[0]];
2563         }
2564         return @matches;
2565 }
2566
2567 # highlight match (if any), and escape HTML
2568 sub esc_html_match_hl {
2569         my ($str, $regexp) = @_;
2570         return esc_html($str) unless defined $regexp;
2571
2572         my @matches = matchpos_list($str, $regexp);
2573         return esc_html($str) unless @matches;
2574
2575         return esc_html_hl_regions($str, 'match', @matches);
2576 }
2577
2578
2579 # highlight match (if any) of shortened string, and escape HTML
2580 sub esc_html_match_hl_chopped {
2581         my ($str, $chopped, $regexp) = @_;
2582         return esc_html_match_hl($str, $regexp) unless defined $chopped;
2583
2584         my @matches = matchpos_list($str, $regexp);
2585         return esc_html($chopped) unless @matches;
2586
2587         # filter matches so that we mark chopped string
2588         my $tail = "... "; # see chop_str
2589         unless ($chopped =~ s/\Q$tail\E$//) {
2590                 $tail = '';
2591         }
2592         my $chop_len = length($chopped);
2593         my $tail_len = length($tail);
2594         my @filtered;
2595
2596         for my $m (@matches) {
2597                 if ($m->[0] > $chop_len) {
2598                         push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
2599                         last;
2600                 } elsif ($m->[1] > $chop_len) {
2601                         push @filtered, [ $m->[0], $chop_len + $tail_len ];
2602                         last;
2603                 }
2604                 push @filtered, $m;
2605         }
2606
2607         return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
2608 }
2609
2610 ## ----------------------------------------------------------------------
2611 ## functions returning short strings
2612
2613 # CSS class for given age epoch value (in seconds)
2614 # and reference time (optional, defaults to now) as second value
2615 sub age_class {
2616         my ($age_epoch, $time_now) = @_;
2617         return "noage" unless defined $age_epoch;
2618         defined $time_now or $time_now = time;
2619         my $age = $time_now - $age_epoch;
2620
2621         if ($age < 60*60*2) {
2622                 return "age0";
2623         } elsif ($age < 60*60*24*2) {
2624                 return "age1";
2625         } else {
2626                 return "age2";
2627         }
2628 }
2629
2630 # convert age epoch in seconds to "nn units ago" string
2631 # reference time used is now unless second argument passed in
2632 # to get the old behavior, pass 0 as the first argument and
2633 # the time in seconds as the second
2634 sub age_string {
2635         my ($age_epoch, $time_now) = @_;
2636         return "unknown" unless defined $age_epoch;
2637         return "<?gitweb age_string $age_epoch?>" if $cache_mode_active;
2638         defined $time_now or $time_now = time;
2639         my $age = $time_now - $age_epoch;
2640         my $age_str;
2641
2642         if ($age > 60*60*24*365*2) {
2643                 $age_str = (int $age/60/60/24/365);
2644                 $age_str .= " years ago";
2645         } elsif ($age > 60*60*24*(365/12)*2) {
2646                 $age_str = int $age/60/60/24/(365/12);
2647                 $age_str .= " months ago";
2648         } elsif ($age > 60*60*24*7*2) {
2649                 $age_str = int $age/60/60/24/7;
2650                 $age_str .= " weeks ago";
2651         } elsif ($age > 60*60*24*2) {
2652                 $age_str = int $age/60/60/24;
2653                 $age_str .= " days ago";
2654         } elsif ($age > 60*60*2) {
2655                 $age_str = int $age/60/60;
2656                 $age_str .= " hours ago";
2657         } elsif ($age > 60*2) {
2658                 $age_str = int $age/60;
2659                 $age_str .= " min ago";
2660         } elsif ($age > 2) {
2661                 $age_str = int $age;
2662                 $age_str .= " sec ago";
2663         } else {
2664                 $age_str .= " right now";
2665         }
2666         return $age_str;
2667 }
2668
2669 # returns age_string if the age is <= 2 weeks otherwise an absolute date
2670 # this is typically shown to the user directly with the age_string_age as a title
2671 sub age_string_date {
2672         my ($age_epoch, $time_now) = @_;
2673         return "unknown" unless defined $age_epoch;
2674         return "<?gitweb age_string_date $age_epoch?>" if $cache_mode_active;
2675         defined $time_now or $time_now = time;
2676         my $age = $time_now - $age_epoch;
2677
2678         if ($age > 60*60*24*7*2) {
2679                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2680                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2681         } else {
2682                 return age_string($age_epoch, $time_now);
2683         }
2684 }
2685
2686 # returns an absolute date if the age is <= 2 weeks otherwise age_string
2687 # this is typically used for the 'title' attribute so it will show as a tooltip
2688 sub age_string_age {
2689         my ($age_epoch, $time_now) = @_;
2690         return "unknown" unless defined $age_epoch;
2691         return "<?gitweb age_string_age $age_epoch?>" if $cache_mode_active;
2692         defined $time_now or $time_now = time;
2693         my $age = $time_now - $age_epoch;
2694
2695         if ($age > 60*60*24*7*2) {
2696                 return age_string($age_epoch, $time_now);
2697         } else {
2698                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2699                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2700         }
2701 }
2702
2703 use constant {
2704         S_IFINVALID => 0030000,
2705         S_IFGITLINK => 0160000,
2706 };
2707
2708 # submodule/subproject, a commit object reference
2709 sub S_ISGITLINK {
2710         my $mode = shift;
2711
2712         return (($mode & S_IFMT) == S_IFGITLINK)
2713 }
2714
2715 # convert file mode in octal to symbolic file mode string
2716 sub mode_str {
2717         my $mode = oct shift;
2718
2719         if (S_ISGITLINK($mode)) {
2720                 return 'm---------';
2721         } elsif (S_ISDIR($mode & S_IFMT)) {
2722                 return 'drwxr-xr-x';
2723         } elsif (S_ISLNK($mode)) {
2724                 return 'lrwxrwxrwx';
2725         } elsif (S_ISREG($mode)) {
2726                 # git cares only about the executable bit
2727                 if ($mode & S_IXUSR) {
2728                         return '-rwxr-xr-x';
2729                 } else {
2730                         return '-rw-r--r--';
2731                 };
2732         } else {
2733                 return '----------';
2734         }
2735 }
2736
2737 # convert file mode in octal to file type string
2738 sub file_type {
2739         my $mode = shift;
2740
2741         if ($mode !~ m/^[0-7]+$/) {
2742                 return $mode;
2743         } else {
2744                 $mode = oct $mode;
2745         }
2746
2747         if (S_ISGITLINK($mode)) {
2748                 return "submodule";
2749         } elsif (S_ISDIR($mode & S_IFMT)) {
2750                 return "directory";
2751         } elsif (S_ISLNK($mode)) {
2752                 return "symlink";
2753         } elsif (S_ISREG($mode)) {
2754                 return "file";
2755         } else {
2756                 return "unknown";
2757         }
2758 }
2759
2760 # convert file mode in octal to file type description string
2761 sub file_type_long {
2762         my $mode = shift;
2763
2764         if ($mode !~ m/^[0-7]+$/) {
2765                 return $mode;
2766         } else {
2767                 $mode = oct $mode;
2768         }
2769
2770         if (S_ISGITLINK($mode)) {
2771                 return "submodule";
2772         } elsif (S_ISDIR($mode & S_IFMT)) {
2773                 return "directory";
2774         } elsif (S_ISLNK($mode)) {
2775                 return "symlink";
2776         } elsif (S_ISREG($mode)) {
2777                 if ($mode & S_IXUSR) {
2778                         return "executable";
2779                 } else {
2780                         return "file";
2781                 };
2782         } else {
2783                 return "unknown";
2784         }
2785 }
2786
2787
2788 ## ----------------------------------------------------------------------
2789 ## functions returning short HTML fragments, or transforming HTML fragments
2790 ## which don't belong to other sections
2791
2792 # format line of commit message.
2793 sub format_log_line_html {
2794         my $line = shift;
2795
2796         $line = esc_html($line, -nbsp=>1);
2797         $line =~ s{
2798         \b
2799         (
2800             # The output of "git describe", e.g. v2.10.0-297-gf6727b0
2801             # or hadoop-20160921-113441-20-g094fb7d
2802             (?<!-) # see strbuf_check_tag_ref(). Tags can't start with -
2803             [A-Za-z0-9.-]+
2804             (?!\.) # refs can't end with ".", see check_refname_format()
2805             -g[0-9a-fA-F]{7,40}
2806             |
2807             # Just a normal looking Git SHA1
2808             [0-9a-fA-F]{7,40}
2809         )
2810         \b
2811     }{
2812                 $cgi->a({-href => href(action=>"object", hash=>$1),
2813                                         -class => "text"}, $1);
2814         }egx unless $line =~ /^\s*git-svn-id:/;
2815
2816         return $line;
2817 }
2818
2819 # format marker of refs pointing to given object
2820
2821 # the destination action is chosen based on object type and current context:
2822 # - for annotated tags, we choose the tag view unless it's the current view
2823 #   already, in which case we go to shortlog view
2824 # - for other refs, we keep the current view if we're in history, shortlog or
2825 #   log view, and select shortlog otherwise
2826 sub format_ref_marker {
2827         my ($refs, $id) = @_;
2828         my $markers = '';
2829
2830         if (defined $refs->{$id}) {
2831                 foreach my $ref (@{$refs->{$id}}) {
2832                         # this code exploits the fact that non-lightweight tags are the
2833                         # only indirect objects, and that they are the only objects for which
2834                         # we want to use tag instead of shortlog as action
2835                         my ($type, $name) = qw();
2836                         my $indirect = ($ref =~ s/\^\{\}$//);
2837                         # e.g. tags/v2.6.11 or heads/next
2838                         if ($ref =~ m!^(.*?)s?/(.*)$!) {
2839                                 $type = $1;
2840                                 $name = $2;
2841                         } else {
2842                                 $type = "ref";
2843                                 $name = $ref;
2844                         }
2845
2846                         my $class = $type;
2847                         $class .= " indirect" if $indirect;
2848
2849                         my $dest_action = "shortlog";
2850
2851                         if ($indirect) {
2852                                 $dest_action = "tag" unless $action eq "tag";
2853                         } elsif ($action =~ /^(history|(short)?log)$/) {
2854                                 $dest_action = $action;
2855                         }
2856
2857                         my $dest = "";
2858                         $dest .= "refs/" unless $ref =~ m!^refs/!;
2859                         $dest .= $ref;
2860
2861                         my $link = $cgi->a({
2862                                 -href => href(
2863                                         action=>$dest_action,
2864                                         hash=>$dest
2865                                 )}, esc_html($name));
2866
2867                         $markers .= "<span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2868                                 $link . "</span>";
2869                 }
2870         }
2871
2872         if ($markers) {
2873                 return '<span class="refs">'. $markers . '</span>';
2874         } else {
2875                 return "";
2876         }
2877 }
2878
2879 # format, perhaps shortened and with markers, title line
2880 sub format_subject_html {
2881         my ($long, $short, $href, $extra) = @_;
2882         $extra = '' unless defined($extra);
2883
2884         if (length($short) < length($long)) {
2885                 use bytes;
2886                 $long =~ s/[[:cntrl:]]/?/g;
2887                 return $cgi->a({-href => $href, -class => "list subject",
2888                                 -title => to_utf8($long)},
2889                        esc_html($short)) . $extra;
2890         } else {
2891                 return $cgi->a({-href => $href, -class => "list subject"},
2892                        esc_html($long)) . $extra;
2893         }
2894 }
2895
2896 # Rather than recomputing the url for an email multiple times, we cache it
2897 # after the first hit. This gives a visible benefit in views where the avatar
2898 # for the same email is used repeatedly (e.g. shortlog).
2899 # The cache is shared by all avatar engines (currently gravatar only), which
2900 # are free to use it as preferred. Since only one avatar engine is used for any
2901 # given page, there's no risk for cache conflicts.
2902 our %avatar_cache = ();
2903
2904 # Compute the picon url for a given email, by using the picon search service over at
2905 # http://www.cs.indiana.edu/picons/search.html
2906 sub picon_url {
2907         my $email = lc shift;
2908         if (!$avatar_cache{$email}) {
2909                 my ($user, $domain) = split('@', $email);
2910                 $avatar_cache{$email} =
2911                         "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2912                         "$domain/$user/" .
2913                         "users+domains+unknown/up/single";
2914         }
2915         return $avatar_cache{$email};
2916 }
2917
2918 # Compute the gravatar url for a given email, if it's not in the cache already.
2919 # Gravatar stores only the part of the URL before the size, since that's the
2920 # one computationally more expensive. This also allows reuse of the cache for
2921 # different sizes (for this particular engine).
2922 sub gravatar_url {
2923         my $email = lc shift;
2924         my $size = shift;
2925         $avatar_cache{$email} ||=
2926                 "//www.gravatar.com/avatar/" .
2927                         Digest::MD5::md5_hex($email) . "?s=";
2928         return $avatar_cache{$email} . $size;
2929 }
2930
2931 # Insert an avatar for the given $email at the given $size if the feature
2932 # is enabled.
2933 sub git_get_avatar {
2934         my ($email, %opts) = @_;
2935         my $pre_white  = ($opts{-pad_before} ? "&#160;" : "");
2936         my $post_white = ($opts{-pad_after}  ? "&#160;" : "");
2937         $opts{-size} ||= 'default';
2938         my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2939         my $url = "";
2940         if ($git_avatar eq 'gravatar') {
2941                 $url = gravatar_url($email, $size);
2942         } elsif ($git_avatar eq 'picon') {
2943                 $url = picon_url($email);
2944         }
2945         # Other providers can be added by extending the if chain, defining $url
2946         # as needed. If no variant puts something in $url, we assume avatars
2947         # are completely disabled/unavailable.
2948         if ($url) {
2949                 return $pre_white .
2950                        "<img width=\"$size\" " .
2951                             "class=\"avatar\" " .
2952                             "src=\"".esc_url($url)."\" " .
2953                             "alt=\"\" " .
2954                        "/>" . $post_white;
2955         } else {
2956                 return "";
2957         }
2958 }
2959
2960 sub format_search_author {
2961         my ($author, $searchtype, $displaytext) = @_;
2962         my $have_search = gitweb_check_feature('search');
2963
2964         if ($have_search) {
2965                 my $performed = "";
2966                 if ($searchtype eq 'author') {
2967                         $performed = "authored";
2968                 } elsif ($searchtype eq 'committer') {
2969                         $performed = "committed";
2970                 }
2971
2972                 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2973                                 searchtext=>$author,
2974                                 searchtype=>$searchtype), class=>"list",
2975                                 title=>"Search for commits $performed by $author"},
2976                                 $displaytext);
2977
2978         } else {
2979                 return $displaytext;
2980         }
2981 }
2982
2983 # format the author name of the given commit with the given tag
2984 # the author name is chopped and escaped according to the other
2985 # optional parameters (see chop_str).
2986 sub format_author_html {
2987         my $tag = shift;
2988         my $co = shift;
2989         my $author = chop_and_escape_str($co->{'author_name'}, @_);
2990         return "<$tag class=\"author\">" .
2991                format_search_author($co->{'author_name'}, "author",
2992                        git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2993                        $author) .
2994                "</$tag>";
2995 }
2996
2997 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
2998 sub format_git_diff_header_line {
2999         my $line = shift;
3000         my $diffinfo = shift;
3001         my ($from, $to) = @_;
3002
3003         if ($diffinfo->{'nparents'}) {
3004                 # combined diff
3005                 $line =~ s!^(diff (.*?) )"?.*$!$1!;
3006                 if ($to->{'href'}) {
3007                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
3008                                          esc_path($to->{'file'}));
3009                 } else { # file was deleted (no href)
3010                         $line .= esc_path($to->{'file'});
3011                 }
3012         } else {
3013                 # "ordinary" diff
3014                 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
3015                 if ($from->{'href'}) {
3016                         $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
3017                                          'a/' . esc_path($from->{'file'}));
3018                 } else { # file was added (no href)
3019                         $line .= 'a/' . esc_path($from->{'file'});
3020                 }
3021                 $line .= ' ';
3022                 if ($to->{'href'}) {
3023                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
3024                                          'b/' . esc_path($to->{'file'}));
3025                 } else { # file was deleted
3026                         $line .= 'b/' . esc_path($to->{'file'});
3027                 }
3028         }
3029
3030         return "<div class=\"diff header\">$line</div>\n";
3031 }
3032
3033 # format extended diff header line, before patch itself
3034 sub format_extended_diff_header_line {
3035         my $line = shift;
3036         my $diffinfo = shift;
3037         my ($from, $to) = @_;
3038
3039         # match <path>
3040         if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
3041                 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
3042                                        esc_path($from->{'file'}));
3043         }
3044         if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
3045                 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3046                                  esc_path($to->{'file'}));
3047         }
3048         # match single <mode>
3049         if ($line =~ m/\s(\d{6})$/) {
3050                 $line .= '<span class="info"> (' .
3051                          file_type_long($1) .
3052                          ')</span>';
3053         }
3054         # match <hash>
3055         if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
3056                 # can match only for combined diff
3057                 $line = 'index ';
3058                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3059                         if ($from->{'href'}[$i]) {
3060                                 $line .= $cgi->a({-href=>$from->{'href'}[$i],
3061                                                   -class=>"hash"},
3062                                                  substr($diffinfo->{'from_id'}[$i],0,7));
3063                         } else {
3064                                 $line .= '0' x 7;
3065                         }
3066                         # separator
3067                         $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
3068                 }
3069                 $line .= '..';
3070                 if ($to->{'href'}) {
3071                         $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
3072                                          substr($diffinfo->{'to_id'},0,7));
3073                 } else {
3074                         $line .= '0' x 7;
3075                 }
3076
3077         } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
3078                 # can match only for ordinary diff
3079                 my ($from_link, $to_link);
3080                 if ($from->{'href'}) {
3081                         $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
3082                                              substr($diffinfo->{'from_id'},0,7));
3083                 } else {
3084                         $from_link = '0' x 7;
3085                 }
3086                 if ($to->{'href'}) {
3087                         $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
3088                                            substr($diffinfo->{'to_id'},0,7));
3089                 } else {
3090                         $to_link = '0' x 7;
3091                 }
3092                 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
3093                 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
3094         }
3095
3096         return $line . "<br/>\n";
3097 }
3098
3099 # format from-file/to-file diff header
3100 sub format_diff_from_to_header {
3101         my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
3102         my $line;
3103         my $result = '';
3104
3105         $line = $from_line;
3106         #assert($line =~ m/^---/) if DEBUG;
3107         # no extra formatting for "^--- /dev/null"
3108         if (! $diffinfo->{'nparents'}) {
3109                 # ordinary (single parent) diff
3110                 if ($line =~ m!^--- "?a/!) {
3111                         if ($from->{'href'}) {
3112                                 $line = '--- a/' .
3113                                         $cgi->a({-href=>$from->{'href'}, -class=>"path"},
3114                                                 esc_path($from->{'file'}));
3115                         } else {
3116                                 $line = '--- a/' .
3117                                         esc_path($from->{'file'});
3118                         }
3119                 }
3120                 $result .= qq!<div class="diff from_file">$line</div>\n!;
3121
3122         } else {
3123                 # combined diff (merge commit)
3124                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3125                         if ($from->{'href'}[$i]) {
3126                                 $line = '--- ' .
3127                                         $cgi->a({-href=>href(action=>"blobdiff",
3128                                                              hash_parent=>$diffinfo->{'from_id'}[$i],
3129                                                              hash_parent_base=>$parents[$i],
3130                                                              file_parent=>$from->{'file'}[$i],
3131                                                              hash=>$diffinfo->{'to_id'},
3132                                                              hash_base=>$hash,
3133                                                              file_name=>$to->{'file'}),
3134                                                  -class=>"path",
3135                                                  -title=>"diff" . ($i+1)},
3136                                                 $i+1) .
3137                                         '/' .
3138                                         $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
3139                                                 esc_path($from->{'file'}[$i]));
3140                         } else {
3141                                 $line = '--- /dev/null';
3142                         }
3143                         $result .= qq!<div class="diff from_file">$line</div>\n!;
3144                 }
3145         }
3146
3147         $line = $to_line;
3148         #assert($line =~ m/^\+\+\+/) if DEBUG;
3149         # no extra formatting for "^+++ /dev/null"
3150         if ($line =~ m!^\+\+\+ "?b/!) {
3151                 if ($to->{'href'}) {
3152                         $line = '+++ b/' .
3153                                 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3154                                         esc_path($to->{'file'}));
3155                 } else {
3156                         $line = '+++ b/' .
3157                                 esc_path($to->{'file'});
3158                 }
3159         }
3160         $result .= qq!<div class="diff to_file">$line</div>\n!;
3161
3162         return $result;
3163 }
3164
3165 # create note for patch simplified by combined diff
3166 sub format_diff_cc_simplified {
3167         my ($diffinfo, @parents) = @_;
3168         my $result = '';
3169
3170         $result .= "<div class=\"diff header\">" .
3171                    "diff --cc ";
3172         if (!is_deleted($diffinfo)) {
3173                 $result .= $cgi->a({-href => href(action=>"blob",
3174                                                   hash_base=>$hash,
3175                                                   hash=>$diffinfo->{'to_id'},
3176                                                   file_name=>$diffinfo->{'to_file'}),
3177                                     -class => "path"},
3178                                    esc_path($diffinfo->{'to_file'}));
3179         } else {
3180                 $result .= esc_path($diffinfo->{'to_file'});
3181         }
3182         $result .= "</div>\n" . # class="diff header"
3183                    "<div class=\"diff nodifferences\">" .
3184                    "Simple merge" .
3185                    "</div>\n"; # class="diff nodifferences"
3186
3187         return $result;
3188 }
3189
3190 sub diff_line_class {
3191         my ($line, $from, $to) = @_;
3192
3193         # ordinary diff
3194         my $num_sign = 1;
3195         # combined diff
3196         if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
3197                 $num_sign = scalar @{$from->{'href'}};
3198         }
3199
3200         my @diff_line_classifier = (
3201                 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
3202                 { regexp => qr/^\\/,               class => "incomplete"  },
3203                 { regexp => qr/^ {$num_sign}/,     class => "ctx" },
3204                 # classifier for context must come before classifier add/rem,
3205                 # or we would have to use more complicated regexp, for example
3206                 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
3207                 { regexp => qr/^[+ ]{$num_sign}/,   class => "add" },
3208                 { regexp => qr/^[- ]{$num_sign}/,   class => "rem" },
3209         );
3210         for my $clsfy (@diff_line_classifier) {
3211                 return $clsfy->{'class'}
3212                         if ($line =~ $clsfy->{'regexp'});
3213         }
3214
3215         # fallback
3216         return "";
3217 }
3218
3219 # assumes that $from and $to are defined and correctly filled,
3220 # and that $line holds a line of chunk header for unified diff
3221 sub format_unidiff_chunk_header {
3222         my ($line, $from, $to) = @_;
3223
3224         my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
3225                 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
3226
3227         $from_lines = 0 unless defined $from_lines;
3228         $to_lines   = 0 unless defined $to_lines;
3229
3230         if ($from->{'href'}) {
3231                 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
3232                                      -class=>"list"}, $from_text);
3233         }
3234         if ($to->{'href'}) {
3235                 $to_text   = $cgi->a({-href=>"$to->{'href'}#l$to_start",
3236                                      -class=>"list"}, $to_text);
3237         }
3238         $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
3239                 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3240         return $line;
3241 }
3242
3243 # assumes that $from and $to are defined and correctly filled,
3244 # and that $line holds a line of chunk header for combined diff
3245 sub format_cc_diff_chunk_header {
3246         my ($line, $from, $to) = @_;
3247
3248         my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
3249         my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
3250
3251         @from_text = split(' ', $ranges);
3252         for (my $i = 0; $i < @from_text; ++$i) {
3253                 ($from_start[$i], $from_nlines[$i]) =
3254                         (split(',', substr($from_text[$i], 1)), 0);
3255         }
3256
3257         $to_text   = pop @from_text;
3258         $to_start  = pop @from_start;
3259         $to_nlines = pop @from_nlines;
3260
3261         $line = "<span class=\"chunk_info\">$prefix ";
3262         for (my $i = 0; $i < @from_text; ++$i) {
3263                 if ($from->{'href'}[$i]) {
3264                         $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
3265                                           -class=>"list"}, $from_text[$i]);
3266                 } else {
3267                         $line .= $from_text[$i];
3268                 }
3269                 $line .= " ";
3270         }
3271         if ($to->{'href'}) {
3272                 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
3273                                   -class=>"list"}, $to_text);
3274         } else {
3275                 $line .= $to_text;
3276         }
3277         $line .= " $prefix</span>" .
3278                  "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3279         return $line;
3280 }
3281
3282 # process patch (diff) line (not to be used for diff headers),
3283 # returning HTML-formatted (but not wrapped) line.
3284 # If the line is passed as a reference, it is treated as HTML and not
3285 # esc_html()'ed.
3286 sub format_diff_line {
3287         my ($line, $diff_class, $from, $to) = @_;
3288
3289         if (ref($line)) {
3290                 $line = $$line;
3291         } else {
3292                 chomp $line;
3293                 $line = untabify($line);
3294
3295                 if ($from && $to && $line =~ m/^\@{2} /) {
3296                         $line = format_unidiff_chunk_header($line, $from, $to);
3297                 } elsif ($from && $to && $line =~ m/^\@{3}/) {
3298                         $line = format_cc_diff_chunk_header($line, $from, $to);
3299                 } else {
3300                         $line = esc_html($line, -nbsp=>1);
3301                 }
3302         }
3303
3304         my $diff_classes = "diff diff_body";
3305         $diff_classes .= " $diff_class" if ($diff_class);
3306         $line = "<div class=\"$diff_classes\">$line</div>\n";
3307
3308         return $line;
3309 }
3310
3311 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
3312 # linked.  Pass the hash of the tree/commit to snapshot.
3313 sub format_snapshot_links {
3314         my ($hash) = @_;
3315         my $num_fmts = @snapshot_fmts;
3316         if ($num_fmts > 1) {
3317                 # A parenthesized list of links bearing format names.
3318                 # e.g. "snapshot (_tar.gz_ _zip_)"
3319                 return "<span class=\"snapshots\">snapshot (" . join(' ', map
3320                         $cgi->a({
3321                                 -href => href(
3322                                         action=>"snapshot",
3323                                         hash=>$hash,
3324                                         snapshot_format=>$_
3325                                 )
3326                         }, $known_snapshot_formats{$_}{'display'})
3327                 , @snapshot_fmts) . ")</span>";
3328         } elsif ($num_fmts == 1) {
3329                 # A single "snapshot" link whose tooltip bears the format name.
3330                 # i.e. "_snapshot_"
3331                 my ($fmt) = @snapshot_fmts;
3332                 return "<span class=\"snapshots\">" .
3333                         $cgi->a({
3334                                 -href => href(
3335                                         action=>"snapshot",
3336                                         hash=>$hash,
3337                                         snapshot_format=>$fmt
3338                                 ),
3339                                 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
3340                         }, "snapshot") . "</span>";
3341         } else { # $num_fmts == 0
3342                 return undef;
3343         }
3344 }
3345
3346 ## ......................................................................
3347 ## functions returning values to be passed, perhaps after some
3348 ## transformation, to other functions; e.g. returning arguments to href()
3349
3350 # returns hash to be passed to href to generate gitweb URL
3351 # in -title key it returns description of link
3352 sub get_feed_info {
3353         my $format = shift || 'Atom';
3354         my %res = (action => lc($format));
3355         my $matched_ref = 0;
3356
3357         # feed links are possible only for project views
3358         return unless (defined $project);
3359         # some views should link to OPML, or to generic project feed,
3360         # or don't have specific feed yet (so they should use generic)
3361         return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
3362
3363         my $branch = undef;
3364         # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
3365         # (fullname) to differentiate from tag links; this also makes
3366         # possible to detect branch links
3367         for my $ref (get_branch_refs()) {
3368                 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
3369                     (defined $hash      && $hash      =~ m!^refs/\Q$ref\E/(.*)$!)) {
3370                         $branch = $1;
3371                         $matched_ref = $ref;
3372                         last;
3373                 }
3374         }
3375         # find log type for feed description (title)
3376         my $type = 'log';
3377         if (defined $file_name) {
3378                 $type  = "history of $file_name";
3379                 $type .= "/" if ($action eq 'tree');
3380                 $type .= " on '$branch'" if (defined $branch);
3381         } else {
3382                 $type = "log of $branch" if (defined $branch);
3383         }
3384
3385         $res{-title} = $type;
3386         $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
3387         $res{'file_name'} = $file_name;
3388
3389         return %res;
3390 }
3391
3392 ## ----------------------------------------------------------------------
3393 ## git utility subroutines, invoking git commands
3394
3395 # returns path to the core git executable and the --git-dir parameter as list
3396 sub git_cmd {
3397         $number_of_git_cmds++;
3398         return $GIT, '--git-dir='.$git_dir;
3399 }
3400
3401 # opens a "-|" cmd pipe handle with 2>/dev/null and returns it
3402 sub cmd_pipe {
3403
3404         # In order to be compatible with FCGI mode we must use POSIX
3405         # and access the STDERR_FILENO file descriptor directly
3406
3407         use POSIX qw(STDERR_FILENO dup dup2);
3408
3409         open(my $null, '>', File::Spec->devnull) or die "couldn't open devnull: $!";
3410         (my $saveerr = dup(STDERR_FILENO)) or die "couldn't dup STDERR: $!";
3411         my $dup2ok = dup2(fileno($null), STDERR_FILENO);
3412         close($null) or !$dup2ok or die "couldn't close NULL: $!";
3413         $dup2ok or POSIX::close($saveerr), die "couldn't dup NULL to STDERR: $!";
3414         my $result = open(my $fd, "-|", @_);
3415         $dup2ok = dup2($saveerr, STDERR_FILENO);
3416         POSIX::close($saveerr) or !$dup2ok or die "couldn't close SAVEERR: $!";
3417         $dup2ok or die "couldn't dup SAVERR to STDERR: $!";
3418
3419         return $result ? $fd : undef;
3420 }
3421
3422 # opens a "-|" git_cmd pipe handle with 2>/dev/null and returns it
3423 sub git_cmd_pipe {
3424         return cmd_pipe git_cmd(), @_;
3425 }
3426
3427 # quote the given arguments for passing them to the shell
3428 # quote_command("command", "arg 1", "arg with ' and ! characters")
3429 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
3430 # Try to avoid using this function wherever possible.
3431 sub quote_command {
3432         return join(' ',
3433                 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
3434 }
3435
3436 # get HEAD ref of given project as hash
3437 sub git_get_head_hash {
3438         return git_get_full_hash(shift, 'HEAD');
3439 }
3440
3441 sub git_get_full_hash {
3442         return git_get_hash(@_);
3443 }
3444
3445 sub git_get_short_hash {
3446         return git_get_hash(@_, '--short=7');
3447 }
3448
3449 sub git_get_hash {
3450         my ($project, $hash, @options) = @_;
3451         my $o_git_dir = $git_dir;
3452         my $retval = undef;
3453         $git_dir = "$projectroot/$project";
3454         if (defined(my $fd = git_cmd_pipe 'rev-parse',
3455             '--verify', '-q', @options, $hash)) {
3456                 $retval = <$fd>;
3457                 chomp $retval if defined $retval;
3458                 close $fd;
3459         }
3460         if (defined $o_git_dir) {
3461                 $git_dir = $o_git_dir;
3462         }
3463         return $retval;
3464 }
3465
3466 # get type of given object
3467 sub git_get_type {
3468         my $hash = shift;
3469
3470         defined(my $fd = git_cmd_pipe "cat-file", '-t', $hash) or return;
3471         my $type = <$fd>;
3472         close $fd or return;
3473         chomp $type;
3474         return $type;
3475 }
3476
3477 # repository configuration
3478 our $config_file = '';
3479 our %config;
3480
3481 # store multiple values for single key as anonymous array reference
3482 # single values stored directly in the hash, not as [ <value> ]
3483 sub hash_set_multi {
3484         my ($hash, $key, $value) = @_;
3485
3486         if (!exists $hash->{$key}) {
3487                 $hash->{$key} = $value;
3488         } elsif (!ref $hash->{$key}) {
3489                 $hash->{$key} = [ $hash->{$key}, $value ];
3490         } else {
3491                 push @{$hash->{$key}}, $value;
3492         }
3493 }
3494
3495 # return hash of git project configuration
3496 # optionally limited to some section, e.g. 'gitweb'
3497 sub git_parse_project_config {
3498         my $section_regexp = shift;
3499         my %config;
3500
3501         local $/ = "\0";
3502
3503         defined(my $fh = git_cmd_pipe "config", '-z', '-l')
3504                 or return;
3505
3506         while (my $keyval = to_utf8(scalar <$fh>)) {
3507                 chomp $keyval;
3508                 my ($key, $value) = split(/\n/, $keyval, 2);
3509
3510                 hash_set_multi(\%config, $key, $value)
3511                         if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
3512         }
3513         close $fh;
3514
3515         return %config;
3516 }
3517
3518 # convert config value to boolean: 'true' or 'false'
3519 # no value, number > 0, 'true' and 'yes' values are true
3520 # rest of values are treated as false (never as error)
3521 sub config_to_bool {
3522         my $val = shift;
3523
3524         return 1 if !defined $val;             # section.key
3525
3526         # strip leading and trailing whitespace
3527         $val =~ s/^\s+//;
3528         $val =~ s/\s+$//;
3529
3530         return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
3531                 ($val =~ /^(?:true|yes)$/i));  # section.key = true
3532 }
3533
3534 # convert config value to simple decimal number
3535 # an optional value suffix of 'k', 'm', or 'g' will cause the value
3536 # to be multiplied by 1024, 1048576, or 1073741824
3537 sub config_to_int {
3538         my $val = shift;
3539
3540         # strip leading and trailing whitespace
3541         $val =~ s/^\s+//;
3542         $val =~ s/\s+$//;
3543
3544         if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
3545                 $unit = lc($unit);
3546                 # unknown unit is treated as 1
3547                 return $num * ($unit eq 'g' ? 1073741824 :
3548                                $unit eq 'm' ?    1048576 :
3549                                $unit eq 'k' ?       1024 : 1);
3550         }
3551         return $val;
3552 }
3553
3554 # convert config value to array reference, if needed
3555 sub config_to_multi {
3556         my $val = shift;
3557
3558         return ref($val) ? $val : (defined($val) ? [ $val ] : []);
3559 }
3560
3561 sub git_get_project_config {
3562         my ($key, $type) = @_;
3563
3564         return unless defined $git_dir;
3565
3566         # key sanity check
3567         return unless ($key);
3568         # only subsection, if exists, is case sensitive,
3569         # and not lowercased by 'git config -z -l'
3570         if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
3571                 $lo =~ s/_//g;
3572                 $key = join(".", lc($hi), $mi, lc($lo));
3573                 return if ($lo =~ /\W/ || $hi =~ /\W/);
3574         } else {
3575                 $key = lc($key);
3576                 $key =~ s/_//g;
3577                 return if ($key =~ /\W/);
3578         }
3579         $key =~ s/^gitweb\.//;
3580
3581         # type sanity check
3582         if (defined $type) {
3583                 $type =~ s/^--//;
3584                 $type = undef
3585                         unless ($type eq 'bool' || $type eq 'int');
3586         }
3587
3588         # get config
3589         if (!defined $config_file ||
3590             $config_file ne "$git_dir/config") {
3591                 %config = git_parse_project_config('gitweb');
3592                 $config_file = "$git_dir/config";
3593         }
3594
3595         # check if config variable (key) exists
3596         return unless exists $config{"gitweb.$key"};
3597
3598         # ensure given type
3599         if (!defined $type) {
3600                 return $config{"gitweb.$key"};
3601         } elsif ($type eq 'bool') {
3602                 # backward compatibility: 'git config --bool' returns true/false
3603                 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
3604         } elsif ($type eq 'int') {
3605                 return config_to_int($config{"gitweb.$key"});
3606         }
3607         return $config{"gitweb.$key"};
3608 }
3609
3610 # get hash of given path at given ref
3611 sub git_get_hash_by_path {
3612         my $base = shift;
3613         my $path = shift || return undef;
3614         my $type = shift;
3615
3616         $path =~ s,/+$,,;
3617
3618         defined(my $fd = git_cmd_pipe "ls-tree", $base, "--", $path)
3619                 or die_error(500, "Open git-ls-tree failed");
3620         my $line = to_utf8(scalar <$fd>);
3621         close $fd or return undef;
3622
3623         if (!defined $line) {
3624                 # there is no tree or hash given by $path at $base
3625                 return undef;
3626         }
3627
3628         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3629         $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
3630         if (defined $type && $type ne $2) {
3631                 # type doesn't match
3632                 return undef;
3633         }
3634         return $3;
3635 }
3636
3637 # get path of entry with given hash at given tree-ish (ref)
3638 # used to get 'from' filename for combined diff (merge commit) for renames
3639 sub git_get_path_by_hash {
3640         my $base = shift || return;
3641         my $hash = shift || return;
3642
3643         local $/ = "\0";
3644
3645         defined(my $fd = git_cmd_pipe "ls-tree", '-r', '-t', '-z', $base)
3646                 or return undef;
3647         while (my $line = to_utf8(scalar <$fd>)) {
3648                 chomp $line;
3649
3650                 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423  gitweb'
3651                 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f  gitweb/README'
3652                 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
3653                         close $fd;
3654                         return $1;
3655                 }
3656         }
3657         close $fd;
3658         return undef;
3659 }
3660
3661 ## ......................................................................
3662 ## git utility functions, directly accessing git repository
3663
3664 # get the value of config variable either from file named as the variable
3665 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
3666 # configuration variable in the repository config file.
3667 sub git_get_file_or_project_config {
3668         my ($path, $name) = @_;
3669
3670         $git_dir = "$projectroot/$path";
3671         open my $fd, '<', "$git_dir/$name"
3672                 or return git_get_project_config($name);
3673         my $conf = to_utf8(scalar <$fd>);
3674         close $fd;
3675         if (defined $conf) {
3676                 chomp $conf;
3677         }
3678         return $conf;
3679 }
3680
3681 sub git_get_project_description {
3682         my $path = shift;
3683         return git_get_file_or_project_config($path, 'description');
3684 }
3685
3686 sub git_get_project_category {
3687         my $path = shift;
3688         return git_get_file_or_project_config($path, 'category');
3689 }
3690
3691
3692 # supported formats:
3693 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
3694 #   - if its contents is a number, use it as tag weight,
3695 #   - otherwise add a tag with weight 1
3696 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
3697 #   the same value multiple times increases tag weight
3698 # * `gitweb.ctag' multi-valued repo config variable
3699 sub git_get_project_ctags {
3700         my $project = shift;
3701         my $ctags = {};
3702
3703         $git_dir = "$projectroot/$project";
3704         if (opendir my $dh, "$git_dir/ctags") {
3705                 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
3706                 foreach my $tagfile (@files) {
3707                         open my $ct, '<', $tagfile
3708                                 or next;
3709                         my $val = <$ct>;
3710                         chomp $val if $val;
3711                         close $ct;
3712
3713                         (my $ctag = $tagfile) =~ s#.*/##;
3714                         $ctag = to_utf8($ctag);
3715                         if ($val =~ /^\d+$/) {
3716                                 $ctags->{$ctag} = $val;
3717                         } else {
3718                                 $ctags->{$ctag} = 1;
3719                         }
3720                 }
3721                 closedir $dh;
3722
3723         } elsif (open my $fh, '<', "$git_dir/ctags") {
3724                 while (my $line = to_utf8(scalar <$fh>)) {
3725                         chomp $line;
3726                         $ctags->{$line}++ if $line;
3727                 }
3728                 close $fh;
3729
3730         } else {
3731                 my $taglist = config_to_multi(git_get_project_config('ctag'));
3732                 foreach my $tag (@$taglist) {
3733                         $ctags->{$tag}++;
3734                 }
3735         }
3736
3737         return $ctags;
3738 }
3739
3740 # return hash, where keys are content tags ('ctags'),
3741 # and values are sum of weights of given tag in every project
3742 sub git_gather_all_ctags {
3743         my $projects = shift;
3744         my $ctags = {};
3745
3746         foreach my $p (@$projects) {
3747                 foreach my $ct (keys %{$p->{'ctags'}}) {
3748                         $ctags->{$ct} += $p->{'ctags'}->{$ct};
3749                 }
3750         }
3751
3752         return $ctags;
3753 }
3754
3755 sub git_populate_project_tagcloud {
3756         my ($ctags, $action) = @_;
3757
3758         # First, merge different-cased tags; tags vote on casing
3759         my %ctags_lc;
3760         foreach (keys %$ctags) {
3761                 $ctags_lc{lc $_}->{count} += $ctags->{$_};
3762                 if (not $ctags_lc{lc $_}->{topcount}
3763                     or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
3764                         $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
3765                         $ctags_lc{lc $_}->{topname} = $_;
3766                 }
3767         }
3768
3769         my $cloud;
3770         my $matched = $input_params{'ctag_filter'};
3771         if (eval { require HTML::TagCloud; 1; }) {
3772                 $cloud = HTML::TagCloud->new;
3773                 foreach my $ctag (sort keys %ctags_lc) {
3774                         # Pad the title with spaces so that the cloud looks
3775                         # less crammed.
3776                         my $title = esc_html($ctags_lc{$ctag}->{topname});
3777                         $title =~ s/ /&#160;/g;
3778                         $title =~ s/^/&#160;/g;
3779                         $title =~ s/$/&#160;/g;
3780                         if (defined $matched && $matched eq $ctag) {
3781                                 $title = qq(<span class="match">$title</span>);
3782                         }
3783                         $cloud->add($title, href(-replay=>1, action=>$action, ctag_filter=>$ctag),
3784                                     $ctags_lc{$ctag}->{count});
3785                 }
3786         } else {
3787                 $cloud = {};
3788                 foreach my $ctag (keys %ctags_lc) {
3789                         my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3790                         if (defined $matched && $matched eq $ctag) {
3791                                 $title = qq(<span class="match">$title</span>);
3792                         }
3793                         $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3794                         $cloud->{$ctag}{ctag} =
3795                                 $cgi->a({-href=>href(-replay=>1, action=>$action, ctag_filter=>$ctag)}, $title);
3796                 }
3797         }
3798         return $cloud;
3799 }
3800
3801 sub git_show_project_tagcloud {
3802         my ($cloud, $count) = @_;
3803         if (ref $cloud eq 'HTML::TagCloud') {
3804                 return $cloud->html_and_css($count);
3805         } else {
3806                 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3807                 return
3808                         '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3809                         join (', ', map {
3810                                 $cloud->{$_}->{'ctag'}
3811                         } splice(@tags, 0, $count)) .
3812                         '</div>';
3813         }
3814 }
3815
3816 sub git_get_project_url_list {
3817         my $path = shift;
3818
3819         $git_dir = "$projectroot/$path";
3820         open my $fd, '<', "$git_dir/cloneurl"
3821                 or return wantarray ?
3822                 @{ config_to_multi(git_get_project_config('url')) } :
3823                    config_to_multi(git_get_project_config('url'));
3824         my @git_project_url_list = map { chomp; to_utf8($_) } <$fd>;
3825         close $fd;
3826
3827         return wantarray ? @git_project_url_list : \@git_project_url_list;
3828 }
3829
3830 sub git_get_projects_list {
3831         my $filter = shift;
3832         my $paranoid = shift;
3833         my @list;
3834         defined($filter) or $filter = "";
3835
3836         if (-d $projects_list) {
3837                 # search in directory
3838                 my $dir = $projects_list;
3839                 # remove the trailing "/"
3840                 $dir =~ s!/+$!!;
3841                 my $pfxlen = length("$dir");
3842                 my $pfxdepth = ($dir =~ tr!/!!);
3843                 # when filtering, search only given subdirectory
3844                 if ($filter ne "" && !$paranoid) {
3845                         $dir .= "/$filter";
3846                         $dir =~ s!/+$!!;
3847                 }
3848
3849                 File::Find::find({
3850                         follow_fast => 1, # follow symbolic links
3851                         follow_skip => 2, # ignore duplicates
3852                         dangling_symlinks => 0, # ignore dangling symlinks, silently
3853                         wanted => sub {
3854                                 # global variables
3855                                 our $project_maxdepth;
3856                                 our $projectroot;
3857                                 # skip project-list toplevel, if we get it.
3858                                 return if (m!^[/.]$!);
3859                                 # only directories can be git repositories
3860                                 return unless (-d $_);
3861                                 # don't traverse too deep (Find is super slow on os x)
3862                                 # $project_maxdepth excludes depth of $projectroot
3863                                 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3864                                         $File::Find::prune = 1;
3865                                         return;
3866                                 }
3867
3868                                 my $path = substr($File::Find::name, $pfxlen + 1);
3869                                 # paranoidly only filter here
3870                                 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3871                                         next;
3872                                 }
3873                                 # we check related file in $projectroot
3874                                 if (check_export_ok("$projectroot/$path")) {
3875                                         push @list, { path => $path };
3876                                         $File::Find::prune = 1;
3877                                 }
3878                         },
3879                 }, "$dir");
3880
3881         } elsif (-f $projects_list) {
3882                 # read from file(url-encoded):
3883                 # 'git%2Fgit.git Linus+Torvalds'
3884                 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3885                 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3886                 open my $fd, '<', $projects_list or return;
3887         PROJECT:
3888                 while (my $line = <$fd>) {
3889                         chomp $line;
3890                         my ($path, $owner) = split ' ', $line;
3891                         $path = unescape($path);
3892                         $owner = unescape($owner);
3893                         if (!defined $path) {
3894                                 next;
3895                         }
3896                         # if $filter is rpovided, check if $path begins with $filter
3897                         if ($filter ne "" && $path !~ m!^\Q$filter\E/!) {
3898                                 next;
3899                         }
3900                         if (check_export_ok("$projectroot/$path")) {
3901                                 my $pr = {
3902                                         path => $path
3903                                 };
3904                                 if ($owner) {
3905                                         $pr->{'owner'} = to_utf8($owner);
3906                                 }
3907                                 push @list, $pr;
3908                         }
3909                 }
3910                 close $fd;
3911         }
3912         return @list;
3913 }
3914
3915 # written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
3916 # as side effects it sets 'forks' field to list of forks for forked projects
3917 sub filter_forks_from_projects_list {
3918         my $projects = shift;
3919
3920         my %trie; # prefix tree of directories (path components)
3921         # generate trie out of those directories that might contain forks
3922         foreach my $pr (@$projects) {
3923                 my $path = $pr->{'path'};
3924                 $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
3925                 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3926                 next if ($path eq "");    # skip '.git' repository: tests, git-instaweb
3927                 next unless (-d "$projectroot/$path"); # containing directory exists
3928                 $pr->{'forks'} = [];      # there can be 0 or more forks of project
3929
3930                 # add to trie
3931                 my @dirs = split('/', $path);
3932                 # walk the trie, until either runs out of components or out of trie
3933                 my $ref = \%trie;
3934                 while (scalar @dirs &&
3935                        exists($ref->{$dirs[0]})) {
3936                         $ref = $ref->{shift @dirs};
3937                 }
3938                 # create rest of trie structure from rest of components
3939                 foreach my $dir (@dirs) {
3940                         $ref = $ref->{$dir} = {};
3941                 }
3942                 # create end marker, store $pr as a data
3943                 $ref->{''} = $pr if (!exists $ref->{''});
3944         }
3945
3946         # filter out forks, by finding shortest prefix match for paths
3947         my @filtered;
3948  PROJECT:
3949         foreach my $pr (@$projects) {
3950                 # trie lookup
3951                 my $ref = \%trie;
3952         DIR:
3953                 foreach my $dir (split('/', $pr->{'path'})) {
3954                         if (exists $ref->{''}) {
3955                                 # found [shortest] prefix, is a fork - skip it
3956                                 push @{$ref->{''}{'forks'}}, $pr;
3957                                 next PROJECT;
3958                         }
3959                         if (!exists $ref->{$dir}) {
3960                                 # not in trie, cannot have prefix, not a fork
3961                                 push @filtered, $pr;
3962                                 next PROJECT;
3963                         }
3964                         # If the dir is there, we just walk one step down the trie.
3965                         $ref = $ref->{$dir};
3966                 }
3967                 # we ran out of trie
3968                 # (shouldn't happen: it's either no match, or end marker)
3969                 push @filtered, $pr;
3970         }
3971
3972         return @filtered;
3973 }
3974
3975 # note: fill_project_list_info must be run first,
3976 # for 'descr_long' and 'ctags' to be filled
3977 sub search_projects_list {
3978         my ($projlist, %opts) = @_;
3979         my $tagfilter  = $opts{'tagfilter'};
3980         my $search_re = $opts{'search_regexp'};
3981
3982         return @$projlist
3983                 unless ($tagfilter || $search_re);
3984
3985         # searching projects require filling to be run before it;
3986         fill_project_list_info($projlist,
3987                                $tagfilter  ? 'ctags' : (),
3988                                $search_re ? ('path', 'descr') : ());
3989         my @projects;
3990  PROJECT:
3991         foreach my $pr (@$projlist) {
3992
3993                 if ($tagfilter) {
3994                         next unless ref($pr->{'ctags'}) eq 'HASH';
3995                         next unless
3996                                 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3997                 }
3998
3999                 if ($search_re) {
4000                         my $path = $pr->{'path'};
4001                         $path =~ s/\.git$//; # should not be included in search
4002                         next unless
4003                                 $path =~ /$search_re/ ||
4004                                 $pr->{'descr_long'} =~ /$search_re/;
4005                 }
4006
4007                 push @projects, $pr;
4008         }
4009
4010         return @projects;
4011 }
4012
4013 our $gitweb_project_owner = undef;
4014 sub git_get_project_list_from_file {
4015
4016         return if (defined $gitweb_project_owner);
4017
4018         $gitweb_project_owner = {};
4019         # read from file (url-encoded):
4020         # 'git%2Fgit.git Linus+Torvalds'
4021         # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
4022         # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
4023         if (-f $projects_list) {
4024                 open(my $fd, '<', $projects_list);
4025                 while (my $line = <$fd>) {
4026                         chomp $line;
4027                         my ($pr, $ow) = split ' ', $line;
4028                         $pr = unescape($pr);
4029                         $ow = unescape($ow);
4030                         $gitweb_project_owner->{$pr} = to_utf8($ow);
4031                 }
4032                 close $fd;
4033         }
4034 }
4035
4036 sub git_get_project_owner {
4037         my $proj = shift;
4038         my $owner;
4039
4040         return undef unless $proj;
4041         $git_dir = "$projectroot/$proj";
4042
4043         if (defined $project && $proj eq $project) {
4044                 $owner = git_get_project_config('owner');
4045         }
4046         if (!defined $owner && !defined $gitweb_project_owner) {
4047                 git_get_project_list_from_file();
4048         }
4049         if (!defined $owner && exists $gitweb_project_owner->{$proj}) {
4050                 $owner = $gitweb_project_owner->{$proj};
4051         }
4052         if (!defined $owner && (!defined $project || $proj ne $project)) {
4053                 $owner = git_get_project_config('owner');
4054         }
4055         if (!defined $owner) {
4056                 $owner = get_file_owner("$git_dir");
4057         }
4058
4059         return $owner;
4060 }
4061
4062 sub parse_activity_date {
4063         my $dstr = shift;
4064
4065         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
4066                 # Unix timestamp
4067                 return 0 + $1;
4068         }
4069         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt _](\d{1,2}):(\d{2}):(\d{2})(?:[ _]?([Zz]|(?:[-+]\d{1,2}:?\d{2})))?\s*$/) {
4070                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
4071                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, 0+$Y);
4072                 defined($z) && $z ne '' or $z = 'Z';
4073                 $z =~ s/://;
4074                 substr($z,1,0) = '0' if length($z) == 4;
4075                 my $off = 0;
4076                 if (uc($z) ne 'Z') {
4077                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
4078                         $off = -$off if substr($z,0,1) eq '-';
4079                 }
4080                 return $seconds - $off;
4081         }
4082         return undef;
4083 }
4084
4085 # If $quick is true only look at $lastactivity_file
4086 sub git_get_last_activity {
4087         my ($path, $quick) = @_;
4088         my $fd;
4089
4090         $git_dir = "$projectroot/$path";
4091         if ($lastactivity_file && open($fd, "<", "$git_dir/$lastactivity_file")) {
4092                 my $activity = <$fd>;
4093                 close $fd;
4094                 return (undef) unless defined $activity;
4095                 chomp $activity;
4096                 return (undef) if $activity eq '';
4097                 if (my $timestamp = parse_activity_date($activity)) {
4098                         return ($timestamp);
4099                 }
4100         }
4101         return (undef) if $quick;
4102         defined($fd = git_cmd_pipe 'for-each-ref',
4103              '--format=%(committer)',
4104              '--sort=-committerdate',
4105              '--count=1',
4106              map { "refs/$_" } get_branch_refs ()) or return;
4107         my $most_recent = <$fd>;
4108         close $fd or return (undef);
4109         if (defined $most_recent &&
4110             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
4111                 my $timestamp = $1;
4112                 return ($timestamp);
4113         }
4114         return (undef);
4115 }
4116
4117 # Implementation note: when a single remote is wanted, we cannot use 'git
4118 # remote show -n' because that command always work (assuming it's a remote URL
4119 # if it's not defined), and we cannot use 'git remote show' because that would
4120 # try to make a network roundtrip. So the only way to find if that particular
4121 # remote is defined is to walk the list provided by 'git remote -v' and stop if
4122 # and when we find what we want.
4123 sub git_get_remotes_list {
4124         my $wanted = shift;
4125         my %remotes = ();
4126
4127         my $fd = git_cmd_pipe 'remote', '-v';
4128         return unless $fd;
4129         while (my $remote = to_utf8(scalar <$fd>)) {
4130                 chomp $remote;
4131                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
4132                 next if $wanted and not $remote eq $wanted;
4133                 my ($url, $key) = ($1, $2);
4134
4135                 $remotes{$remote} ||= { 'heads' => [] };
4136                 $remotes{$remote}{$key} = $url;
4137         }
4138         close $fd or return;
4139         return wantarray ? %remotes : \%remotes;
4140 }
4141
4142 # Takes a hash of remotes as first parameter and fills it by adding the
4143 # available remote heads for each of the indicated remotes.
4144 sub fill_remote_heads {
4145         my $remotes = shift;
4146         my @heads = map { "remotes/$_" } keys %$remotes;
4147         my @remoteheads = git_get_heads_list(undef, @heads);
4148         foreach my $remote (keys %$remotes) {
4149                 $remotes->{$remote}{'heads'} = [ grep {
4150                         $_->{'name'} =~ s!^$remote/!!
4151                         } @remoteheads ];
4152         }
4153 }
4154
4155 sub git_get_references {
4156         my $type = shift || "";
4157         my %refs;
4158         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
4159         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
4160         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
4161                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
4162                 or return;
4163
4164         while (my $line = to_utf8(scalar <$fd>)) {
4165                 chomp $line;
4166                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
4167                         if (defined $refs{$1}) {
4168                                 push @{$refs{$1}}, $2;
4169                         } else {
4170                                 $refs{$1} = [ $2 ];
4171                         }
4172                 }
4173         }
4174         close $fd or return;
4175         return \%refs;
4176 }
4177
4178 sub git_get_rev_name_tags {
4179         my $hash = shift || return undef;
4180
4181         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
4182                 or return;
4183         my $name_rev = to_utf8(scalar <$fd>);
4184         close $fd;
4185
4186         if ($name_rev =~ m|^$hash tags/(.*)$|) {
4187                 return $1;
4188         } else {
4189                 # catches also '$hash undefined' output
4190                 return undef;
4191         }
4192 }
4193
4194 ## ----------------------------------------------------------------------
4195 ## parse to hash functions
4196
4197 sub parse_date {
4198         my $epoch = shift;
4199         my $tz = shift || "-0000";
4200
4201         my %date;
4202         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
4203         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
4204         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
4205         $date{'hour'} = $hour;
4206         $date{'minute'} = $min;
4207         $date{'mday'} = $mday;
4208         $date{'day'} = $days[$wday];
4209         $date{'month'} = $months[$mon];
4210         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
4211                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
4212         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
4213                              $mday, $months[$mon], $hour ,$min;
4214         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
4215                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
4216
4217         my ($tz_sign, $tz_hour, $tz_min) =
4218                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
4219         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
4220         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
4221         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
4222         $date{'hour_local'} = $hour;
4223         $date{'minute_local'} = $min;
4224         $date{'mday_local'} = $mday;
4225         $date{'tz_local'} = $tz;
4226         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
4227                                   1900+$year, $mon+1, $mday,
4228                                   $hour, $min, $sec, $tz);
4229         return %date;
4230 }
4231
4232 sub parse_file_date {
4233         my $file = shift;
4234         my $mtime = (stat("$projectroot/$project/$file"))[9];
4235         return () unless defined $mtime;
4236         my ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
4237         my $tzoffset = timegm($sec,$min,$hour,$mday,$mon,$year+1900) - $mtime;
4238         my $tzstring = '+';
4239         if ($tzoffset <= 0) {
4240                 $tzstring = '-';
4241                 $tzoffset *= -1;
4242         }
4243         $tzoffset = int($tzoffset/60);
4244         $tzstring .= sprintf("%02d%02d", int($tzoffset/60), $tzoffset%60);
4245         return parse_date($mtime, $tzstring);
4246 }
4247
4248 sub parse_tag {
4249         my $tag_id = shift;
4250         my %tag;
4251         my @comment;
4252
4253         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
4254         $tag{'id'} = $tag_id;
4255         while (my $line = to_utf8(scalar <$fd>)) {
4256                 chomp $line;
4257                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
4258                         $tag{'object'} = $1;
4259                 } elsif ($line =~ m/^type (.+)$/) {
4260                         $tag{'type'} = $1;
4261                 } elsif ($line =~ m/^tag (.+)$/) {
4262                         $tag{'name'} = $1;
4263                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
4264                         $tag{'author'} = $1;
4265                         $tag{'author_epoch'} = $2;
4266                         $tag{'author_tz'} = $3;
4267                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4268                                 $tag{'author_name'}  = $1;
4269                                 $tag{'author_email'} = $2;
4270                         } else {
4271                                 $tag{'author_name'} = $tag{'author'};
4272                         }
4273                 } elsif ($line =~ m/--BEGIN/) {
4274                         push @comment, $line;
4275                         last;
4276                 } elsif ($line eq "") {
4277                         last;
4278                 }
4279         }
4280         push @comment, map(to_utf8($_), <$fd>);
4281         $tag{'comment'} = \@comment;
4282         close $fd or return;
4283         if (!defined $tag{'name'}) {
4284                 return
4285         };
4286         return %tag
4287 }
4288
4289 sub parse_commit_text {
4290         my ($commit_text, $withparents) = @_;
4291         my @commit_lines = split '\n', $commit_text;
4292         my %co;
4293
4294         pop @commit_lines; # Remove '\0'
4295
4296         if (! @commit_lines) {
4297                 return;
4298         }
4299
4300         my $header = shift @commit_lines;
4301         if ($header !~ m/^[0-9a-fA-F]{40}/) {
4302                 return;
4303         }
4304         ($co{'id'}, my @parents) = split ' ', $header;
4305         while (my $line = shift @commit_lines) {
4306                 last if $line eq "\n";
4307                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
4308                         $co{'tree'} = $1;
4309                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
4310                         push @parents, $1;
4311                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
4312                         $co{'author'} = to_utf8($1);
4313                         $co{'author_epoch'} = $2;
4314                         $co{'author_tz'} = $3;
4315                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4316                                 $co{'author_name'}  = $1;
4317                                 $co{'author_email'} = $2;
4318                         } else {
4319                                 $co{'author_name'} = $co{'author'};
4320                         }
4321                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
4322                         $co{'committer'} = to_utf8($1);
4323                         $co{'committer_epoch'} = $2;
4324                         $co{'committer_tz'} = $3;
4325                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
4326                                 $co{'committer_name'}  = $1;
4327                                 $co{'committer_email'} = $2;
4328                         } else {
4329                                 $co{'committer_name'} = $co{'committer'};
4330                         }
4331                 }
4332         }
4333         if (!defined $co{'tree'}) {
4334                 return;
4335         };
4336         $co{'parents'} = \@parents;
4337         $co{'parent'} = $parents[0];
4338
4339         @commit_lines = map to_utf8($_), @commit_lines;
4340         foreach my $title (@commit_lines) {
4341                 $title =~ s/^    //;
4342                 if ($title ne "") {
4343                         $co{'title'} = chop_str($title, 80, 5);
4344                         # remove leading stuff of merges to make the interesting part visible
4345                         if (length($title) > 50) {
4346                                 $title =~ s/^Automatic //;
4347                                 $title =~ s/^merge (of|with) /Merge ... /i;
4348                                 if (length($title) > 50) {
4349                                         $title =~ s/(http|rsync):\/\///;
4350                                 }
4351                                 if (length($title) > 50) {
4352                                         $title =~ s/(master|www|rsync)\.//;
4353                                 }
4354                                 if (length($title) > 50) {
4355                                         $title =~ s/kernel.org:?//;
4356                                 }
4357                                 if (length($title) > 50) {
4358                                         $title =~ s/\/pub\/scm//;
4359                                 }
4360                         }
4361                         $co{'title_short'} = chop_str($title, 50, 5);
4362                         last;
4363                 }
4364         }
4365         if (! defined $co{'title'} || $co{'title'} eq "") {
4366                 $co{'title'} = $co{'title_short'} = '(no commit message)';
4367         }
4368         # remove added spaces
4369         foreach my $line (@commit_lines) {
4370                 $line =~ s/^    //;
4371         }
4372         $co{'comment'} = \@commit_lines;
4373
4374         my $age_epoch = $co{'committer_epoch'};
4375         $co{'age_epoch'} = $age_epoch;
4376         my $time_now = time;
4377         $co{'age_string'} = age_string($age_epoch, $time_now);
4378         $co{'age_string_date'} = age_string_date($age_epoch, $time_now);
4379         $co{'age_string_age'} = age_string_age($age_epoch, $time_now);
4380         return %co;
4381 }
4382
4383 sub parse_commit {
4384         my ($commit_id) = @_;
4385         my %co;
4386
4387         local $/ = "\0";
4388
4389         defined(my $fd = git_cmd_pipe "rev-list",
4390                 "--parents",
4391                 "--header",
4392                 "--max-count=1",
4393                 $commit_id,
4394                 "--")
4395                 or die_error(500, "Open git-rev-list failed");
4396         %co = parse_commit_text(<$fd>, 1);
4397         close $fd;
4398
4399         return %co;
4400 }
4401
4402 sub parse_commits {
4403         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
4404         my @cos;
4405
4406         $maxcount ||= 1;
4407         $skip ||= 0;
4408
4409         local $/ = "\0";
4410
4411         defined(my $fd = git_cmd_pipe "rev-list",
4412                 "--header",
4413                 @args,
4414                 ("--max-count=" . $maxcount),
4415                 ("--skip=" . $skip),
4416                 @extra_options,
4417                 $commit_id,
4418                 "--",
4419                 ($filename ? ($filename) : ()))
4420                 or die_error(500, "Open git-rev-list failed");
4421         while (my $line = <$fd>) {
4422                 my %co = parse_commit_text($line);
4423                 push @cos, \%co;
4424         }
4425         close $fd;
4426
4427         return wantarray ? @cos : \@cos;
4428 }
4429
4430 # parse line of git-diff-tree "raw" output
4431 sub parse_difftree_raw_line {
4432         my $line = shift;
4433         my %res;
4434
4435         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
4436         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
4437         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
4438                 $res{'from_mode'} = $1;
4439                 $res{'to_mode'} = $2;
4440                 $res{'from_id'} = $3;
4441                 $res{'to_id'} = $4;
4442                 $res{'status'} = $5;
4443                 $res{'similarity'} = $6;
4444                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
4445                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
4446                 } else {
4447                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
4448                 }
4449         }
4450         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
4451         # combined diff (for merge commit)
4452         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
4453                 $res{'nparents'}  = length($1);
4454                 $res{'from_mode'} = [ split(' ', $2) ];
4455                 $res{'to_mode'} = pop @{$res{'from_mode'}};
4456                 $res{'from_id'} = [ split(' ', $3) ];
4457                 $res{'to_id'} = pop @{$res{'from_id'}};
4458                 $res{'status'} = [ split('', $4) ];
4459                 $res{'to_file'} = unquote($5);
4460         }
4461         # 'c512b523472485aef4fff9e57b229d9d243c967f'
4462         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
4463                 $res{'commit'} = $1;
4464         }
4465
4466         return wantarray ? %res : \%res;
4467 }
4468
4469 # wrapper: return parsed line of git-diff-tree "raw" output
4470 # (the argument might be raw line, or parsed info)
4471 sub parsed_difftree_line {
4472         my $line_or_ref = shift;
4473
4474         if (ref($line_or_ref) eq "HASH") {
4475                 # pre-parsed (or generated by hand)
4476                 return $line_or_ref;
4477         } else {
4478                 return parse_difftree_raw_line($line_or_ref);
4479         }
4480 }
4481
4482 # parse line of git-ls-tree output
4483 sub parse_ls_tree_line {
4484         my $line = shift;
4485         my %opts = @_;
4486         my %res;
4487
4488         if ($opts{'-l'}) {
4489                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
4490                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
4491
4492                 $res{'mode'} = $1;
4493                 $res{'type'} = $2;
4494                 $res{'hash'} = $3;
4495                 $res{'size'} = $4;
4496                 if ($opts{'-z'}) {
4497                         $res{'name'} = $5;
4498                 } else {
4499                         $res{'name'} = unquote($5);
4500                 }
4501         } else {
4502                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
4503                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
4504
4505                 $res{'mode'} = $1;
4506                 $res{'type'} = $2;
4507                 $res{'hash'} = $3;
4508                 if ($opts{'-z'}) {
4509                         $res{'name'} = $4;
4510                 } else {
4511                         $res{'name'} = unquote($4);
4512                 }
4513         }
4514
4515         return wantarray ? %res : \%res;
4516 }
4517
4518 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4519 sub parse_from_to_diffinfo {
4520         my ($diffinfo, $from, $to, @parents) = @_;
4521
4522         if ($diffinfo->{'nparents'}) {
4523                 # combined diff
4524                 $from->{'file'} = [];
4525                 $from->{'href'} = [];
4526                 fill_from_file_info($diffinfo, @parents)
4527                         unless exists $diffinfo->{'from_file'};
4528                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4529                         $from->{'file'}[$i] =
4530                                 defined $diffinfo->{'from_file'}[$i] ?
4531                                         $diffinfo->{'from_file'}[$i] :
4532                                         $diffinfo->{'to_file'};
4533                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4534                                 $from->{'href'}[$i] = href(action=>"blob",
4535                                                            hash_base=>$parents[$i],
4536                                                            hash=>$diffinfo->{'from_id'}[$i],
4537                                                            file_name=>$from->{'file'}[$i]);
4538                         } else {
4539                                 $from->{'href'}[$i] = undef;
4540                         }
4541                 }
4542         } else {
4543                 # ordinary (not combined) diff
4544                 $from->{'file'} = $diffinfo->{'from_file'};
4545                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4546                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4547                                                hash=>$diffinfo->{'from_id'},
4548                                                file_name=>$from->{'file'});
4549                 } else {
4550                         delete $from->{'href'};
4551                 }
4552         }
4553
4554         $to->{'file'} = $diffinfo->{'to_file'};
4555         if (!is_deleted($diffinfo)) { # file exists in result
4556                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4557                                      hash=>$diffinfo->{'to_id'},
4558                                      file_name=>$to->{'file'});
4559         } else {
4560                 delete $to->{'href'};
4561         }
4562 }
4563
4564 ## ......................................................................
4565 ## parse to array of hashes functions
4566
4567 sub git_get_heads_list {
4568         my ($limit, @classes) = @_;
4569         @classes = get_branch_refs() unless @classes;
4570         my @patterns = map { "refs/$_" } @classes;
4571         my @headslist;
4572
4573         defined(my $fd = git_cmd_pipe 'for-each-ref',
4574                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4575                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4576                 @patterns)
4577                 or return;
4578         while (my $line = to_utf8(scalar <$fd>)) {
4579                 my %ref_item;
4580
4581                 chomp $line;
4582                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4583                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4584                 my ($committer, $epoch, $tz) =
4585                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4586                 $ref_item{'fullname'}  = $name;
4587                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4588                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4589                 $ref_item{'name'} = $name;
4590                 # for refs neither in 'heads' nor 'remotes' we want to
4591                 # show their ref dir
4592                 my $ref_dir = (defined $1) ? $1 : '';
4593                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4594                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4595                 }
4596
4597                 $ref_item{'id'}    = $hash;
4598                 $ref_item{'title'} = $title || '(no commit message)';
4599                 $ref_item{'epoch'} = $epoch;
4600                 if ($epoch) {
4601                         $ref_item{'age'} = age_string($ref_item{'epoch'});
4602                 } else {
4603                         $ref_item{'age'} = "unknown";
4604                 }
4605
4606                 push @headslist, \%ref_item;
4607         }
4608         close $fd;
4609
4610         return wantarray ? @headslist : \@headslist;
4611 }
4612
4613 sub git_get_tags_list {
4614         my $limit = shift;
4615         my @tagslist;
4616         my $all = shift || 0;
4617         my $order = shift || $default_refs_order;
4618         my $sortkey = $all && $order eq 'name' ? 'refname' : '-creatordate';
4619
4620         defined(my $fd = git_cmd_pipe 'for-each-ref',
4621                 ($limit ? '--count='.($limit+1) : ()), "--sort=$sortkey",
4622                 '--format=%(objectname) %(objecttype) %(refname) '.
4623                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4624                 ($all ? 'refs' : 'refs/tags'))
4625                 or return;
4626         while (my $line = to_utf8(scalar <$fd>)) {
4627                 my %ref_item;
4628
4629                 chomp $line;
4630                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4631                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4632                 my ($creator, $epoch, $tz) =
4633                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4634                 $ref_item{'fullname'} = $name;
4635                 $name =~ s!^refs/!! if $all;
4636                 $name =~ s!^refs/tags/!! unless $all;
4637
4638                 $ref_item{'type'} = $type;
4639                 $ref_item{'id'} = $id;
4640                 $ref_item{'name'} = $name;
4641                 if ($type eq "tag") {
4642                         $ref_item{'subject'} = $title;
4643                         $ref_item{'reftype'} = $reftype;
4644                         $ref_item{'refid'}   = $refid;
4645                 } else {
4646                         $ref_item{'reftype'} = $type;
4647                         $ref_item{'refid'}   = $id;
4648                 }
4649
4650                 if ($type eq "tag" || $type eq "commit") {
4651                         $ref_item{'epoch'} = $epoch;
4652                         if ($epoch) {
4653                                 $ref_item{'age'} = age_string($ref_item{'epoch'});
4654                         } else {
4655                                 $ref_item{'age'} = "unknown";
4656                         }
4657                 }
4658
4659                 push @tagslist, \%ref_item;
4660         }
4661         close $fd;
4662
4663         return wantarray ? @tagslist : \@tagslist;
4664 }
4665
4666 ## ----------------------------------------------------------------------
4667 ## filesystem-related functions
4668
4669 sub get_file_owner {
4670         my $path = shift;
4671
4672         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4673         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4674         if (!defined $gcos) {
4675                 return undef;
4676         }
4677         my $owner = $gcos;
4678         $owner =~ s/[,;].*$//;
4679         return to_utf8($owner);
4680 }
4681
4682 # assume that file exists
4683 sub insert_file {
4684         my $filename = shift;
4685
4686         open my $fd, '<', $filename;
4687         while (<$fd>) {
4688                 print to_utf8($_);
4689         }
4690         close $fd;
4691 }
4692
4693 # return undef on failure
4694 sub collect_output {
4695         defined(my $fd = cmd_pipe @_) or return undef;
4696         if (eof $fd) {
4697                 close $fd;
4698                 return undef;
4699         }
4700         my $result = join('', map({ to_utf8($_) } <$fd>));
4701         close $fd or return undef;
4702         return $result;
4703 }
4704
4705 # return undef on failure
4706 # return '' if only comments
4707 sub collect_html_file {
4708         my $filename = shift;
4709
4710         open my $fd, '<', $filename or return undef;
4711         my $result = join('', map({ to_utf8($_) } <$fd>));
4712         close $fd or return undef;
4713         return undef unless defined($result);
4714         my $test = $result;
4715         $test =~ s/<!--(?:[^-]|(?:-(?!-)))*-->//gs;
4716         $test =~ s/\s+//s;
4717         return $test eq '' ? '' : $result;
4718 }
4719
4720 ## ......................................................................
4721 ## mimetype related functions
4722
4723 sub mimetype_guess_file {
4724         my $filename = shift;
4725         my $mimemap = shift;
4726         my $rawmode = shift;
4727         -r $mimemap or return undef;
4728
4729         my %mimemap;
4730         open(my $mh, '<', $mimemap) or return undef;
4731         while (<$mh>) {
4732                 next if m/^#/; # skip comments
4733                 my ($mimetype, @exts) = split(/\s+/);
4734                 foreach my $ext (@exts) {
4735                         $mimemap{$ext} = $mimetype;
4736                 }
4737         }
4738         close($mh);
4739
4740         my ($ext, $ans);
4741         $ext = $1 if $filename =~ /\.([^.]*)$/;
4742         $ans = $mimemap{$ext} if $ext;
4743         if (defined $ans) {
4744                 my $l = lc($ans);
4745                 $ans = 'text/html' if $l eq 'application/xhtml+xml';
4746                 if (!$rawmode) {
4747                         $ans = 'text/xml' if $l =~ m!^application/[^\s:;,=]+\+xml$! ||
4748                                              $l eq 'image/svg+xml' ||
4749                                              $l eq 'application/xml-dtd' ||
4750                                              $l eq 'application/xml-external-parsed-entity';
4751                 }
4752         }
4753         return $ans;
4754 }
4755
4756 sub mimetype_guess {
4757         my $filename = shift;
4758         my $rawmode = shift;
4759         my $mime;
4760         $filename =~ /\./ or return undef;
4761
4762         if ($mimetypes_file) {
4763                 my $file = $mimetypes_file;
4764                 if ($file !~ m!^/!) { # if it is relative path
4765                         # it is relative to project
4766                         $file = "$projectroot/$project/$file";
4767                 }
4768                 $mime = mimetype_guess_file($filename, $file, $rawmode);
4769         }
4770         $mime ||= mimetype_guess_file($filename, '/etc/mime.types', $rawmode);
4771         return $mime;
4772 }
4773
4774 sub blob_mimetype {
4775         my $fd = shift;
4776         my $filename = shift;
4777         my $rawmode = shift;
4778         my $mime;
4779
4780         # The -T/-B file operators produce the wrong result unless a perlio
4781         # layer is present when the file handle is a pipe that delivers less
4782         # than 512 bytes of data before reaching EOF.
4783         #
4784         # If we are running in a Perl that uses the stdio layer rather than the
4785         # unix+perlio layers we will end up adding a perlio layer on top of the
4786         # stdio layer and get a second level of buffering.  This is harmless
4787         # and it makes the -T/-B file operators work properly in all cases.
4788
4789         binmode $fd, ":perlio" or die_error(500, "Adding perlio layer failed")
4790                 unless grep /^perlio$/, PerlIO::get_layers($fd);
4791
4792         $mime = mimetype_guess($filename, $rawmode) if defined $filename;
4793
4794         if (!$mime && $filename) {
4795                 if ($filename =~ m/\.html?$/i) {
4796                         $mime = 'text/html';
4797                 } elsif ($filename =~ m/\.xht(?:ml)?$/i) {
4798                         $mime = 'text/html';
4799                 } elsif ($filename =~ m/\.te?xt?$/i) {
4800                         $mime = 'text/plain';
4801                 } elsif ($filename =~ m/\.(?:markdown|md)$/i) {
4802                         $mime = 'text/plain';
4803                 } elsif ($filename =~ m/\.png$/i) {
4804                         $mime = 'image/png';
4805                 } elsif ($filename =~ m/\.gif$/i) {
4806                         $mime = 'image/gif';
4807                 } elsif ($filename =~ m/\.jpe?g$/i) {
4808                         $mime = 'image/jpeg';
4809                 } elsif ($filename =~ m/\.svgz?$/i) {
4810                         $mime = 'image/svg+xml';
4811                 }
4812         }
4813
4814         # just in case
4815         return $default_blob_plain_mimetype || 'application/octet-stream' unless $fd || $mime;
4816
4817         $mime = -T $fd ? 'text/plain' : 'application/octet-stream' unless $mime;
4818
4819         return $mime;
4820 }
4821
4822 sub is_ascii {
4823         use bytes;
4824         my $data = shift;
4825         return scalar($data =~ /^[\x00-\x7f]*$/);
4826 }
4827
4828 sub is_valid_utf8 {
4829         my $data = shift;
4830         return utf8::decode($data);
4831 }
4832
4833 sub extract_html_charset {
4834         return undef unless $_[0] && "$_[0]</head>" =~ m#<head(?:\s+[^>]*)?(?<!/)>(.*?)</head\s*>#is;
4835         my $head = $1;
4836         return $2 if $head =~ m#<meta\s+charset\s*=\s*(['"])\s*([a-z0-9(:)_.+-]+)\s*\1\s*/?>#is;
4837         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) {
4838                 my %kv = (lc($1) => $3, lc($4) => $6);
4839                 my ($he, $c) = (lc($kv{'http-equiv'}), $kv{'content'});
4840                 return $1 if $he && $c && $he eq 'content-type' &&
4841                         $c =~ m!\s*text/html\s*;\s*charset\s*=\s*([a-z0-9(:)_.+-]+)\s*$!is;
4842         }
4843         return undef;
4844 }
4845
4846 sub blob_contenttype {
4847         my ($fd, $file_name, $type) = @_;
4848
4849         $type ||= blob_mimetype($fd, $file_name, 1);
4850         return $type unless $type =~ m!^text/.+!i;
4851         my ($leader, $charset, $htmlcharset);
4852         if ($fd && read($fd, $leader, 32768)) {{
4853                 $charset='US-ASCII' if is_ascii($leader);
4854                 return ("$type; charset=UTF-8", $leader) if !$charset && is_valid_utf8($leader);
4855                 $charset='ISO-8859-1' unless $charset;
4856                 $htmlcharset = extract_html_charset($leader) if $type eq 'text/html';
4857                 if ($htmlcharset && $charset ne 'US-ASCII') {
4858                         $htmlcharset = undef if $htmlcharset =~ /^(?:utf-8|us-ascii)$/i
4859                 }
4860         }}
4861         return ("$type; charset=$htmlcharset", $leader) if $htmlcharset;
4862         my $defcharset = $default_text_plain_charset || '';
4863         $defcharset =~ s/^\s+//;
4864         $defcharset =~ s/\s+$//;
4865         $defcharset = '' if $charset && $charset ne 'US-ASCII' && $defcharset =~ /^(?:utf-8|us-ascii)$/i;
4866         return ("$type; charset=" . ($defcharset || 'ISO-8859-1'), $leader);
4867 }
4868
4869 # peek the first upto 128 bytes off a file handle
4870 sub peek128bytes {
4871         my $fd = shift;
4872
4873         use IO::Handle;
4874         use bytes;
4875
4876         my $prefix128;
4877         return '' unless $fd && read($fd, $prefix128, 128);
4878
4879         # In the general case, we're guaranteed only to be able to ungetc one
4880         # character (provided, of course, we actually got a character first).
4881         #
4882         # However, we know:
4883         #
4884         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4885         #    already been called at least once on the file handle before us
4886         #
4887         # 2) we have an $fd positioned at the start of the input stream and
4888         #    therefore know we were positioned at a buffer boundary before
4889         #    reading the initial upto 128 bytes
4890         #
4891         # 3) the buffer size is at least 512 bytes
4892         #
4893         # 4) we are careful to only unget raw bytes
4894         #
4895         # 5) we are attempting to unget exactly the same number of bytes we got
4896         #
4897         # Given the above conditions we will ALWAYS be able to safely unget
4898         # the $prefix128 value we just got.
4899         #
4900         # In fact, we could read up to 511 bytes and still be sure.
4901         # (Reading 512 might pop us into the next internal buffer, but probably
4902         # not since that could break the always able to unget at least the one
4903         # you just got guarantee.)
4904
4905         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4906
4907         return $prefix128;
4908 }
4909
4910 # guess file syntax for syntax highlighting; return undef if no highlighting
4911 # the name of syntax can (in the future) depend on syntax highlighter used
4912 sub guess_file_syntax {
4913         my ($fd, $mimetype, $file_name) = @_;
4914         return undef unless $fd && defined $file_name &&
4915                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4916         my $basename = basename($file_name, '.in');
4917         return $highlight_basename{$basename}
4918                 if exists $highlight_basename{$basename};
4919
4920         # Peek to see if there's a shebang or xml line.
4921         # We always operate on bytes when testing this.
4922         {
4923                 use bytes;
4924                 my $shebang = peek128bytes($fd);
4925                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4926                         foreach my $key (keys %highlight_shebang) {
4927                                 my $ar = ref($highlight_shebang{$key}) ?
4928                                         $highlight_shebang{$key} :
4929                                         [$highlight_shebang{key}];
4930                                 map {return $key if $shebang =~ /$_/} @$ar;
4931                         }
4932                 }
4933                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4934         }
4935
4936         $basename =~ /\.([^.]*)$/;
4937         my $ext = $1 or return undef;
4938         return $highlight_ext{$ext}
4939                 if exists $highlight_ext{$ext};
4940
4941         return undef;
4942 }
4943
4944 # run highlighter and return FD of its output,
4945 # or return original FD if no highlighting
4946 sub run_highlighter {
4947         my ($fd, $syntax) = @_;
4948         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4949
4950         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4951                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4952                 $to_utf8_pipe_command.
4953                 quote_command($highlight_bin).
4954                 " --replace-tabs=8 --fragment --syntax $syntax")
4955                 or die_error(500, "Couldn't open file or run syntax highlighter");
4956         if (eof $hifd) {
4957                 # just in case, should not happen as we tested !eof($fd) above
4958                 return $fd if close($hifd);
4959
4960                 # should not happen
4961                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4962
4963                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4964                 # instead of dying horribly on this, just skip the highlighting
4965                 # but do output a message about it to STDERR that will end up in the log
4966                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4967                         sprintf("child exit status 0x%x\n", $?);
4968                 return $fd
4969         }
4970         close $fd;
4971         return ($hifd, 1);
4972 }
4973
4974 ## ======================================================================
4975 ## functions printing HTML: header, footer, error page
4976
4977 sub get_page_title {
4978         my $title = to_utf8($site_name);
4979
4980         unless (defined $project) {
4981                 if (defined $project_filter) {
4982                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4983                 }
4984                 return $title;
4985         }
4986         $title .= " - " . to_utf8($project);
4987
4988         return $title unless (defined $action);
4989         my $action_print = $action eq 'blame_incremental' ? 'blame' : $action;
4990         $title .= "/$action_print"; # $action is US-ASCII (7bit ASCII)
4991
4992         return $title unless (defined $file_name);
4993         $title .= " - " . esc_path($file_name);
4994         if ($action eq "tree" && $file_name !~ m|/$|) {
4995                 $title .= "/";
4996         }
4997
4998         return $title;
4999 }
5000
5001 sub get_content_type_html {
5002         # We do not ever emit application/xhtml+xml since that gives us
5003         # no benefits and it makes many browsers (e.g. Firefox) exceedingly
5004         # strict, which is troublesome for example when showing user-supplied
5005         # README.html files.
5006         return 'text/html';
5007 }
5008
5009 sub print_feed_meta {
5010         if (defined $project) {
5011                 my %href_params = get_feed_info();
5012                 if (!exists $href_params{'-title'}) {
5013                         $href_params{'-title'} = 'log';
5014                 }
5015
5016                 foreach my $format (qw(RSS Atom)) {
5017                         my $type = lc($format);
5018                         my %link_attr = (
5019                                 '-rel' => 'alternate',
5020                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
5021                                 '-type' => "application/$type+xml"
5022                         );
5023
5024                         $href_params{'extra_options'} = undef;
5025                         $href_params{'action'} = $type;
5026                         $link_attr{'-href'} = href(%href_params);
5027                         print "<link ".
5028                               "rel=\"$link_attr{'-rel'}\" ".
5029                               "title=\"$link_attr{'-title'}\" ".
5030                               "href=\"$link_attr{'-href'}\" ".
5031                               "type=\"$link_attr{'-type'}\" ".
5032                               "/>\n";
5033
5034                         $href_params{'extra_options'} = '--no-merges';
5035                         $link_attr{'-href'} = href(%href_params);
5036                         $link_attr{'-title'} .= ' (no merges)';
5037                         print "<link ".
5038                               "rel=\"$link_attr{'-rel'}\" ".
5039                               "title=\"$link_attr{'-title'}\" ".
5040                               "href=\"$link_attr{'-href'}\" ".
5041                               "type=\"$link_attr{'-type'}\" ".
5042                               "/>\n";
5043                 }
5044
5045         } else {
5046                 printf('<link rel="alternate" title="%s projects list" '.
5047                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
5048                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
5049                 printf('<link rel="alternate" title="%s projects feeds" '.
5050                        'href="%s" type="text/x-opml" />'."\n",
5051                        esc_attr($site_name), href(project=>undef, action=>"opml"));
5052         }
5053 }
5054
5055 sub compute_stylesheet_links {
5056         return "<?gitweb compute_stylesheet_links?>" if $cache_mode_active;
5057
5058         # include each stylesheet that exists, providing backwards capability
5059         # for those people who defined $stylesheet in a config file
5060         if (defined $stylesheet) {
5061                 return '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
5062         } else {
5063                 my $sheets = '';
5064                 foreach my $stylesheet (@stylesheets) {
5065                         next unless $stylesheet;
5066                         $sheets .= '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
5067                 }
5068                 return $sheets;
5069         }
5070 }
5071
5072 sub print_header_links {
5073         my $status = shift;
5074
5075         print compute_stylesheet_links();
5076         print_feed_meta()
5077                 if ($status eq '200 OK');
5078         if (defined $favicon) {
5079                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
5080         }
5081 }
5082
5083 sub print_nav_breadcrumbs_path {
5084         my $dirprefix = undef;
5085         while (my $part = shift) {
5086                 $dirprefix .= "/" if defined $dirprefix;
5087                 $dirprefix .= $part;
5088                 print $cgi->a({-href => href(project => undef,
5089                                              project_filter => $dirprefix,
5090                                              action => "project_list")},
5091                               esc_html($part)) . $slssep;
5092         }
5093 }
5094
5095 sub print_nav_breadcrumbs {
5096         my %opts = @_;
5097
5098         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
5099                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . $slssep;
5100         }
5101         if (defined $project) {
5102                 my @dirname = split '/', $project;
5103                 my $projectbasename = pop @dirname;
5104                 print_nav_breadcrumbs_path(@dirname);
5105                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
5106                 if (defined $action) {
5107                         my $action_print = $action ;
5108                         $action_print = 'blame' if $action_print eq 'blame_incremental';
5109                         if (defined $opts{-action_extra}) {
5110                                 $action_print = $cgi->a({-href => href(action=>$action)},
5111                                         $action);
5112                         }
5113                         print "$slssep$action_print";
5114                 }
5115                 if (defined $opts{-action_extra}) {
5116                         print "$slssep$opts{-action_extra}";
5117                 }
5118                 print "\n";
5119         } elsif (defined $project_filter) {
5120                 print_nav_breadcrumbs_path(split '/', $project_filter);
5121         }
5122 }
5123
5124 sub print_search_form {
5125         if (!defined $searchtext) {
5126                 $searchtext = "";
5127         }
5128         my $search_hash;
5129         if (defined $hash_base) {
5130                 $search_hash = $hash_base;
5131         } elsif (defined $hash) {
5132                 $search_hash = $hash;
5133         } else {
5134                 $search_hash = "HEAD";
5135         }
5136         # We can't use href() here because we need to encode the
5137         # URL parameters into the form, not into the action link.
5138         my $action = $my_uri;
5139         my $use_pathinfo = gitweb_check_feature('pathinfo');
5140         if ($use_pathinfo) {
5141                 # See notes about doubled / in href()
5142                 $action =~ s,/$,,;
5143                 $action .= "/".esc_path_info($project);
5144         }
5145         $cgi->start_form(-method => "get", -action => $action);
5146         print sprintf(qq/<form method="%s" action="%s" enctype="%s">\n/,
5147               "get", CGI::escapeHTML($action), &CGI::URL_ENCODED) .
5148               "<div class=\"search\">\n" .
5149               (!$use_pathinfo &&
5150               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
5151               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
5152               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
5153               $cgi->popup_menu(-name => 'st', -default => 'commit',
5154                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
5155               $cgi->sup($cgi->a({-href => href(action=>"search_help"),
5156                                  -title => "search help" },
5157                                 "<span style=\"padding-bottom:1em\">?&#160;</span>")) . " search:\n",
5158               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
5159               "<span title=\"Extended regular expression\">" .
5160               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5161                              -checked => $search_use_regexp) .
5162               "</span>" .
5163               "</div>" .
5164               $cgi->end_form() . "\n";
5165 }
5166
5167 sub git_header_html {
5168         my $status = shift || "200 OK";
5169         my $expires = shift;
5170         my %opts = @_;
5171
5172         my $title = get_page_title();
5173         my $content_type = get_content_type_html();
5174         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
5175                            -status=> $status, -expires => $expires)
5176                 unless ($opts{'-no_http_header'});
5177         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
5178         print <<EOF;
5179 <?xml version="1.0" encoding="utf-8"?>
5180 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
5181 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
5182 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
5183 <!-- git core binaries version $git_version -->
5184 <head>
5185 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
5186 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
5187 <meta name="robots" content="index, nofollow"/>
5188 <title>$title</title>
5189 <script type="text/javascript">/* <![CDATA[ */
5190 function fixBlameLinks() {
5191         var allLinks = document.getElementsByTagName("a");
5192         for (var i = 0; i < allLinks.length; i++) {
5193                 var link = allLinks.item(i);
5194                 if (link.className == 'blamelink')
5195                         link.href = link.href.replace("/blame/", "/blame_incremental/");
5196         }
5197 }
5198 /* ]]> */</script>
5199 EOF
5200         # the stylesheet, favicon etc urls won't work correctly with path_info
5201         # unless we set the appropriate base URL
5202         if ($ENV{'PATH_INFO'}) {
5203                 print "<base href=\"".esc_url($base_url)."\" />\n";
5204         }
5205         print_header_links($status);
5206
5207         if (defined $site_html_head_string) {
5208                 print to_utf8($site_html_head_string);
5209         }
5210
5211         print "</head>\n" .
5212               "<body><span class=\"body\">\n";
5213
5214         if (defined $site_header && -f $site_header) {
5215                 insert_file($site_header);
5216         }
5217
5218         print "<div class=\"page_header\">\n";
5219         print "<span class=\"logo-container\"><span class=\"logo-default\">";
5220         if (defined $logo) {
5221                 print $cgi->a({-href => esc_url($logo_url),
5222                                -title => $logo_label,
5223                                -class => "logo-link"},
5224                               $cgi->img({-src => esc_url($logo),
5225                                          -width => 72, -height => 27,
5226                                          -alt => "git",
5227                                          -class => "logo"}));
5228         }
5229         print "</span></span>$spctxt<span class=\"banner-container\">";
5230         print_nav_breadcrumbs(%opts);
5231         print "</span></div>\n";
5232
5233         my $have_search = gitweb_check_feature('search');
5234         if (defined $project && $have_search) {
5235                 print_search_form();
5236         }
5237 }
5238
5239 sub compute_timed_interval {
5240         return "<?gitweb compute_timed_interval?>" if $cache_mode_active;
5241         return tv_interval($t0, [ gettimeofday() ]);
5242 }
5243
5244 sub compute_commands_count {
5245         return "<?gitweb compute_commands_count?>" if $cache_mode_active;
5246         my $s = $number_of_git_cmds == 1 ? '' : 's';
5247         return '<span id="generating_cmd">'.
5248                 $number_of_git_cmds.
5249                 "</span> git command$s";
5250 }
5251
5252 sub git_footer_html {
5253         my $feed_class = 'rss_logo';
5254
5255         print "<div class=\"page_footer\">\n";
5256         if (defined $project) {
5257                 my $descr = git_get_project_description($project);
5258                 if (defined $descr) {
5259                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
5260                 }
5261
5262                 my %href_params = get_feed_info();
5263                 if (!%href_params) {
5264                         $feed_class .= ' generic';
5265                 }
5266                 $href_params{'-title'} ||= 'log';
5267
5268                 foreach my $format (qw(RSS Atom)) {
5269                         $href_params{'action'} = lc($format);
5270                         print $cgi->a({-href => href(%href_params),
5271                                       -title => "$href_params{'-title'} $format feed",
5272                                       -class => $feed_class}, $format)."\n";
5273                 }
5274
5275         } else {
5276                 print $cgi->a({-href => href(project=>undef, action=>"opml",
5277                                              project_filter => $project_filter),
5278                               -class => $feed_class}, "OPML") . " ";
5279                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
5280                                              project_filter => $project_filter),
5281                               -class => $feed_class}, "TXT") . "\n";
5282         }
5283         print "</div>\n"; # class="page_footer"
5284
5285         if (defined $t0 && gitweb_check_feature('timed')) {
5286                 print "<div id=\"generating_info\">\n";
5287                 print 'This page took '.
5288                       '<span id="generating_time" class="time_span">'.
5289                       compute_timed_interval().
5290                       ' seconds </span>'.
5291                       ' and '.
5292                       compute_commands_count().
5293                       " to generate.\n";
5294                 print "</div>\n"; # class="page_footer"
5295         }
5296
5297         if (defined $site_footer && -f $site_footer) {
5298                 insert_file($site_footer);
5299         }
5300
5301         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
5302         if (defined $action &&
5303             $action eq 'blame_incremental') {
5304                 print qq!<script type="text/javascript">\n!.
5305                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
5306                       qq!           "!. href() .qq!");\n!.
5307                       qq!</script>\n!;
5308         } else {
5309                 my ($jstimezone, $tz_cookie, $datetime_class) =
5310                         gitweb_get_feature('javascript-timezone');
5311
5312                 print qq!<script type="text/javascript">\n!.
5313                       qq!window.onload = function () {\n!;
5314                 if (gitweb_check_feature('blame_incremental')) {
5315                         print qq!       fixBlameLinks();\n!;
5316                 }
5317                 if (gitweb_check_feature('javascript-actions')) {
5318                         print qq!       fixLinks();\n!;
5319                 }
5320                 if ($jstimezone && $tz_cookie && $datetime_class) {
5321                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
5322                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
5323                 }
5324                 print qq!};\n!.
5325                       qq!</script>\n!;
5326         }
5327
5328         print "</span></body>\n" .
5329               "</html>";
5330 }
5331
5332 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
5333 # Example: die_error(404, 'Hash not found')
5334 # By convention, use the following status codes (as defined in RFC 2616):
5335 # 400: Invalid or missing CGI parameters, or
5336 #      requested object exists but has wrong type.
5337 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
5338 #      this server or project.
5339 # 404: Requested object/revision/project doesn't exist.
5340 # 500: The server isn't configured properly, or
5341 #      an internal error occurred (e.g. failed assertions caused by bugs), or
5342 #      an unknown error occurred (e.g. the git binary died unexpectedly).
5343 # 503: The server is currently unavailable (because it is overloaded,
5344 #      or down for maintenance).  Generally, this is a temporary state.
5345 sub die_error {
5346         my $status = shift || 500;
5347         my $error = esc_html(shift) || "Internal Server Error";
5348         my $extra = shift;
5349         my %opts = @_;
5350
5351         my %http_responses = (
5352                 400 => '400 Bad Request',
5353                 403 => '403 Forbidden',
5354                 404 => '404 Not Found',
5355                 500 => '500 Internal Server Error',
5356                 503 => '503 Service Unavailable',
5357         );
5358         git_header_html($http_responses{$status}, undef, %opts);
5359         print <<EOF;
5360 <div class="page_body">
5361 <br /><br />
5362 $status - $error
5363 <br />
5364 EOF
5365         if (defined $extra) {
5366                 print "<hr />\n" .
5367                       "$extra\n";
5368         }
5369         print "</div>\n";
5370
5371         git_footer_html();
5372         CORE::die
5373                 unless ($opts{'-error_handler'});
5374 }
5375
5376 ## ----------------------------------------------------------------------
5377 ## functions printing or outputting HTML: navigation
5378
5379 # $content is wrapped in a span with class 'tab'
5380 # If $selected is true it also has class 'selected'
5381 # If $disabled is true it also has class 'disabled'
5382 # Whether or not a tab can be disabled and selected at the same time
5383 # is up to the caller
5384 # If $extra_classes is non-empty, it is a whitespace-separated list of
5385 # additional class names to include
5386 # Note that $content MUST already be html-escaped as needed because
5387 # it is included verbatim.  And so are any extra class names.
5388 sub tabspan {
5389         my ($content, $selected, $disabled, $extra_classes) = @_;
5390         my @classes = ("tab");
5391         push(@classes, "selected") if $selected;
5392         push(@classes, "disabled") if $disabled;
5393         push(@classes, split(' ', $extra_classes)) if $extra_classes;
5394         return "<span class=\"" . join(" ", @classes) . "\">". $content . "</span>";
5395 }
5396
5397 sub git_print_page_nav {
5398         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
5399         $extra = '' if !defined $extra; # pager or formats
5400         $extra = "<span class=\"page_nav_sub\">".$extra."</span>" if $extra ne '';
5401
5402         my @navs = qw(summary log commit commitdiff tree refs);
5403         if ($suppress) {
5404                 my %omit;
5405                 if (ref($suppress) eq 'ARRAY') {
5406                         %omit = map { ($_ => 1) } @$suppress;
5407                 } else {
5408                         %omit = ($suppress => 1);
5409                 }
5410                 @navs = grep { !$omit{$_} } @navs;
5411         }
5412
5413         my %arg = map { $_ => {action=>$_} } @navs;
5414         if (defined $head) {
5415                 for (qw(commit commitdiff)) {
5416                         $arg{$_}{'hash'} = $head;
5417                 }
5418                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
5419                         $arg{'log'}{'hash'} = $head;
5420                 }
5421         }
5422
5423         $arg{'log'}{'action'} = 'shortlog';
5424         if ($current eq 'log') {
5425                 $current = 'shortlog';
5426         } elsif ($current eq 'shortlog') {
5427                 $current = 'log';
5428         }
5429         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
5430         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
5431
5432         my @actions = gitweb_get_feature('actions');
5433         my $escname = $project;
5434         $escname =~ s/[+]/%2B/g;
5435         my %repl = (
5436                 '%' => '%',
5437                 'n' => $project,         # project name
5438                 'f' => $git_dir,         # project path within filesystem
5439                 'h' => $treehead || '',  # current hash ('h' parameter)
5440                 'b' => $treebase || '',  # hash base ('hb' parameter)
5441                 'e' => $escname,         # project name with '+' escaped
5442         );
5443         while (@actions) {
5444                 my ($label, $link, $pos) = splice(@actions,0,3);
5445                 # insert
5446                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
5447                 # munch munch
5448                 $link =~ s/%([%nfhbe])/$repl{$1}/g;
5449                 $arg{$label}{'_href'} = $link;
5450         }
5451
5452         print "<div class=\"page_nav\">\n" .
5453                 (join $barsep,
5454                  map { $_ eq $current ?
5455                        tabspan($_, 1) :
5456                        tabspan($cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_"))
5457                  } @navs);
5458         print "<br/>\n$extra<br/>\n" .
5459               "</div>\n";
5460 }
5461
5462 # returns a submenu for the nagivation of the refs views (tags, heads,
5463 # remotes) with the current view disabled and the remotes view only
5464 # available if the feature is enabled
5465 sub format_ref_views {
5466         my ($current) = @_;
5467         my @ref_views = qw{tags heads};
5468         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
5469         return join $barsep, map {
5470                 $_ eq $current ? tabspan($_, 1) :
5471                 tabspan($cgi->a({-href => href(action=>$_)}, $_))
5472         } @ref_views
5473 }
5474
5475 sub format_paging_nav {
5476         my ($action, $page, $has_next_link) = @_;
5477         my $paging_nav = "<span class=\"paging_nav\">";
5478
5479         if ($page > 0) {
5480                 $paging_nav .= tabspan(
5481                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first")) .
5482                         $mdotsep . tabspan(
5483                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
5484                                  -accesskey => "p", -title => "Alt-p"}, "prev"));
5485         } else {
5486                 $paging_nav .= tabspan("first", 1).${mdotsep}.tabspan("prev", 0, 1);
5487         }
5488
5489         if ($has_next_link) {
5490                 $paging_nav .= $mdotsep . tabspan(
5491                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
5492                                  -accesskey => "n", -title => "Alt-n"}, "next"));
5493         } else {
5494                 $paging_nav .= ${mdotsep}.tabspan("next", 0, 1);
5495         }
5496
5497         return $paging_nav."</span>";
5498 }
5499
5500 sub format_log_nav {
5501         my ($action, $page, $has_next_link, $extra) = @_;
5502         my $paging_nav;
5503         defined $extra or $extra = '';
5504         $extra eq '' or $extra .= $barsep;
5505
5506         if ($action eq 'shortlog') {
5507                 $paging_nav .= tabspan('shortlog', 1);
5508         } else {
5509                 $paging_nav .= tabspan($cgi->a({-href => href(action=>'shortlog', -replay=>1)}, 'shortlog'));
5510         }
5511         $paging_nav .= $barsep;
5512         if ($action eq 'log') {
5513                 $paging_nav .= tabspan('fulllog', 1);
5514         } else {
5515                 $paging_nav .= tabspan($cgi->a({-href => href(action=>'log', -replay=>1)}, 'fulllog'));
5516         }
5517
5518         $paging_nav .= $barsep . $extra . format_paging_nav($action, $page, $has_next_link);
5519         return $paging_nav;
5520 }
5521
5522 ## ......................................................................
5523 ## functions printing or outputting HTML: div
5524
5525 sub git_print_header_div {
5526         my ($action, $title, $hash, $hash_base, $extra) = @_;
5527         my %args = ();
5528         defined $extra or $extra = '';
5529
5530         $args{'action'} = $action;
5531         $args{'hash'} = $hash if $hash;
5532         $args{'hash_base'} = $hash_base if $hash_base;
5533
5534         my $link1 = $cgi->a({-href => href(%args), -class => "title"},
5535                             $title ? $title : $action);
5536         my $link2 = $cgi->a({-href => href(%args), -class => "cover"}, "");
5537         print "<div class=\"header\">\n" . '<span class="title">' .
5538               $link1 . $extra . $link2 . '</span>' . "\n</div>\n";
5539 }
5540
5541 sub format_repo_url {
5542         my ($name, $url) = @_;
5543         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
5544 }
5545
5546 # Group output by placing it in a DIV element and adding a header.
5547 # Options for start_div() can be provided by passing a hash reference as the
5548 # first parameter to the function.
5549 # Options to git_print_header_div() can be provided by passing an array
5550 # reference. This must follow the options to start_div if they are present.
5551 # The content can be a scalar, which is output as-is, a scalar reference, which
5552 # is output after html escaping, an IO handle passed either as *handle or
5553 # *handle{IO}, or a function reference. In the latter case all following
5554 # parameters will be taken as argument to the content function call.
5555 sub git_print_section {
5556         my ($div_args, $header_args, $content);
5557         my $arg = shift;
5558         if (ref($arg) eq 'HASH') {
5559                 $div_args = $arg;
5560                 $arg = shift;
5561         }
5562         if (ref($arg) eq 'ARRAY') {
5563                 $header_args = $arg;
5564                 $arg = shift;
5565         }
5566         $content = $arg;
5567
5568         print $cgi->start_div($div_args);
5569         git_print_header_div(@$header_args);
5570
5571         if (ref($content) eq 'CODE') {
5572                 $content->(@_);
5573         } elsif (ref($content) eq 'SCALAR') {
5574                 print esc_html($$content);
5575         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
5576                 while (<$content>) {
5577                         print to_utf8($_);
5578                 }
5579         } elsif (!ref($content) && defined($content)) {
5580                 print $content;
5581         }
5582
5583         print $cgi->end_div;
5584 }
5585
5586 sub format_timestamp_html {
5587         my $date = shift;
5588         my $useatnight = shift;
5589         defined($useatnight) or $useatnight = 1;
5590         my $strtime = $date->{'rfc2822'};
5591
5592         my (undef, undef, $datetime_class) =
5593                 gitweb_get_feature('javascript-timezone');
5594         if ($datetime_class) {
5595                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
5596         }
5597
5598         my $localtime_format = '(%d %02d:%02d %s)';
5599         if ($useatnight && $date->{'hour_local'} < 6) {
5600                 $localtime_format = '(%d <span class="atnight">%02d:%02d</span> %s)';
5601         }
5602         $strtime .= ' ' .
5603                     sprintf($localtime_format, $date->{'mday_local'},
5604                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
5605
5606         return $strtime;
5607 }
5608
5609 sub format_lastrefresh_row {
5610         return "<?gitweb format_lastrefresh_row?>" if $cache_mode_active;
5611         my %rd = parse_file_date('.last_refresh');
5612         if (defined $rd{'rfc2822'}) {
5613                 return "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td>" .
5614                        "<td>".format_timestamp_html(\%rd,0)."</td></tr>";
5615         }
5616         return "";
5617 }
5618
5619 # Outputs the author name and date in long form
5620 sub git_print_authorship {
5621         my $co = shift;
5622         my %opts = @_;
5623         my $tag = $opts{-tag} || 'div';
5624         my $author = $co->{'author_name'};
5625
5626         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
5627         print "<$tag class=\"author_date\">" .
5628               format_search_author($author, "author", esc_html($author)) .
5629               " [".format_timestamp_html(\%ad)."]".
5630               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
5631               "</$tag>\n";
5632 }
5633
5634 # Outputs table rows containing the full author or committer information,
5635 # in the format expected for 'commit' view (& similar).
5636 # Parameters are a commit hash reference, followed by the list of people
5637 # to output information for. If the list is empty it defaults to both
5638 # author and committer.
5639 sub git_print_authorship_rows {
5640         my $co = shift;
5641         # too bad we can't use @people = @_ || ('author', 'committer')
5642         my @people = @_;
5643         @people = ('author', 'committer') unless @people;
5644         foreach my $who (@people) {
5645                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
5646                 print "<tr><td>$who</td><td>" .
5647                       format_search_author($co->{"${who}_name"}, $who,
5648                                            esc_html($co->{"${who}_name"})) . " " .
5649                       format_search_author($co->{"${who}_email"}, $who,
5650                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
5651                       "</td><td rowspan=\"2\">" .
5652                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
5653                       "</td></tr>\n" .
5654                       "<tr>" .
5655                       "<td></td><td>" .
5656                       format_timestamp_html(\%wd) .
5657                       "</td>" .
5658                       "</tr>\n";
5659         }
5660 }
5661
5662 sub git_print_page_path {
5663         my $name = shift;
5664         my $type = shift;
5665         my $hb = shift;
5666
5667
5668         print "<div class=\"page_path\">";
5669         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
5670                       -title => 'tree root'}, to_utf8("[$project]"));
5671         print $slssep;
5672         if (defined $name) {
5673                 my @dirname = split '/', $name;
5674                 my $basename = pop @dirname;
5675                 my $fullname = '';
5676
5677                 foreach my $dir (@dirname) {
5678                         $fullname .= ($fullname ? '/' : '') . $dir;
5679                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
5680                                                      hash_base=>$hb),
5681                                       -title => $fullname}, esc_path($dir));
5682                         print $slssep;
5683                 }
5684                 if (defined $type && $type eq 'blob') {
5685                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
5686                                                      hash_base=>$hb),
5687                                       -title => $name}, esc_path($basename));
5688                 } elsif (defined $type && $type eq 'tree') {
5689                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
5690                                                      hash_base=>$hb),
5691                                       -title => $name}, esc_path($basename));
5692                         print $slssep;
5693                 } else {
5694                         print esc_path($basename);
5695                 }
5696         }
5697         print "<br/></div>\n";
5698 }
5699
5700 sub git_print_log {
5701         my $log = shift;
5702         my %opts = @_;
5703
5704         if ($opts{'-remove_title'}) {
5705                 # remove title, i.e. first line of log
5706                 shift @$log;
5707         }
5708         # remove leading empty lines
5709         while (defined $log->[0] && $log->[0] eq "") {
5710                 shift @$log;
5711         }
5712
5713         # print log
5714         my $skip_blank_line = 0;
5715         foreach my $line (@$log) {
5716                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5717                         if (! $opts{'-remove_signoff'}) {
5718                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5719                                 $skip_blank_line = 1;
5720                         }
5721                         next;
5722                 }
5723
5724                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5725                         if (! $opts{'-remove_signoff'}) {
5726                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5727                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5728                                         "</span><br/>\n";
5729                                 $skip_blank_line = 1;
5730                         }
5731                         next;
5732                 }
5733
5734                 # print only one empty line
5735                 # do not print empty line after signoff
5736                 if ($line eq "") {
5737                         next if ($skip_blank_line);
5738                         $skip_blank_line = 1;
5739                 } else {
5740                         $skip_blank_line = 0;
5741                 }
5742
5743                 print format_log_line_html($line) . "<br/>\n";
5744         }
5745
5746         if ($opts{'-final_empty_line'}) {
5747                 # end with single empty line
5748                 print "<br/>\n" unless $skip_blank_line;
5749         }
5750 }
5751
5752 # return link target (what link points to)
5753 sub git_get_link_target {
5754         my $hash = shift;
5755         my $link_target;
5756
5757         # read link
5758         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5759                 or return;
5760         {
5761                 local $/ = undef;
5762                 $link_target = to_utf8(scalar <$fd>);
5763         }
5764         close $fd
5765                 or return;
5766
5767         return $link_target;
5768 }
5769
5770 # given link target, and the directory (basedir) the link is in,
5771 # return target of link relative to top directory (top tree);
5772 # return undef if it is not possible (including absolute links).
5773 sub normalize_link_target {
5774         my ($link_target, $basedir) = @_;
5775
5776         # absolute symlinks (beginning with '/') cannot be normalized
5777         return if (substr($link_target, 0, 1) eq '/');
5778
5779         # normalize link target to path from top (root) tree (dir)
5780         my $path;
5781         if ($basedir) {
5782                 $path = $basedir . '/' . $link_target;
5783         } else {
5784                 # we are in top (root) tree (dir)
5785                 $path = $link_target;
5786         }
5787
5788         # remove //, /./, and /../
5789         my @path_parts;
5790         foreach my $part (split('/', $path)) {
5791                 # discard '.' and ''
5792                 next if (!$part || $part eq '.');
5793                 # handle '..'
5794                 if ($part eq '..') {
5795                         if (@path_parts) {
5796                                 pop @path_parts;
5797                         } else {
5798                                 # link leads outside repository (outside top dir)
5799                                 return;
5800                         }
5801                 } else {
5802                         push @path_parts, $part;
5803                 }
5804         }
5805         $path = join('/', @path_parts);
5806
5807         return $path;
5808 }
5809
5810 # print tree entry (row of git_tree), but without encompassing <tr> element
5811 sub git_print_tree_entry {
5812         my ($t, $basedir, $hash_base, $have_blame) = @_;
5813
5814         my %base_key = ();
5815         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5816
5817         # The format of a table row is: mode list link.  Where mode is
5818         # the mode of the entry, list is the name of the entry, an href,
5819         # and link is the action links of the entry.
5820
5821         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5822         if (exists $t->{'size'}) {
5823                 print "<td class=\"size\">$t->{'size'}</td>\n";
5824         }
5825         if ($t->{'type'} eq "blob") {
5826                 print "<td class=\"list\">" .
5827                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5828                                                file_name=>"$basedir$t->{'name'}", %base_key),
5829                                 -class => "list"}, esc_path($t->{'name'}));
5830                 if (S_ISLNK(oct $t->{'mode'})) {
5831                         my $link_target = git_get_link_target($t->{'hash'});
5832                         if ($link_target) {
5833                                 my $norm_target = normalize_link_target($link_target, $basedir);
5834                                 if (defined $norm_target) {
5835                                         print " -> " .
5836                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5837                                                                      file_name=>$norm_target),
5838                                                        -title => $norm_target}, esc_path($link_target));
5839                                 } else {
5840                                         print " -> " . esc_path($link_target);
5841                                 }
5842                         }
5843                 }
5844                 print "</td>\n";
5845                 print "<td class=\"link\">";
5846                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5847                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5848                               "blob");
5849                 if ($have_blame) {
5850                         print $barsep .
5851                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5852                                                      file_name=>"$basedir$t->{'name'}", %base_key),
5853                                       -class => "blamelink"},
5854                                       "blame");
5855                 }
5856                 if (defined $hash_base) {
5857                         print $barsep .
5858                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5859                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5860                                       "history");
5861                 }
5862                 print $barsep .
5863                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5864                                                file_name=>"$basedir$t->{'name'}")},
5865                                 "raw");
5866                 print "</td>\n";
5867
5868         } elsif ($t->{'type'} eq "tree") {
5869                 print "<td class=\"list\">";
5870                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5871                                              file_name=>"$basedir$t->{'name'}",
5872                                              %base_key)},
5873                               esc_path($t->{'name'}));
5874                 print "</td>\n";
5875                 print "<td class=\"link\">";
5876                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5877                                              file_name=>"$basedir$t->{'name'}",
5878                                              %base_key)},
5879                               "tree");
5880                 if (defined $hash_base) {
5881                         print $barsep .
5882                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5883                                                      file_name=>"$basedir$t->{'name'}")},
5884                                       "history");
5885                 }
5886                 print "</td>\n";
5887         } else {
5888                 # unknown object: we can only present history for it
5889                 # (this includes 'commit' object, i.e. submodule support)
5890                 print "<td class=\"list\">" .
5891                       esc_path($t->{'name'}) .
5892                       "</td>\n";
5893                 print "<td class=\"link\">";
5894                 if (defined $hash_base) {
5895                         print $cgi->a({-href => href(action=>"history",
5896                                                      hash_base=>$hash_base,
5897                                                      file_name=>"$basedir$t->{'name'}")},
5898                                       "history");
5899                 }
5900                 print "</td>\n";
5901         }
5902 }
5903
5904 ## ......................................................................
5905 ## functions printing large fragments of HTML
5906
5907 # get pre-image filenames for merge (combined) diff
5908 sub fill_from_file_info {
5909         my ($diff, @parents) = @_;
5910
5911         $diff->{'from_file'} = [ ];
5912         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5913         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5914                 if ($diff->{'status'}[$i] eq 'R' ||
5915                     $diff->{'status'}[$i] eq 'C') {
5916                         $diff->{'from_file'}[$i] =
5917                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5918                 }
5919         }
5920
5921         return $diff;
5922 }
5923
5924 # is current raw difftree line of file deletion
5925 sub is_deleted {
5926         my $diffinfo = shift;
5927
5928         return $diffinfo->{'to_id'} eq ('0' x 40);
5929 }
5930
5931 # does patch correspond to [previous] difftree raw line
5932 # $diffinfo  - hashref of parsed raw diff format
5933 # $patchinfo - hashref of parsed patch diff format
5934 #              (the same keys as in $diffinfo)
5935 sub is_patch_split {
5936         my ($diffinfo, $patchinfo) = @_;
5937
5938         return defined $diffinfo && defined $patchinfo
5939                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5940 }
5941
5942
5943 sub git_difftree_body {
5944         my ($difftree, $hash, @parents) = @_;
5945         my ($parent) = $parents[0];
5946         my $have_blame = gitweb_check_feature('blame');
5947         print "<div class=\"list_head\">\n";
5948         if ($#{$difftree} > 10) {
5949                 print(($#{$difftree} + 1) . " files changed:\n");
5950         }
5951         print "</div>\n";
5952
5953         print "<table class=\"" .
5954               (@parents > 1 ? "combined " : "") .
5955               "diff_tree\">\n";
5956
5957         # header only for combined diff in 'commitdiff' view
5958         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5959         if ($has_header) {
5960                 # table header
5961                 print "<thead><tr>\n" .
5962                        "<th></th><th></th>\n"; # filename, patchN link
5963                 for (my $i = 0; $i < @parents; $i++) {
5964                         my $par = $parents[$i];
5965                         print "<th>" .
5966                               $cgi->a({-href => href(action=>"commitdiff",
5967                                                      hash=>$hash, hash_parent=>$par),
5968                                        -title => 'commitdiff to parent number ' .
5969                                                   ($i+1) . ': ' . substr($par,0,7)},
5970                                       $i+1) .
5971                               "&#160;</th>\n";
5972                 }
5973                 print "</tr></thead>\n<tbody>\n";
5974         }
5975
5976         my $alternate = 1;
5977         my $patchno = 0;
5978         foreach my $line (@{$difftree}) {
5979                 my $diff = parsed_difftree_line($line);
5980
5981                 if ($alternate) {
5982                         print "<tr class=\"dark\">\n";
5983                 } else {
5984                         print "<tr class=\"light\">\n";
5985                 }
5986                 $alternate ^= 1;
5987
5988                 if (exists $diff->{'nparents'}) { # combined diff
5989
5990                         fill_from_file_info($diff, @parents)
5991                                 unless exists $diff->{'from_file'};
5992
5993                         if (!is_deleted($diff)) {
5994                                 # file exists in the result (child) commit
5995                                 print "<td>" .
5996                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5997                                                              file_name=>$diff->{'to_file'},
5998                                                              hash_base=>$hash),
5999                                               -class => "list"}, esc_path($diff->{'to_file'})) .
6000                                       "</td>\n";
6001                         } else {
6002                                 print "<td>" .
6003                                       esc_path($diff->{'to_file'}) .
6004                                       "</td>\n";
6005                         }
6006
6007                         if ($action eq 'commitdiff') {
6008                                 # link to patch
6009                                 $patchno++;
6010                                 print "<td class=\"link\">" .
6011                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
6012                                               "patch") .
6013                                       $barsep .
6014                                       "</td>\n";
6015                         }
6016
6017                         my $has_history = 0;
6018                         my $not_deleted = 0;
6019                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
6020                                 my $hash_parent = $parents[$i];
6021                                 my $from_hash = $diff->{'from_id'}[$i];
6022                                 my $from_path = $diff->{'from_file'}[$i];
6023                                 my $status = $diff->{'status'}[$i];
6024
6025                                 $has_history ||= ($status ne 'A');
6026                                 $not_deleted ||= ($status ne 'D');
6027
6028                                 if ($status eq 'A') {
6029                                         print "<td  class=\"link\" align=\"right\">$barsep</td>\n";
6030                                 } elsif ($status eq 'D') {
6031                                         print "<td class=\"link\">" .
6032                                               $cgi->a({-href => href(action=>"blob",
6033                                                                      hash_base=>$hash,
6034                                                                      hash=>$from_hash,
6035                                                                      file_name=>$from_path)},
6036                                                       "blob" . ($i+1)) .
6037                                               "$barsep</td>\n";
6038                                 } else {
6039                                         if ($diff->{'to_id'} eq $from_hash) {
6040                                                 print "<td class=\"link nochange\">";
6041                                         } else {
6042                                                 print "<td class=\"link\">";
6043                                         }
6044                                         print $cgi->a({-href => href(action=>"blobdiff",
6045                                                                      hash=>$diff->{'to_id'},
6046                                                                      hash_parent=>$from_hash,
6047                                                                      hash_base=>$hash,
6048                                                                      hash_parent_base=>$hash_parent,
6049                                                                      file_name=>$diff->{'to_file'},
6050                                                                      file_parent=>$from_path)},
6051                                                       "diff" . ($i+1)) .
6052                                               "$barsep</td>\n";
6053                                 }
6054                         }
6055
6056                         print "<td class=\"link\">";
6057                         if ($not_deleted) {
6058                                 print $cgi->a({-href => href(action=>"blob",
6059                                                              hash=>$diff->{'to_id'},
6060                                                              file_name=>$diff->{'to_file'},
6061                                                              hash_base=>$hash)},
6062                                               "blob");
6063                                 print $barsep if ($has_history);
6064                         }
6065                         if ($has_history) {
6066                                 print $cgi->a({-href => href(action=>"history",
6067                                                              file_name=>$diff->{'to_file'},
6068                                                              hash_base=>$hash)},
6069                                               "history");
6070                         }
6071                         print "</td>\n";
6072
6073                         print "</tr>\n";
6074                         next; # instead of 'else' clause, to avoid extra indent
6075                 }
6076                 # else ordinary diff
6077
6078                 my ($to_mode_oct, $to_mode_str, $to_file_type);
6079                 my ($from_mode_oct, $from_mode_str, $from_file_type);
6080                 if ($diff->{'to_mode'} ne ('0' x 6)) {
6081                         $to_mode_oct = oct $diff->{'to_mode'};
6082                         if (S_ISREG($to_mode_oct)) { # only for regular file
6083                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
6084                         }
6085                         $to_file_type = file_type($diff->{'to_mode'});
6086                 }
6087                 if ($diff->{'from_mode'} ne ('0' x 6)) {
6088                         $from_mode_oct = oct $diff->{'from_mode'};
6089                         if (S_ISREG($from_mode_oct)) { # only for regular file
6090                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
6091                         }
6092                         $from_file_type = file_type($diff->{'from_mode'});
6093                 }
6094
6095                 if ($diff->{'status'} eq "A") { # created
6096                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
6097                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
6098                         $mode_chng   .= "]</span>";
6099                         print "<td>";
6100                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6101                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6102                                       -class => "list"}, esc_path($diff->{'file'}));
6103                         print "</td>\n";
6104                         print "<td>$mode_chng</td>\n";
6105                         print "<td class=\"link\">";
6106                         if ($action eq 'commitdiff') {
6107                                 # link to patch
6108                                 $patchno++;
6109                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6110                                               "patch") .
6111                                       $barsep;
6112                         }
6113                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6114                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6115                                       "blob");
6116                         print "</td>\n";
6117
6118                 } elsif ($diff->{'status'} eq "D") { # deleted
6119                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
6120                         print "<td>";
6121                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
6122                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
6123                                        -class => "list"}, esc_path($diff->{'file'}));
6124                         print "</td>\n";
6125                         print "<td>$mode_chng</td>\n";
6126                         print "<td class=\"link\">";
6127                         if ($action eq 'commitdiff') {
6128                                 # link to patch
6129                                 $patchno++;
6130                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6131                                               "patch") .
6132                                       $barsep;
6133                         }
6134                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
6135                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
6136                                       "blob") . $barsep;
6137                         if ($have_blame) {
6138                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
6139                                                              file_name=>$diff->{'file'}),
6140                                               -class => "blamelink"},
6141                                               "blame") . $barsep;
6142                         }
6143                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
6144                                                      file_name=>$diff->{'file'})},
6145                                       "history");
6146                         print "</td>\n";
6147
6148                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
6149                         my $mode_chnge = "";
6150                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6151                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
6152                                 if ($from_file_type ne $to_file_type) {
6153                                         $mode_chnge .= " from $from_file_type to $to_file_type";
6154                                 }
6155                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
6156                                         if ($from_mode_str && $to_mode_str) {
6157                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
6158                                         } elsif ($to_mode_str) {
6159                                                 $mode_chnge .= " mode: $to_mode_str";
6160                                         }
6161                                 }
6162                                 $mode_chnge .= "]</span>\n";
6163                         }
6164                         print "<td>";
6165                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6166                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6167                                       -class => "list"}, esc_path($diff->{'file'}));
6168                         print "</td>\n";
6169                         print "<td>$mode_chnge</td>\n";
6170                         print "<td class=\"link\">";
6171                         if ($action eq 'commitdiff') {
6172                                 # link to patch
6173                                 $patchno++;
6174                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6175                                               "patch") .
6176                                       $barsep;
6177                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6178                                 # "commit" view and modified file (not onlu mode changed)
6179                                 print $cgi->a({-href => href(action=>"blobdiff",
6180                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6181                                                              hash_base=>$hash, hash_parent_base=>$parent,
6182                                                              file_name=>$diff->{'file'})},
6183                                               "diff") .
6184                                       $barsep;
6185                         }
6186                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6187                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6188                                        "blob") . $barsep;
6189                         if ($have_blame) {
6190                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6191                                                              file_name=>$diff->{'file'}),
6192                                               -class => "blamelink"},
6193                                               "blame") . $barsep;
6194                         }
6195                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6196                                                      file_name=>$diff->{'file'})},
6197                                       "history");
6198                         print "</td>\n";
6199
6200                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
6201                         my %status_name = ('R' => 'moved', 'C' => 'copied');
6202                         my $nstatus = $status_name{$diff->{'status'}};
6203                         my $mode_chng = "";
6204                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6205                                 # mode also for directories, so we cannot use $to_mode_str
6206                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
6207                         }
6208                         print "<td>" .
6209                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
6210                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
6211                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
6212                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
6213                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
6214                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
6215                                       -class => "list"}, esc_path($diff->{'from_file'})) .
6216                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
6217                               "<td class=\"link\">";
6218                         if ($action eq 'commitdiff') {
6219                                 # link to patch
6220                                 $patchno++;
6221                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6222                                               "patch") .
6223                                       $barsep;
6224                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6225                                 # "commit" view and modified file (not only pure rename or copy)
6226                                 print $cgi->a({-href => href(action=>"blobdiff",
6227                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6228                                                              hash_base=>$hash, hash_parent_base=>$parent,
6229                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
6230                                               "diff") .
6231                                       $barsep;
6232                         }
6233                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6234                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
6235                                       "blob") . $barsep;
6236                         if ($have_blame) {
6237                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6238                                                              file_name=>$diff->{'to_file'}),
6239                                               -class => "blamelink"},
6240                                               "blame") . $barsep;
6241                         }
6242                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6243                                                     file_name=>$diff->{'to_file'})},
6244                                       "history");
6245                         print "</td>\n";
6246
6247                 } # we should not encounter Unmerged (U) or Unknown (X) status
6248                 print "</tr>\n";
6249         }
6250         print "</tbody>" if $has_header;
6251         print "</table>\n";
6252 }
6253
6254 # Print context lines and then rem/add lines in a side-by-side manner.
6255 sub print_sidebyside_diff_lines {
6256         my ($ctx, $rem, $add) = @_;
6257
6258         # print context block before add/rem block
6259         if (@$ctx) {
6260                 print join '',
6261                         '<div class="chunk_block ctx">',
6262                                 '<div class="old">',
6263                                 @$ctx,
6264                                 '</div>',
6265                                 '<div class="new">',
6266                                 @$ctx,
6267                                 '</div>',
6268                         '</div>';
6269         }
6270
6271         if (!@$add) {
6272                 # pure removal
6273                 print join '',
6274                         '<div class="chunk_block rem">',
6275                                 '<div class="old">',
6276                                 @$rem,
6277                                 '</div>',
6278                         '</div>';
6279         } elsif (!@$rem) {
6280                 # pure addition
6281                 print join '',
6282                         '<div class="chunk_block add">',
6283                                 '<div class="new">',
6284                                 @$add,
6285                                 '</div>',
6286                         '</div>';
6287         } else {
6288                 print join '',
6289                         '<div class="chunk_block chg">',
6290                                 '<div class="old">',
6291                                 @$rem,
6292                                 '</div>',
6293                                 '<div class="new">',
6294                                 @$add,
6295                                 '</div>',
6296                         '</div>';
6297         }
6298 }
6299
6300 # Print context lines and then rem/add lines in inline manner.
6301 sub print_inline_diff_lines {
6302         my ($ctx, $rem, $add) = @_;
6303
6304         print @$ctx, @$rem, @$add;
6305 }
6306
6307 # Format removed and added line, mark changed part and HTML-format them.
6308 # Implementation is based on contrib/diff-highlight
6309 sub format_rem_add_lines_pair {
6310         my ($rem, $add, $num_parents) = @_;
6311
6312         # We need to untabify lines before split()'ing them;
6313         # otherwise offsets would be invalid.
6314         chomp $rem;
6315         chomp $add;
6316         $rem = untabify($rem);
6317         $add = untabify($add);
6318
6319         my @rem = split(//, $rem);
6320         my @add = split(//, $add);
6321         my ($esc_rem, $esc_add);
6322         # Ignore leading +/- characters for each parent.
6323         my ($prefix_len, $suffix_len) = ($num_parents, 0);
6324         my ($prefix_has_nonspace, $suffix_has_nonspace);
6325
6326         my $shorter = (@rem < @add) ? @rem : @add;
6327         while ($prefix_len < $shorter) {
6328                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
6329
6330                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
6331                 $prefix_len++;
6332         }
6333
6334         while ($prefix_len + $suffix_len < $shorter) {
6335                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
6336
6337                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
6338                 $suffix_len++;
6339         }
6340
6341         # Mark lines that are different from each other, but have some common
6342         # part that isn't whitespace.  If lines are completely different, don't
6343         # mark them because that would make output unreadable, especially if
6344         # diff consists of multiple lines.
6345         if ($prefix_has_nonspace || $suffix_has_nonspace) {
6346                 $esc_rem = esc_html_hl_regions($rem, 'marked',
6347                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
6348                 $esc_add = esc_html_hl_regions($add, 'marked',
6349                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
6350         } else {
6351                 $esc_rem = esc_html($rem, -nbsp=>1);
6352                 $esc_add = esc_html($add, -nbsp=>1);
6353         }
6354
6355         return format_diff_line(\$esc_rem, 'rem'),
6356                format_diff_line(\$esc_add, 'add');
6357 }
6358
6359 # HTML-format diff context, removed and added lines.
6360 sub format_ctx_rem_add_lines {
6361         my ($ctx, $rem, $add, $num_parents) = @_;
6362         my (@new_ctx, @new_rem, @new_add);
6363         my $can_highlight = 0;
6364         my $is_combined = ($num_parents > 1);
6365
6366         # Highlight if every removed line has a corresponding added line.
6367         if (@$add > 0 && @$add == @$rem) {
6368                 $can_highlight = 1;
6369
6370                 # Highlight lines in combined diff only if the chunk contains
6371                 # diff between the same version, e.g.
6372                 #
6373                 #    - a
6374                 #   -  b
6375                 #    + c
6376                 #   +  d
6377                 #
6378                 # Otherwise the highlightling would be confusing.
6379                 if ($is_combined) {
6380                         for (my $i = 0; $i < @$add; $i++) {
6381                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
6382                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
6383
6384                                 $prefix_rem =~ s/-/+/g;
6385
6386                                 if ($prefix_rem ne $prefix_add) {
6387                                         $can_highlight = 0;
6388                                         last;
6389                                 }
6390                         }
6391                 }
6392         }
6393
6394         if ($can_highlight) {
6395                 for (my $i = 0; $i < @$add; $i++) {
6396                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
6397                                 $rem->[$i], $add->[$i], $num_parents);
6398                         push @new_rem, $line_rem;
6399                         push @new_add, $line_add;
6400                 }
6401         } else {
6402                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
6403                 @new_add = map { format_diff_line($_, 'add') } @$add;
6404         }
6405
6406         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
6407
6408         return (\@new_ctx, \@new_rem, \@new_add);
6409 }
6410
6411 # Print context lines and then rem/add lines.
6412 sub print_diff_lines {
6413         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
6414         my $is_combined = $num_parents > 1;
6415
6416         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
6417                 $num_parents);
6418
6419         if ($diff_style eq 'sidebyside' && !$is_combined) {
6420                 print_sidebyside_diff_lines($ctx, $rem, $add);
6421         } else {
6422                 # default 'inline' style and unknown styles
6423                 print_inline_diff_lines($ctx, $rem, $add);
6424         }
6425 }
6426
6427 sub print_diff_chunk {
6428         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
6429         my (@ctx, @rem, @add);
6430
6431         # The class of the previous line.
6432         my $prev_class = '';
6433
6434         return unless @chunk;
6435
6436         # incomplete last line might be among removed or added lines,
6437         # or both, or among context lines: find which
6438         for (my $i = 1; $i < @chunk; $i++) {
6439                 if ($chunk[$i][0] eq 'incomplete') {
6440                         $chunk[$i][0] = $chunk[$i-1][0];
6441                 }
6442         }
6443
6444         # guardian
6445         push @chunk, ["", ""];
6446
6447         foreach my $line_info (@chunk) {
6448                 my ($class, $line) = @$line_info;
6449
6450                 # print chunk headers
6451                 if ($class && $class eq 'chunk_header') {
6452                         print format_diff_line($line, $class, $from, $to);
6453                         next;
6454                 }
6455
6456                 ## print from accumulator when have some add/rem lines or end
6457                 # of chunk (flush context lines), or when have add and rem
6458                 # lines and new block is reached (otherwise add/rem lines could
6459                 # be reordered)
6460                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
6461                     (@rem && @add && $class ne $prev_class)) {
6462                         print_diff_lines(\@ctx, \@rem, \@add,
6463                                          $diff_style, $num_parents);
6464                         @ctx = @rem = @add = ();
6465                 }
6466
6467                 ## adding lines to accumulator
6468                 # guardian value
6469                 last unless $line;
6470                 # rem, add or change
6471                 if ($class eq 'rem') {
6472                         push @rem, $line;
6473                 } elsif ($class eq 'add') {
6474                         push @add, $line;
6475                 }
6476                 # context line
6477                 if ($class eq 'ctx') {
6478                         push @ctx, $line;
6479                 }
6480
6481                 $prev_class = $class;
6482         }
6483 }
6484
6485 sub git_patchset_body {
6486         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
6487         my ($hash_parent) = $hash_parents[0];
6488
6489         my $is_combined = (@hash_parents > 1);
6490         my $patch_idx = 0;
6491         my $patch_number = 0;
6492         my $patch_line;
6493         my $diffinfo;
6494         my $to_name;
6495         my (%from, %to);
6496         my @chunk; # for side-by-side diff
6497
6498         print "<div class=\"patchset\">\n";
6499
6500         # skip to first patch
6501         while ($patch_line = to_utf8(scalar <$fd>)) {
6502                 chomp $patch_line;
6503
6504                 last if ($patch_line =~ m/^diff /);
6505         }
6506
6507  PATCH:
6508         while ($patch_line) {
6509
6510                 # parse "git diff" header line
6511                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
6512                         # $1 is from_name, which we do not use
6513                         $to_name = unquote($2);
6514                         $to_name =~ s!^b/!!;
6515                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
6516                         # $1 is 'cc' or 'combined', which we do not use
6517                         $to_name = unquote($2);
6518                 } else {
6519                         $to_name = undef;
6520                 }
6521
6522                 # check if current patch belong to current raw line
6523                 # and parse raw git-diff line if needed
6524                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
6525                         # this is continuation of a split patch
6526                         print "<div class=\"patch cont\">\n";
6527                 } else {
6528                         # advance raw git-diff output if needed
6529                         $patch_idx++ if defined $diffinfo;
6530
6531                         # read and prepare patch information
6532                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6533
6534                         # compact combined diff output can have some patches skipped
6535                         # find which patch (using pathname of result) we are at now;
6536                         if ($is_combined) {
6537                                 while ($to_name ne $diffinfo->{'to_file'}) {
6538                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6539                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
6540                                               "</div>\n";  # class="patch"
6541
6542                                         $patch_idx++;
6543                                         $patch_number++;
6544
6545                                         last if $patch_idx > $#$difftree;
6546                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6547                                 }
6548                         }
6549
6550                         # modifies %from, %to hashes
6551                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
6552
6553                         # this is first patch for raw difftree line with $patch_idx index
6554                         # we index @$difftree array from 0, but number patches from 1
6555                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
6556                 }
6557
6558                 # git diff header
6559                 #assert($patch_line =~ m/^diff /) if DEBUG;
6560                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
6561                 $patch_number++;
6562                 # print "git diff" header
6563                 print format_git_diff_header_line($patch_line, $diffinfo,
6564                                                   \%from, \%to);
6565
6566                 # print extended diff header
6567                 print "<div class=\"diff extended_header\">\n";
6568         EXTENDED_HEADER:
6569                 while ($patch_line = to_utf8(scalar<$fd>)) {
6570                         chomp $patch_line;
6571
6572                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
6573
6574                         print format_extended_diff_header_line($patch_line, $diffinfo,
6575                                                                \%from, \%to);
6576                 }
6577                 print "</div>\n"; # class="diff extended_header"
6578
6579                 # from-file/to-file diff header
6580                 if (! $patch_line) {
6581                         print "</div>\n"; # class="patch"
6582                         last PATCH;
6583                 }
6584                 next PATCH if ($patch_line =~ m/^diff /);
6585                 #assert($patch_line =~ m/^---/) if DEBUG;
6586
6587                 my $last_patch_line = $patch_line;
6588                 $patch_line = to_utf8(scalar <$fd>);
6589                 chomp $patch_line;
6590                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
6591
6592                 print format_diff_from_to_header($last_patch_line, $patch_line,
6593                                                  $diffinfo, \%from, \%to,
6594                                                  @hash_parents);
6595
6596                 # the patch itself
6597         LINE:
6598                 while ($patch_line = to_utf8(scalar <$fd>)) {
6599                         chomp $patch_line;
6600
6601                         next PATCH if ($patch_line =~ m/^diff /);
6602
6603                         my $class = diff_line_class($patch_line, \%from, \%to);
6604
6605                         if ($class eq 'chunk_header') {
6606                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6607                                 @chunk = ();
6608                         }
6609
6610                         push @chunk, [ $class, $patch_line ];
6611                 }
6612
6613         } continue {
6614                 if (@chunk) {
6615                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6616                         @chunk = ();
6617                 }
6618                 print "</div>\n"; # class="patch"
6619         }
6620
6621         # for compact combined (--cc) format, with chunk and patch simplification
6622         # the patchset might be empty, but there might be unprocessed raw lines
6623         for (++$patch_idx if $patch_number > 0;
6624              $patch_idx < @$difftree;
6625              ++$patch_idx) {
6626                 # read and prepare patch information
6627                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6628
6629                 # generate anchor for "patch" links in difftree / whatchanged part
6630                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6631                       format_diff_cc_simplified($diffinfo, @hash_parents) .
6632                       "</div>\n";  # class="patch"
6633
6634                 $patch_number++;
6635         }
6636
6637         if ($patch_number == 0) {
6638                 if (@hash_parents > 1) {
6639                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
6640                 } else {
6641                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
6642                 }
6643         }
6644
6645         print "</div>\n"; # class="patchset"
6646 }
6647
6648 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6649
6650 sub git_project_search_form {
6651         my ($searchtext, $search_use_regexp) = @_;
6652
6653         my $limit = '';
6654         if ($project_filter) {
6655                 $limit = " in '$project_filter'";
6656         }
6657
6658         print "<div class=\"projsearch\">\n";
6659         $cgi->start_form(-method => 'get', -action => $my_uri);
6660         print sprintf(qq/<form method="%s" action="%s" enctype="%s">\n/,
6661               'get', CGI::escapeHTML($my_uri), &CGI::URL_ENCODED) .
6662               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
6663         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
6664                 if (defined $project_filter);
6665         print $cgi->textfield(-name => 's', -value => $searchtext,
6666                               -title => "Search project by name and description$limit",
6667                               -size => 60) . "\n" .
6668               "<span title=\"Extended regular expression\">" .
6669               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
6670                              -checked => $search_use_regexp) .
6671               "</span>\n" .
6672               $cgi->submit(-name => 'btnS', -value => 'Search') .
6673               $cgi->end_form() . "\n" .
6674               "<span class=\"projectlist_link\">" .
6675               $cgi->a({-href => href(project => undef, searchtext => undef,
6676                                      action => 'project_list',
6677                                      project_filter => $project_filter)},
6678                       esc_html("List all projects$limit")) . "</span><br />\n";
6679         print "<span class=\"projectlist_link\">" .
6680               $cgi->a({-href => href(project => undef, searchtext => undef,
6681                                      action => 'project_list',
6682                                      project_filter => undef)},
6683                       esc_html("List all projects")) . "</span>\n" if $project_filter;
6684         print "</div>\n";
6685 }
6686
6687 # entry for given @keys needs filling if at least one of keys in list
6688 # is not present in %$project_info
6689 sub project_info_needs_filling {
6690         my ($project_info, @keys) = @_;
6691
6692         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
6693         foreach my $key (@keys) {
6694                 if (!exists $project_info->{$key}) {
6695                         return 1;
6696                 }
6697         }
6698         return;
6699 }
6700
6701 sub git_cache_file_format {
6702         return GITWEB_CACHE_FORMAT .
6703                 (gitweb_check_feature('forks') ? " (forks)" : "");
6704 }
6705
6706 sub git_retrieve_cache_file {
6707         my $cache_file = shift;
6708
6709         use Storable qw(retrieve);
6710
6711         if ((my $dump = eval { retrieve($cache_file) })) {
6712                 return $$dump[1] if
6713                         ref($dump) eq 'ARRAY' &&
6714                         @$dump == 2 &&
6715                         ref($$dump[1]) eq 'ARRAY' &&
6716                         @{$$dump[1]} == 2 &&
6717                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
6718                         ref(${$$dump[1]}[1]) eq 'HASH' &&
6719                         $$dump[0] eq git_cache_file_format();
6720         }
6721
6722         return undef;
6723 }
6724
6725 sub git_store_cache_file {
6726         my ($cache_file, $cachedata) = @_;
6727
6728         use File::Basename qw(dirname);
6729         use File::stat;
6730         use POSIX qw(:fcntl_h);
6731         use Storable qw(store_fd);
6732
6733         my $result = undef;
6734         my $cache_d = dirname($cache_file);
6735         my $mask = umask();
6736         umask($mask & ~0070) if $cache_grpshared;
6737         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6738             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6739                 store_fd([git_cache_file_format(), $cachedata], $fd);
6740                 close $fd;
6741                 rename "$cache_file.lock", $cache_file;
6742                 $result = stat($cache_file)->mtime;
6743         }
6744         umask($mask) if $cache_grpshared;
6745         return $result;
6746 }
6747
6748 sub verify_cached_project {
6749         my ($hashref, $path) = @_;
6750         return undef unless $path;
6751         delete $$hashref{$path}, return undef unless is_valid_project($path);
6752         return $$hashref{$path} if exists $$hashref{$path};
6753
6754         # A valid project was requested but it's not yet in the cache
6755         # Manufacture a minimal project entry (path, name, description)
6756         # Also provide age, but only if it's available via $lastactivity_file
6757
6758         my %proj = ('path' => $path);
6759         my $val = git_get_project_description($path);
6760         defined $val or $val = '';
6761         $proj{'descr_long'} = $val;
6762         $proj{'descr'} = chop_str($val, $projects_list_description_width, 5);
6763         unless ($omit_owner) {
6764                 $val = git_get_project_owner($path);
6765                 defined $val or $val = '';
6766                 $proj{'owner'} = $val;
6767         }
6768         unless ($omit_age_column) {
6769                 ($val) = git_get_last_activity($path, 1);
6770                 $proj{'age_epoch'} = $val if defined $val;
6771         }
6772         $$hashref{$path} = \%proj;
6773         return \%proj;
6774 }
6775
6776 sub git_filter_cached_projects {
6777         my ($cache, $projlist, $verify) = @_;
6778         my $hashref = $$cache[1];
6779         my $sub = $verify ?
6780                 sub {verify_cached_project($hashref, $_[0])} :
6781                 sub {$$hashref{$_[0]}};
6782         return map {
6783                 my $c = &$sub($_->{'path'});
6784                 defined $c ? ($_ = $c) : ()
6785         } @$projlist;
6786 }
6787
6788 # fills project list info (age, description, owner, category, forks, etc.)
6789 # for each project in the list, removing invalid projects from
6790 # returned list, or fill only specified info.
6791 #
6792 # Invalid projects are removed from the returned list if and only if you
6793 # ask 'age_epoch' to be filled, because they are the only fields
6794 # that run unconditionally git command that requires repository, and
6795 # therefore do always check if project repository is invalid.
6796 #
6797 # USAGE:
6798 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6799 #   ensures that 'descr_long' and 'ctags' fields are filled
6800 # * @project_list = fill_project_list_info(\@project_list)
6801 #   ensures that all fields are filled (and invalid projects removed)
6802 #
6803 # NOTE: modifies $projlist, but does not remove entries from it
6804 sub fill_project_list_info {
6805         my ($projlist, @wanted_keys) = @_;
6806
6807         my $rebuild = @wanted_keys && $wanted_keys[0] eq 'rebuild-cache' && shift @wanted_keys;
6808         return fill_project_list_info_uncached($projlist, @wanted_keys)
6809                 unless $projlist_cache_lifetime && $projlist_cache_lifetime > 0;
6810
6811         use File::stat;
6812
6813         my $cache_lifetime = $rebuild ? 0 : $projlist_cache_lifetime;
6814         my $cache_file = "$cache_dir/$projlist_cache_name";
6815
6816         my @projects;
6817         my $stale = 0;
6818         my $now = time();
6819         my $cache_mtime;
6820         if ($cache_lifetime && -f $cache_file) {
6821                 $cache_mtime = stat($cache_file)->mtime;
6822                 $cache_dump = undef if $cache_mtime &&
6823                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6824         }
6825         if (defined $cache_mtime && # caching is on and $cache_file exists
6826             $cache_mtime + $cache_lifetime*60 > $now &&
6827             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6828                 # Cache hit.
6829                 $cache_dump_mtime = $cache_mtime;
6830                 $stale = $now - $cache_mtime;
6831                 my $verify = ($action eq 'summary' || $action eq 'forks') &&
6832                         gitweb_check_feature('forks');
6833                 @projects = git_filter_cached_projects($cache_dump, $projlist, $verify);
6834
6835         } else { # Cache miss.
6836                 if (defined $cache_mtime) {
6837                         # Postpone timeout by two minutes so that we get
6838                         # enough time to do our job, or to be more exact
6839                         # make cache expire after two minutes from now.
6840                         my $time = $now - $cache_lifetime*60 + 120;
6841                         utime $time, $time, $cache_file;
6842                 }
6843                 my @all_projects = git_get_projects_list();
6844                 my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6845                         fill_project_list_info_uncached(\@all_projects);
6846                 map { $all_projects_filled{$_->{'path'}} = $_ }
6847                         filter_forks_from_projects_list([values(%all_projects_filled)])
6848                         if gitweb_check_feature('forks');
6849                 $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6850                                \%all_projects_filled];
6851                 $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6852                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6853         }
6854
6855         if ($cache_lifetime && $stale > 0) {
6856                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6857                         unless $shown_stale_message;
6858                 $shown_stale_message = 1;
6859         }
6860
6861         return @projects;
6862 }
6863
6864 sub fill_project_list_info_uncached {
6865         my ($projlist, @wanted_keys) = @_;
6866         my @projects;
6867         my $filter_set = sub { return @_; };
6868         if (@wanted_keys) {
6869                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6870                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6871         }
6872
6873         my $show_ctags = gitweb_check_feature('ctags');
6874  PROJECT:
6875         foreach my $pr (@$projlist) {
6876                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6877                         my (@activity) = git_get_last_activity($pr->{'path'});
6878                         unless (@activity) {
6879                                 next PROJECT;
6880                         }
6881                         ($pr->{'age_epoch'}) = @activity;
6882                 }
6883                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6884                         my $descr = git_get_project_description($pr->{'path'}) || "";
6885                         $descr = to_utf8($descr);
6886                         $pr->{'descr_long'} = $descr;
6887                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6888                 }
6889                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6890                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6891                 }
6892                 if ($show_ctags &&
6893                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6894                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6895                 }
6896                 if ($projects_list_group_categories &&
6897                     project_info_needs_filling($pr, $filter_set->('category'))) {
6898                         my $cat = git_get_project_category($pr->{'path'}) ||
6899                                                            $project_list_default_category;
6900                         $pr->{'category'} = to_utf8($cat);
6901                 }
6902
6903                 push @projects, $pr;
6904         }
6905
6906         return @projects;
6907 }
6908
6909 sub sort_projects_list {
6910         my ($projlist, $order) = @_;
6911
6912         sub order_str {
6913                 my $key = shift;
6914                 return sub { lc($a->{$key}) cmp lc($b->{$key}) };
6915         }
6916
6917         sub order_reverse_num_then_undef {
6918                 my $key = shift;
6919                 return sub {
6920                         defined $a->{$key} ?
6921                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6922                                 (defined $b->{$key} ? 1 : 0)
6923                 };
6924         }
6925
6926         my %orderings = (
6927                 project => order_str('path'),
6928                 descr => order_str('descr_long'),
6929                 owner => order_str('owner'),
6930                 age => order_reverse_num_then_undef('age_epoch'),
6931         );
6932
6933         my $ordering = $orderings{$order};
6934         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6935 }
6936
6937 # returns a hash of categories, containing the list of project
6938 # belonging to each category
6939 sub build_projlist_by_category {
6940         my ($projlist, $from, $to) = @_;
6941         my %categories;
6942
6943         $from = 0 unless defined $from;
6944         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6945
6946         for (my $i = $from; $i <= $to; $i++) {
6947                 my $pr = $projlist->[$i];
6948                 push @{$categories{ $pr->{'category'} }}, $pr;
6949         }
6950
6951         return wantarray ? %categories : \%categories;
6952 }
6953
6954 # print 'sort by' <th> element, generating 'sort by $name' replay link
6955 # if that order is not selected
6956 sub print_sort_th {
6957         print format_sort_th(@_);
6958 }
6959
6960 sub format_sort_th {
6961         my ($name, $order, $header) = @_;
6962         my $sort_th = "";
6963         $header ||= ucfirst($name);
6964
6965         if ($order eq $name) {
6966                 $sort_th .= "<th>$header</th>\n";
6967         } else {
6968                 $sort_th .= "<th>" .
6969                             $cgi->a({-href => href(-replay=>1, order=>$name),
6970                                      -class => "header"}, $header) .
6971                             "</th>\n";
6972         }
6973
6974         return $sort_th;
6975 }
6976
6977 sub git_project_list_rows {
6978         my ($projlist, $from, $to, $check_forks) = @_;
6979
6980         $from = 0 unless defined $from;
6981         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6982
6983         my $now = time;
6984         my $alternate = 1;
6985         for (my $i = $from; $i <= $to; $i++) {
6986                 my $pr = $projlist->[$i];
6987
6988                 if ($alternate) {
6989                         print "<tr class=\"dark\">\n";
6990                 } else {
6991                         print "<tr class=\"light\">\n";
6992                 }
6993                 $alternate ^= 1;
6994
6995                 if ($check_forks) {
6996                         print "<td>";
6997                         if ($pr->{'forks'}) {
6998                                 my $nforks = scalar @{$pr->{'forks'}};
6999                                 my $s = $nforks == 1 ? '' : 's';
7000                                 if ($nforks > 0) {
7001                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
7002                                                        -title => "$nforks fork$s"}, "+");
7003                                 } else {
7004                                         print $cgi->span({-title => "$nforks fork$s"}, "+");
7005                                 }
7006                         }
7007                         print "</td>\n";
7008                 }
7009                 my $path = $pr->{'path'};
7010                 my $dotgit = $path =~ s/\.git$// ? '.git' : '';
7011                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
7012                                         -class => "list"},
7013                                        esc_html_match_hl($path, $search_regexp).$dotgit) .
7014                       "</td>\n" .
7015                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
7016                                         -class => "list",
7017                                         -title => $pr->{'descr_long'}},
7018                                         $search_regexp
7019                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
7020                                                                     $pr->{'descr'}, $search_regexp)
7021                                         : esc_html($pr->{'descr'})) .
7022                       "</td>\n";
7023                 unless ($omit_owner) {
7024                         print "<td><i>" . ($owner_link_hook
7025                                           ? $cgi->a({-href => $owner_link_hook->($pr->{'owner'}), -class => "list"},
7026                                                     chop_and_escape_str($pr->{'owner'}, 15))
7027                                           : chop_and_escape_str($pr->{'owner'}, 15)) . "</i></td>\n";
7028                 }
7029                 unless ($omit_age_column) {
7030                         my ($age_epoch, $age_string) = ($pr->{'age_epoch'});
7031                         $age_string = defined $age_epoch ? age_string($age_epoch, $now) : "No commits";
7032                         print "<td class=\"". age_class($age_epoch, $now) . "\">" . $age_string . "</td>\n";
7033                 }
7034                 print"<td class=\"link\">" .
7035                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . $barsep .
7036                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "log") . $barsep .
7037                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
7038                       ($pr->{'forks'} ? $barsep . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
7039                       "</td>\n" .
7040                       "</tr>\n";
7041         }
7042 }
7043
7044 sub git_project_list_body {
7045         # actually uses global variable $project
7046         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action, $keep_top) = @_;
7047         my @projects = @$projlist;
7048
7049         my $check_forks = gitweb_check_feature('forks');
7050         my $show_ctags  = gitweb_check_feature('ctags');
7051         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
7052         $check_forks = undef
7053                 if ($tagfilter || $search_regexp);
7054
7055         # filtering out forks before filling info allows us to do less work
7056         if ($check_forks) {
7057                 @projects = filter_forks_from_projects_list(\@projects);
7058                 push @projects, { 'path' => "$project_filter.git" }
7059                         if $project_filter && $keep_top && is_valid_project("$project_filter.git");
7060         }
7061         # search_projects_list pre-fills required info
7062         @projects = search_projects_list(\@projects,
7063                                          'search_regexp' => $search_regexp,
7064                                          'tagfilter'  => $tagfilter)
7065                 if ($tagfilter || $search_regexp);
7066         # fill the rest
7067         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
7068         push @all_fields, 'age_epoch' unless($omit_age_column);
7069         push @all_fields, 'owner' unless($omit_owner);
7070         @projects = fill_project_list_info(\@projects, @all_fields);
7071
7072         $order ||= $default_projects_order;
7073         $from = 0 unless defined $from;
7074         $to = $#projects if (!defined $to || $#projects < $to);
7075
7076         # short circuit
7077         if ($from > $to) {
7078                 print "<center>\n".
7079                       "<b>No such projects found</b><br />\n".
7080                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
7081                       "</center>\n<br />\n";
7082                 return;
7083         }
7084
7085         @projects = sort_projects_list(\@projects, $order);
7086
7087         if ($show_ctags) {
7088                 my $ctags = git_gather_all_ctags(\@projects);
7089                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
7090                 print git_show_project_tagcloud($cloud, 64);
7091         }
7092
7093         print "<table class=\"project_list\">\n";
7094         unless ($no_header) {
7095                 print "<tr>\n";
7096                 if ($check_forks) {
7097                         print "<th></th>\n";
7098                 }
7099                 print_sort_th('project', $order, 'Project');
7100                 print_sort_th('descr', $order, 'Description');
7101                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
7102                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
7103                 print "<th></th>\n" . # for links
7104                       "</tr>\n";
7105         }
7106
7107         if ($projects_list_group_categories) {
7108                 # only display categories with projects in the $from-$to window
7109                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
7110                 my %categories = build_projlist_by_category(\@projects, $from, $to);
7111                 foreach my $cat (sort keys %categories) {
7112                         unless ($cat eq "") {
7113                                 print "<tr>\n";
7114                                 if ($check_forks) {
7115                                         print "<td></td>\n";
7116                                 }
7117                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
7118                                 print "</tr>\n";
7119                         }
7120
7121                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
7122                 }
7123         } else {
7124                 git_project_list_rows(\@projects, $from, $to, $check_forks);
7125         }
7126
7127         if (defined $extra) {
7128                 print "<tr class=\"extra\">\n";
7129                 if ($check_forks) {
7130                         print "<td></td>\n";
7131                 }
7132                 print "<td colspan=\"5\" class=\"extra\">$extra</td>\n" .
7133                       "</tr>\n";
7134         }
7135         print "</table>\n";
7136 }
7137
7138 sub git_log_body {
7139         # uses global variable $project
7140         my ($commitlist, $from, $to, $refs, $extra) = @_;
7141
7142         $from = 0 unless defined $from;
7143         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7144
7145         for (my $i = 0; $i <= $to; $i++) {
7146                 my %co = %{$commitlist->[$i]};
7147                 next if !%co;
7148                 my $commit = $co{'id'};
7149                 my $ref = format_ref_marker($refs, $commit);
7150                 git_print_header_div('commit',
7151                                "<span class=\"age\">$co{'age_string'}</span>" .
7152                                esc_html($co{'title'}),
7153                                $commit, undef, $ref);
7154                 print "<div class=\"title_text\">\n" .
7155                       "<div class=\"log_link\">\n" .
7156                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
7157                       $barsep .
7158                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
7159                       $barsep .
7160                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
7161                       "<br/>\n" .
7162                       "</div>\n";
7163                       git_print_authorship(\%co, -tag => 'span');
7164                       print "<br/>\n</div>\n";
7165
7166                 print "<div class=\"log_body\">\n";
7167                 git_print_log($co{'comment'}, -final_empty_line=> 1);
7168                 print "</div>\n";
7169         }
7170         if ($extra) {
7171                 print "<div class=\"page_nav_trailer\">\n";
7172                 print "$extra\n";
7173                 print "</div>\n";
7174         }
7175 }
7176
7177 sub git_shortlog_body {
7178         # uses global variable $project
7179         my ($commitlist, $from, $to, $refs, $extra) = @_;
7180
7181         $from = 0 unless defined $from;
7182         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7183
7184         print "<table class=\"shortlog\">\n";
7185         my $alternate = 1;
7186         for (my $i = $from; $i <= $to; $i++) {
7187                 my %co = %{$commitlist->[$i]};
7188                 my $commit = $co{'id'};
7189                 my $ref = format_ref_marker($refs, $commit);
7190                 if ($alternate) {
7191                         print "<tr class=\"dark\">\n";
7192                 } else {
7193                         print "<tr class=\"light\">\n";
7194                 }
7195                 $alternate ^= 1;
7196                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
7197                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7198                       format_author_html('td', \%co, 10) . "<td>";
7199                 print format_subject_html($co{'title'}, $co{'title_short'},
7200                                           href(action=>"commit", hash=>$commit), $ref);
7201                 print "</td>\n" .
7202                       "<td class=\"link\">" .
7203                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . $barsep .
7204                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . $barsep .
7205                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
7206                 my $snapshot_links = format_snapshot_links($commit);
7207                 if (defined $snapshot_links) {
7208                         print $barsep . $snapshot_links;
7209                 }
7210                 print "</td>\n" .
7211                       "</tr>\n";
7212         }
7213         if (defined $extra) {
7214                 print "<tr class=\"extra\">\n" .
7215                       "<td colspan=\"4\" class=\"extra\">$extra</td>\n" .
7216                       "</tr>\n";
7217         }
7218         print "</table>\n";
7219 }
7220
7221 sub git_history_body {
7222         # Warning: assumes constant type (blob or tree) during history
7223         my ($commitlist, $from, $to, $refs, $extra,
7224             $file_name, $file_hash, $ftype) = @_;
7225
7226         $from = 0 unless defined $from;
7227         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
7228
7229         print "<table class=\"history\">\n";
7230         my $alternate = 1;
7231         for (my $i = $from; $i <= $to; $i++) {
7232                 my %co = %{$commitlist->[$i]};
7233                 if (!%co) {
7234                         next;
7235                 }
7236                 my $commit = $co{'id'};
7237
7238                 my $ref = format_ref_marker($refs, $commit);
7239
7240                 if ($alternate) {
7241                         print "<tr class=\"dark\">\n";
7242                 } else {
7243                         print "<tr class=\"light\">\n";
7244                 }
7245                 $alternate ^= 1;
7246                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7247         # shortlog:   format_author_html('td', \%co, 10)
7248                       format_author_html('td', \%co, 15, 3) . "<td>";
7249                 # originally git_history used chop_str($co{'title'}, 50)
7250                 print format_subject_html($co{'title'}, $co{'title_short'},
7251                                           href(action=>"commit", hash=>$commit), $ref);
7252                 print "</td>\n" .
7253                       "<td class=\"link\">" .
7254                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . $barsep .
7255                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
7256
7257                 if ($ftype eq 'blob') {
7258                         my $blob_current = $file_hash;
7259                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
7260                         if (defined $blob_current && defined $blob_parent &&
7261                                         $blob_current ne $blob_parent) {
7262                                 print $barsep .
7263                                         $cgi->a({-href => href(action=>"blobdiff",
7264                                                                hash=>$blob_current, hash_parent=>$blob_parent,
7265                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
7266                                                                file_name=>$file_name)},
7267                                                 "diff to current");
7268                         }
7269                 }
7270                 print "</td>\n" .
7271                       "</tr>\n";
7272         }
7273         if (defined $extra) {
7274                 print "<tr class=\"extra\">\n" .
7275                       "<td colspan=\"4\" class=\"extra\">$extra</td>\n" .
7276                       "</tr>\n";
7277         }
7278         print "</table>\n";
7279 }
7280
7281 sub git_tags_body {
7282         # uses global variable $project
7283         my ($taglist, $from, $to, $extra, $head_at, $full, $order) = @_;
7284         $from = 0 unless defined $from;
7285         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
7286         $order ||= $default_refs_order;
7287
7288         print "<table class=\"tags\">\n";
7289         if ($full) {
7290                 print "<tr class=\"tags_header\">\n";
7291                 print_sort_th('age', $order, 'Last Change');
7292                 print_sort_th('name', $order, 'Name');
7293                 print "<th></th>\n" . # for comment
7294                       "<th></th>\n" . # for tag
7295                       "<th></th>\n" . # for links
7296                       "</tr>\n";
7297         }
7298         my $alternate = 1;
7299         for (my $i = $from; $i <= $to; $i++) {
7300                 my $entry = $taglist->[$i];
7301                 my %tag = %$entry;
7302                 my $comment = $tag{'subject'};
7303                 my $comment_short;
7304                 if (defined $comment) {
7305                         $comment_short = chop_str($comment, 30, 5);
7306                 }
7307                 my $curr = defined $head_at && $tag{'id'} eq $head_at;
7308                 if ($alternate) {
7309                         print "<tr class=\"dark\">\n";
7310                 } else {
7311                         print "<tr class=\"light\">\n";
7312                 }
7313                 $alternate ^= 1;
7314                 if (defined $tag{'age'}) {
7315                         print "<td><i>$tag{'age'}</i></td>\n";
7316                 } else {
7317                         print "<td></td>\n";
7318                 }
7319                 print(($curr ? "<td class=\"current_head\">" : "<td>") .
7320                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
7321                                -class => "list name"}, esc_html($tag{'name'})) .
7322                       "</td>\n" .
7323                       "<td>");
7324                 if (defined $comment) {
7325                         print format_subject_html($comment, $comment_short,
7326                                                   href(action=>"tag", hash=>$tag{'id'}));
7327                 }
7328                 print "</td>\n" .
7329                       "<td class=\"selflink\">";
7330                 if ($tag{'type'} eq "tag") {
7331                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
7332                 } else {
7333                         print "&#160;";
7334                 }
7335                 print "</td>\n" .
7336                       "<td class=\"link\">" . $barsep .
7337                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
7338                 if ($tag{'reftype'} eq "commit") {
7339                         print $barsep . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "log");
7340                         print $barsep . $cgi->a({-href => href(action=>"tree", hash=>$tag{'fullname'})}, "tree") if $full;
7341                 } elsif ($tag{'reftype'} eq "blob") {
7342                         print $barsep . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
7343                 }
7344                 print "</td>\n" .
7345                       "</tr>";
7346         }
7347         if (defined $extra) {
7348                 print "<tr class=\"extra\">\n" .
7349                       "<td colspan=\"5\" class=\"extra\">$extra</td>\n" .
7350                       "</tr>\n";
7351         }
7352         print "</table>\n";
7353 }
7354
7355 sub git_heads_body {
7356         # uses global variable $project
7357         my ($headlist, $head_at, $from, $to, $extra) = @_;
7358         $from = 0 unless defined $from;
7359         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
7360
7361         print "<table class=\"heads\">\n";
7362         my $alternate = 1;
7363         for (my $i = $from; $i <= $to; $i++) {
7364                 my $entry = $headlist->[$i];
7365                 my %ref = %$entry;
7366                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
7367                 if ($alternate) {
7368                         print "<tr class=\"dark\">\n";
7369                 } else {
7370                         print "<tr class=\"light\">\n";
7371                 }
7372                 $alternate ^= 1;
7373                 print "<td><i>$ref{'age'}</i></td>\n" .
7374                       ($curr ? "<td class=\"current_head\">" : "<td>") .
7375                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
7376                                -class => "list name"},esc_html($ref{'name'})) .
7377                       "</td>\n" .
7378                       "<td class=\"link\">" .
7379                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "log") . $barsep .
7380                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
7381                       "</td>\n" .
7382                       "</tr>";
7383         }
7384         if (defined $extra) {
7385                 print "<tr class=\"extra\">\n" .
7386                       "<td colspan=\"3\" class=\"extra\">$extra</td>\n" .
7387                       "</tr>\n";
7388         }
7389         print "</table>\n";
7390 }
7391
7392 # Display a single remote block
7393 sub git_remote_block {
7394         my ($remote, $rdata, $limit, $head) = @_;
7395
7396         my $heads = $rdata->{'heads'};
7397         my $fetch = $rdata->{'fetch'};
7398         my $push = $rdata->{'push'};
7399
7400         my $urls_table = "<table class=\"projects_list\">\n" ;
7401
7402         if (defined $fetch) {
7403                 if ($fetch eq $push) {
7404                         $urls_table .= format_repo_url("URL", $fetch);
7405                 } else {
7406                         $urls_table .= format_repo_url("Fetch&#160;URL", $fetch);
7407                         $urls_table .= format_repo_url("Push&#160;URL", $push) if defined $push;
7408                 }
7409         } elsif (defined $push) {
7410                 $urls_table .= format_repo_url("Push&#160;URL", $push);
7411         } else {
7412                 $urls_table .= format_repo_url("", "No remote URL");
7413         }
7414
7415         $urls_table .= "</table>\n";
7416
7417         my $dots;
7418         if (defined $limit && $limit < @$heads) {
7419                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
7420         }
7421
7422         print $urls_table;
7423         git_heads_body($heads, $head, 0, $limit, $dots);
7424 }
7425
7426 # Display a list of remote names with the respective fetch and push URLs
7427 sub git_remotes_list {
7428         my ($remotedata, $limit) = @_;
7429         print "<table class=\"heads\">\n";
7430         my $alternate = 1;
7431         my @remotes = sort keys %$remotedata;
7432
7433         my $limited = $limit && $limit < @remotes;
7434
7435         $#remotes = $limit - 1 if $limited;
7436
7437         while (my $remote = shift @remotes) {
7438                 my $rdata = $remotedata->{$remote};
7439                 my $fetch = $rdata->{'fetch'};
7440                 my $push = $rdata->{'push'};
7441                 if ($alternate) {
7442                         print "<tr class=\"dark\">\n";
7443                 } else {
7444                         print "<tr class=\"light\">\n";
7445                 }
7446                 $alternate ^= 1;
7447                 print "<td>" .
7448                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
7449                                -class=> "list name"},esc_html($remote)) .
7450                       "</td>";
7451                 print "<td class=\"link\">" .
7452                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
7453                       $barsep .
7454                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
7455                       "</td>";
7456
7457                 print "</tr>\n";
7458         }
7459
7460         if ($limited) {
7461                 print "<tr>\n" .
7462                       "<td colspan=\"3\">" .
7463                       $cgi->a({-href => href(action=>"remotes")}, "...") .
7464                       "</td>\n" . "</tr>\n";
7465         }
7466
7467         print "</table>";
7468 }
7469
7470 # Display remote heads grouped by remote, unless there are too many
7471 # remotes, in which case we only display the remote names
7472 sub git_remotes_body {
7473         my ($remotedata, $limit, $head) = @_;
7474         if ($limit and $limit < keys %$remotedata) {
7475                 git_remotes_list($remotedata, $limit);
7476         } else {
7477                 fill_remote_heads($remotedata);
7478                 while (my ($remote, $rdata) = each %$remotedata) {
7479                         git_print_section({-class=>"remote", -id=>$remote},
7480                                 ["remotes", $remote, $remote], sub {
7481                                         git_remote_block($remote, $rdata, $limit, $head);
7482                                 });
7483                 }
7484         }
7485 }
7486
7487 sub git_search_message {
7488         my %co = @_;
7489
7490         my $greptype;
7491         if ($searchtype eq 'commit') {
7492                 $greptype = "--grep=";
7493         } elsif ($searchtype eq 'author') {
7494                 $greptype = "--author=";
7495         } elsif ($searchtype eq 'committer') {
7496                 $greptype = "--committer=";
7497         }
7498         $greptype .= $searchtext;
7499         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
7500                                        $greptype, '--regexp-ignore-case',
7501                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
7502
7503         my $paging_nav = "<span class=\"paging_nav\">";
7504         if ($page > 0) {
7505                 $paging_nav .= tabspan(
7506                         $cgi->a({-href => href(-replay=>1, page=>undef)},
7507                                 "first")) .
7508                         $mdotsep . tabspan(
7509                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
7510                                  -accesskey => "p", -title => "Alt-p"}, "prev"));
7511         } else {
7512                 $paging_nav .= tabspan("first", 1, 0).${mdotsep}.tabspan("prev", 0, 1);
7513         }
7514         my $next_link = '';
7515         if ($#commitlist >= 100) {
7516                 $next_link = tabspan(
7517                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7518                                  -accesskey => "n", -title => "Alt-n"}, "next"));
7519                 $paging_nav .= "${mdotsep}$next_link";
7520         } else {
7521                 $paging_nav .= ${mdotsep}.tabspan("next", 0, 1);
7522         }
7523
7524         git_header_html();
7525
7526         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav."</span>");
7527         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7528         if ($page == 0 && !@commitlist) {
7529                 print "<p>No match.</p>\n";
7530         } else {
7531                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
7532         }
7533
7534         git_footer_html();
7535 }
7536
7537 sub git_search_changes {
7538         my %co = @_;
7539
7540         local $/ = "\n";
7541         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
7542                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
7543                 ($search_use_regexp ? '--pickaxe-regex' : ()))
7544                         or die_error(500, "Open git-log failed");
7545
7546         git_header_html();
7547
7548         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7549         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7550
7551         print "<table class=\"pickaxe search\">\n";
7552         my $alternate = 1;
7553         undef %co;
7554         my @files;
7555         while (my $line = to_utf8(scalar <$fd>)) {
7556                 chomp $line;
7557                 next unless $line;
7558
7559                 my %set = parse_difftree_raw_line($line);
7560                 if (defined $set{'commit'}) {
7561                         # finish previous commit
7562                         if (%co) {
7563                                 print "</td>\n" .
7564                                       "<td class=\"link\">" .
7565                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7566                                               "commit") .
7567                                       $barsep .
7568                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7569                                                              hash_base=>$co{'id'})},
7570                                               "tree") .
7571                                       "</td>\n" .
7572                                       "</tr>\n";
7573                         }
7574
7575                         if ($alternate) {
7576                                 print "<tr class=\"dark\">\n";
7577                         } else {
7578                                 print "<tr class=\"light\">\n";
7579                         }
7580                         $alternate ^= 1;
7581                         %co = parse_commit($set{'commit'});
7582                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
7583                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7584                               "<td><i>$author</i></td>\n" .
7585                               "<td>" .
7586                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7587                                       -class => "list subject"},
7588                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
7589                 } elsif (defined $set{'to_id'}) {
7590                         next if ($set{'to_id'} =~ m/^0{40}$/);
7591
7592                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
7593                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
7594                                       -class => "list"},
7595                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
7596                               "<br/>\n";
7597                 }
7598         }
7599         close $fd;
7600
7601         # finish last commit (warning: repetition!)
7602         if (%co) {
7603                 print "</td>\n" .
7604                       "<td class=\"link\">" .
7605                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7606                               "commit") .
7607                       $barsep .
7608                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7609                                              hash_base=>$co{'id'})},
7610                               "tree") .
7611                       "</td>\n" .
7612                       "</tr>\n";
7613         }
7614
7615         print "</table>\n";
7616
7617         git_footer_html();
7618 }
7619
7620 sub git_search_files {
7621         my %co = @_;
7622
7623         local $/ = "\n";
7624         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
7625                 $search_use_regexp ? ('-E', '-i') : '-F',
7626                 $searchtext, $co{'tree'})
7627                         or die_error(500, "Open git-grep failed");
7628
7629         git_header_html();
7630
7631         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7632         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7633
7634         print "<table class=\"grep_search\">\n";
7635         my $alternate = 1;
7636         my $matches = 0;
7637         my $lastfile = '';
7638         my $file_href;
7639         while (my $line = to_utf8(scalar <$fd>)) {
7640                 chomp $line;
7641                 my ($file, $lno, $ltext, $binary);
7642                 last if ($matches++ > 1000);
7643                 if ($line =~ /^Binary file (.+) matches$/) {
7644                         $file = $1;
7645                         $binary = 1;
7646                 } else {
7647                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
7648                         $file =~ s/^$co{'tree'}://;
7649                 }
7650                 if ($file ne $lastfile) {
7651                         $lastfile and print "</td></tr>\n";
7652                         if ($alternate++) {
7653                                 print "<tr class=\"dark\">\n";
7654                         } else {
7655                                 print "<tr class=\"light\">\n";
7656                         }
7657                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
7658                                           file_name=>$file);
7659                         print "<td class=\"list\">".
7660                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
7661                         print "</td><td>\n";
7662                         $lastfile = $file;
7663                 }
7664                 if ($binary) {
7665                         print "<div class=\"binary\">Binary file</div>\n";
7666                 } else {
7667                         $ltext = untabify($ltext);
7668                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
7669                                 $ltext = esc_html($1, -nbsp=>1);
7670                                 $ltext .= '<span class="match">';
7671                                 $ltext .= esc_html($2, -nbsp=>1);
7672                                 $ltext .= '</span>';
7673                                 $ltext .= esc_html($3, -nbsp=>1);
7674                         } else {
7675                                 $ltext = esc_html($ltext, -nbsp=>1);
7676                         }
7677                         print "<div class=\"pre\">" .
7678                                 $cgi->a({-href => $file_href.'#l'.$lno,
7679                                         -class => "linenr"}, sprintf('%4i ', $lno)) .
7680                                 $ltext . "</div>\n";
7681                 }
7682         }
7683         if ($lastfile) {
7684                 print "</td></tr>\n";
7685                 if ($matches > 1000) {
7686                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
7687                 }
7688         } else {
7689                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
7690         }
7691         close $fd;
7692
7693         print "</table>\n";
7694
7695         git_footer_html();
7696 }
7697
7698 sub git_search_grep_body {
7699         my ($commitlist, $from, $to, $extra) = @_;
7700         $from = 0 unless defined $from;
7701         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7702
7703         print "<table class=\"commit_search\">\n";
7704         my $alternate = 1;
7705         for (my $i = $from; $i <= $to; $i++) {
7706                 my %co = %{$commitlist->[$i]};
7707                 if (!%co) {
7708                         next;
7709                 }
7710                 my $commit = $co{'id'};
7711                 if ($alternate) {
7712                         print "<tr class=\"dark\">\n";
7713                 } else {
7714                         print "<tr class=\"light\">\n";
7715                 }
7716                 $alternate ^= 1;
7717                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7718                       format_author_html('td', \%co, 15, 5) .
7719                       "<td>" .
7720                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7721                                -class => "list subject"},
7722                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
7723                 my $comment = $co{'comment'};
7724                 foreach my $line (@$comment) {
7725                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
7726                                 my ($lead, $match, $trail) = ($1, $2, $3);
7727                                 $match = chop_str($match, 70, 5, 'center');
7728                                 my $contextlen = int((80 - length($match))/2);
7729                                 $contextlen = 30 if ($contextlen > 30);
7730                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
7731                                 $trail = chop_str($trail, $contextlen, 10, 'right');
7732
7733                                 $lead  = esc_html($lead);
7734                                 $match = esc_html($match);
7735                                 $trail = esc_html($trail);
7736
7737                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
7738                         }
7739                 }
7740                 print "</td>\n" .
7741                       "<td class=\"link\">" .
7742                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7743                       $barsep .
7744                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7745                       $barsep .
7746                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7747                 print "</td>\n" .
7748                       "</tr>\n";
7749         }
7750         if (defined $extra) {
7751                 print "<tr class=\"extra\">\n" .
7752                       "<td colspan=\"3\" class=\"extra\">$extra</td>\n" .
7753                       "</tr>\n";
7754         }
7755         print "</table>\n";
7756 }
7757
7758 ## ======================================================================
7759 ## ======================================================================
7760 ## actions
7761
7762 sub git_project_list_load {
7763         my $empty_list_ok = shift;
7764         my $order = $input_params{'order'};
7765         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7766                 die_error(400, "Unknown order parameter");
7767         }
7768
7769         my @list = git_get_projects_list($project_filter, $strict_export);
7770         if ($project_filter && (!@list || !gitweb_check_feature('forks'))) {
7771                 push @list, { 'path' => "$project_filter.git" }
7772                         if is_valid_project("$project_filter.git");
7773         }
7774         if (!@list) {
7775                 die_error(404, "No projects found") unless $empty_list_ok;
7776         }
7777
7778         return (\@list, $order);
7779 }
7780
7781 sub git_frontpage {
7782         my ($projlist, $order);
7783
7784         if ($frontpage_no_project_list) {
7785                 $project = undef;
7786                 $project_filter = undef;
7787         } else {
7788                 ($projlist, $order) = git_project_list_load(1);
7789         }
7790         git_header_html();
7791         if (defined $home_text && -f $home_text) {
7792                 print "<div class=\"index_include\">\n";
7793                 insert_file($home_text);
7794                 print "</div>\n";
7795         }
7796         git_project_search_form($searchtext, $search_use_regexp);
7797         if ($frontpage_no_project_list) {
7798                 my $show_ctags = gitweb_check_feature('ctags');
7799                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7800                         my @projects = git_get_projects_list($project_filter, $strict_export);
7801                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7802                         @projects = fill_project_list_info(\@projects, 'ctags');
7803                         my $ctags = git_gather_all_ctags(\@projects);
7804                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7805                         print git_show_project_tagcloud($cloud, 64);
7806                 }
7807         } else {
7808                 git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7809         }
7810         git_footer_html();
7811 }
7812
7813 sub git_project_list {
7814         my ($projlist, $order) = git_project_list_load();
7815         git_header_html();
7816         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7817                 print "<div class=\"index_include\">\n";
7818                 insert_file($home_text);
7819                 print "</div>\n";
7820         }
7821         git_project_search_form();
7822         git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7823         git_footer_html();
7824 }
7825
7826 sub git_forks {
7827         my $order = $input_params{'order'};
7828         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7829                 die_error(400, "Unknown order parameter");
7830         }
7831
7832         my $filter = $project;
7833         $filter =~ s/\.git$//;
7834         my @list = git_get_projects_list($filter);
7835         if (!@list) {
7836                 die_error(404, "No forks found");
7837         }
7838
7839         git_header_html();
7840         git_print_page_nav('','');
7841         git_print_header_div('summary', "$project forks");
7842         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7843         git_footer_html();
7844 }
7845
7846 sub git_project_index {
7847         my @projects = git_get_projects_list($project_filter, $strict_export);
7848         if (!@projects) {
7849                 die_error(404, "No projects found");
7850         }
7851
7852         print $cgi->header(
7853                 -type => 'text/plain',
7854                 -charset => 'utf-8',
7855                 -content_disposition => 'inline; filename="index.aux"');
7856
7857         foreach my $pr (@projects) {
7858                 if (!exists $pr->{'owner'}) {
7859                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7860                 }
7861
7862                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7863                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7864                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7865                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7866                 $path  =~ s/ /\+/g;
7867                 $owner =~ s/ /\+/g;
7868
7869                 print "$path $owner\n";
7870         }
7871 }
7872
7873 sub git_summary {
7874         my $descr = git_get_project_description($project) || "none";
7875         my %co = parse_commit("HEAD");
7876         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7877         my $head = $co{'id'};
7878         my $remote_heads = gitweb_check_feature('remote_heads');
7879
7880         my $owner = git_get_project_owner($project);
7881         my $homepage = git_get_project_config('homepage');
7882         my $base_url = git_get_project_config('baseurl');
7883
7884         my $refs = git_get_references();
7885         # These get_*_list functions return one more to allow us to see if
7886         # there are more ...
7887         my @taglist  = git_get_tags_list(16);
7888         my @headlist = git_get_heads_list(16);
7889         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7890         my @forklist;
7891         my $check_forks = gitweb_check_feature('forks');
7892
7893         if ($check_forks) {
7894                 # find forks of a project
7895                 my $filter = $project;
7896                 $filter =~ s/\.git$//;
7897                 @forklist = git_get_projects_list($filter);
7898                 # filter out forks of forks
7899                 @forklist = filter_forks_from_projects_list(\@forklist)
7900                         if (@forklist);
7901         }
7902
7903         git_header_html();
7904         git_print_page_nav('summary','', $head);
7905
7906         if ($check_forks and $project =~ m#/#) {
7907                 my $xproject = $project; $xproject =~ s#/[^/]+$#.git#; #
7908                 if (is_valid_project($xproject) && -f "$projectroot/$project/objects/info/alternates" && -s _) {
7909                         my $r = $cgi->a({-href=> href(project => $xproject, action => 'summary')}, $xproject);
7910                         print <<EOT;
7911 <div class="forkinfo">
7912 This project is a fork of the $r project. If you have that one
7913 already cloned locally, you can use
7914 <pre>git clone --reference /path/to/your/$xproject/incarnation mirror_URL</pre>
7915 to save bandwidth during cloning.
7916 </div>
7917 EOT
7918                 }
7919         }
7920
7921         print "<div class=\"title\">&#160;</div>\n";
7922         print "<table class=\"projects_list\">\n" .
7923               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7924         if ($homepage) {
7925                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7926         }
7927         if ($base_url) {
7928                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7929         }
7930         if ($owner and not $omit_owner) {
7931                 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . ($owner_link_hook
7932                         ? $cgi->a({-href => $owner_link_hook->($owner)}, email_obfuscate($owner))
7933                         : email_obfuscate($owner)) . "</td></tr>\n";
7934         }
7935         if (defined $cd{'rfc2822'}) {
7936                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7937                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7938         }
7939         print format_lastrefresh_row(), "\n";
7940
7941         # use per project git URL list in $projectroot/$project/cloneurl
7942         # or make project git URL from git base URL and project name
7943         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7944         my $url_class = "metadata_url";
7945         my @url_list = git_get_project_url_list($project);
7946         unless (@url_list) {
7947                 @url_list = @git_base_url_list;
7948                 if ((git_get_project_config("showpush", '--bool')||'false') eq "true" ||
7949                     -f "$projectroot/$project/.nofetch") {
7950                         my $pushidx = @url_list;
7951                         foreach (@git_base_push_urls) {
7952                                 if ($https_hint_html && !ref($_) && $_ =~ /^https:/i) {
7953                                         push(@url_list, [$_, $https_hint_html]);
7954                                 } else {
7955                                         push(@url_list, $_);
7956                                 }
7957                         }
7958                         if ($#url_list >= $pushidx) {
7959                                 my $pushtag = "push&#160;URL";
7960                                 my $classtag = "metadata_pushurl";
7961                                 if (ref($url_list[$pushidx])) {
7962                                         $url_list[$pushidx] = [
7963                                                 ${$url_list[$pushidx]}[0],
7964                                                 ${$url_list[$pushidx]}[1],
7965                                                 $pushtag,
7966                                                 $classtag];
7967                                 } else {
7968                                         $url_list[$pushidx] = [
7969                                                 $url_list[$pushidx],
7970                                                 undef,
7971                                                 $pushtag,
7972                                                 $classtag];
7973                                 }
7974                         }
7975                 } else {
7976                         push(@url_list, @git_base_mirror_urls);
7977                 }
7978                 for (my $i=0; $i<=$#url_list; ++$i) {
7979                         if (ref($url_list[$i])) {
7980                                 $url_list[$i] = [
7981                                         ${$url_list[$i]}[0] . "/$project",
7982                                         ${$url_list[$i]}[1],
7983                                         ${$url_list[$i]}[2],
7984                                         ${$url_list[$i]}[3]];
7985                         } else {
7986                                 $url_list[$i] .= "/$project";
7987                         }
7988                 }
7989         }
7990         foreach (@url_list) {
7991                 next unless $_;
7992                 my $git_url;
7993                 my $html_hint = "";
7994                 my $next_tag = undef;
7995                 my $next_class = undef;
7996                 if (ref($_)) {
7997                         $git_url = $$_[0];
7998                         $html_hint = "&#160;" . $$_[1] if defined($$_[1]);
7999                         $next_tag = $$_[2];
8000                         $next_class = $$_[3];
8001                 } else {
8002                         $git_url = $_;
8003                 }
8004                 next unless $git_url;
8005                 $url_class = $next_class if $next_class;
8006                 $url_tag = $next_tag if $next_tag;
8007                 print "<tr class=\"$url_class\"><td>$url_tag</td><td>$git_url$html_hint</td></tr>\n";
8008                 $url_tag = "";
8009         }
8010
8011         if (defined($git_base_bundles_url) && -d "$projectroot/$project/bundles") {
8012                 my $projname = $project;
8013                 $projname =~ s|^.*/||;
8014                 my $url = "$git_base_bundles_url/$project/bundles";
8015                 print format_repo_url(
8016                         "bundle&#160;info",
8017                         "<a rel='nofollow' href='$url'>$projname downloadable bundles</a>");
8018         }
8019
8020         # Tag cloud
8021         my $show_ctags = gitweb_check_feature('ctags');
8022         if ($show_ctags) {
8023                 my $ctags = git_get_project_ctags($project);
8024                 if (%$ctags || $show_ctags !~ /^\d+$/) {
8025                         # without ability to add tags, don't show if there are none
8026                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
8027                         print "<tr id=\"metadata_ctags\">" .
8028                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
8029                         print "</td>\n<td>" unless %$ctags;
8030                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
8031                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
8032                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
8033                               unless $show_ctags =~ /^\d+$/;
8034                         print "</td>\n<td>" if %$ctags;
8035                         print git_show_project_tagcloud($cloud, 48)."</td>" .
8036                               "</tr>\n";
8037                 }
8038         }
8039
8040         print "</table>\n";
8041
8042         # If XSS prevention is on, we don't include README.html.
8043         # TODO: Allow a readme in some safe format.
8044         if (!$prevent_xss) {
8045                 my $readme_name = "readme";
8046                 my $readme;
8047                 if (-s "$projectroot/$project/README.html") {
8048                         $readme = collect_html_file("$projectroot/$project/README.html");
8049                 } else {
8050                         $readme = collect_output($git_automatic_readme_html, "$projectroot/$project");
8051                         if ($readme && $readme =~ /^<!-- README NAME: ((?:[^-]|(?:-(?!-)))+) -->/) {
8052                                 $readme_name = $1;
8053                                 $readme =~ s/^<!--(?:[^-]|(?:-(?!-)))*-->\n?//;
8054                         }
8055                 }
8056                 if (defined($readme)) {
8057                         $readme =~ s/^\s+//s;
8058                         $readme =~ s/\s+$//s;
8059                         print "<div class=\"title\">$readme_name</div>\n",
8060                               "<div id=\"readme\" class=\"readme\">\n",
8061                               $readme,
8062                               "\n</div>\n"
8063                         if $readme ne '';
8064                 }
8065         }
8066
8067         # we need to request one more than 16 (0..15) to check if
8068         # those 16 are all
8069         my @commitlist = $head ? parse_commits($head, 17) : ();
8070         if (@commitlist) {
8071                 git_print_header_div('shortlog');
8072                 git_shortlog_body(\@commitlist, 0, 15, $refs,
8073                                   $#commitlist <=  15 ? undef :
8074                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
8075         }
8076
8077         if (@taglist) {
8078                 git_print_header_div('tags');
8079                 git_tags_body(\@taglist, 0, 15,
8080                               $#taglist <=  15 ? undef :
8081                               $cgi->a({-href => href(action=>"tags")}, "..."));
8082         }
8083
8084         if (@headlist) {
8085                 git_print_header_div('heads');
8086                 git_heads_body(\@headlist, $head, 0, 15,
8087                                $#headlist <= 15 ? undef :
8088                                $cgi->a({-href => href(action=>"heads")}, "..."));
8089         }
8090
8091         if (%remotedata) {
8092                 git_print_header_div('remotes');
8093                 git_remotes_body(\%remotedata, 15, $head);
8094         }
8095
8096         if (@forklist) {
8097                 git_print_header_div('forks');
8098                 git_project_list_body(\@forklist, 'age', 0, 15,
8099                                       $#forklist <= 15 ? undef :
8100                                       $cgi->a({-href => href(action=>"forks")}, "..."),
8101                                       'no_header', 'forks');
8102         }
8103
8104         git_footer_html();
8105 }
8106
8107 sub git_tag {
8108         my %tag = parse_tag($hash);
8109
8110         if (! %tag) {
8111                 die_error(404, "Unknown tag object");
8112         }
8113
8114         my $fullhash;
8115         $fullhash = $hash if $hash =~ m/^[0-9a-fA-F]{40}$/;
8116         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8117
8118         my $obj = $tag{'object'};
8119         git_header_html();
8120         if ($tag{'type'} eq 'commit') {
8121                 git_print_page_nav('','', $obj,undef,$obj);
8122                 git_print_header_div('commit', esc_html($tag{'name'}), $hash);
8123         } else {
8124                 if ($tag{'type'} eq 'tree') {
8125                         git_print_page_nav('',['commit','commitdiff'], undef,undef,$obj);
8126                 } else {
8127                         git_print_page_nav('',['commit','commitdiff','tree'], undef,undef,undef);
8128                 }
8129                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8130         }
8131         print "<div class=\"title_text\">\n" .
8132               "<table class=\"object_header\">\n" .
8133               "<tr><td>tag</td><td class=\"sha1\">$fullhash</td></tr>\n" .
8134               "<tr>\n" .
8135               "<td>object</td>\n" .
8136               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
8137                                $tag{'object'}) . "</td>\n" .
8138               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
8139                                               $tag{'type'}) . "</td>\n" .
8140               "</tr>\n";
8141         if (defined($tag{'author'})) {
8142                 git_print_authorship_rows(\%tag, 'author');
8143         }
8144         print "</table>\n\n" .
8145               "</div>\n";
8146         print "<div class=\"page_body\">";
8147         my $comment = $tag{'comment'};
8148         foreach my $line (@$comment) {
8149                 chomp $line;
8150                 print esc_html($line, -nbsp=>1) . "<br/>\n";
8151         }
8152         print "</div>\n";
8153         git_footer_html();
8154 }
8155
8156 sub git_blame_common {
8157         my $format = shift || 'porcelain';
8158         if ($format eq 'porcelain' && $input_params{'javascript'}) {
8159                 $format = 'incremental';
8160                 $action = 'blame_incremental'; # for page title etc
8161         }
8162
8163         # permissions
8164         gitweb_check_feature('blame')
8165                 or die_error(403, "Blame view not allowed");
8166
8167         # error checking
8168         die_error(400, "No file name given") unless $file_name;
8169         $hash_base ||= git_get_head_hash($project);
8170         die_error(404, "Couldn't find base commit") unless $hash_base;
8171         my %co = parse_commit($hash_base)
8172                 or die_error(404, "Commit not found");
8173         my $ftype = "blob";
8174         if (!defined $hash) {
8175                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
8176                         or die_error(404, "Error looking up file");
8177         } else {
8178                 $ftype = git_get_type($hash);
8179                 if ($ftype !~ "blob") {
8180                         die_error(400, "Object is not a blob");
8181                 }
8182         }
8183
8184         my $fd;
8185         if ($format eq 'incremental') {
8186                 # get file contents (as base)
8187                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
8188                         or die_error(500, "Open git-cat-file failed");
8189         } elsif ($format eq 'data') {
8190                 # run git-blame --incremental
8191                 defined($fd = git_cmd_pipe "blame", "--incremental",
8192                         $hash_base, "--", $file_name)
8193                         or die_error(500, "Open git-blame --incremental failed");
8194         } else {
8195                 # run git-blame --porcelain
8196                 defined($fd = git_cmd_pipe "blame", '-p',
8197                         $hash_base, '--', $file_name)
8198                         or die_error(500, "Open git-blame --porcelain failed");
8199         }
8200
8201         # incremental blame data returns early
8202         if ($format eq 'data') {
8203                 print $cgi->header(
8204                         -type=>"text/plain", -charset => "utf-8",
8205                         -status=> "200 OK");
8206                 local $| = 1; # output autoflush
8207                 while (<$fd>) {
8208                         print to_utf8($_);
8209                 }
8210                 close $fd
8211                         or print "ERROR $!\n";
8212
8213                 print 'END';
8214                 if (defined $t0 && gitweb_check_feature('timed')) {
8215                         print ' '.
8216                               tv_interval($t0, [ gettimeofday() ]).
8217                               ' '.$number_of_git_cmds;
8218                 }
8219                 print "\n";
8220
8221                 return;
8222         }
8223
8224         # page header
8225         git_header_html();
8226         my $formats_nav = tabspan(
8227                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
8228                         "blob"));
8229         $formats_nav .=
8230                 $barsep . tabspan(
8231                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8232                         "history")) .
8233                 $barsep . tabspan(
8234                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
8235                         "HEAD"));
8236         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8237         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8238         git_print_page_path($file_name, $ftype, $hash_base);
8239
8240         # page body
8241         if ($format eq 'incremental') {
8242                 print "<noscript>\n<div class=\"error\"><center><b>\n".
8243                       "This page requires JavaScript to run.\n Use ".
8244                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
8245                               'this page').
8246                       " instead.\n".
8247                       "</b></center></div>\n</noscript>\n";
8248
8249                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
8250         }
8251
8252         print qq!<div class="page_body">\n!;
8253         print qq!<div id="progress_info">...&#160;/&#160;...</div>\n!
8254                 if ($format eq 'incremental');
8255         print qq!<table id="blame_table" class="blame" width="100%">\n!.
8256               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
8257               qq!<thead>\n!.
8258               qq!<tr><th nowrap="nowrap" style="white-space:nowrap">!.
8259               qq!Commit&#160;<a href="javascript:extra_blame_columns()" id="columns_expander" !.
8260               qq!title="toggles blame author information display">[+]</a></th>!.
8261               qq!<th class="extra_column">Author</th><th class="extra_column">Date</th>!.
8262               qq!<th>Line</th><th width="100%">Data</th></tr>\n!.
8263               qq!</thead>\n!.
8264               qq!<tbody>\n!;
8265
8266         my @rev_color = qw(light dark);
8267         my $num_colors = scalar(@rev_color);
8268         my $current_color = 0;
8269
8270         if ($format eq 'incremental') {
8271                 my $color_class = $rev_color[$current_color];
8272
8273                 #contents of a file
8274                 my $linenr = 0;
8275         LINE:
8276                 while (my $line = to_utf8(scalar <$fd>)) {
8277                         chomp $line;
8278                         $linenr++;
8279
8280                         print qq!<tr id="l$linenr" class="$color_class">!.
8281                               qq!<td class="sha1"><a href=""> </a></td>!.
8282                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8283                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8284                               qq!<td class="linenr">!.
8285                               qq!<a class="linenr" href="">$linenr</a></td>!;
8286                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
8287                         print qq!</tr>\n!;
8288                 }
8289
8290         } else { # porcelain, i.e. ordinary blame
8291                 my %metainfo = (); # saves information about commits
8292
8293                 # blame data
8294         LINE:
8295                 while (my $line = to_utf8(scalar <$fd>)) {
8296                         chomp $line;
8297                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
8298                         # no <lines in group> for subsequent lines in group of lines
8299                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
8300                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
8301                         if (!exists $metainfo{$full_rev}) {
8302                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
8303                         }
8304                         my $meta = $metainfo{$full_rev};
8305                         my $data;
8306                         while ($data = to_utf8(scalar <$fd>)) {
8307                                 chomp $data;
8308                                 last if ($data =~ s/^\t//); # contents of line
8309                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
8310                                         $meta->{$1} = $2 unless exists $meta->{$1};
8311                                 }
8312                                 if ($data =~ /^previous /) {
8313                                         $meta->{'nprevious'}++;
8314                                 }
8315                         }
8316                         my $short_rev = substr($full_rev, 0, 8);
8317                         my $author = $meta->{'author'};
8318                         my %date =
8319                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
8320                         my $date = $date{'iso-tz'};
8321                         if ($group_size) {
8322                                 $current_color = ($current_color + 1) % $num_colors;
8323                         }
8324                         my $tr_class = $rev_color[$current_color];
8325                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
8326                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
8327                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
8328                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
8329                         if ($group_size) {
8330                                 my $rowspan = $group_size > 1 ? " rowspan=\"$group_size\"" : "";
8331                                 print "<td class=\"sha1\"";
8332                                 print " title=\"". esc_html($author) . ", $date\"";
8333                                 print "$rowspan>";
8334                                 print $cgi->a({-href => href(action=>"commit",
8335                                                              hash=>$full_rev,
8336                                                              file_name=>$file_name)},
8337                                               esc_html($short_rev));
8338                                 if ($group_size >= 2) {
8339                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
8340                                         if (@author_initials) {
8341                                                 print "<br />" .
8342                                                       esc_html(join('', @author_initials));
8343                                                 #           or join('.', ...)
8344                                         }
8345                                 }
8346                                 print "</td>\n";
8347                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". esc_html($author) . "</td>";
8348                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". $date . "</td>";
8349                         }
8350                         # 'previous' <sha1 of parent commit> <filename at commit>
8351                         if (exists $meta->{'previous'} &&
8352                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
8353                                 $meta->{'parent'} = $1;
8354                                 $meta->{'file_parent'} = unquote($2);
8355                         }
8356                         my $linenr_commit =
8357                                 exists($meta->{'parent'}) ?
8358                                 $meta->{'parent'} : $full_rev;
8359                         my $linenr_filename =
8360                                 exists($meta->{'file_parent'}) ?
8361                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
8362                         my $blamed = href(action => 'blame',
8363                                           file_name => $linenr_filename,
8364                                           hash_base => $linenr_commit);
8365                         print "<td class=\"linenr\">";
8366                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
8367                                         -class => "linenr" },
8368                                       esc_html($lineno));
8369                         print "</td>";
8370                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
8371                         print "</tr>\n";
8372                 } # end while
8373
8374         }
8375
8376         # footer
8377         print "</tbody>\n".
8378               "</table>\n"; # class="blame"
8379         print "</div>\n";   # class="blame_body"
8380         close $fd
8381                 or print "Reading blob failed\n";
8382
8383         git_footer_html();
8384 }
8385
8386 sub git_blame {
8387         git_blame_common();
8388 }
8389
8390 sub git_blame_incremental {
8391         git_blame_common('incremental');
8392 }
8393
8394 sub git_blame_data {
8395         git_blame_common('data');
8396 }
8397
8398 sub git_tags {
8399         my $head = git_get_head_hash($project);
8400         git_header_html();
8401         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
8402         git_print_header_div('summary', $project);
8403
8404         my @tagslist = git_get_tags_list();
8405         if (@tagslist) {
8406                 git_tags_body(\@tagslist);
8407         }
8408         git_footer_html();
8409 }
8410
8411 sub git_refs {
8412         my $order = $input_params{'order'};
8413         if (defined $order && $order !~ m/age|name/) {
8414                 die_error(400, "Unknown order parameter");
8415         }
8416
8417         my $head = git_get_head_hash($project);
8418         git_header_html();
8419         git_print_page_nav('','', $head,undef,$head,format_ref_views('refs'));
8420         git_print_header_div('summary', $project);
8421
8422         my @refslist = git_get_tags_list(undef, 1, $order);
8423         if (@refslist) {
8424                 git_tags_body(\@refslist, undef, undef, undef, $head, 1, $order);
8425         }
8426         git_footer_html();
8427 }
8428
8429 sub git_heads {
8430         my $head = git_get_head_hash($project);
8431         git_header_html();
8432         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
8433         git_print_header_div('summary', $project);
8434
8435         my @headslist = git_get_heads_list();
8436         if (@headslist) {
8437                 git_heads_body(\@headslist, $head);
8438         }
8439         git_footer_html();
8440 }
8441
8442 # used both for single remote view and for list of all the remotes
8443 sub git_remotes {
8444         gitweb_check_feature('remote_heads')
8445                 or die_error(403, "Remote heads view is disabled");
8446
8447         my $head = git_get_head_hash($project);
8448         my $remote = $input_params{'hash'};
8449
8450         my $remotedata = git_get_remotes_list($remote);
8451         die_error(500, "Unable to get remote information") unless defined $remotedata;
8452
8453         unless (%$remotedata) {
8454                 die_error(404, defined $remote ?
8455                         "Remote $remote not found" :
8456                         "No remotes found");
8457         }
8458
8459         git_header_html(undef, undef, -action_extra => $remote);
8460         git_print_page_nav('', '',  $head, undef, $head,
8461                 format_ref_views($remote ? '' : 'remotes'));
8462
8463         fill_remote_heads($remotedata);
8464         if (defined $remote) {
8465                 git_print_header_div('remotes', "$remote remote for $project");
8466                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
8467         } else {
8468                 git_print_header_div('summary', "$project remotes");
8469                 git_remotes_body($remotedata, undef, $head);
8470         }
8471
8472         git_footer_html();
8473 }
8474
8475 sub git_blob_plain {
8476         my $type = shift;
8477         my $expires;
8478
8479         if (!defined $hash) {
8480                 if (defined $file_name) {
8481                         my $base = $hash_base || git_get_head_hash($project);
8482                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8483                                 or die_error(404, "Cannot find file");
8484                 } else {
8485                         die_error(400, "No file name defined");
8486                 }
8487         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8488                 # blobs defined by non-textual hash id's can be cached
8489                 $expires = "+1d";
8490         }
8491
8492         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8493                 or die_error(500, "Open git-cat-file blob '$hash' failed");
8494         binmode($fd);
8495
8496         # content-type (can include charset)
8497         my $leader;
8498         ($type, $leader) = blob_contenttype($fd, $file_name, $type);
8499
8500         # "save as" filename, even when no $file_name is given
8501         my $save_as = "$hash";
8502         if (defined $file_name) {
8503                 $save_as = $file_name;
8504         } elsif ($type =~ m/^text\//) {
8505                 $save_as .= '.txt';
8506         }
8507
8508         # With XSS prevention on, blobs of all types except a few known safe
8509         # ones are served with "Content-Disposition: attachment" to make sure
8510         # they don't run in our security domain.  For certain image types,
8511         # blob view writes an <img> tag referring to blob_plain view, and we
8512         # want to be sure not to break that by serving the image as an
8513         # attachment (though Firefox 3 doesn't seem to care).
8514         my $sandbox = $prevent_xss &&
8515                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
8516
8517         # serve text/* as text/plain
8518         if ($prevent_xss &&
8519             ($type =~ m!^text/[a-z]+\b(.*)$! ||
8520              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
8521                 my $rest = $1;
8522                 $rest = defined $rest ? $rest : '';
8523                 $type = "text/plain$rest";
8524         }
8525
8526         print $cgi->header(
8527                 -type => $type,
8528                 -expires => $expires,
8529                 -content_disposition =>
8530                         ($sandbox ? 'attachment' : 'inline')
8531                         . '; filename="' . $save_as . '"');
8532         binmode STDOUT, ':raw';
8533         $fcgi_raw_mode = 1;
8534         print $leader if defined $leader;
8535         my $buf;
8536         while (read($fd, $buf, 32768)) {
8537                 print $buf;
8538         }
8539         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8540         $fcgi_raw_mode = 0;
8541         close $fd;
8542 }
8543
8544 sub git_blob {
8545         my $expires;
8546
8547         if (!defined $hash) {
8548                 if (defined $file_name) {
8549                         my $base = $hash_base || git_get_head_hash($project);
8550                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8551                                 or die_error(404, "Cannot find file");
8552                 } else {
8553                         die_error(400, "No file name defined");
8554                 }
8555         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8556                 # blobs defined by non-textual hash id's can be cached
8557                 $expires = "+1d";
8558         }
8559         my $fullhash = git_get_full_hash($project, "$hash^{blob}");
8560         die_error(404, "No such blob") unless defined($fullhash);
8561
8562         my $have_blame = gitweb_check_feature('blame');
8563         defined(my $fd = git_cmd_pipe "cat-file", "blob", $fullhash)
8564                 or die_error(500, "Couldn't cat $file_name, $hash");
8565         binmode($fd);
8566         my $mimetype = blob_mimetype($fd, $file_name);
8567         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
8568         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
8569                 close $fd;
8570                 return git_blob_plain($mimetype);
8571         }
8572         # we can have blame only for text/* mimetype
8573         $have_blame &&= ($mimetype =~ m!^text/!);
8574
8575         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
8576         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
8577         my $highlight_mode_active;
8578         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
8579
8580         git_header_html(undef, $expires);
8581         my $formats_nav = '';
8582         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8583                 if (defined $file_name) {
8584                         if ($have_blame) {
8585                                 $formats_nav .= tabspan(
8586                                         $cgi->a({-href => href(action=>"blame", -replay=>1),
8587                                                 -class => "blamelink"},
8588                                                 "blame")) .
8589                                         $barsep;
8590                         }
8591                         $formats_nav .= tabspan(
8592                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8593                                         "history")) .
8594                                 $barsep . tabspan(
8595                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8596                                         "raw")) .
8597                                 $barsep . tabspan(
8598                                 $cgi->a({-href => href(action=>"blob",
8599                                                        hash_base=>"HEAD", file_name=>$file_name)},
8600                                         "HEAD"));
8601                 } else {
8602                         $formats_nav .= tabspan(
8603                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8604                                         "raw"));
8605                 }
8606                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8607                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8608         } else {
8609                 git_print_page_nav('',['commit','commitdiff','tree'], undef,undef,undef);
8610                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8611         }
8612         git_print_page_path($file_name, "blob", $hash_base);
8613         print "<div class=\"title_text\">\n" .
8614               "<table class=\"object_header\">\n";
8615         print "<tr><td>blob</td><td class=\"sha1\">$fullhash</td></tr>\n";
8616         print "</table>".
8617               "</div>\n";
8618         print "<div class=\"page_body\">\n";
8619         if ($mimetype =~ m!^image/!) {
8620                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
8621                 if ($file_name) {
8622                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
8623                 }
8624                 print qq! src="! .
8625                       href(action=>"blob_plain", hash=>$hash,
8626                            hash_base=>$hash_base, file_name=>$file_name) .
8627                       qq!" />\n!;
8628                 close $fd; # ignore likely EPIPE error from child
8629         } else {
8630                 my $nr;
8631                 while (my $line = to_utf8(scalar <$fd>)) {
8632                         chomp $line;
8633                         $nr++;
8634                         $line = untabify($line);
8635                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i </a>%s</div>\n!,
8636                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
8637                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
8638                 }
8639                 close $fd
8640                         or print "Reading blob failed.\n";
8641         }
8642         print "</div>";
8643         git_footer_html();
8644 }
8645
8646 sub git_tree {
8647         if (!defined $hash_base) {
8648                 $hash_base = "HEAD";
8649         }
8650         if (!defined $hash) {
8651                 if (defined $file_name) {
8652                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
8653                 } else {
8654                         $hash = $hash_base;
8655                 }
8656         }
8657         die_error(404, "No such tree") unless defined($hash);
8658         my $fullhash = git_get_full_hash($project, "$hash^{tree}");
8659         die_error(404, "No such tree") unless defined($fullhash);
8660
8661         my $show_sizes = gitweb_check_feature('show-sizes');
8662         my $have_blame = gitweb_check_feature('blame');
8663
8664         my @entries = ();
8665         {
8666                 local $/ = "\0";
8667                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
8668                         ($show_sizes ? '-l' : ()), @extra_options, $fullhash)
8669                         or die_error(500, "Open git-ls-tree failed");
8670                 @entries = map { chomp; to_utf8($_) } <$fd>;
8671                 close $fd
8672                         or die_error(404, "Reading tree failed");
8673         }
8674
8675         git_header_html();
8676         my $basedir = '';
8677         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8678                 my $refs = git_get_references();
8679                 my $ref = format_ref_marker($refs, $co{'id'});
8680                 my @views_nav = ();
8681                 if (defined $file_name) {
8682                         push @views_nav,
8683                                 tabspan($cgi->a({-href => href(action=>"history", -replay=>1)},
8684                                                 "history")),
8685                                 tabspan($cgi->a({-href => href(action=>"tree",
8686                                                                hash_base=>"HEAD", file_name=>$file_name)},
8687                                                  "HEAD")),
8688                 }
8689                 my $snapshot_links = format_snapshot_links($hash);
8690                 if (defined $snapshot_links) {
8691                         # FIXME: Should be available when we have no hash base as well.
8692                         push @views_nav, $snapshot_links;
8693                 }
8694                 git_print_page_nav('tree','', $hash_base, undef, undef,
8695                                    join($barsep, @views_nav));
8696                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base, undef, $ref);
8697         } else {
8698                 git_print_page_nav('tree',['commit','commitdiff'], undef,undef,$hash_base);
8699                 undef $hash_base;
8700                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8701         }
8702         if (defined $file_name) {
8703                 $basedir = $file_name;
8704                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
8705                         $basedir .= '/';
8706                 }
8707                 git_print_page_path($file_name, 'tree', $hash_base);
8708         }
8709         print "<div class=\"title_text\">\n" .
8710               "<table class=\"object_header\">\n";
8711         print "<tr><td>tree</td><td class=\"sha1\">$fullhash</td></tr>\n";
8712         print "</table>".
8713               "</div>\n";
8714         print "<div class=\"page_body\">\n";
8715         print "<table class=\"tree\">\n";
8716         my $alternate = 1;
8717         # '..' (top directory) link if possible
8718         if (defined $hash_base &&
8719             defined $file_name && $file_name =~ m![^/]+$!) {
8720                 if ($alternate) {
8721                         print "<tr class=\"dark\">\n";
8722                 } else {
8723                         print "<tr class=\"light\">\n";
8724                 }
8725                 $alternate ^= 1;
8726
8727                 my $up = $file_name;
8728                 $up =~ s!/?[^/]+$!!;
8729                 undef $up unless $up;
8730                 # based on git_print_tree_entry
8731                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
8732                 print '<td class="size">&#160;</td>'."\n" if $show_sizes;
8733                 print '<td class="list">';
8734                 print $cgi->a({-href => href(action=>"tree",
8735                                              hash_base=>$hash_base,
8736                                              file_name=>$up)},
8737                               "..");
8738                 print "</td>\n";
8739                 print "<td class=\"link\"></td>\n";
8740
8741                 print "</tr>\n";
8742         }
8743         foreach my $line (@entries) {
8744                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
8745
8746                 if ($alternate) {
8747                         print "<tr class=\"dark\">\n";
8748                 } else {
8749                         print "<tr class=\"light\">\n";
8750                 }
8751                 $alternate ^= 1;
8752
8753                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
8754
8755                 print "</tr>\n";
8756         }
8757         print "</table>\n" .
8758               "</div>";
8759         git_footer_html();
8760 }
8761
8762 sub sanitize_for_filename {
8763     my $name = shift;
8764
8765     $name =~ s!/!-!g;
8766     $name =~ s/[^[:alnum:]_.-]//g;
8767
8768     return $name;
8769 }
8770
8771 sub snapshot_name {
8772         my ($project, $hash) = @_;
8773
8774         # path/to/project.git  -> project
8775         # path/to/project/.git -> project
8776         my $name = to_utf8($project);
8777         $name =~ s,([^/])/*\.git$,$1,;
8778         $name = sanitize_for_filename(basename($name));
8779
8780         my $ver = $hash;
8781         if ($hash =~ /^[0-9a-fA-F]+$/) {
8782                 # shorten SHA-1 hash
8783                 my $full_hash = git_get_full_hash($project, $hash);
8784                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
8785                         $ver = git_get_short_hash($project, $hash);
8786                 }
8787         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
8788                 # tags don't need shortened SHA-1 hash
8789                 $ver = $1;
8790         } else {
8791                 # branches and other need shortened SHA-1 hash
8792                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
8793                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
8794                         my $ref_dir = (defined $1) ? $1 : '';
8795                         $ver = $2;
8796
8797                         $ref_dir = sanitize_for_filename($ref_dir);
8798                         # for refs neither in heads nor remotes we want to
8799                         # add a ref dir to archive name
8800                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
8801                                 $ver = $ref_dir . '-' . $ver;
8802                         }
8803                 }
8804                 $ver .= '-' . git_get_short_hash($project, $hash);
8805         }
8806         # special case of sanitization for filename - we change
8807         # slashes to dots instead of dashes
8808         # in case of hierarchical branch names
8809         $ver =~ s!/!.!g;
8810         $ver =~ s/[^[:alnum:]_.-]//g;
8811
8812         # name = project-version_string
8813         $name = "$name-$ver";
8814
8815         return wantarray ? ($name, $name) : $name;
8816 }
8817
8818 sub exit_if_unmodified_since {
8819         my ($latest_epoch) = @_;
8820         our $cgi;
8821
8822         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
8823         if (defined $if_modified) {
8824                 my $since;
8825                 if (eval { require HTTP::Date; 1; }) {
8826                         $since = HTTP::Date::str2time($if_modified);
8827                 } elsif (eval { require Time::ParseDate; 1; }) {
8828                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
8829                 }
8830                 if (defined $since && $latest_epoch <= $since) {
8831                         my %latest_date = parse_date($latest_epoch);
8832                         print $cgi->header(
8833                                 -last_modified => $latest_date{'rfc2822'},
8834                                 -status => '304 Not Modified');
8835                         CORE::die;
8836                 }
8837         }
8838 }
8839
8840 sub git_snapshot {
8841         my $format = $input_params{'snapshot_format'};
8842         if (!@snapshot_fmts) {
8843                 die_error(403, "Snapshots not allowed");
8844         }
8845         # default to first supported snapshot format
8846         $format ||= $snapshot_fmts[0];
8847         if ($format !~ m/^[a-z0-9]+$/) {
8848                 die_error(400, "Invalid snapshot format parameter");
8849         } elsif (!exists($known_snapshot_formats{$format})) {
8850                 die_error(400, "Unknown snapshot format");
8851         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
8852                 die_error(403, "Snapshot format not allowed");
8853         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
8854                 die_error(403, "Unsupported snapshot format");
8855         }
8856
8857         my $type = git_get_type("$hash^{}");
8858         if (!$type) {
8859                 die_error(404, 'Object does not exist');
8860         }  elsif ($type eq 'blob') {
8861                 die_error(400, 'Object is not a tree-ish');
8862         }
8863
8864         my ($name, $prefix) = snapshot_name($project, $hash);
8865         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
8866
8867         my %co = parse_commit($hash);
8868         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
8869
8870         my @cmd = (
8871                 git_cmd(), 'archive',
8872                 "--format=$known_snapshot_formats{$format}{'format'}",
8873                 "--prefix=$prefix/", $hash);
8874         if (exists $known_snapshot_formats{$format}{'compressor'}) {
8875                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
8876                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
8877         }
8878
8879         $filename =~ s/(["\\])/\\$1/g;
8880         my %latest_date;
8881         if (%co) {
8882                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
8883         }
8884
8885         print $cgi->header(
8886                 -type => $known_snapshot_formats{$format}{'type'},
8887                 -content_disposition => 'inline; filename="' . $filename . '"',
8888                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8889                 -status => '200 OK');
8890
8891         defined(my $fd = cmd_pipe @cmd)
8892                 or die_error(500, "Execute git-archive failed");
8893         binmode($fd);
8894         binmode STDOUT, ':raw';
8895         $fcgi_raw_mode = 1;
8896         my $buf;
8897         while (read($fd, $buf, 32768)) {
8898                 print $buf;
8899         }
8900         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8901         $fcgi_raw_mode = 0;
8902         close $fd;
8903 }
8904
8905 sub git_log_generic {
8906         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8907
8908         my $head = git_get_head_hash($project);
8909         if (!defined $base) {
8910                 $base = $head;
8911         }
8912         if (!defined $page) {
8913                 $page = 0;
8914         }
8915         my $refs = git_get_references();
8916
8917         my $commit_hash = $base;
8918         if (defined $parent) {
8919                 $commit_hash = "$parent..$base";
8920         }
8921         my @commitlist =
8922                 parse_commits($commit_hash, 101, (100 * $page),
8923                               defined $file_name ? ($file_name, "--full-history") : ());
8924
8925         my $ftype;
8926         if (!defined $file_hash && defined $file_name) {
8927                 # some commits could have deleted file in question,
8928                 # and not have it in tree, but one of them has to have it
8929                 for (my $i = 0; $i < @commitlist; $i++) {
8930                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8931                         last if defined $file_hash;
8932                 }
8933         }
8934         if (defined $file_hash) {
8935                 $ftype = git_get_type($file_hash);
8936         }
8937         if (defined $file_name && !defined $ftype) {
8938                 die_error(500, "Unknown type of object");
8939         }
8940         my %co;
8941         if (defined $file_name) {
8942                 %co = parse_commit($base)
8943                         or die_error(404, "Unknown commit object");
8944         }
8945
8946
8947         my $next_link = '';
8948         if ($#commitlist >= 100) {
8949                 $next_link =
8950                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8951                                  -accesskey => "n", -title => "Alt-n"}, "next");
8952         }
8953         my $extra = '';
8954         my ($patch_max) = gitweb_get_feature('patches');
8955         if ($patch_max && !defined $file_name) {
8956                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8957                         $extra = $cgi->a({-href => href(action=>"patches", -replay=>1)},
8958                                         "patches");
8959                 }
8960         }
8961         my $paging_nav = format_log_nav($fmt_name, $page, $#commitlist >= 100, $extra);
8962
8963         {
8964                 local $action = 'log';
8965                 git_header_html();
8966         }
8967         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8968         if (defined $file_name) {
8969                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8970         } else {
8971                 git_print_header_div('summary', $project)
8972         }
8973         git_print_page_path($file_name, $ftype, $hash_base)
8974                 if (defined $file_name);
8975
8976         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8977                      $file_name, $file_hash, $ftype);
8978
8979         git_footer_html();
8980 }
8981
8982 sub git_log {
8983         git_log_generic('log', \&git_log_body,
8984                         $hash, $hash_parent);
8985 }
8986
8987 sub git_commit {
8988         $hash ||= $hash_base || "HEAD";
8989         my %co = parse_commit($hash)
8990             or die_error(404, "Unknown commit object");
8991
8992         my $parent  = $co{'parent'};
8993         my $parents = $co{'parents'}; # listref
8994
8995         # we need to prepare $formats_nav before any parameter munging
8996         my $formats_nav;
8997         if (!defined $parent) {
8998                 # --root commitdiff
8999                 $formats_nav .= '<span class="parents none">(initial)</span>';
9000         } elsif (@$parents == 1) {
9001                 # single parent commit
9002                 $formats_nav .=
9003                         '<span class="parents single">(parent:&#160;' .
9004                         $cgi->a({-href => href(action=>"commit",
9005                                                hash=>$parent)},
9006                                 esc_html(substr($parent, 0, 7))) .
9007                         ')</span>';
9008         } else {
9009                 # merge commit
9010                 $formats_nav .=
9011                         '<span class="parents multiple">(merge:&#160;' .
9012                         join(' ', map {
9013                                 $cgi->a({-href => href(action=>"commit",
9014                                                        hash=>$_)},
9015                                         esc_html(substr($_, 0, 7)));
9016                         } @$parents ) .
9017                         ')</span>';
9018         }
9019         if (gitweb_check_feature('patches') && @$parents <= 1) {
9020                 $formats_nav .= $barsep . tabspan(
9021                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
9022                                 "patch"));
9023         }
9024
9025         if (!defined $parent) {
9026                 $parent = "--root";
9027         }
9028         my @difftree;
9029         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
9030                 @diff_opts,
9031                 (@$parents <= 1 ? $parent : '-c'),
9032                 $hash, "--")
9033                 or die_error(500, "Open git-diff-tree failed");
9034         @difftree = map { chomp; to_utf8($_) } <$fd>;
9035         close $fd or die_error(404, "Reading git-diff-tree failed");
9036
9037         # non-textual hash id's can be cached
9038         my $expires;
9039         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9040                 $expires = "+1d";
9041         }
9042         my $refs = git_get_references();
9043         my $ref = format_ref_marker($refs, $co{'id'});
9044
9045         git_header_html(undef, $expires);
9046         git_print_page_nav('commit', '',
9047                            $hash, $co{'tree'}, $hash,
9048                            $formats_nav);
9049
9050         if (defined $co{'parent'}) {
9051                 git_print_header_div('commitdiff', esc_html($co{'title'}), $hash, undef, $ref);
9052         } else {
9053                 git_print_header_div('tree', esc_html($co{'title'}), $co{'tree'}, $hash, $ref);
9054         }
9055         print "<div class=\"title_text\">\n" .
9056               "<table class=\"object_header\">\n";
9057         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
9058         git_print_authorship_rows(\%co);
9059         print "<tr>" .
9060               "<td>tree</td>" .
9061               "<td class=\"sha1\">" .
9062               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
9063                        class => "list"}, $co{'tree'}) .
9064               "</td>" .
9065               "<td class=\"link\">" .
9066               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
9067                       "tree");
9068         my $snapshot_links = format_snapshot_links($hash);
9069         if (defined $snapshot_links) {
9070                 print $barsep . $snapshot_links;
9071         }
9072         print "</td>" .
9073               "</tr>\n";
9074
9075         foreach my $par (@$parents) {
9076                 print "<tr>" .
9077                       "<td>parent</td>" .
9078                       "<td class=\"sha1\">" .
9079                       $cgi->a({-href => href(action=>"commit", hash=>$par),
9080                                class => "list"}, $par) .
9081                       "</td>" .
9082                       "<td class=\"link\">" .
9083                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
9084                       $barsep .
9085                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
9086                       "</td>" .
9087                       "</tr>\n";
9088         }
9089         print "</table>".
9090               "</div>\n";
9091
9092         print "<div class=\"page_body\">\n";
9093         git_print_log($co{'comment'});
9094         print "</div>\n";
9095
9096         git_difftree_body(\@difftree, $hash, @$parents);
9097
9098         git_footer_html();
9099 }
9100
9101 sub git_object {
9102         # object is defined by:
9103         # - hash or hash_base alone
9104         # - hash_base and file_name
9105         my $type;
9106
9107         # - hash or hash_base alone
9108         if ($hash || ($hash_base && !defined $file_name)) {
9109                 my $object_id = $hash || $hash_base;
9110
9111                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
9112                         or die_error(404, "Object does not exist");
9113                 $type = <$fd>;
9114                 defined $type && chomp $type;
9115                 close $fd
9116                         or die_error(404, "Object does not exist");
9117
9118         # - hash_base and file_name
9119         } elsif ($hash_base && defined $file_name) {
9120                 $file_name =~ s,/+$,,;
9121
9122                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
9123                         or die_error(404, "Base object does not exist");
9124
9125                 # here errors should not happen
9126                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
9127                         or die_error(500, "Open git-ls-tree failed");
9128                 my $line = to_utf8(scalar <$fd>);
9129                 close $fd;
9130
9131                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
9132                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
9133                         die_error(404, "File or directory for given base does not exist");
9134                 }
9135                 $type = $2;
9136                 $hash = $3;
9137         } else {
9138                 die_error(400, "Not enough information to find object");
9139         }
9140
9141         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
9142                                           hash=>$hash, hash_base=>$hash_base,
9143                                           file_name=>$file_name),
9144                              -status => '302 Found');
9145 }
9146
9147 sub git_blobdiff {
9148         my $format = shift || 'html';
9149         my $diff_style = $input_params{'diff_style'} || 'inline';
9150
9151         my $fd;
9152         my @difftree;
9153         my %diffinfo;
9154         my $expires;
9155
9156         # preparing $fd and %diffinfo for git_patchset_body
9157         # new style URI
9158         if (defined $hash_base && defined $hash_parent_base) {
9159                 if (defined $file_name) {
9160                         # read raw output
9161                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9162                                 $hash_parent_base, $hash_base,
9163                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
9164                                 or die_error(500, "Open git-diff-tree failed");
9165                         @difftree = map { chomp; to_utf8($_) } <$fd>;
9166                         close $fd
9167                                 or die_error(404, "Reading git-diff-tree failed");
9168                         @difftree
9169                                 or die_error(404, "Blob diff not found");
9170
9171                 } elsif (defined $hash &&
9172                          $hash =~ /[0-9a-fA-F]{40}/) {
9173                         # try to find filename from $hash
9174
9175                         # read filtered raw output
9176                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9177                                 $hash_parent_base, $hash_base, "--")
9178                                 or die_error(500, "Open git-diff-tree failed");
9179                         @difftree =
9180                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
9181                                 # $hash == to_id
9182                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
9183                                 map { chomp; to_utf8($_) } <$fd>;
9184                         close $fd
9185                                 or die_error(404, "Reading git-diff-tree failed");
9186                         @difftree
9187                                 or die_error(404, "Blob diff not found");
9188
9189                 } else {
9190                         die_error(400, "Missing one of the blob diff parameters");
9191                 }
9192
9193                 if (@difftree > 1) {
9194                         die_error(400, "Ambiguous blob diff specification");
9195                 }
9196
9197                 %diffinfo = parse_difftree_raw_line($difftree[0]);
9198                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
9199                 $file_name   ||= $diffinfo{'to_file'};
9200
9201                 $hash_parent ||= $diffinfo{'from_id'};
9202                 $hash        ||= $diffinfo{'to_id'};
9203
9204                 # non-textual hash id's can be cached
9205                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
9206                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
9207                         $expires = '+1d';
9208                 }
9209
9210                 # open patch output
9211                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9212                         '-p', ($format eq 'html' ? "--full-index" : ()),
9213                         $hash_parent_base, $hash_base,
9214                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
9215                         or die_error(500, "Open git-diff-tree failed");
9216         }
9217
9218         # old/legacy style URI -- not generated anymore since 1.4.3.
9219         if (!%diffinfo) {
9220                 die_error('404 Not Found', "Missing one of the blob diff parameters")
9221         }
9222
9223         # header
9224         if ($format eq 'html') {
9225                 my $formats_nav =
9226                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
9227                                 "raw");
9228                 $formats_nav .= diff_style_nav($diff_style);
9229                 git_header_html(undef, $expires);
9230                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
9231                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
9232                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
9233                 } else {
9234                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
9235                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
9236                 }
9237                 if (defined $file_name) {
9238                         git_print_page_path($file_name, "blob", $hash_base);
9239                 } else {
9240                         print "<div class=\"page_path\"></div>\n";
9241                 }
9242
9243         } elsif ($format eq 'plain') {
9244                 print $cgi->header(
9245                         -type => 'text/plain',
9246                         -charset => 'utf-8',
9247                         -expires => $expires,
9248                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
9249
9250                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9251
9252         } else {
9253                 die_error(400, "Unknown blobdiff format");
9254         }
9255
9256         # patch
9257         if ($format eq 'html') {
9258                 print "<div class=\"page_body\">\n";
9259
9260                 git_patchset_body($fd, $diff_style,
9261                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
9262                 close $fd;
9263
9264                 print "</div>\n"; # class="page_body"
9265                 git_footer_html();
9266
9267         } else {
9268                 while (my $line = to_utf8(scalar <$fd>)) {
9269                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
9270                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
9271
9272                         print $line;
9273
9274                         last if $line =~ m!^\+\+\+!;
9275                 }
9276                 while (<$fd>) {
9277                         print to_utf8($_);
9278                 }
9279                 close $fd;
9280         }
9281 }
9282
9283 sub git_blobdiff_plain {
9284         git_blobdiff('plain');
9285 }
9286
9287 # assumes that it is added as later part of already existing navigation,
9288 # so it returns "| foo | bar" rather than just "foo | bar"
9289 sub diff_style_nav {
9290         my ($diff_style, $is_combined) = @_;
9291         $diff_style ||= 'inline';
9292
9293         return "" if ($is_combined);
9294
9295         my @styles = (inline => 'inline', 'sidebyside' => 'side&#160;by&#160;side');
9296         my %styles = @styles;
9297         @styles =
9298                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
9299
9300         return $barsep . '<span class="diffstyles">' . join($barsep,
9301                 map {
9302                         $_ eq $diff_style ?
9303                         '<span class="diffstyle selected">' . $styles{$_} . '</span>' :
9304                         '<span class="diffstyle">' .
9305                                 $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_}) .
9306                                 '</span>'
9307                 } @styles) . '</span>';
9308 }
9309
9310 sub git_commitdiff {
9311         my %params = @_;
9312         my $format = $params{-format} || 'html';
9313         my $diff_style = $input_params{'diff_style'} || 'inline';
9314
9315         my ($patch_max) = gitweb_get_feature('patches');
9316         if ($format eq 'patch') {
9317                 die_error(403, "Patch view not allowed") unless $patch_max;
9318         }
9319
9320         $hash ||= $hash_base || "HEAD";
9321         my %co = parse_commit($hash)
9322             or die_error(404, "Unknown commit object");
9323
9324         # choose format for commitdiff for merge
9325         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
9326                 $hash_parent = '--cc';
9327         }
9328         # we need to prepare $formats_nav before almost any parameter munging
9329         my $formats_nav;
9330         if ($format eq 'html') {
9331                 $formats_nav = tabspan(
9332                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
9333                                 "raw"));
9334                 if ($patch_max && @{$co{'parents'}} <= 1) {
9335                         $formats_nav .= $barsep . tabspan(
9336                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
9337                                         "patch"));
9338                 }
9339                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
9340
9341                 if (defined $hash_parent &&
9342                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
9343                         # commitdiff with two commits given
9344                         my $hash_parent_short = $hash_parent;
9345                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
9346                                 $hash_parent_short = substr($hash_parent, 0, 7);
9347                         }
9348                         $formats_nav .= $spcsep . '<span class="parents multiple">' .
9349                                 '(from';
9350                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
9351                                 if ($co{'parents'}[$i] eq $hash_parent) {
9352                                         $formats_nav .= '&#160;parent&#160;' . ($i+1);
9353                                         last;
9354                                 }
9355                         }
9356                         $formats_nav .= ':&#160;' .
9357                                 $cgi->a({-href => href(-replay=>1,
9358                                                        hash=>$hash_parent, hash_base=>undef)},
9359                                         esc_html($hash_parent_short)) .
9360                                 ')</span>';
9361                 } elsif (!$co{'parent'}) {
9362                         # --root commitdiff
9363                         $formats_nav .= $spcsep . '<span class="parents none">(initial)</span>';
9364                 } elsif (scalar @{$co{'parents'}} == 1) {
9365                         # single parent commit
9366                         $formats_nav .= $spcsep .
9367                                 '<span class="parents single">(parent:&#160;' .
9368                                 $cgi->a({-href => href(-replay=>1,
9369                                                        hash=>$co{'parent'}, hash_base=>undef)},
9370                                         esc_html(substr($co{'parent'}, 0, 7))) .
9371                                 ')</span>';
9372                 } else {
9373                         # merge commit
9374                         if ($hash_parent eq '--cc') {
9375                                 $formats_nav .= $barsep . tabspan(
9376                                         $cgi->a({-href => href(-replay=>1,
9377                                                                hash=>$hash, hash_parent=>'-c')},
9378                                                 'combined'));
9379                         } else { # $hash_parent eq '-c'
9380                                 $formats_nav .= $barsep . tabspan(
9381                                         $cgi->a({-href => href(-replay=>1,
9382                                                                hash=>$hash, hash_parent=>'--cc')},
9383                                                 'compact'));
9384                         }
9385                         $formats_nav .= $spcsep .
9386                                 '<span class="parents multiple">(merge:&#160;' .
9387                                 join(' ', map {
9388                                         $cgi->a({-href => href(-replay=>1,
9389                                                                hash=>$_, hash_base=>undef)},
9390                                                 esc_html(substr($_, 0, 7)));
9391                                 } @{$co{'parents'}} ) .
9392                                 ')</span>';
9393                 }
9394         }
9395
9396         my $hash_parent_param = $hash_parent;
9397         if (!defined $hash_parent_param) {
9398                 # --cc for multiple parents, --root for parentless
9399                 $hash_parent_param =
9400                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
9401         }
9402
9403         # read commitdiff
9404         my $fd;
9405         my @difftree;
9406         if ($format eq 'html') {
9407                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9408                         "--no-commit-id", "--patch-with-raw", "--full-index",
9409                         $hash_parent_param, $hash, "--")
9410                         or die_error(500, "Open git-diff-tree failed");
9411
9412                 while (my $line = to_utf8(scalar <$fd>)) {
9413                         chomp $line;
9414                         # empty line ends raw part of diff-tree output
9415                         last unless $line;
9416                         push @difftree, scalar parse_difftree_raw_line($line);
9417                 }
9418
9419         } elsif ($format eq 'plain') {
9420                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9421                         '-p', $hash_parent_param, $hash, "--")
9422                         or die_error(500, "Open git-diff-tree failed");
9423         } elsif ($format eq 'patch') {
9424                 # For commit ranges, we limit the output to the number of
9425                 # patches specified in the 'patches' feature.
9426                 # For single commits, we limit the output to a single patch,
9427                 # diverging from the git-format-patch default.
9428                 my @commit_spec = ();
9429                 if ($hash_parent) {
9430                         if ($patch_max > 0) {
9431                                 push @commit_spec, "-$patch_max";
9432                         }
9433                         push @commit_spec, '-n', "$hash_parent..$hash";
9434                 } else {
9435                         if ($params{-single}) {
9436                                 push @commit_spec, '-1';
9437                         } else {
9438                                 if ($patch_max > 0) {
9439                                         push @commit_spec, "-$patch_max";
9440                                 }
9441                                 push @commit_spec, "-n";
9442                         }
9443                         push @commit_spec, '--root', $hash;
9444                 }
9445                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
9446                         '--encoding=utf8', '--stdout', @commit_spec)
9447                         or die_error(500, "Open git-format-patch failed");
9448         } else {
9449                 die_error(400, "Unknown commitdiff format");
9450         }
9451
9452         # non-textual hash id's can be cached
9453         my $expires;
9454         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9455                 $expires = "+1d";
9456         }
9457
9458         # write commit message
9459         if ($format eq 'html') {
9460                 my $refs = git_get_references();
9461                 my $ref = format_ref_marker($refs, $co{'id'});
9462
9463                 git_header_html(undef, $expires);
9464                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
9465                 git_print_header_div('commit', esc_html($co{'title'}), $hash, undef, $ref);
9466                 print "<div class=\"title_text\">\n" .
9467                       "<table class=\"object_header\">\n";
9468                 git_print_authorship_rows(\%co);
9469                 print "</table>".
9470                       "</div>\n";
9471                 print "<div class=\"page_body\">\n";
9472                 if (@{$co{'comment'}} > 1) {
9473                         print "<div class=\"log\">\n";
9474                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
9475                         print "</div>\n"; # class="log"
9476                 }
9477
9478         } elsif ($format eq 'plain') {
9479                 my $refs = git_get_references("tags");
9480                 my $tagname = git_get_rev_name_tags($hash);
9481                 my $filename = basename($project) . "-$hash.patch";
9482
9483                 print $cgi->header(
9484                         -type => 'text/plain',
9485                         -charset => 'utf-8',
9486                         -expires => $expires,
9487                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9488                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
9489                 print "From: " . to_utf8($co{'author'}) . "\n";
9490                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
9491                 print "Subject: " . to_utf8($co{'title'}) . "\n";
9492
9493                 print "X-Git-Tag: $tagname\n" if $tagname;
9494                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9495
9496                 foreach my $line (@{$co{'comment'}}) {
9497                         print to_utf8($line) . "\n";
9498                 }
9499                 print "---\n\n";
9500         } elsif ($format eq 'patch') {
9501                 my $filename = basename($project) . "-$hash.patch";
9502
9503                 print $cgi->header(
9504                         -type => 'text/plain',
9505                         -charset => 'utf-8',
9506                         -expires => $expires,
9507                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9508         }
9509
9510         # write patch
9511         if ($format eq 'html') {
9512                 my $use_parents = !defined $hash_parent ||
9513                         $hash_parent eq '-c' || $hash_parent eq '--cc';
9514                 git_difftree_body(\@difftree, $hash,
9515                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9516                 print "<br/>\n";
9517
9518                 git_patchset_body($fd, $diff_style,
9519                                   \@difftree, $hash,
9520                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9521                 close $fd;
9522                 print "</div>\n"; # class="page_body"
9523                 git_footer_html();
9524
9525         } elsif ($format eq 'plain') {
9526                 while (<$fd>) {
9527                         print to_utf8($_);
9528                 }
9529                 close $fd
9530                         or print "Reading git-diff-tree failed\n";
9531         } elsif ($format eq 'patch') {
9532                 while (<$fd>) {
9533                         print to_utf8($_);
9534                 }
9535                 close $fd
9536                         or print "Reading git-format-patch failed\n";
9537         }
9538 }
9539
9540 sub git_commitdiff_plain {
9541         git_commitdiff(-format => 'plain');
9542 }
9543
9544 # format-patch-style patches
9545 sub git_patch {
9546         git_commitdiff(-format => 'patch', -single => 1);
9547 }
9548
9549 sub git_patches {
9550         git_commitdiff(-format => 'patch');
9551 }
9552
9553 sub git_history {
9554         git_log_generic('history', \&git_history_body,
9555                         $hash_base, $hash_parent_base,
9556                         $file_name, $hash);
9557 }
9558
9559 sub git_search {
9560         $searchtype ||= 'commit';
9561
9562         # check if appropriate features are enabled
9563         gitweb_check_feature('search')
9564                 or die_error(403, "Search is disabled");
9565         if ($searchtype eq 'pickaxe') {
9566                 # pickaxe may take all resources of your box and run for several minutes
9567                 # with every query - so decide by yourself how public you make this feature
9568                 gitweb_check_feature('pickaxe')
9569                         or die_error(403, "Pickaxe search is disabled");
9570         }
9571         if ($searchtype eq 'grep') {
9572                 # grep search might be potentially CPU-intensive, too
9573                 gitweb_check_feature('grep')
9574                         or die_error(403, "Grep search is disabled");
9575         }
9576         if ($search_use_regexp) {
9577                 # regular expression search can be disabled to avoid potentially
9578                 # malicious regular expressions
9579                 gitweb_check_feature('regexp')
9580                         or die_error(403, "Regular expression search is disabled");
9581         }
9582
9583         if (!defined $searchtext) {
9584                 die_error(400, "Text field is empty");
9585         }
9586         if (!defined $hash) {
9587                 $hash = git_get_head_hash($project);
9588         }
9589         my %co = parse_commit($hash);
9590         if (!%co) {
9591                 die_error(404, "Unknown commit object");
9592         }
9593         if (!defined $page) {
9594                 $page = 0;
9595         }
9596
9597         if ($searchtype eq 'commit' ||
9598             $searchtype eq 'author' ||
9599             $searchtype eq 'committer') {
9600                 git_search_message(%co);
9601         } elsif ($searchtype eq 'pickaxe') {
9602                 git_search_changes(%co);
9603         } elsif ($searchtype eq 'grep') {
9604                 git_search_files(%co);
9605         } else {
9606                 die_error(400, "Unknown search type");
9607         }
9608 }
9609
9610 sub git_search_help {
9611         git_header_html();
9612         git_print_page_nav('','', $hash,$hash,$hash);
9613         print <<EOT;
9614 <div class="search_help">
9615 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
9616 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
9617 the pattern entered is recognized as the POSIX extended
9618 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
9619 insensitive).</p>
9620 <dl>
9621 <dt><b>commit</b></dt>
9622 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
9623 EOT
9624         my $have_grep = gitweb_check_feature('grep');
9625         if ($have_grep) {
9626                 print <<EOT;
9627 <dt><b>grep</b></dt>
9628 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
9629     a different one) are searched for the given pattern. On large trees, this search can take
9630 a while and put some strain on the server, so please use it with some consideration. Note that
9631 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
9632 case-sensitive.</dd>
9633 EOT
9634         }
9635         print <<EOT;
9636 <dt><b>author</b></dt>
9637 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
9638 <dt><b>committer</b></dt>
9639 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
9640 EOT
9641         my $have_pickaxe = gitweb_check_feature('pickaxe');
9642         if ($have_pickaxe) {
9643                 print <<EOT;
9644 <dt><b>pickaxe</b></dt>
9645 <dd>All commits that caused the string to appear or disappear from any file (changes that
9646 added, removed or "modified" the string) will be listed. This search can take a while and
9647 takes a lot of strain on the server, so please use it wisely. Note that since you may be
9648 interested even in changes just changing the case as well, this search is case sensitive.</dd>
9649 EOT
9650         }
9651         print "</dl>\n</div>\n";
9652         git_footer_html();
9653 }
9654
9655 sub git_shortlog {
9656         git_log_generic('shortlog', \&git_shortlog_body,
9657                         $hash, $hash_parent);
9658 }
9659
9660 ## ......................................................................
9661 ## feeds (RSS, Atom; OPML)
9662
9663 sub git_feed {
9664         my $format = shift || 'atom';
9665         my $have_blame = gitweb_check_feature('blame');
9666
9667         # Atom: http://www.atomenabled.org/developers/syndication/
9668         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
9669         if ($format ne 'rss' && $format ne 'atom') {
9670                 die_error(400, "Unknown web feed format");
9671         }
9672
9673         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
9674         my $head = $hash || 'HEAD';
9675         my @commitlist = parse_commits($head, 150, 0, $file_name);
9676
9677         my %latest_commit;
9678         my %latest_date;
9679         my $content_type = "application/$format+xml";
9680         if (defined $cgi->http('HTTP_ACCEPT') &&
9681                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
9682                 # browser (feed reader) prefers text/xml
9683                 $content_type = 'text/xml';
9684         }
9685         if (defined($commitlist[0])) {
9686                 %latest_commit = %{$commitlist[0]};
9687                 my $latest_epoch = $latest_commit{'committer_epoch'};
9688                 exit_if_unmodified_since($latest_epoch);
9689                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
9690         }
9691         print $cgi->header(
9692                 -type => $content_type,
9693                 -charset => 'utf-8',
9694                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
9695                 -status => '200 OK');
9696
9697         # Optimization: skip generating the body if client asks only
9698         # for Last-Modified date.
9699         return if ($cgi->request_method() eq 'HEAD');
9700
9701         # header variables
9702         my $title = "$site_name - $project/$action";
9703         my $feed_type = 'log';
9704         if (defined $hash) {
9705                 $title .= " - '$hash'";
9706                 $feed_type = 'branch log';
9707                 if (defined $file_name) {
9708                         $title .= " :: $file_name";
9709                         $feed_type = 'history';
9710                 }
9711         } elsif (defined $file_name) {
9712                 $title .= " - $file_name";
9713                 $feed_type = 'history';
9714         }
9715         $title .= " $feed_type";
9716         $title = esc_html($title);
9717         my $descr = git_get_project_description($project);
9718         if (defined $descr) {
9719                 $descr = esc_html($descr);
9720         } else {
9721                 $descr = "$project " .
9722                          ($format eq 'rss' ? 'RSS' : 'Atom') .
9723                          " feed";
9724         }
9725         my $owner = git_get_project_owner($project);
9726         $owner = esc_html($owner);
9727
9728         #header
9729         my $alt_url;
9730         if (defined $file_name) {
9731                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
9732         } elsif (defined $hash) {
9733                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
9734         } else {
9735                 $alt_url = href(-full=>1, action=>"summary");
9736         }
9737         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
9738         if ($format eq 'rss') {
9739                 print <<XML;
9740 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
9741 <channel>
9742 XML
9743                 print "<title>$title</title>\n" .
9744                       "<link>$alt_url</link>\n" .
9745                       "<description>$descr</description>\n" .
9746                       "<language>en</language>\n" .
9747                       # project owner is responsible for 'editorial' content
9748                       "<managingEditor>$owner</managingEditor>\n";
9749                 if (defined $logo || defined $favicon) {
9750                         # prefer the logo to the favicon, since RSS
9751                         # doesn't allow both
9752                         my $img = esc_url($logo || $favicon);
9753                         print "<image>\n" .
9754                               "<url>$img</url>\n" .
9755                               "<title>$title</title>\n" .
9756                               "<link>$alt_url</link>\n" .
9757                               "</image>\n";
9758                 }
9759                 if (%latest_date) {
9760                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
9761                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
9762                 }
9763                 print "<generator>gitweb v.$version/$git_version</generator>\n";
9764         } elsif ($format eq 'atom') {
9765                 print <<XML;
9766 <feed xmlns="http://www.w3.org/2005/Atom">
9767 XML
9768                 print "<title>$title</title>\n" .
9769                       "<subtitle>$descr</subtitle>\n" .
9770                       '<link rel="alternate" type="text/html" href="' .
9771                       $alt_url . '" />' . "\n" .
9772                       '<link rel="self" type="' . $content_type . '" href="' .
9773                       $cgi->self_url() . '" />' . "\n" .
9774                       "<id>" . href(-full=>1) . "</id>\n" .
9775                       # use project owner for feed author
9776                       '<author><name>'. email_obfuscate($owner) . '</name></author>\n';
9777                 if (defined $favicon) {
9778                         print "<icon>" . esc_url($favicon) . "</icon>\n";
9779                 }
9780                 if (defined $logo) {
9781                         # not twice as wide as tall: 72 x 27 pixels
9782                         print "<logo>" . esc_url($logo) . "</logo>\n";
9783                 }
9784                 if (! %latest_date) {
9785                         # dummy date to keep the feed valid until commits trickle in:
9786                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
9787                 } else {
9788                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
9789                 }
9790                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
9791         }
9792
9793         # contents
9794         for (my $i = 0; $i <= $#commitlist; $i++) {
9795                 my %co = %{$commitlist[$i]};
9796                 my $commit = $co{'id'};
9797                 # we read 150, we always show 30 and the ones more recent than 48 hours
9798                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
9799                         last;
9800                 }
9801                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
9802
9803                 # get list of changed files
9804                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9805                         $co{'parent'} || "--root",
9806                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
9807                         or next;
9808                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
9809                 close $fd
9810                         or next;
9811
9812                 # print element (entry, item)
9813                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
9814                 if ($format eq 'rss') {
9815                         print "<item>\n" .
9816                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
9817                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
9818                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
9819                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
9820                               "<link>$co_url</link>\n" .
9821                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
9822                               "<content:encoded>" .
9823                               "<![CDATA[\n";
9824                 } elsif ($format eq 'atom') {
9825                         print "<entry>\n" .
9826                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
9827                               "<updated>$cd{'iso-8601'}</updated>\n" .
9828                               "<author>\n" .
9829                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
9830                         if ($co{'author_email'}) {
9831                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
9832                         }
9833                         print "</author>\n" .
9834                               # use committer for contributor
9835                               "<contributor>\n" .
9836                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
9837                         if ($co{'committer_email'}) {
9838                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
9839                         }
9840                         print "</contributor>\n" .
9841                               "<published>$cd{'iso-8601'}</published>\n" .
9842                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
9843                               "<id>$co_url</id>\n" .
9844                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
9845                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
9846                 }
9847                 my $comment = $co{'comment'};
9848                 print "<pre>\n";
9849                 foreach my $line (@$comment) {
9850                         $line = esc_html($line);
9851                         print "$line\n";
9852                 }
9853                 print "</pre><ul>\n";
9854                 foreach my $difftree_line (@difftree) {
9855                         my %difftree = parse_difftree_raw_line($difftree_line);
9856                         next if !$difftree{'from_id'};
9857
9858                         my $file = $difftree{'file'} || $difftree{'to_file'};
9859
9860                         print "<li>" .
9861                               "[" .
9862                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
9863                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
9864                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
9865                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
9866                                       -title => "diff"}, 'D');
9867                         if ($have_blame) {
9868                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
9869                                                              file_name=>$file, hash_base=>$commit),
9870                                               -class => "blamelink",
9871                                               -title => "blame"}, 'B');
9872                         }
9873                         # if this is not a feed of a file history
9874                         if (!defined $file_name || $file_name ne $file) {
9875                                 print $cgi->a({-href => href(-full=>1, action=>"history",
9876                                                              file_name=>$file, hash=>$commit),
9877                                               -title => "history"}, 'H');
9878                         }
9879                         $file = esc_path($file);
9880                         print "] ".
9881                               "$file</li>\n";
9882                 }
9883                 if ($format eq 'rss') {
9884                         print "</ul>]]>\n" .
9885                               "</content:encoded>\n" .
9886                               "</item>\n";
9887                 } elsif ($format eq 'atom') {
9888                         print "</ul>\n</div>\n" .
9889                               "</content>\n" .
9890                               "</entry>\n";
9891                 }
9892         }
9893
9894         # end of feed
9895         if ($format eq 'rss') {
9896                 print "</channel>\n</rss>\n";
9897         } elsif ($format eq 'atom') {
9898                 print "</feed>\n";
9899         }
9900 }
9901
9902 sub git_rss {
9903         git_feed('rss');
9904 }
9905
9906 sub git_atom {
9907         git_feed('atom');
9908 }
9909
9910 sub git_opml {
9911         my @list = git_get_projects_list($project_filter, $strict_export);
9912         if (!@list) {
9913                 die_error(404, "No projects found");
9914         }
9915
9916         print $cgi->header(
9917                 -type => 'text/xml',
9918                 -charset => 'utf-8',
9919                 -content_disposition => 'inline; filename="opml.xml"');
9920
9921         my $title = esc_html($site_name);
9922         my $filter = " within subdirectory ";
9923         if (defined $project_filter) {
9924                 $filter .= esc_html($project_filter);
9925         } else {
9926                 $filter = "";
9927         }
9928         print <<XML;
9929 <?xml version="1.0" encoding="utf-8"?>
9930 <opml version="1.0">
9931 <head>
9932   <title>$title OPML Export$filter</title>
9933 </head>
9934 <body>
9935 <outline text="git RSS feeds">
9936 XML
9937
9938         foreach my $pr (@list) {
9939                 my %proj = %$pr;
9940                 my $head = git_get_head_hash($proj{'path'});
9941                 if (!defined $head) {
9942                         next;
9943                 }
9944                 $git_dir = "$projectroot/$proj{'path'}";
9945                 my %co = parse_commit($head);
9946                 if (!%co) {
9947                         next;
9948                 }
9949
9950                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9951                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9952                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9953                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9954         }
9955         print <<XML;
9956 </outline>
9957 </body>
9958 </opml>
9959 XML
9960 }