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
  33 BEGIN {
  34         CGI->compile() if $ENV{'MOD_PERL'};
  35 }
  36
  37 our $version = "++GIT_VERSION++";
  38
  39 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
  40 sub evaluate_uri {
  41         our $cgi;
  42
  43         {
  44                 local $ENV{PATH_INFO} = ""
  45                         if exists($ENV{PATH_INFO}) && (!defined($CGI::VERSION) || $CGI::VERSION < 3.34);
  46                 our $my_url = $cgi->url();
  47                 our $my_uri = $cgi->url(-absolute => 1);
  48         }
  49
  50         # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
  51         # needed and used only for URLs with nonempty PATH_INFO
  52         # This must be an absolute URL (i.e. no scheme, host or port), NOT a full one
  53         our $base_url = $my_uri || '/';
  54
  55         # When the script is used as DirectoryIndex, the URL does not contain the name
  56         # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
  57         # have to do it ourselves. We make $path_info global because it's also used
  58         # later on.
  59         #
  60         # Another issue with the script being the DirectoryIndex is that the resulting
  61         # $my_url data is not the full script URL: this is good, because we want
  62         # generated links to keep implying the script name if it wasn't explicitly
  63         # indicated in the URL we're handling, but it means that $my_url cannot be used
  64         # as base URL.
  65         # Therefore, if we needed to strip PATH_INFO, then we know that we have
  66         # to build the base URL ourselves:
  67         our $path_info = decode_utf8($ENV{"PATH_INFO"});
  68         if ($path_info) {
  69                 # $path_info has already been URL-decoded by the web server, but
  70                 # $my_url and $my_uri have not. URL-decode them so we can properly
  71                 # strip $path_info.
  72                 $my_url = unescape($my_url);
  73                 $my_uri = unescape($my_uri);
  74                 if ($my_url =~ s,\Q$path_info\E$,, &&
  75                     $my_uri =~ s,\Q$path_info\E$,, &&
  76                     defined $ENV{'SCRIPT_NAME'}) {
  77                         $base_url = $ENV{'SCRIPT_NAME'} || '/';
  78                 }
  79         }
  80
  81         # target of the home link on top of all pages
  82         our $home_link = $my_uri || "/";
  83 }
  84
  85 # core git executable to use
  86 # this can just be "git" if your webserver has a sensible PATH
  87 our $GIT = "++GIT_BINDIR++/git";
  88
  89 # absolute fs-path which will be prepended to the project path
  90 #our $projectroot = "/pub/scm";
  91 our $projectroot = "++GITWEB_PROJECTROOT++";
  92
  93 # fs traversing limit for getting project list
  94 # the number is relative to the projectroot
  95 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
  96
  97 # string of the home link on top of all pages
  98 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
  99
 100 # extra breadcrumbs preceding the home link
 101 our @extra_breadcrumbs = ();
 102
 103 # name of your site or organization to appear in page titles
 104 # replace this with something more descriptive for clearer bookmarks
 105 our $site_name = "++GITWEB_SITENAME++"
 106                  || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
 107
 108 # html snippet to include in the <head> section of each page
 109 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
 110 # filename of html text to include at top of each page
 111 our $site_header = "++GITWEB_SITE_HEADER++";
 112 # html text to include at home page
 113 our $home_text = "++GITWEB_HOMETEXT++";
 114 # filename of html text to include at bottom of each page
 115 our $site_footer = "++GITWEB_SITE_FOOTER++";
 116
 117 # URI of stylesheets
 118 our @stylesheets = ("++GITWEB_CSS++");
 119 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
 120 our $stylesheet = undef;
 121 # URI of GIT logo (72x27 size)
 122 our $logo = "++GITWEB_LOGO++";
 123 # URI of GIT favicon, assumed to be image/png type
 124 our $favicon = "++GITWEB_FAVICON++";
 125 # URI of gitweb.js (JavaScript code for gitweb)
 126 our $javascript = "++GITWEB_JS++";
 127
 128 # URI and label (title) of GIT logo link
 129 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
 130 #our $logo_label = "git documentation";
 131 our $logo_url = "http://git-scm.com/";
 132 our $logo_label = "git homepage";
 133
 134 # source of projects list
 135 our $projects_list = "++GITWEB_LIST++";
 136
 137 # the width (in characters) of the projects list "Description" column
 138 our $projects_list_description_width = 25;
 139
 140 # group projects by category on the projects list
 141 # (enabled if this variable evaluates to true)
 142 our $projects_list_group_categories = 0;
 143
 144 # default category if none specified
 145 # (leave the empty string for no category)
 146 our $project_list_default_category = "";
 147
 148 # default order of projects list
 149 # valid values are none, project, descr, owner, and age
 150 our $default_projects_order = "project";
 151
 152 # default order of refs list
 153 # valid values are age and name
 154 our $default_refs_order = "age";
 155
 156 # show repository only if this file exists
 157 # (only effective if this variable evaluates to true)
 158 our $export_ok = "++GITWEB_EXPORT_OK++";
 159
 160 # don't generate age column on the projects list page
 161 our $omit_age_column = 0;
 162
 163 # use contents of this file (in iso, iso-strict or raw format) as
 164 # the last activity data if it exists and is a valid date
 165 our $lastactivity_file = undef;
 166
 167 # don't generate information about owners of repositories
 168 our $omit_owner=0;
 169
 170 # owner link hook given owner name (full and NOT obfuscated)
 171 # should return full URL-escaped link to attach to owner, for example:
 172 #    sub { return "/showowner.cgi?owner=".CGI::Util::escape($_[0]); }
 173 our $owner_link_hook = undef;
 174
 175 # show repository only if this subroutine returns true
 176 # when given the path to the project, for example:
 177 #    sub { return -e "$_[0]/git-daemon-export-ok"; }
 178 our $export_auth_hook = undef;
 179
 180 # only allow viewing of repositories also shown on the overview page
 181 our $strict_export = "++GITWEB_STRICT_EXPORT++";
 182
 183 # base URL for bundle info link shown on summary page, but only if
 184 # this config item is defined AND a 'bundles' subdirectory exists
 185 # in the project's repository.
 186 # i.e. full URL is "git_base_bundles_url/$project/bundles"
 187 our $git_base_bundles_url = undef;
 188
 189 ## URL Hints
 190 ##
 191 ## Any of the urls in @git_base_url_list, @git_base_mirror_urls or
 192 ## @git_base_push_urls may be an array ref instead of a scalar in which
 193 ## case ${}[0] is the url and ${}[1] is an html fragment "hint" to display
 194 ## right after the URL.
 195
 196 # list of git base URLs used for URL to where fetch project from,
 197 # i.e. full URL is "$git_base_url/$project"
 198 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
 199
 200 ## For push projects (a .nofetch file exists OR gitweb.showpush is true)
 201 ## @git_base_url_list entries are shown as "URL" and @git_base_push_urls
 202 ## are shown as "push URL" and @git_base_mirror_urls are ignored.
 203 ## For non-push projects, @git_base_url_list and @git_base_mirror_urls are shown
 204 ## as "URL" and @git_base_push_urls are ignored.
 205
 206 # URLs shown for mirrors but not for push projects in addition to base_url_list,
 207 # extended by the project name (i.e. full URL is "$git_mirror_url/$project")
 208 our @git_base_mirror_urls = ();
 209
 210 # URLs designated for pushing new changes, extended by the
 211 # project name (i.e. "$git_base_push_url[0]/$project")
 212 our @git_base_push_urls = ();
 213
 214 # https hint html inserted right after any https push URL (undef for none)
 215 # ignored if the url already has its own hint
 216 # this is supported for backwards compatibility but is now deprecated in favor
 217 # of using an array ref in the @git_base_push_urls list instead
 218 our $https_hint_html = undef;
 219
 220 # default blob_plain mimetype and default charset for text/plain blob
 221 our $default_blob_plain_mimetype = 'application/octet-stream';
 222 our $default_text_plain_charset  = undef;
 223
 224 # file to use for guessing MIME types before trying /etc/mime.types
 225 # (relative to the current git repository)
 226 our $mimetypes_file = undef;
 227
 228 # assume this charset if line contains non-UTF-8 characters;
 229 # it should be valid encoding (see Encoding::Supported(3pm) for list),
 230 # for which encoding all byte sequences are valid, for example
 231 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
 232 # could be even 'utf-8' for the old behavior)
 233 our $fallback_encoding = 'latin1';
 234
 235 # rename detection options for git-diff and git-diff-tree
 236 # - default is '-M', with the cost proportional to
 237 #   (number of removed files) * (number of new files).
 238 # - more costly is '-C' (which implies '-M'), with the cost proportional to
 239 #   (number of changed files + number of removed files) * (number of new files)
 240 # - even more costly is '-C', '--find-copies-harder' with cost
 241 #   (number of files in the original tree) * (number of new files)
 242 # - one might want to include '-B' option, e.g. '-B', '-M'
 243 our @diff_opts = ('-M'); # taken from git_commit
 244
 245 # cache directory (relative to $GIT_DIR) for project-specific html page caches.
 246 # the directory must exist and be writable by the process running gitweb.
 247 # additionally some actions must be selected for caching in %html_cache_actions
 248 # - default is 'htmlcache'
 249 our $html_cache_dir = 'htmlcache';
 250
 251 # which actions to cache in $html_cache_dir
 252 # if $html_cache_dir exists (relative to $GIT_DIR) and is writable by the
 253 # process running gitweb, then any actions selected here will have their output
 254 # cached and the cache file will be returned instead of regenerating the page
 255 # if it exists.  For this to be useful, an external process must create the
 256 # 'changed' file (if it does not already exist) in the $html_cache_dir whenever
 257 # the project information has been changed.  Alternatively it may create a
 258 # "$action.changed" file (if it does not exist) instead to limit the changes
 259 # to just "$action" instead of any action.  If 'changed' or "$action.changed"
 260 # exist, then the cached version will never be used for "$action" and a new
 261 # cache page will be regenerated (and the "changed" files removed as appropriate).
 262 #
 263 # Additionally if $projlist_cache_lifetime is > 0 AND the forks feature has been
 264 # enabled ('$feature{'forks'}{'default'} = [1];') then additionally an external
 265 # process must create the 'forkchange' file or update its timestamp if it already
 266 # exists whenever a fork is added to or removed from the project (as well as
 267 # create the 'changed' or "$action.changed" file).  Otherwise the "forks"
 268 # section on the summary page may remain out-of-date indefinately.
 269 #
 270 # - default is none
 271 #   currently only caching of the summary page is supported
 272 # - to enable caching of the summary page use:
 273 #   $html_cache_actions{'summary'} = 1;
 274 our %html_cache_actions = ();
 275
 276 # utility to automatically produce a default README.html if README.html is
 277 # enabled and it does not exist or is 0 bytes in length.  If this is set to an
 278 # executable utility that takes an absolute path to a .git directory as its
 279 # first argument and outputs an HTML fragment to use for README.html, then
 280 # it will be called when README.html is enabled but empty or missing.
 281 our $git_automatic_readme_html = undef;
 282
 283 # Disables features that would allow repository owners to inject script into
 284 # the gitweb domain.
 285 our $prevent_xss = 0;
 286
 287 # Path to a POSIX shell.  Needed to run $highlight_bin and a snapshot compressor.
 288 # Only used when highlight is enabled or snapshots with compressors are enabled.
 289 our $posix_shell_bin = "++POSIX_SHELL_BIN++";
 290
 291 # Path to the highlight executable to use (must be the one from
 292 # http://www.andre-simon.de due to assumptions about parameters and output).
 293 # Useful if highlight is not installed on your webserver's PATH.
 294 # [Default: highlight]
 295 our $highlight_bin = "++HIGHLIGHT_BIN++";
 296
 297 # Whether to include project list on the gitweb front page; 0 means yes,
 298 # 1 means no list but show tag cloud if enabled (all projects still need
 299 # to be scanned, unless the info is cached), 2 means no list and no tag cloud
 300 # (very fast)
 301 our $frontpage_no_project_list = 0;
 302
 303 # projects list cache for busy sites with many projects;
 304 # if you set this to non-zero, it will be used as the cached
 305 # index lifetime in minutes
 306 #
 307 # the cached list version is stored in $cache_dir/$cache_name and can
 308 # be tweaked by other scripts running with the same uid as gitweb -
 309 # use this ONLY at secure installations; only single gitweb project
 310 # root per system is supported, unless you tweak configuration!
 311 our $projlist_cache_lifetime = 0; # in minutes
 312 # FHS compliant $cache_dir would be "/var/cache/gitweb"
 313 our $cache_dir =
 314         (defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp').'/gitweb';
 315 our $projlist_cache_name = 'gitweb.index.cache';
 316 our $cache_grpshared = 0;
 317
 318 # information about snapshot formats that gitweb is capable of serving
 319 our %known_snapshot_formats = (
 320         # name => {
 321         #       'display' => display name,
 322         #       'type' => mime type,
 323         #       'suffix' => filename suffix,
 324         #       'format' => --format for git-archive,
 325         #       'compressor' => [compressor command and arguments]
 326         #                       (array reference, optional)
 327         #       'disabled' => boolean (optional)}
 328         #
 329         'tgz' => {
 330                 'display' => 'tar.gz',
 331                 'type' => 'application/x-gzip',
 332                 'suffix' => '.tar.gz',
 333                 'format' => 'tar',
 334                 'compressor' => ['gzip', '-n']},
 335
 336         'tbz2' => {
 337                 'display' => 'tar.bz2',
 338                 'type' => 'application/x-bzip2',
 339                 'suffix' => '.tar.bz2',
 340                 'format' => 'tar',
 341                 'compressor' => ['bzip2']},
 342
 343         'txz' => {
 344                 'display' => 'tar.xz',
 345                 'type' => 'application/x-xz',
 346                 'suffix' => '.tar.xz',
 347                 'format' => 'tar',
 348                 'compressor' => ['xz'],
 349                 'disabled' => 1},
 350
 351         'zip' => {
 352                 'display' => 'zip',
 353                 'type' => 'application/x-zip',
 354                 'suffix' => '.zip',
 355                 'format' => 'zip'},
 356 );
 357
 358 # Aliases so we understand old gitweb.snapshot values in repository
 359 # configuration.
 360 our %known_snapshot_format_aliases = (
 361         'gzip'  => 'tgz',
 362         'bzip2' => 'tbz2',
 363         'xz'    => 'txz',
 364
 365         # backward compatibility: legacy gitweb config support
 366         'x-gzip' => undef, 'gz' => undef,
 367         'x-bzip2' => undef, 'bz2' => undef,
 368         'x-zip' => undef, '' => undef,
 369 );
 370
 371 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
 372 # are changed, it may be appropriate to change these values too via
 373 # $GITWEB_CONFIG.
 374 our %avatar_size = (
 375         'default' => 16,
 376         'double'  => 32
 377 );
 378
 379 # Used to set the maximum load that we will still respond to gitweb queries.
 380 # If server load exceed this value then return "503 server busy" error.
 381 # If gitweb cannot determined server load, it is taken to be 0.
 382 # Leave it undefined (or set to 'undef') to turn off load checking.
 383 our $maxload = 300;
 384
 385 # configuration for 'highlight' (http://www.andre-simon.de/)
 386 # match by basename
 387 our %highlight_basename = (
 388         #'Program' => 'py',
 389         #'Library' => 'py',
 390         'SConstruct' => 'py', # SCons equivalent of Makefile
 391         'Makefile' => 'make',
 392         'makefile' => 'make',
 393         'GNUmakefile' => 'make',
 394         'BSDmakefile' => 'make',
 395 );
 396 # match by shebang regex
 397 our %highlight_shebang = (
 398         # Each entry has a key which is the syntax to use and
 399         # a value which is either a qr regex or an array of qr regexs to match
 400         # against the first 128 (less if the blob is shorter) BYTES of the blob.
 401         # We match /usr/bin/env items separately to require "/usr/bin/env" and
 402         # allow a limited subset of NAME=value items to appear.
 403         'awk'    => [ qr,^#!\s*/(?:\w+/)*(?:[gnm]?awk)(?:\s|$),mo,
 404                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[gnm]?awk)(?:\s|$),mo ],
 405         'make'   => [ qr,^#!\s*/(?:\w+/)*(?:g?make)(?:\s|$),mo,
 406                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:g?make)(?:\s|$),mo ],
 407         'php'    => [ qr,^#!\s*/(?:\w+/)*(?:php)(?:\s|$),mo,
 408                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:php)(?:\s|$),mo ],
 409         'pl'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 410                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 411         'py'     => [ qr,^#!\s*/(?:\w+/)*(?:python)(?:\s|$),mo,
 412                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:python)(?:\s|$),mo ],
 413         'sh'     => [ qr,^#!\s*/(?:\w+/)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo,
 414                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo ],
 415         'rb'     => [ qr,^#!\s*/(?:\w+/)*(?:ruby)(?:\s|$),mo,
 416                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:ruby)(?:\s|$),mo ],
 417 );
 418 # match by extension
 419 our %highlight_ext = (
 420         # main extensions, defining name of syntax;
 421         # see files in /usr/share/highlight/langDefs/ directory
 422         (map { $_ => $_ } qw(
 423                 4gl a4c abnf abp ada agda ahk ampl amtrix applescript arc
 424                 arm as asm asp aspect ats au3 avenue awk bat bb bbcode bib
 425                 bms bnf boo c cb cfc chl clipper clojure clp cob cs css d
 426                 diff dot dylan e ebnf erl euphoria exp f90 flx for frink fs
 427                 go haskell hcl html httpd hx icl icn idl idlang ili
 428                 inc_luatex ini inp io iss j java js jsp lbn ldif lgt lhs
 429                 lisp lotos ls lsl lua ly make mel mercury mib miranda ml mo
 430                 mod2 mod3 mpl ms mssql n nas nbc nice nrx nsi nut nxc oberon
 431                 objc octave oorexx os oz pas php pike pl pl1 pov pro
 432                 progress ps ps1 psl pure py pyx q qmake qu r rb rebol rexx
 433                 rnc s sas sc scala scilab sh sma smalltalk sml sno spec spn
 434                 sql sybase tcl tcsh tex ttcn3 vala vb verilog vhd xml xpp y
 435                 yaiff znn)),
 436         # alternate extensions, see /etc/highlight/filetypes.conf
 437         (map { $_ => '4gl' } qw(informix)),
 438         (map { $_ => 'a4c' } qw(ascend)),
 439         (map { $_ => 'abp' } qw(abp4)),
 440         (map { $_ => 'ada' } qw(a adb ads gnad)),
 441         (map { $_ => 'ahk' } qw(autohotkey)),
 442         (map { $_ => 'ampl' } qw(dat run)),
 443         (map { $_ => 'amtrix' } qw(hnd s4 s4h s4t t4)),
 444         (map { $_ => 'as' } qw(actionscript)),
 445         (map { $_ => 'asm' } qw(29k 68s 68x a51 assembler x68 x86)),
 446         (map { $_ => 'asp' } qw(asa)),
 447         (map { $_ => 'aspect' } qw(was wud)),
 448         (map { $_ => 'ats' } qw(dats)),
 449         (map { $_ => 'au3' } qw(autoit)),
 450         (map { $_ => 'bat' } qw(cmd)),
 451         (map { $_ => 'bb' } qw(blitzbasic)),
 452         (map { $_ => 'bib' } qw(bibtex)),
 453         (map { $_ => 'c' } qw(c++ cc cpp cu cxx h hh hpp hxx)),
 454         (map { $_ => 'cb' } qw(clearbasic)),
 455         (map { $_ => 'cfc' } qw(cfm coldfusion)),
 456         (map { $_ => 'chl' } qw(chill)),
 457         (map { $_ => 'cob' } qw(cbl cobol)),
 458         (map { $_ => 'cs' } qw(csharp)),
 459         (map { $_ => 'diff' } qw(patch)),
 460         (map { $_ => 'dot' } qw(graphviz)),
 461         (map { $_ => 'e' } qw(eiffel se)),
 462         (map { $_ => 'erl' } qw(erlang hrl)),
 463         (map { $_ => 'euphoria' } qw(eu ew ex exu exw wxu)),
 464         (map { $_ => 'exp' } qw(express)),
 465         (map { $_ => 'f90' } qw(f95)),
 466         (map { $_ => 'flx' } qw(felix)),
 467         (map { $_ => 'for' } qw(f f77 ftn)),
 468         (map { $_ => 'fs' } qw(fsharp fsx)),
 469         (map { $_ => 'haskell' } qw(hs)),
 470         (map { $_ => 'html' } qw(htm xhtml)),
 471         (map { $_ => 'hx' } qw(haxe)),
 472         (map { $_ => 'icl' } qw(clean)),
 473         (map { $_ => 'icn' } qw(icon)),
 474         (map { $_ => 'ili' } qw(interlis)),
 475         (map { $_ => 'inp' } qw(fame)),
 476         (map { $_ => 'iss' } qw(innosetup)),
 477         (map { $_ => 'j' } qw(jasmin)),
 478         (map { $_ => 'java' } qw(groovy grv)),
 479         (map { $_ => 'lbn' } qw(luban)),
 480         (map { $_ => 'lgt' } qw(logtalk)),
 481         (map { $_ => 'lisp' } qw(cl clisp el lsp sbcl scom)),
 482         (map { $_ => 'ls' } qw(lotus)),
 483         (map { $_ => 'lsl' } qw(lindenscript)),
 484         (map { $_ => 'ly' } qw(lilypond)),
 485         (map { $_ => 'make' } qw(mak mk kmk)),
 486         (map { $_ => 'mel' } qw(maya)),
 487         (map { $_ => 'mib' } qw(smi snmp)),
 488         (map { $_ => 'ml' } qw(mli ocaml)),
 489         (map { $_ => 'mo' } qw(modelica)),
 490         (map { $_ => 'mod2' } qw(def mod)),
 491         (map { $_ => 'mod3' } qw(i3 m3)),
 492         (map { $_ => 'mpl' } qw(maple)),
 493         (map { $_ => 'n' } qw(nemerle)),
 494         (map { $_ => 'nas' } qw(nasal)),
 495         (map { $_ => 'nrx' } qw(netrexx)),
 496         (map { $_ => 'nsi' } qw(nsis)),
 497         (map { $_ => 'nut' } qw(squirrel)),
 498         (map { $_ => 'oberon' } qw(ooc)),
 499         (map { $_ => 'objc' } qw(M m mm)),
 500         (map { $_ => 'php' } qw(php3 php4 php5 php6)),
 501         (map { $_ => 'pike' } qw(pmod)),
 502         (map { $_ => 'pl' } qw(perl plex plx pm)),
 503         (map { $_ => 'pl1' } qw(bdy ff fp fpp rpp sf sp spb spe spp sps wf wp wpb wpp wps)),
 504         (map { $_ => 'progress' } qw(i p w)),
 505         (map { $_ => 'py' } qw(python)),
 506         (map { $_ => 'pyx' } qw(pyrex)),
 507         (map { $_ => 'rb' } qw(pp rjs ruby)),
 508         (map { $_ => 'rexx' } qw(rex rx the)),
 509         (map { $_ => 'sc' } qw(paradox)),
 510         (map { $_ => 'scilab' } qw(sce sci)),
 511         (map { $_ => 'sh' } qw(bash ebuild eclass ksh zsh)),
 512         (map { $_ => 'sma' } qw(small)),
 513         (map { $_ => 'smalltalk' } qw(gst sq st)),
 514         (map { $_ => 'sno' } qw(snobal)),
 515         (map { $_ => 'sybase' } qw(sp)),
 516         (map { $_ => 'tcl' } qw(itcl wish)),
 517         (map { $_ => 'tex' } qw(cls sty)),
 518         (map { $_ => 'vb' } qw(bas basic bi vbs)),
 519         (map { $_ => 'verilog' } qw(v)),
 520         (map { $_ => 'xml' } qw(dtd ecf ent hdr hub jnlp nrm plist resx sgm sgml svg tld vxml wml xsd xsl)),
 521         (map { $_ => 'y' } qw(bison)),
 522 );
 523
 524 # You define site-wide feature defaults here; override them with
 525 # $GITWEB_CONFIG as necessary.
 526 our %feature = (
 527         # feature => {
 528         #       'sub' => feature-sub (subroutine),
 529         #       'override' => allow-override (boolean),
 530         #       'default' => [ default options...] (array reference)}
 531         #
 532         # if feature is overridable (it means that allow-override has true value),
 533         # then feature-sub will be called with default options as parameters;
 534         # return value of feature-sub indicates if to enable specified feature
 535         #
 536         # if there is no 'sub' key (no feature-sub), then feature cannot be
 537         # overridden
 538         #
 539         # use gitweb_get_feature(<feature>) to retrieve the <feature> value
 540         # (an array) or gitweb_check_feature(<feature>) to check if <feature>
 541         # is enabled
 542
 543         # Enable the 'blame' blob view, showing the last commit that modified
 544         # each line in the file. This can be very CPU-intensive.
 545
 546         # To enable system wide have in $GITWEB_CONFIG
 547         # $feature{'blame'}{'default'} = [1];
 548         # To have project specific config enable override in $GITWEB_CONFIG
 549         # $feature{'blame'}{'override'} = 1;
 550         # and in project config gitweb.blame = 0|1;
 551         'blame' => {
 552                 'sub' => sub { feature_bool('blame', @_) },
 553                 'override' => 0,
 554                 'default' => [0]},
 555
 556         # Enable the 'incremental blame' blob view, which uses javascript to
 557         # incrementally show the revisions of lines as they are discovered
 558         # in the history. It is better for large histories, files and slow
 559         # servers, but requires javascript in the client and can slow down the
 560         # browser on large files.
 561
 562         # To enable system wide have in $GITWEB_CONFIG
 563         # $feature{'blame_incremental'}{'default'} = [1];
 564         # To have project specific config enable override in $GITWEB_CONFIG
 565         # $feature{'blame_incremental'}{'override'} = 1;
 566         # and in project config gitweb.blame_incremental = 0|1;
 567         'blame_incremental' => {
 568                 'sub' => sub { feature_bool('blame_incremental', @_) },
 569                 'override' => 0,
 570                 'default' => [0]},
 571
 572         # Enable the 'snapshot' link, providing a compressed archive of any
 573         # tree. This can potentially generate high traffic if you have large
 574         # project.
 575
 576         # Value is a list of formats defined in %known_snapshot_formats that
 577         # you wish to offer.
 578         # To disable system wide have in $GITWEB_CONFIG
 579         # $feature{'snapshot'}{'default'} = [];
 580         # To have project specific config enable override in $GITWEB_CONFIG
 581         # $feature{'snapshot'}{'override'} = 1;
 582         # and in project config, a comma-separated list of formats or "none"
 583         # to disable.  Example: gitweb.snapshot = tbz2,zip;
 584         'snapshot' => {
 585                 'sub' => \&feature_snapshot,
 586                 'override' => 0,
 587                 'default' => ['tgz']},
 588
 589         # Enable text search, which will list the commits which match author,
 590         # committer or commit text to a given string.  Enabled by default.
 591         # Project specific override is not supported.
 592         #
 593         # Note that this controls all search features, which means that if
 594         # it is disabled, then 'grep' and 'pickaxe' search would also be
 595         # disabled.
 596         'search' => {
 597                 'override' => 0,
 598                 'default' => [1]},
 599
 600         # Enable regular expression search.  Enabled by default.
 601         # Note that you need to have 'search' feature enabled too.
 602         #
 603         # Note that this affects all git search features, which means that if
 604         # it is disabled, none of the git search options will allow a regular
 605         # expression (the "RE" checkbox) to be used.  However, the project
 606         # list search is unaffected by this setting (it uses Perl to do the
 607         # matching not Git) and will always allow a regular expression to
 608         # be used (by checking the box) regardless of this setting.
 609         'regexp' => {
 610                 'sub' => sub { feature_bool('regexp', @_) },
 611                 'override' => 0,
 612                 'default' => [1]},
 613
 614         # Enable grep search, which will list the files in currently selected
 615         # tree containing the given string. Enabled by default. This can be
 616         # potentially CPU-intensive, of course.
 617         # Note that you need to have 'search' feature enabled too.
 618
 619         # To enable system wide have in $GITWEB_CONFIG
 620         # $feature{'grep'}{'default'} = [1];
 621         # To have project specific config enable override in $GITWEB_CONFIG
 622         # $feature{'grep'}{'override'} = 1;
 623         # and in project config gitweb.grep = 0|1;
 624         'grep' => {
 625                 'sub' => sub { feature_bool('grep', @_) },
 626                 'override' => 0,
 627                 'default' => [1]},
 628
 629         # Enable the pickaxe search, which will list the commits that modified
 630         # a given string in a file. This can be practical and quite faster
 631         # alternative to 'blame', but still potentially CPU-intensive.
 632         # Note that you need to have 'search' feature enabled too.
 633
 634         # To enable system wide have in $GITWEB_CONFIG
 635         # $feature{'pickaxe'}{'default'} = [1];
 636         # To have project specific config enable override in $GITWEB_CONFIG
 637         # $feature{'pickaxe'}{'override'} = 1;
 638         # and in project config gitweb.pickaxe = 0|1;
 639         'pickaxe' => {
 640                 'sub' => sub { feature_bool('pickaxe', @_) },
 641                 'override' => 0,
 642                 'default' => [1]},
 643
 644         # Enable showing size of blobs in a 'tree' view, in a separate
 645         # column, similar to what 'ls -l' does.  This cost a bit of IO.
 646
 647         # To disable system wide have in $GITWEB_CONFIG
 648         # $feature{'show-sizes'}{'default'} = [0];
 649         # To have project specific config enable override in $GITWEB_CONFIG
 650         # $feature{'show-sizes'}{'override'} = 1;
 651         # and in project config gitweb.showsizes = 0|1;
 652         'show-sizes' => {
 653                 'sub' => sub { feature_bool('showsizes', @_) },
 654                 'override' => 0,
 655                 'default' => [1]},
 656
 657         # Make gitweb use an alternative format of the URLs which can be
 658         # more readable and natural-looking: project name is embedded
 659         # directly in the path and the query string contains other
 660         # auxiliary information. All gitweb installations recognize
 661         # URL in either format; this configures in which formats gitweb
 662         # generates links.
 663
 664         # To enable system wide have in $GITWEB_CONFIG
 665         # $feature{'pathinfo'}{'default'} = [1];
 666         # Project specific override is not supported.
 667
 668         # Note that you will need to change the default location of CSS,
 669         # favicon, logo and possibly other files to an absolute URL. Also,
 670         # if gitweb.cgi serves as your indexfile, you will need to force
 671         # $my_uri to contain the script name in your $GITWEB_CONFIG (and you
 672         # will also likely want to set $home_link if you're setting $my_uri).
 673         'pathinfo' => {
 674                 'override' => 0,
 675                 'default' => [0]},
 676
 677         # Make gitweb consider projects in project root subdirectories
 678         # to be forks of existing projects. Given project $projname.git,
 679         # projects matching $projname/*.git will not be shown in the main
 680         # projects list, instead a '+' mark will be added to $projname
 681         # there and a 'forks' view will be enabled for the project, listing
 682         # all the forks. If project list is taken from a file, forks have
 683         # to be listed after the main project.
 684
 685         # To enable system wide have in $GITWEB_CONFIG
 686         # $feature{'forks'}{'default'} = [1];
 687         # Project specific override is not supported.
 688         'forks' => {
 689                 'override' => 0,
 690                 'default' => [0]},
 691
 692         # Insert custom links to the action bar of all project pages.
 693         # This enables you mainly to link to third-party scripts integrating
 694         # into gitweb; e.g. git-browser for graphical history representation
 695         # or custom web-based repository administration interface.
 696
 697         # The 'default' value consists of a list of triplets in the form
 698         # (label, link, position) where position is the label after which
 699         # to insert the link and link is a format string where %n expands
 700         # to the project name, %f to the project path within the filesystem,
 701         # %h to the current hash (h gitweb parameter) and %b to the current
 702         # hash base (hb gitweb parameter); %% expands to %.  %e expands to the
 703         # project name where all needed characters have been %-escaped.
 704
 705         # To enable system wide have in $GITWEB_CONFIG e.g.
 706         # $feature{'actions'}{'default'} = [('graphiclog',
 707         #       '/git-browser/by-commit.html?r=%n', 'summary')];
 708         # Project specific override is not supported.
 709         'actions' => {
 710                 'override' => 0,
 711                 'default' => []},
 712
 713         # Allow gitweb scan project content tags of project repository,
 714         # and display the popular Web 2.0-ish "tag cloud" near the projects
 715         # list.  Note that this is something COMPLETELY different from the
 716         # normal Git tags.
 717
 718         # gitweb by itself can show existing tags, but it does not handle
 719         # tagging itself; you need to do it externally, outside gitweb.
 720         # The format is described in git_get_project_ctags() subroutine.
 721         # You may want to install the HTML::TagCloud Perl module to get
 722         # a pretty tag cloud instead of just a list of tags.
 723
 724         # To enable system wide have in $GITWEB_CONFIG
 725         # $feature{'ctags'}{'default'} = [1];
 726         # Project specific override is not supported.
 727
 728         # A value of 0 means no ctags display or editing.  A value of
 729         # 1 enables ctags display but never editing.  A non-empty value
 730         # that is not a string of digits enables ctags display AND the
 731         # ability to add tags using a form that uses method POST and
 732         # an action value set to the configured 'ctags' value.
 733         'ctags' => {
 734                 'override' => 0,
 735                 'default' => [0]},
 736
 737         # The maximum number of patches in a patchset generated in patch
 738         # view. Set this to 0 or undef to disable patch view, or to a
 739         # negative number to remove any limit.
 740
 741         # To disable system wide have in $GITWEB_CONFIG
 742         # $feature{'patches'}{'default'} = [0];
 743         # To have project specific config enable override in $GITWEB_CONFIG
 744         # $feature{'patches'}{'override'} = 1;
 745         # and in project config gitweb.patches = 0|n;
 746         # where n is the maximum number of patches allowed in a patchset.
 747         'patches' => {
 748                 'sub' => \&feature_patches,
 749                 'override' => 0,
 750                 'default' => [16]},
 751
 752         # Avatar support. When this feature is enabled, views such as
 753         # shortlog or commit will display an avatar associated with
 754         # the email of the committer(s) and/or author(s).
 755
 756         # Currently available providers are gravatar and picon.
 757         # If an unknown provider is specified, the feature is disabled.
 758
 759         # Gravatar depends on Digest::MD5.
 760         # Picon currently relies on the indiana.edu database.
 761
 762         # To enable system wide have in $GITWEB_CONFIG
 763         # $feature{'avatar'}{'default'} = ['<provider>'];
 764         # where <provider> is either gravatar or picon.
 765         # To have project specific config enable override in $GITWEB_CONFIG
 766         # $feature{'avatar'}{'override'} = 1;
 767         # and in project config gitweb.avatar = <provider>;
 768         'avatar' => {
 769                 'sub' => \&feature_avatar,
 770                 'override' => 0,
 771                 'default' => ['']},
 772
 773         # Enable displaying how much time and how many git commands
 774         # it took to generate and display page.  Disabled by default.
 775         # Project specific override is not supported.
 776         'timed' => {
 777                 'override' => 0,
 778                 'default' => [0]},
 779
 780         # Enable turning some links into links to actions which require
 781         # JavaScript to run (like 'blame_incremental').  Not enabled by
 782         # default.  Project specific override is currently not supported.
 783         'javascript-actions' => {
 784                 'override' => 0,
 785                 'default' => [0]},
 786
 787         # Enable and configure ability to change common timezone for dates
 788         # in gitweb output via JavaScript.  Enabled by default.
 789         # Project specific override is not supported.
 790         'javascript-timezone' => {
 791                 'override' => 0,
 792                 'default' => [
 793                         'local',     # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
 794                                      # or undef to turn off this feature
 795                         'gitweb_tz', # name of cookie where to store selected timezone
 796                         'datetime',  # CSS class used to mark up dates for manipulation
 797                 ]},
 798
 799         # Syntax highlighting support. This is based on Daniel Svensson's
 800         # and Sham Chukoury's work in gitweb-xmms2.git.
 801         # It requires the 'highlight' program present in $PATH,
 802         # and therefore is disabled by default.
 803
 804         # To enable system wide have in $GITWEB_CONFIG
 805         # $feature{'highlight'}{'default'} = [1];
 806
 807         'highlight' => {
 808                 'sub' => sub { feature_bool('highlight', @_) },
 809                 'override' => 0,
 810                 'default' => [0]},
 811
 812         # Enable displaying of remote heads in the heads list
 813
 814         # To enable system wide have in $GITWEB_CONFIG
 815         # $feature{'remote_heads'}{'default'} = [1];
 816         # To have project specific config enable override in $GITWEB_CONFIG
 817         # $feature{'remote_heads'}{'override'} = 1;
 818         # and in project config gitweb.remoteheads = 0|1;
 819         'remote_heads' => {
 820                 'sub' => sub { feature_bool('remote_heads', @_) },
 821                 'override' => 0,
 822                 'default' => [0]},
 823
 824         # Enable showing branches under other refs in addition to heads
 825
 826         # To set system wide extra branch refs have in $GITWEB_CONFIG
 827         # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
 828         # To have project specific config enable override in $GITWEB_CONFIG
 829         # $feature{'extra-branch-refs'}{'override'} = 1;
 830         # and in project config gitweb.extrabranchrefs = dirs of choice
 831         # Every directory is separated with whitespace.
 832
 833         'extra-branch-refs' => {
 834                 'sub' => \&feature_extra_branch_refs,
 835                 'override' => 0,
 836                 'default' => []},
 837 );
 838
 839 sub gitweb_get_feature {
 840         my ($name) = @_;
 841         return unless exists $feature{$name};
 842         my ($sub, $override, @defaults) = (
 843                 $feature{$name}{'sub'},
 844                 $feature{$name}{'override'},
 845                 @{$feature{$name}{'default'}});
 846         # project specific override is possible only if we have project
 847         our $git_dir; # global variable, declared later
 848         if (!$override || !defined $git_dir) {
 849                 return @defaults;
 850         }
 851         if (!defined $sub) {
 852                 warn "feature $name is not overridable";
 853                 return @defaults;
 854         }
 855         return $sub->(@defaults);
 856 }
 857
 858 # A wrapper to check if a given feature is enabled.
 859 # With this, you can say
 860 #
 861 #   my $bool_feat = gitweb_check_feature('bool_feat');
 862 #   gitweb_check_feature('bool_feat') or somecode;
 863 #
 864 # instead of
 865 #
 866 #   my ($bool_feat) = gitweb_get_feature('bool_feat');
 867 #   (gitweb_get_feature('bool_feat'))[0] or somecode;
 868 #
 869 sub gitweb_check_feature {
 870         return (gitweb_get_feature(@_))[0];
 871 }
 872
 873
 874 sub feature_bool {
 875         my $key = shift;
 876         my ($val) = git_get_project_config($key, '--bool');
 877
 878         if (!defined $val) {
 879                 return ($_[0]);
 880         } elsif ($val eq 'true') {
 881                 return (1);
 882         } elsif ($val eq 'false') {
 883                 return (0);
 884         }
 885 }
 886
 887 sub feature_snapshot {
 888         my (@fmts) = @_;
 889
 890         my ($val) = git_get_project_config('snapshot');
 891
 892         if ($val) {
 893                 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
 894         }
 895
 896         return @fmts;
 897 }
 898
 899 sub feature_patches {
 900         my @val = (git_get_project_config('patches', '--int'));
 901
 902         if (@val) {
 903                 return @val;
 904         }
 905
 906         return ($_[0]);
 907 }
 908
 909 sub feature_avatar {
 910         my @val = (git_get_project_config('avatar'));
 911
 912         return @val ? @val : @_;
 913 }
 914
 915 sub feature_extra_branch_refs {
 916         my (@branch_refs) = @_;
 917         my $values = git_get_project_config('extrabranchrefs');
 918
 919         if ($values) {
 920                 $values = config_to_multi ($values);
 921                 @branch_refs = ();
 922                 foreach my $value (@{$values}) {
 923                         push @branch_refs, split /\s+/, $value;
 924                 }
 925         }
 926
 927         return @branch_refs;
 928 }
 929
 930 # checking HEAD file with -e is fragile if the repository was
 931 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
 932 # and then pruned.
 933 sub check_head_link {
 934         my ($dir) = @_;
 935         return 0 unless -d "$dir/objects" && -x _;
 936         return 0 unless -d "$dir/refs" && -x _;
 937         my $headfile = "$dir/HEAD";
 938         return -l $headfile ?
 939                 readlink($headfile) =~ /^refs\/heads\// : -f $headfile;
 940 }
 941
 942 sub check_export_ok {
 943         my ($dir) = @_;
 944         return (check_head_link($dir) &&
 945                 (!$export_ok || -e "$dir/$export_ok") &&
 946                 (!$export_auth_hook || $export_auth_hook->($dir)));
 947 }
 948
 949 # process alternate names for backward compatibility
 950 # filter out unsupported (unknown) snapshot formats
 951 sub filter_snapshot_fmts {
 952         my @fmts = @_;
 953
 954         @fmts = map {
 955                 exists $known_snapshot_format_aliases{$_} ?
 956                        $known_snapshot_format_aliases{$_} : $_} @fmts;
 957         @fmts = grep {
 958                 exists $known_snapshot_formats{$_} &&
 959                 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
 960 }
 961
 962 sub filter_and_validate_refs {
 963         my @refs = @_;
 964         my %unique_refs = ();
 965
 966         foreach my $ref (@refs) {
 967                 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
 968                 # 'heads' are added implicitly in get_branch_refs().
 969                 $unique_refs{$ref} = 1 if ($ref ne 'heads');
 970         }
 971         return sort keys %unique_refs;
 972 }
 973
 974 # If it is set to code reference, it is code that it is to be run once per
 975 # request, allowing updating configurations that change with each request,
 976 # while running other code in config file only once.
 977 #
 978 # Otherwise, if it is false then gitweb would process config file only once;
 979 # if it is true then gitweb config would be run for each request.
 980 our $per_request_config = 1;
 981
 982 # If true and fileno STDIN is 0 and getsockname succeeds and getpeername fails
 983 # with ENOTCONN, then FCGI mode will be activated automatically in just the
 984 # same way as though the --fcgi option had been given instead.
 985 our $auto_fcgi = 0;
 986
 987 # read and parse gitweb config file given by its parameter.
 988 # returns true on success, false on recoverable error, allowing
 989 # to chain this subroutine, using first file that exists.
 990 # dies on errors during parsing config file, as it is unrecoverable.
 991 sub read_config_file {
 992         my $filename = shift;
 993         return unless defined $filename;
 994         # die if there are errors parsing config file
 995         if (-e $filename) {
 996                 do $filename;
 997                 die $@ if $@;
 998                 return 1;
 999         }
1000         return;
1001 }
1002
1003 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
1004 sub evaluate_gitweb_config {
1005         our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
1006         our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
1007         our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
1008
1009         # Protect against duplications of file names, to not read config twice.
1010         # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
1011         # there possibility of duplication of filename there doesn't matter.
1012         $GITWEB_CONFIG = ""        if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
1013         $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
1014
1015         # Common system-wide settings for convenience.
1016         # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
1017         read_config_file($GITWEB_CONFIG_COMMON);
1018
1019         # Use first config file that exists.  This means use the per-instance
1020         # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
1021         read_config_file($GITWEB_CONFIG) and return;
1022         read_config_file($GITWEB_CONFIG_SYSTEM);
1023 }
1024
1025 our $encode_object;
1026 our $to_utf8_pipe_command = '';
1027
1028 sub evaluate_encoding {
1029         my $requested = $fallback_encoding || 'ISO-8859-1';
1030         my $obj = Encode::find_encoding($requested) or
1031                 die_error(400, "Requested fallback encoding not found");
1032         if ($obj->name eq 'iso-8859-1') {
1033                 # Use Windows-1252 instead as required by the HTML 5 standard
1034                 my $altobj = Encode::find_encoding('Windows-1252');
1035                 $obj = $altobj if $altobj;
1036         }
1037         $encode_object = $obj;
1038         my $nm = lc($encode_object->name);
1039         unless ($nm eq 'cp1252' || $nm eq 'ascii' || $nm eq 'utf8' ||
1040                 $nm =~ /^utf-8/ || $nm =~ /^iso-8859-/) {
1041                 $to_utf8_pipe_command =
1042                   quote_command($^X, '-CO', '-MEncode=decode,FB_DEFAULT', '-pse',
1043                     '$_ = decode($fe, $_, FB_DEFAULT) if !utf8::decode($_);',
1044                     '--', "-fe=$fallback_encoding")." | ";
1045         }
1046 }
1047
1048 sub evaluate_email_obfuscate {
1049         # email obfuscation
1050         our $email;
1051         if (!$email && eval { require HTML::Email::Obfuscate; 1 }) {
1052                 $email = HTML::Email::Obfuscate->new(lite => 1);
1053         }
1054 }
1055
1056 # Get loadavg of system, to compare against $maxload.
1057 # Currently it requires '/proc/loadavg' present to get loadavg;
1058 # if it is not present it returns 0, which means no load checking.
1059 sub get_loadavg {
1060         if( -e '/proc/loadavg' ){
1061                 open my $fd, '<', '/proc/loadavg'
1062                         or return 0;
1063                 my @load = split(/\s+/, scalar <$fd>);
1064                 close $fd;
1065
1066                 # The first three columns measure CPU and IO utilization of the last one,
1067                 # five, and 10 minute periods.  The fourth column shows the number of
1068                 # currently running processes and the total number of processes in the m/n
1069                 # format.  The last column displays the last process ID used.
1070                 return $load[0] || 0;
1071         }
1072         # additional checks for load average should go here for things that don't export
1073         # /proc/loadavg
1074
1075         return 0;
1076 }
1077
1078 # version of the core git binary
1079 our $git_version;
1080 our $git_vernum = "0"; # guaranteed to always match /^\d+(\.\d+)*$/
1081 sub evaluate_git_version {
1082         $git_version = $version; # don't leak system information to attackers
1083         $git_vernum eq "0" or return; # don't run it again
1084         sub cmd_pipe;
1085         my $vers;
1086         if (defined(my $fd = cmd_pipe $GIT, '--version')) {
1087                 $vers = <$fd>;
1088                 close $fd;
1089                 $number_of_git_cmds++;
1090         }
1091         $git_vernum = $1 if defined($vers) && $vers =~ /git\s+version\s+(\d+(?:\.\d+)*)$/io;
1092 }
1093
1094 sub check_loadavg {
1095         if (defined $maxload && get_loadavg() > $maxload) {
1096                 die_error(503, "The load average on the server is too high");
1097         }
1098 }
1099
1100 # ======================================================================
1101 # input validation and dispatch
1102
1103 # input parameters can be collected from a variety of sources (presently, CGI
1104 # and PATH_INFO), so we define an %input_params hash that collects them all
1105 # together during validation: this allows subsequent uses (e.g. href()) to be
1106 # agnostic of the parameter origin
1107
1108 our %input_params = ();
1109
1110 # input parameters are stored with the long parameter name as key. This will
1111 # also be used in the href subroutine to convert parameters to their CGI
1112 # equivalent, and since the href() usage is the most frequent one, we store
1113 # the name -> CGI key mapping here, instead of the reverse.
1114 #
1115 # XXX: Warning: If you touch this, check the search form for updating,
1116 # too.
1117
1118 our @cgi_param_mapping = (
1119         project => "p",
1120         action => "a",
1121         file_name => "f",
1122         file_parent => "fp",
1123         hash => "h",
1124         hash_parent => "hp",
1125         hash_base => "hb",
1126         hash_parent_base => "hpb",
1127         page => "pg",
1128         order => "o",
1129         searchtext => "s",
1130         searchtype => "st",
1131         snapshot_format => "sf",
1132         ctag_filter => 't',
1133         extra_options => "opt",
1134         search_use_regexp => "sr",
1135         ctag => "by_tag",
1136         diff_style => "ds",
1137         project_filter => "pf",
1138         # this must be last entry (for manipulation from JavaScript)
1139         javascript => "js"
1140 );
1141 our %cgi_param_mapping = @cgi_param_mapping;
1142
1143 # we will also need to know the possible actions, for validation
1144 our %actions = (
1145         "blame" => \&git_blame,
1146         "blame_incremental" => \&git_blame_incremental,
1147         "blame_data" => \&git_blame_data,
1148         "blobdiff" => \&git_blobdiff,
1149         "blobdiff_plain" => \&git_blobdiff_plain,
1150         "blob" => \&git_blob,
1151         "blob_plain" => \&git_blob_plain,
1152         "commitdiff" => \&git_commitdiff,
1153         "commitdiff_plain" => \&git_commitdiff_plain,
1154         "commit" => \&git_commit,
1155         "forks" => \&git_forks,
1156         "heads" => \&git_heads,
1157         "history" => \&git_history,
1158         "log" => \&git_log,
1159         "patch" => \&git_patch,
1160         "patches" => \&git_patches,
1161         "refs" => \&git_refs,
1162         "remotes" => \&git_remotes,
1163         "rss" => \&git_rss,
1164         "atom" => \&git_atom,
1165         "search" => \&git_search,
1166         "search_help" => \&git_search_help,
1167         "shortlog" => \&git_shortlog,
1168         "summary" => \&git_summary,
1169         "tag" => \&git_tag,
1170         "tags" => \&git_tags,
1171         "tree" => \&git_tree,
1172         "snapshot" => \&git_snapshot,
1173         "object" => \&git_object,
1174         # those below don't need $project
1175         "opml" => \&git_opml,
1176         "frontpage" => \&git_frontpage,
1177         "project_list" => \&git_project_list,
1178         "project_index" => \&git_project_index,
1179 );
1180
1181 # the only actions we will allow to be cached
1182 my %supported_cache_actions;
1183 BEGIN {%supported_cache_actions = map {( $_ => 1 )} qw(summary)}
1184
1185 # finally, we have the hash of allowed extra_options for the commands that
1186 # allow them
1187 our %allowed_options = (
1188         "--no-merges" => [ qw(rss atom log shortlog history) ],
1189 );
1190
1191 # fill %input_params with the CGI parameters. All values except for 'opt'
1192 # should be single values, but opt can be an array. We should probably
1193 # build an array of parameters that can be multi-valued, but since for the time
1194 # being it's only this one, we just single it out
1195 sub evaluate_query_params {
1196         our $cgi;
1197
1198         while (my ($name, $symbol) = each %cgi_param_mapping) {
1199                 if ($symbol eq 'opt') {
1200                         $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
1201                 } else {
1202                         $input_params{$name} = decode_utf8($cgi->param($symbol));
1203                 }
1204         }
1205
1206         # Backwards compatibility - by_tag= <=> t=
1207         if ($input_params{'ctag'}) {
1208                 $input_params{'ctag_filter'} = $input_params{'ctag'};
1209         }
1210 }
1211
1212 # now read PATH_INFO and update the parameter list for missing parameters
1213 sub evaluate_path_info {
1214         return if defined $input_params{'project'};
1215         return if !$path_info;
1216         $path_info =~ s,^/+,,;
1217         return if !$path_info;
1218
1219         # find which part of PATH_INFO is project
1220         my $project = $path_info;
1221         $project =~ s,/+$,,;
1222         while ($project && !check_head_link("$projectroot/$project")) {
1223                 $project =~ s,/*[^/]*$,,;
1224         }
1225         return unless $project;
1226         $input_params{'project'} = $project;
1227
1228         # do not change any parameters if an action is given using the query string
1229         return if $input_params{'action'};
1230         $path_info =~ s,^\Q$project\E/*,,;
1231
1232         # next, check if we have an action
1233         my $action = $path_info;
1234         $action =~ s,/.*$,,;
1235         if (exists $actions{$action}) {
1236                 $path_info =~ s,^$action/*,,;
1237                 $input_params{'action'} = $action;
1238         }
1239
1240         # list of actions that want hash_base instead of hash, but can have no
1241         # pathname (f) parameter
1242         my @wants_base = (
1243                 'tree',
1244                 'history',
1245         );
1246
1247         # we want to catch, among others
1248         # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
1249         my ($parentrefname, $parentpathname, $refname, $pathname) =
1250                 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
1251
1252         # first, analyze the 'current' part
1253         if (defined $pathname) {
1254                 # we got "branch:filename" or "branch:dir/"
1255                 # we could use git_get_type(branch:pathname), but:
1256                 # - it needs $git_dir
1257                 # - it does a git() call
1258                 # - the convention of terminating directories with a slash
1259                 #   makes it superfluous
1260                 # - embedding the action in the PATH_INFO would make it even
1261                 #   more superfluous
1262                 $pathname =~ s,^/+,,;
1263                 if (!$pathname || substr($pathname, -1) eq "/") {
1264                         $input_params{'action'} ||= "tree";
1265                         $pathname =~ s,/$,,;
1266                 } else {
1267                         # the default action depends on whether we had parent info
1268                         # or not
1269                         if ($parentrefname) {
1270                                 $input_params{'action'} ||= "blobdiff_plain";
1271                         } else {
1272                                 $input_params{'action'} ||= "blob_plain";
1273                         }
1274                 }
1275                 $input_params{'hash_base'} ||= $refname;
1276                 $input_params{'file_name'} ||= $pathname;
1277         } elsif (defined $refname) {
1278                 # we got "branch". In this case we have to choose if we have to
1279                 # set hash or hash_base.
1280                 #
1281                 # Most of the actions without a pathname only want hash to be
1282                 # set, except for the ones specified in @wants_base that want
1283                 # hash_base instead. It should also be noted that hand-crafted
1284                 # links having 'history' as an action and no pathname or hash
1285                 # set will fail, but that happens regardless of PATH_INFO.
1286                 if (defined $parentrefname) {
1287                         # if there is parent let the default be 'shortlog' action
1288                         # (for http://git.example.com/repo.git/A..B links); if there
1289                         # is no parent, dispatch will detect type of object and set
1290                         # action appropriately if required (if action is not set)
1291                         $input_params{'action'} ||= "shortlog";
1292                 }
1293                 if ($input_params{'action'} &&
1294                     grep { $_ eq $input_params{'action'} } @wants_base) {
1295                         $input_params{'hash_base'} ||= $refname;
1296                 } else {
1297                         $input_params{'hash'} ||= $refname;
1298                 }
1299         }
1300
1301         # next, handle the 'parent' part, if present
1302         if (defined $parentrefname) {
1303                 # a missing pathspec defaults to the 'current' filename, allowing e.g.
1304                 # someproject/blobdiff/oldrev..newrev:/filename
1305                 if ($parentpathname) {
1306                         $parentpathname =~ s,^/+,,;
1307                         $parentpathname =~ s,/$,,;
1308                         $input_params{'file_parent'} ||= $parentpathname;
1309                 } else {
1310                         $input_params{'file_parent'} ||= $input_params{'file_name'};
1311                 }
1312                 # we assume that hash_parent_base is wanted if a path was specified,
1313                 # or if the action wants hash_base instead of hash
1314                 if (defined $input_params{'file_parent'} ||
1315                         grep { $_ eq $input_params{'action'} } @wants_base) {
1316                         $input_params{'hash_parent_base'} ||= $parentrefname;
1317                 } else {
1318                         $input_params{'hash_parent'} ||= $parentrefname;
1319                 }
1320         }
1321
1322         # for the snapshot action, we allow URLs in the form
1323         # $project/snapshot/$hash.ext
1324         # where .ext determines the snapshot and gets removed from the
1325         # passed $refname to provide the $hash.
1326         #
1327         # To be able to tell that $refname includes the format extension, we
1328         # require the following two conditions to be satisfied:
1329         # - the hash input parameter MUST have been set from the $refname part
1330         #   of the URL (i.e. they must be equal)
1331         # - the snapshot format MUST NOT have been defined already (e.g. from
1332         #   CGI parameter sf)
1333         # It's also useless to try any matching unless $refname has a dot,
1334         # so we check for that too
1335         if (defined $input_params{'action'} &&
1336                 $input_params{'action'} eq 'snapshot' &&
1337                 defined $refname && index($refname, '.') != -1 &&
1338                 $refname eq $input_params{'hash'} &&
1339                 !defined $input_params{'snapshot_format'}) {
1340                 # We loop over the known snapshot formats, checking for
1341                 # extensions. Allowed extensions are both the defined suffix
1342                 # (which includes the initial dot already) and the snapshot
1343                 # format key itself, with a prepended dot
1344                 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1345                         my $hash = $refname;
1346                         unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1347                                 next;
1348                         }
1349                         my $sfx = $1;
1350                         # a valid suffix was found, so set the snapshot format
1351                         # and reset the hash parameter
1352                         $input_params{'snapshot_format'} = $fmt;
1353                         $input_params{'hash'} = $hash;
1354                         # we also set the format suffix to the one requested
1355                         # in the URL: this way a request for e.g. .tgz returns
1356                         # a .tgz instead of a .tar.gz
1357                         $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1358                         last;
1359                 }
1360         }
1361 }
1362
1363 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1364      $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1365      $searchtext, $search_regexp, $project_filter);
1366 sub evaluate_and_validate_params {
1367         our $action = $input_params{'action'};
1368         if (defined $action) {
1369                 if (!is_valid_action($action)) {
1370                         die_error(400, "Invalid action parameter");
1371                 }
1372         }
1373
1374         # parameters which are pathnames
1375         our $project = $input_params{'project'};
1376         if (defined $project) {
1377                 if (!is_valid_project($project)) {
1378                         undef $project;
1379                         die_error(404, "No such project");
1380                 }
1381         }
1382
1383         our $project_filter = $input_params{'project_filter'};
1384         if (defined $project_filter) {
1385                 if (!is_valid_pathname($project_filter)) {
1386                         die_error(404, "Invalid project_filter parameter");
1387                 }
1388         }
1389
1390         our $file_name = $input_params{'file_name'};
1391         if (defined $file_name) {
1392                 if (!is_valid_pathname($file_name)) {
1393                         die_error(400, "Invalid file parameter");
1394                 }
1395         }
1396
1397         our $file_parent = $input_params{'file_parent'};
1398         if (defined $file_parent) {
1399                 if (!is_valid_pathname($file_parent)) {
1400                         die_error(400, "Invalid file parent parameter");
1401                 }
1402         }
1403
1404         # parameters which are refnames
1405         our $hash = $input_params{'hash'};
1406         if (defined $hash) {
1407                 if (!is_valid_refname($hash)) {
1408                         die_error(400, "Invalid hash parameter");
1409                 }
1410         }
1411
1412         our $hash_parent = $input_params{'hash_parent'};
1413         if (defined $hash_parent) {
1414                 if (!is_valid_refname($hash_parent)) {
1415                         die_error(400, "Invalid hash parent parameter");
1416                 }
1417         }
1418
1419         our $hash_base = $input_params{'hash_base'};
1420         if (defined $hash_base) {
1421                 if (!is_valid_refname($hash_base)) {
1422                         die_error(400, "Invalid hash base parameter");
1423                 }
1424         }
1425
1426         our @extra_options = @{$input_params{'extra_options'}};
1427         # @extra_options is always defined, since it can only be (currently) set from
1428         # CGI, and $cgi->param() returns the empty array in array context if the param
1429         # is not set
1430         foreach my $opt (@extra_options) {
1431                 if (not exists $allowed_options{$opt}) {
1432                         die_error(400, "Invalid option parameter");
1433                 }
1434                 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1435                         die_error(400, "Invalid option parameter for this action");
1436                 }
1437         }
1438
1439         our $hash_parent_base = $input_params{'hash_parent_base'};
1440         if (defined $hash_parent_base) {
1441                 if (!is_valid_refname($hash_parent_base)) {
1442                         die_error(400, "Invalid hash parent base parameter");
1443                 }
1444         }
1445
1446         # other parameters
1447         our $page = $input_params{'page'};
1448         if (defined $page) {
1449                 if ($page =~ m/[^0-9]/) {
1450                         die_error(400, "Invalid page parameter");
1451                 }
1452         }
1453
1454         our $searchtype = $input_params{'searchtype'};
1455         if (defined $searchtype) {
1456                 if ($searchtype =~ m/[^a-z]/) {
1457                         die_error(400, "Invalid searchtype parameter");
1458                 }
1459         }
1460
1461         our $search_use_regexp = $input_params{'search_use_regexp'};
1462
1463         our $searchtext = $input_params{'searchtext'};
1464         our $search_regexp = undef;
1465         if (defined $searchtext) {
1466                 if (length($searchtext) < 2) {
1467                         die_error(403, "At least two characters are required for search parameter");
1468                 }
1469                 if ($search_use_regexp) {
1470                         $search_regexp = $searchtext;
1471                         if (!eval { qr/$search_regexp/; 1; }) {
1472                                 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1473                                 die_error(400, "Invalid search regexp '$search_regexp'",
1474                                           esc_html($error));
1475                         }
1476                 } else {
1477                         $search_regexp = quotemeta $searchtext;
1478                 }
1479         }
1480 }
1481
1482 # path to the current git repository
1483 our $git_dir;
1484 sub evaluate_git_dir {
1485         our $git_dir = $project ? "$projectroot/$project" : undef;
1486 }
1487
1488 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1489 sub configure_gitweb_features {
1490         # list of supported snapshot formats
1491         our @snapshot_fmts = gitweb_get_feature('snapshot');
1492         @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1493
1494         # check that the avatar feature is set to a known provider name,
1495         # and for each provider check if the dependencies are satisfied.
1496         # if the provider name is invalid or the dependencies are not met,
1497         # reset $git_avatar to the empty string.
1498         our ($git_avatar) = gitweb_get_feature('avatar');
1499         if ($git_avatar eq 'gravatar') {
1500                 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1501         } elsif ($git_avatar eq 'picon') {
1502                 # no dependencies
1503         } else {
1504                 $git_avatar = '';
1505         }
1506
1507         our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1508         @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1509 }
1510
1511 sub get_branch_refs {
1512         return ('heads', @extra_branch_refs);
1513 }
1514
1515 # custom error handler: 'die <message>' is Internal Server Error
1516 sub handle_errors_html {
1517         my $msg = shift; # it is already HTML escaped
1518
1519         # to avoid infinite loop where error occurs in die_error,
1520         # change handler to default handler, disabling handle_errors_html
1521         set_message("Error occurred when inside die_error:\n$msg");
1522
1523         # you cannot jump out of die_error when called as error handler;
1524         # the subroutine set via CGI::Carp::set_message is called _after_
1525         # HTTP headers are already written, so it cannot write them itself
1526         die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1527 }
1528 set_message(\&handle_errors_html);
1529
1530 our $shown_stale_message = 0;
1531 our $cache_dump = undef;
1532 our $cache_dump_mtime = undef;
1533
1534 # dispatch
1535 my $cache_mode_active;
1536 sub dispatch {
1537         if (!defined $action) {
1538                 if (defined $hash) {
1539                         $action = git_get_type($hash);
1540                         $action or die_error(404, "Object does not exist");
1541                 } elsif (defined $hash_base && defined $file_name) {
1542                         $action = git_get_type("$hash_base:$file_name");
1543                         $action or die_error(404, "File or directory does not exist");
1544                 } elsif (defined $project) {
1545                         $action = 'summary';
1546                 } else {
1547                         $action = 'frontpage';
1548                 }
1549         }
1550         if (!defined($actions{$action})) {
1551                 die_error(400, "Unknown action");
1552         }
1553         if ($action !~ m/^(?:opml|frontpage|project_list|project_index)$/ &&
1554             !$project) {
1555                 die_error(400, "Project needed");
1556         }
1557
1558         my $cached_page = $supported_cache_actions{$action}
1559                 ? cached_action_page($action)
1560                 : undef;
1561         goto DUMPCACHE if $cached_page;
1562         local *SAVEOUT = *STDOUT;
1563         $cache_mode_active = $supported_cache_actions{$action}
1564                 ? cached_action_start($action)
1565                 : undef;
1566
1567         configure_gitweb_features();
1568         $actions{$action}->();
1569
1570         return unless $cache_mode_active;
1571
1572         $cached_page = cached_action_finish($action);
1573         *STDOUT = *SAVEOUT;
1574
1575         DUMPCACHE:
1576
1577         $cache_mode_active = 0;
1578         # Avoid any extra unwanted encoding steps as $cached_page is raw bytes
1579         binmode STDOUT, ':raw';
1580         our $fcgi_raw_mode = 1;
1581         print expand_gitweb_pi($cached_page, time);
1582         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
1583         $fcgi_raw_mode = 0;
1584 }
1585
1586 sub reset_timer {
1587         our $t0 = [ gettimeofday() ]
1588                 if defined $t0;
1589         our $number_of_git_cmds = 0;
1590 }
1591
1592 our $first_request = 1;
1593 our $evaluate_uri_force = undef;
1594 sub run_request {
1595         reset_timer();
1596
1597         # Only allow GET and HEAD methods
1598         if (!$ENV{'REQUEST_METHOD'} || ($ENV{'REQUEST_METHOD'} ne 'GET' && $ENV{'REQUEST_METHOD'} ne 'HEAD')) {
1599                 print <<EOT;
1600 Status: 405 Method Not Allowed
1601 Content-Type: text/plain
1602 Allow: GET,HEAD
1603
1604 405 Method Not Allowed
1605 EOT
1606                 return;
1607         }
1608
1609         evaluate_uri();
1610         &$evaluate_uri_force() if $evaluate_uri_force;
1611         if ($per_request_config) {
1612                 if (ref($per_request_config) eq 'CODE') {
1613                         $per_request_config->();
1614                 } elsif (!$first_request) {
1615                         evaluate_gitweb_config();
1616                         evaluate_email_obfuscate();
1617                 }
1618         }
1619         check_loadavg();
1620
1621         # $projectroot and $projects_list might be set in gitweb config file
1622         $projects_list ||= $projectroot;
1623
1624         evaluate_query_params();
1625         evaluate_path_info();
1626         evaluate_and_validate_params();
1627         evaluate_git_dir();
1628
1629         dispatch();
1630 }
1631
1632 our $is_last_request = sub { 1 };
1633 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1634 our $CGI = 'CGI';
1635 our $cgi;
1636 our $fcgi_mode = 0;
1637 our $fcgi_nproc_active = 0;
1638 our $fcgi_raw_mode = 0;
1639 sub is_fcgi {
1640         use Errno;
1641         my $stdinfno = fileno STDIN;
1642         return 0 unless defined $stdinfno && $stdinfno == 0;
1643         return 0 unless getsockname STDIN;
1644         return 0 if getpeername STDIN;
1645         return $!{ENOTCONN}?1:0;
1646 }
1647 sub configure_as_fcgi {
1648         return if $fcgi_mode;
1649
1650         require FCGI;
1651         require CGI::Fast;
1652
1653         # We have gone to great effort to make sure that all incoming data has
1654         # been converted from whatever format it was in into UTF-8.  We have
1655         # even taken care to make sure the output handle is in ':utf8' mode.
1656         # Now along comes FCGI and blows it with:
1657         #
1658         #     Use of wide characters in FCGI::Stream::PRINT is deprecated
1659         #      and will stop wprking[sic] in a future version of FCGI
1660         #
1661         # To fix this we replace FCGI::Stream::PRINT with our own routine that
1662         # first encodes everything and then calls the original routine, but
1663         # not if $fcgi_raw_mode is true (then we just call the original routine).
1664         #
1665         # Note that we could do this by using utf8::is_utf8 to check instead
1666         # of having a $fcgi_raw_mode global, but that would be slower to run
1667         # the test on each element and much slower than skipping the conversion
1668         # entirely when we know we're outputting raw bytes.
1669         my $orig = \&FCGI::Stream::PRINT;
1670         undef *FCGI::Stream::PRINT;
1671         *FCGI::Stream::PRINT = sub {
1672                 @_ = (shift, map {my $x=$_; utf8::encode($x); $x} @_)
1673                         unless $fcgi_raw_mode;
1674                 goto $orig;
1675         };
1676
1677         our $CGI = 'CGI::Fast';
1678
1679         $fcgi_mode = 1;
1680         $first_request = 0;
1681         my $request_number = 0;
1682         # let each child service 100 requests
1683         our $is_last_request = sub { ++$request_number >= 100 };
1684 }
1685 sub evaluate_argv {
1686         my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1687         configure_as_fcgi()
1688                 if $script_name =~ /\.fcgi$/ || ($auto_fcgi && is_fcgi());
1689
1690         my $nproc_sub = sub {
1691                 my ($arg, $val) = @_;
1692                 return unless eval { require FCGI::ProcManager; 1; };
1693                 $fcgi_nproc_active = 1;
1694                 my $proc_manager = FCGI::ProcManager->new({
1695                         n_processes => $val,
1696                 });
1697                 our $pre_listen_hook    = sub { $proc_manager->pm_manage()        };
1698                 our $pre_dispatch_hook  = sub { $proc_manager->pm_pre_dispatch()  };
1699                 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1700         };
1701         if (@ARGV) {
1702                 require Getopt::Long;
1703                 Getopt::Long::GetOptions(
1704                         'fastcgi|fcgi|f' => \&configure_as_fcgi,
1705                         'nproc|n=i' => $nproc_sub,
1706                 );
1707         };
1708         if (!$fcgi_nproc_active && defined $ENV{'GITWEB_FCGI_NPROC'} && $ENV{'GITWEB_FCGI_NPROC'} =~ /^\d+$/) {
1709                 &$nproc_sub('nproc', $ENV{'GITWEB_FCGI_NPROC'});
1710         }
1711 }
1712
1713 # Any "our" variable that could possibly influence correct handling of
1714 # a CGI request MUST be reset in this subroutine
1715 sub _reset_globals {
1716         # Note that $t0 and $number_of_git_commands are handled by reset_timer
1717         our %input_params = ();
1718         our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1719              $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1720              $searchtext, $search_regexp, $project_filter) = ();
1721         our $git_dir = undef;
1722         our (@snapshot_fmts, $git_avatar, @extra_branch_refs) = ();
1723         our %avatar_cache = ();
1724         our $config_file = '';
1725         our %config = ();
1726         our $gitweb_project_owner = undef;
1727         our $shown_stale_message = 0;
1728         our $fcgi_raw_mode = 0;
1729         keys %known_snapshot_formats; # reset 'each' iterator
1730 }
1731
1732 sub run {
1733         evaluate_gitweb_config();
1734         evaluate_encoding();
1735         evaluate_email_obfuscate();
1736         evaluate_git_version();
1737         my ($ml, $mi, $bu, $hl, $subroutine) = ($my_url, $my_uri, $base_url, $home_link, '');
1738         $subroutine .= '$my_url = $ml;' if defined $my_url && $my_url ne '';
1739         $subroutine .= '$my_uri = $mi;' if defined $my_uri; # this one can be ""
1740         $subroutine .= '$base_url = $bu;' if defined $base_url && $base_url ne '';
1741         $subroutine .= '$home_link = $hl;' if defined $home_link && $home_link ne '';
1742         $evaluate_uri_force = eval "sub {$subroutine}" if $subroutine;
1743         $first_request = 1;
1744         evaluate_argv();
1745
1746         $pre_listen_hook->()
1747                 if $pre_listen_hook;
1748
1749  REQUEST:
1750         while ($cgi = $CGI->new()) {
1751                 $pre_dispatch_hook->()
1752                         if $pre_dispatch_hook;
1753                 {
1754                         # most globals can simply be reset
1755                         _reset_globals;
1756
1757                         # evaluate_path_info corrupts %known_snapshot_formats
1758                         # so we need a deepish copy of it -- note that
1759                         # _reset_globals already took care of resetting its
1760                         # hash iterator that evaluate_path_info also leaves
1761                         # in an indeterminate state
1762                         my %formats = ();
1763                         while (my ($k,$v) = each(%known_snapshot_formats)) {
1764                                 $formats{$k} = {%{$known_snapshot_formats{$k}}};
1765                         }
1766                         local *known_snapshot_formats = \%formats;
1767
1768                         eval {run_request()};
1769                 }
1770                 $post_dispatch_hook->()
1771                         if $post_dispatch_hook;
1772                 $first_request = 0;
1773
1774                 last REQUEST if ($is_last_request->());
1775         }
1776
1777         1;
1778 }
1779
1780 run();
1781
1782 if (defined caller) {
1783         # wrapped in a subroutine processing requests,
1784         # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1785         return;
1786 } else {
1787         # pure CGI script, serving single request
1788         exit;
1789 }
1790
1791 ## ======================================================================
1792 ## action links
1793
1794 # possible values of extra options
1795 # -full => 0|1      - use absolute/full URL ($my_uri/$my_url as base)
1796 # -replay => 1      - start from a current view (replay with modifications)
1797 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1798 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1799 sub href {
1800         my %params = @_;
1801         # default is to use -absolute url() i.e. $my_uri
1802         my $href = $params{-full} ? $my_url : $my_uri;
1803
1804         # implicit -replay, must be first of implicit params
1805         $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1806
1807         $params{'project'} = $project unless exists $params{'project'};
1808
1809         if ($params{-replay}) {
1810                 while (my ($name, $symbol) = each %cgi_param_mapping) {
1811                         if (!exists $params{$name}) {
1812                                 $params{$name} = $input_params{$name};
1813                         }
1814                 }
1815         }
1816
1817         my $use_pathinfo = gitweb_check_feature('pathinfo');
1818         if (defined $params{'project'} &&
1819             (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1820                 # try to put as many parameters as possible in PATH_INFO:
1821                 #   - project name
1822                 #   - action
1823                 #   - hash_parent or hash_parent_base:/file_parent
1824                 #   - hash or hash_base:/filename
1825                 #   - the snapshot_format as an appropriate suffix
1826
1827                 # When the script is the root DirectoryIndex for the domain,
1828                 # $href here would be something like http://gitweb.example.com/
1829                 # Thus, we strip any trailing / from $href, to spare us double
1830                 # slashes in the final URL
1831                 $href =~ s,/$,,;
1832
1833                 # Then add the project name, if present
1834                 $href .= "/".esc_path_info($params{'project'});
1835                 delete $params{'project'};
1836
1837                 # since we destructively absorb parameters, we keep this
1838                 # boolean that remembers if we're handling a snapshot
1839                 my $is_snapshot = $params{'action'} eq 'snapshot';
1840
1841                 # Summary just uses the project path URL, any other action is
1842                 # added to the URL
1843                 if (defined $params{'action'}) {
1844                         $href .= "/".esc_path_info($params{'action'})
1845                                 unless $params{'action'} eq 'summary';
1846                         delete $params{'action'};
1847                 }
1848
1849                 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1850                 # stripping nonexistent or useless pieces
1851                 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1852                         || $params{'hash_parent'} || $params{'hash'});
1853                 if (defined $params{'hash_base'}) {
1854                         if (defined $params{'hash_parent_base'}) {
1855                                 $href .= esc_path_info($params{'hash_parent_base'});
1856                                 # skip the file_parent if it's the same as the file_name
1857                                 if (defined $params{'file_parent'}) {
1858                                         if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1859                                                 delete $params{'file_parent'};
1860                                         } elsif ($params{'file_parent'} !~ /\.\./) {
1861                                                 $href .= ":/".esc_path_info($params{'file_parent'});
1862                                                 delete $params{'file_parent'};
1863                                         }
1864                                 }
1865                                 $href .= "..";
1866                                 delete $params{'hash_parent'};
1867                                 delete $params{'hash_parent_base'};
1868                         } elsif (defined $params{'hash_parent'}) {
1869                                 $href .= esc_path_info($params{'hash_parent'}). "..";
1870                                 delete $params{'hash_parent'};
1871                         }
1872
1873                         $href .= esc_path_info($params{'hash_base'});
1874                         if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1875                                 $href .= ":/".esc_path_info($params{'file_name'});
1876                                 delete $params{'file_name'};
1877                         }
1878                         delete $params{'hash'};
1879                         delete $params{'hash_base'};
1880                 } elsif (defined $params{'hash'}) {
1881                         $href .= esc_path_info($params{'hash'});
1882                         delete $params{'hash'};
1883                 }
1884
1885                 # If the action was a snapshot, we can absorb the
1886                 # snapshot_format parameter too
1887                 if ($is_snapshot) {
1888                         my $fmt = $params{'snapshot_format'};
1889                         # snapshot_format should always be defined when href()
1890                         # is called, but just in case some code forgets, we
1891                         # fall back to the default
1892                         $fmt ||= $snapshot_fmts[0];
1893                         $href .= $known_snapshot_formats{$fmt}{'suffix'};
1894                         delete $params{'snapshot_format'};
1895                 }
1896         }
1897
1898         # now encode the parameters explicitly
1899         my @result = ();
1900         for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1901                 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1902                 if (defined $params{$name}) {
1903                         if (ref($params{$name}) eq "ARRAY") {
1904                                 foreach my $par (@{$params{$name}}) {
1905                                         push @result, $symbol . "=" . esc_param($par);
1906                                 }
1907                         } else {
1908                                 push @result, $symbol . "=" . esc_param($params{$name});
1909                         }
1910                 }
1911         }
1912         $href .= "?" . join(';', @result) if scalar @result;
1913
1914         # final transformation: trailing spaces must be escaped (URI-encoded)
1915         $href =~ s/(\s+)$/CGI::escape($1)/e;
1916
1917         if ($params{-anchor}) {
1918                 $href .= "#".esc_param($params{-anchor});
1919         }
1920
1921         return $href;
1922 }
1923
1924
1925 ## ======================================================================
1926 ## validation, quoting/unquoting and escaping
1927
1928 sub is_valid_action {
1929         my $input = shift;
1930         return undef unless exists $actions{$input};
1931         return 1;
1932 }
1933
1934 sub is_valid_project {
1935         my $input = shift;
1936
1937         return unless defined $input;
1938         if (!is_valid_pathname($input) ||
1939                 !(-d "$projectroot/$input") ||
1940                 !check_export_ok("$projectroot/$input") ||
1941                 ($strict_export && !project_in_list($input))) {
1942                 return undef;
1943         } else {
1944                 return 1;
1945         }
1946 }
1947
1948 sub is_valid_pathname {
1949         my $input = shift;
1950
1951         return undef unless defined $input;
1952         # no '.' or '..' as elements of path, i.e. no '.' or '..'
1953         # at the beginning, at the end, and between slashes.
1954         # also this catches doubled slashes
1955         if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1956                 return undef;
1957         }
1958         # no null characters
1959         if ($input =~ m!\0!) {
1960                 return undef;
1961         }
1962         return 1;
1963 }
1964
1965 sub is_valid_ref_format {
1966         my $input = shift;
1967
1968         return undef unless defined $input;
1969         # restrictions on ref name according to git-check-ref-format
1970         if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1971                 return undef;
1972         }
1973         return 1;
1974 }
1975
1976 sub is_valid_refname {
1977         my $input = shift;
1978
1979         return undef unless defined $input;
1980         # textual hashes are O.K.
1981         if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1982                 return 1;
1983         }
1984         # allow repeated trailing '[~^]n*' suffix(es)
1985         $input =~ s/^([^~^]+)(?:[~^]\d*)+$/$1/;
1986         # it must be correct pathname
1987         is_valid_pathname($input) or return undef;
1988         # check git-check-ref-format restrictions
1989         is_valid_ref_format($input) or return undef;
1990         return 1;
1991 }
1992
1993 # decode sequences of octets in utf8 into Perl's internal form,
1994 # which is utf-8 with utf8 flag set if needed.  gitweb writes out
1995 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
1996 sub to_utf8 {
1997         my $str = shift;
1998         return undef unless defined $str;
1999
2000         if (utf8::is_utf8($str) || utf8::decode($str)) {
2001                 return $str;
2002         } else {
2003                 return $encode_object->decode($str, Encode::FB_DEFAULT);
2004         }
2005 }
2006
2007 # quote unsafe chars, but keep the slash, even when it's not
2008 # correct, but quoted slashes look too horrible in bookmarks
2009 sub esc_param {
2010         my $str = shift;
2011         return undef unless defined $str;
2012         $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
2013         $str =~ s/ /\+/g;
2014         return $str;
2015 }
2016
2017 # the quoting rules for path_info fragment are slightly different
2018 sub esc_path_info {
2019         my $str = shift;
2020         return undef unless defined $str;
2021
2022         # path_info doesn't treat '+' as space (specially), but '?' must be escaped
2023         $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
2024
2025         return $str;
2026 }
2027
2028 # quote unsafe chars in whole URL, so some characters cannot be quoted
2029 sub esc_url {
2030         my $str = shift;
2031         return undef unless defined $str;
2032         $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
2033         $str =~ s/ /\+/g;
2034         return $str;
2035 }
2036
2037 # quote unsafe characters in HTML attributes
2038 sub esc_attr {
2039
2040         # for XHTML conformance escaping '"' to '&quot;' is not enough
2041         return esc_html(@_);
2042 }
2043
2044 # replace invalid utf8 character with SUBSTITUTION sequence
2045 sub esc_html {
2046         my $str = shift;
2047         my %opts = @_;
2048
2049         return undef unless defined $str;
2050
2051         $str = to_utf8($str);
2052         $str = $cgi->escapeHTML($str);
2053         if ($opts{'-nbsp'}) {
2054                 $str =~ s/ /&#160;/g;
2055         }
2056         use bytes;
2057         $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
2058         return $str;
2059 }
2060
2061 # quote control characters and escape filename to HTML
2062 sub esc_path {
2063         my $str = shift;
2064         my %opts = @_;
2065
2066         return undef unless defined $str;
2067
2068         $str = to_utf8($str);
2069         $str = $cgi->escapeHTML($str);
2070         if ($opts{'-nbsp'}) {
2071                 $str =~ s/ /&#160;/g;
2072         }
2073         use bytes;
2074         $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
2075         return $str;
2076 }
2077
2078 # Sanitize for use in XHTML + application/xml+xhtml (valid XML 1.0)
2079 sub sanitize {
2080         my $str = shift;
2081
2082         return undef unless defined $str;
2083
2084         $str = to_utf8($str);
2085         use bytes;
2086         $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
2087         return $str;
2088 }
2089
2090 # Make control characters "printable", using character escape codes (CEC)
2091 sub quot_cec {
2092         my $cntrl = shift;
2093         my %opts = @_;
2094         my %es = ( # character escape codes, aka escape sequences
2095                 "\t" => '\t',   # tab            (HT)
2096                 "\n" => '\n',   # line feed      (LF)
2097                 "\r" => '\r',   # carrige return (CR)
2098                 "\f" => '\f',   # form feed      (FF)
2099                 "\b" => '\b',   # backspace      (BS)
2100                 "\a" => '\a',   # alarm (bell)   (BEL)
2101                 "\e" => '\e',   # escape         (ESC)
2102                 "\013" => '\v', # vertical tab   (VT)
2103                 "\000" => '\0', # nul character  (NUL)
2104         );
2105         my $chr = ( (exists $es{$cntrl})
2106                     ? $es{$cntrl}
2107                     : sprintf('\x%02x', ord($cntrl)) );
2108         if ($opts{-nohtml}) {
2109                 return $chr;
2110         } else {
2111                 return "<span class=\"cntrl\">$chr</span>";
2112         }
2113 }
2114
2115 # Alternatively use unicode control pictures codepoints,
2116 # Unicode "printable representation" (PR)
2117 sub quot_upr {
2118         my $cntrl = shift;
2119         my %opts = @_;
2120
2121         my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
2122         if ($opts{-nohtml}) {
2123                 return $chr;
2124         } else {
2125                 return "<span class=\"cntrl\">$chr</span>";
2126         }
2127 }
2128
2129 # git may return quoted and escaped filenames
2130 sub unquote {
2131         my $str = shift;
2132
2133         sub unq {
2134                 my $seq = shift;
2135                 my %es = ( # character escape codes, aka escape sequences
2136                         't' => "\t",   # tab            (HT, TAB)
2137                         'n' => "\n",   # newline        (NL)
2138                         'r' => "\r",   # return         (CR)
2139                         'f' => "\f",   # form feed      (FF)
2140                         'b' => "\b",   # backspace      (BS)
2141                         'a' => "\a",   # alarm (bell)   (BEL)
2142                         'e' => "\e",   # escape         (ESC)
2143                         'v' => "\013", # vertical tab   (VT)
2144                 );
2145
2146                 if ($seq =~ m/^[0-7]{1,3}$/) {
2147                         # octal char sequence
2148                         return chr(oct($seq));
2149                 } elsif (exists $es{$seq}) {
2150                         # C escape sequence, aka character escape code
2151                         return $es{$seq};
2152                 }
2153                 # quoted ordinary character
2154                 return $seq;
2155         }
2156
2157         if ($str =~ m/^"(.*)"$/) {
2158                 # needs unquoting
2159                 $str = $1;
2160                 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
2161         }
2162         return $str;
2163 }
2164
2165 # escape tabs (convert tabs to spaces)
2166 sub untabify {
2167         my $line = shift;
2168
2169         while ((my $pos = index($line, "\t")) != -1) {
2170                 if (my $count = (8 - ($pos % 8))) {
2171                         my $spaces = ' ' x $count;
2172                         $line =~ s/\t/$spaces/;
2173                 }
2174         }
2175
2176         return $line;
2177 }
2178
2179 sub project_in_list {
2180         my $project = shift;
2181         my @list = git_get_projects_list();
2182         return @list && scalar(grep { $_->{'path'} eq $project } @list);
2183 }
2184
2185 sub cached_page_precondition_check {
2186         my $action = shift;
2187         return 1 unless
2188                 $action eq 'summary' &&
2189                 $projlist_cache_lifetime > 0 &&
2190                 gitweb_check_feature('forks');
2191
2192         # Note that ALL the 'forkchange' logic is in this function.
2193         # It does NOT belong in cached_action_page NOR in cached_action_start
2194         # NOR in cached_action_finish.  None of those functions should know anything
2195         # about nor do anything to any of the 'forkchange'/"$action.forkchange" files.
2196
2197         # besides the basic 'changed' "$action.changed" check, we may only use
2198         # a summary cache if:
2199         #
2200         #   1) we are not using a project list cache file
2201         #   -OR-
2202         #   2) we are not using the 'forks' feature
2203         #   -OR-
2204         #   3) there is no 'forkchange' nor "$action.forkchange" file in $html_cache_dir
2205         #   -OR-
2206         #   4) there is no cache file ("$cache_dir/$projlist_cache_name")
2207         #   -OR-
2208         #   5) the OLDER of 'forkchange'/"$action.forkchange" is NEWER than the cache file
2209         #
2210         # Otherwise we must re-generate the cache because we've had a fork change
2211         # (either a fork was added or a fork was removed) AND the change has been
2212         # picked up in the cache file AND we've not got that in our cached copy
2213         #
2214         # For (5) regenerating the cached page wouldn't get us anything if the project
2215         # cache file is older than the 'forkchange'/"$action.forkchange" because the
2216         # forks information comes from the project cache file and it's clearly not
2217         # picked up the changes yet so we may continue to use a cached page until it does.
2218
2219         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2220         my $fc_mt = (stat("$htmlcd/forkchange"))[9];
2221         my $afc_mt = (stat("$htmlcd/$action.forkchange"))[9];
2222         return 1 unless defined($fc_mt) || defined($afc_mt);
2223         my $prj_mt = (stat("$cache_dir/$projlist_cache_name"))[9];
2224         return 1 unless $prj_mt;
2225         my $old_mt = $fc_mt;
2226         $old_mt = $afc_mt if !defined($old_mt) || (defined($afc_mt) && $afc_mt < $old_mt);
2227         return 1 if $old_mt > $prj_mt;
2228
2229         # We're going to regenerate the cached page because we know the project cache
2230         # has new fork information that we cannot possibly have in our cached copy.
2231         #
2232         # However, if both 'forkchange' and "$action.forkchange" exist and one of
2233         # them is older than the project cache and one of them is newer, we still
2234         # need to regenerate the page cache, but we will also need to do it again
2235         # in the future because there's yet another fork update not yet in the cache.
2236         #
2237         # So we make sure to touch "$action.changed" to force a cache regeneration
2238         # and then we remove either or both of 'forkchange'/"$action.forkchange" if
2239         # they're older than the project cache (they've served their purpose, we're
2240         # forcing a page regeneration by touching "$action.changed" but the project
2241         # cache was rebuilt since then so there are no more pending fork updates to
2242         # pick up in the future and they need to go).
2243
2244         # For best results, the external code that touches 'forkchange' should always
2245         # touch 'forkchange' and additionally touch 'summary.forkchange' but only
2246         # if it does not already exist.  That way the cached page will be regenerated
2247         # each time it's requested and ANY fork updates are available in the proj
2248         # cache rather than waiting until they all are before updating.
2249
2250         # Note that we take a shortcut here and will zap 'forkchange' since we know
2251         # that it only affects the 'summary' cache.  If, in the future, it affects
2252         # other cache types, it will first need to be propogated down to
2253         # "$action.forkchange" for those types before we zap it.
2254
2255         my $fd;
2256         open $fd, '>', "$htmlcd/$action.changed" and close $fd;
2257         $fc_mt=undef, unlink "$htmlcd/forkchange" if defined $fc_mt && $fc_mt < $prj_mt;
2258         $afc_mt=undef, unlink "$htmlcd/$action.forkchange" if defined $afc_mt && $afc_mt < $prj_mt;
2259
2260         # Now we propagate 'forkchange' to "$action.forkchange" if we have the
2261         # one and not the other.
2262
2263         if (defined $fc_mt && ! defined $afc_mt) {
2264                 open $fd, '>', "$htmlcd/$action.forkchange" and close $fd;
2265                 -e "$htmlcd/$action.forkchange" and
2266                 utime($fc_mt, $fc_mt, "$htmlcd/$action.forkchange") and
2267                 unlink "$htmlcd/forkchange";
2268         }
2269
2270         return 0;
2271 }
2272
2273 sub cached_action_page {
2274         my $action = shift;
2275
2276         return undef unless $action && $html_cache_actions{$action} && $html_cache_dir;
2277         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2278         return undef if -e "$htmlcd/changed" || -e "$htmlcd/$action.changed";
2279         return undef unless cached_page_precondition_check($action);
2280         open my $fd, '<', "$htmlcd/$action" or return undef;
2281         binmode $fd;
2282         local $/;
2283         my $cached_page = <$fd>;
2284         close $fd or return undef;
2285         return $cached_page;
2286 }
2287
2288 package Git::Gitweb::CacheFile;
2289
2290 sub TIEHANDLE {
2291         use POSIX qw(:fcntl_h);
2292         my $class = shift;
2293         my $cachefile = shift;
2294
2295         sysopen(my $self, $cachefile, O_WRONLY|O_CREAT|O_EXCL, 0664)
2296                 or return undef;
2297         $$self->{'cachefile'} = $cachefile;
2298         $$self->{'opened'} = 1;
2299         $$self->{'contents'} = '';
2300         return bless $self, $class;
2301 }
2302
2303 sub CLOSE {
2304         my $self = shift;
2305         if ($$self->{'opened'}) {
2306                 $$self->{'opened'} = 0;
2307                 my $result = close $self;
2308                 unlink $$self->{'cachefile'} unless $result;
2309                 return $result;
2310         }
2311         return 0;
2312 }
2313
2314 sub DESTROY {
2315         my $self = shift;
2316         if ($$self->{'opened'}) {
2317                 $self->CLOSE() and unlink $$self->{'cachefile'};
2318         }
2319 }
2320
2321 sub PRINT {
2322         my $self = shift;
2323         @_ = (map {my $x=$_; utf8::encode($x); $x} @_) unless $fcgi_raw_mode;
2324         print $self @_ if $$self->{'opened'};
2325         $$self->{'contents'} .= join('', @_);
2326         return 1;
2327 }
2328
2329 sub PRINTF {
2330         my $self = shift;
2331         my $template = shift;
2332         return $self->PRINT(sprintf $template, @_);
2333 }
2334
2335 sub contents {
2336         my $self = shift;
2337         return $$self->{'contents'};
2338 }
2339
2340 package main;
2341
2342 # Caller is responsible for preserving STDOUT beforehand if needed
2343 sub cached_action_start {
2344         my $action = shift;
2345
2346         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2347         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2348         return undef unless -d $htmlcd;
2349         if (-e "$htmlcd/changed") {
2350                 foreach my $cacheable (keys(%html_cache_actions)) {
2351                         next unless $supported_cache_actions{$cacheable} &&
2352                                     $html_cache_actions{$cacheable};
2353                         my $fd;
2354                         open $fd, '>', "$htmlcd/$cacheable.changed"
2355                         and close $fd;
2356                 }
2357                 unlink "$htmlcd/changed";
2358         }
2359         local *CACHEFILE;
2360         tie *CACHEFILE, 'Git::Gitweb::CacheFile', "$htmlcd/$action.lock"  or return undef;
2361         *STDOUT = *CACHEFILE;
2362         unlink "$htmlcd/$action", "$htmlcd/$action.changed";
2363         return 1;
2364 }
2365
2366 # Caller is responsible for restoring STDOUT afterward if needed
2367 sub cached_action_finish {
2368         my $action = shift;
2369
2370         use File::Spec;
2371
2372         my $obj = tied *STDOUT;
2373         return undef unless ref($obj) eq 'Git::Gitweb::CacheFile';
2374         my $cached_page = $obj->contents;
2375         (my $result = close(STDOUT)) or warn "couldn't close cache file on STDOUT: $!";
2376         # Do not leave STDOUT file descriptor invalid!
2377         local *NULL;
2378         open(NULL, '>', File::Spec->devnull) or die "couldn't open NULL to devnull: $!";
2379         *STDOUT = *NULL;
2380         return $cached_page unless $result;
2381         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2382         return $cached_page unless -d $htmlcd;
2383         unlink "$htmlcd/$action.lock" unless rename "$htmlcd/$action.lock", "$htmlcd/$action";
2384         return $cached_page;
2385 }
2386
2387 my %expand_pi_subs;
2388 BEGIN {%expand_pi_subs = (
2389         'age_string'              => \&age_string,
2390         'age_string_date'         => \&age_string_date,
2391         'age_string_age'          => \&age_string_age,
2392         'compute_timed_interval'  => \&compute_timed_interval,
2393         'compute_commands_count'  => \&compute_commands_count,
2394         'format_lastrefresh_row'  => \&format_lastrefresh_row,
2395 )}
2396
2397 # Expands any <?gitweb...> processing instructions and returns the result
2398 sub expand_gitweb_pi {
2399         my $page = shift;
2400         $page .= '';
2401         my @time_now = gettimeofday();
2402         $page =~ s{<\?gitweb(?:\s+([^\s>]+)([^>]*))?\s*\?>}
2403                   {defined($1) ?
2404                           (ref($expand_pi_subs{$1}) eq 'CODE' ?
2405                                   $expand_pi_subs{$1}->(split(' ',$2), @time_now) :
2406                                   '') :
2407                           '' }goes;
2408         return $page;
2409 }
2410
2411 ## ----------------------------------------------------------------------
2412 ## HTML aware string manipulation
2413
2414 # Try to chop given string on a word boundary between position
2415 # $len and $len+$add_len. If there is no word boundary there,
2416 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
2417 # (marking chopped part) would be longer than given string.
2418 sub chop_str {
2419         my $str = shift;
2420         my $len = shift;
2421         my $add_len = shift || 10;
2422         my $where = shift || 'right'; # 'left' | 'center' | 'right'
2423
2424         # Make sure perl knows it is utf8 encoded so we don't
2425         # cut in the middle of a utf8 multibyte char.
2426         $str = to_utf8($str);
2427
2428         # allow only $len chars, but don't cut a word if it would fit in $add_len
2429         # if it doesn't fit, cut it if it's still longer than the dots we would add
2430         # remove chopped character entities entirely
2431
2432         # when chopping in the middle, distribute $len into left and right part
2433         # return early if chopping wouldn't make string shorter
2434         if ($where eq 'center') {
2435                 return $str if ($len + 5 >= length($str)); # filler is length 5
2436                 $len = int($len/2);
2437         } else {
2438                 return $str if ($len + 4 >= length($str)); # filler is length 4
2439         }
2440
2441         # regexps: ending and beginning with word part up to $add_len
2442         my $endre = qr/.{$len}\w{0,$add_len}/;
2443         my $begre = qr/\w{0,$add_len}.{$len}/;
2444
2445         if ($where eq 'left') {
2446                 $str =~ m/^(.*?)($begre)$/;
2447                 my ($lead, $body) = ($1, $2);
2448                 if (length($lead) > 4) {
2449                         $lead = " ...";
2450                 }
2451                 return "$lead$body";
2452
2453         } elsif ($where eq 'center') {
2454                 $str =~ m/^($endre)(.*)$/;
2455                 my ($left, $str)  = ($1, $2);
2456                 $str =~ m/^(.*?)($begre)$/;
2457                 my ($mid, $right) = ($1, $2);
2458                 if (length($mid) > 5) {
2459                         $mid = " ... ";
2460                 }
2461                 return "$left$mid$right";
2462
2463         } else {
2464                 $str =~ m/^($endre)(.*)$/;
2465                 my $body = $1;
2466                 my $tail = $2;
2467                 if (length($tail) > 4) {
2468                         $tail = "... ";
2469                 }
2470                 return "$body$tail";
2471         }
2472 }
2473
2474 # pass-through email filter, obfuscating it when possible
2475 sub email_obfuscate {
2476         our $email;
2477         my ($str) = @_;
2478         if ($email) {
2479                 $str = $email->escape_html($str);
2480                 # Stock HTML::Email::Obfuscate version likes to produce
2481                 # invalid XHTML...
2482                 $str =~ s#<(/?)B>#<$1b>#g;
2483                 return $str;
2484         } else {
2485                 $str = esc_html($str);
2486                 $str =~ s/@/&#x40;/;
2487                 return $str;
2488         }
2489 }
2490
2491 # takes the same arguments as chop_str, but also wraps a <span> around the
2492 # result with a title attribute if it does get chopped. Additionally, the
2493 # string is HTML-escaped.
2494 sub chop_and_escape_str {
2495         my ($str) = @_;
2496
2497         my $chopped = chop_str(@_);
2498         $str = to_utf8($str);
2499         if ($chopped eq $str) {
2500                 return email_obfuscate($chopped);
2501         } else {
2502                 {
2503                         use bytes;
2504                         $str =~ s/[[:cntrl:]]/?/g;
2505                 }
2506                 return $cgi->span({-title=>$str}, email_obfuscate($chopped));
2507         }
2508 }
2509
2510 # Highlight selected fragments of string, using given CSS class,
2511 # and escape HTML.  It is assumed that fragments do not overlap.
2512 # Regions are passed as list of pairs (array references).
2513 #
2514 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
2515 # '<span class="mark">foo</span>bar'
2516 sub esc_html_hl_regions {
2517         my ($str, $css_class, @sel) = @_;
2518         my %opts = grep { ref($_) ne 'ARRAY' } @sel;
2519         @sel     = grep { ref($_) eq 'ARRAY' } @sel;
2520         return esc_html($str, %opts) unless @sel;
2521
2522         my $out = '';
2523         my $pos = 0;
2524
2525         for my $s (@sel) {
2526                 my ($begin, $end) = @$s;
2527
2528                 # Don't create empty <span> elements.
2529                 next if $end <= $begin;
2530
2531                 my $escaped = esc_html(substr($str, $begin, $end - $begin),
2532                                        %opts);
2533
2534                 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
2535                         if ($begin - $pos > 0);
2536                 $out .= $cgi->span({-class => $css_class}, $escaped);
2537
2538                 $pos = $end;
2539         }
2540         $out .= esc_html(substr($str, $pos), %opts)
2541                 if ($pos < length($str));
2542
2543         return $out;
2544 }
2545
2546 # return positions of beginning and end of each match
2547 sub matchpos_list {
2548         my ($str, $regexp) = @_;
2549         return unless (defined $str && defined $regexp);
2550
2551         my @matches;
2552         while ($str =~ /$regexp/g) {
2553                 push @matches, [$-[0], $+[0]];
2554         }
2555         return @matches;
2556 }
2557
2558 # highlight match (if any), and escape HTML
2559 sub esc_html_match_hl {
2560         my ($str, $regexp) = @_;
2561         return esc_html($str) unless defined $regexp;
2562
2563         my @matches = matchpos_list($str, $regexp);
2564         return esc_html($str) unless @matches;
2565
2566         return esc_html_hl_regions($str, 'match', @matches);
2567 }
2568
2569
2570 # highlight match (if any) of shortened string, and escape HTML
2571 sub esc_html_match_hl_chopped {
2572         my ($str, $chopped, $regexp) = @_;
2573         return esc_html_match_hl($str, $regexp) unless defined $chopped;
2574
2575         my @matches = matchpos_list($str, $regexp);
2576         return esc_html($chopped) unless @matches;
2577
2578         # filter matches so that we mark chopped string
2579         my $tail = "... "; # see chop_str
2580         unless ($chopped =~ s/\Q$tail\E$//) {
2581                 $tail = '';
2582         }
2583         my $chop_len = length($chopped);
2584         my $tail_len = length($tail);
2585         my @filtered;
2586
2587         for my $m (@matches) {
2588                 if ($m->[0] > $chop_len) {
2589                         push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
2590                         last;
2591                 } elsif ($m->[1] > $chop_len) {
2592                         push @filtered, [ $m->[0], $chop_len + $tail_len ];
2593                         last;
2594                 }
2595                 push @filtered, $m;
2596         }
2597
2598         return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
2599 }
2600
2601 ## ----------------------------------------------------------------------
2602 ## functions returning short strings
2603
2604 # CSS class for given age epoch value (in seconds)
2605 # and reference time (optional, defaults to now) as second value
2606 sub age_class {
2607         my ($age_epoch, $time_now) = @_;
2608         return "noage" unless defined $age_epoch;
2609         defined $time_now or $time_now = time;
2610         my $age = $time_now - $age_epoch;
2611
2612         if ($age < 60*60*2) {
2613                 return "age0";
2614         } elsif ($age < 60*60*24*2) {
2615                 return "age1";
2616         } else {
2617                 return "age2";
2618         }
2619 }
2620
2621 # convert age epoch in seconds to "nn units ago" string
2622 # reference time used is now unless second argument passed in
2623 # to get the old behavior, pass 0 as the first argument and
2624 # the time in seconds as the second
2625 sub age_string {
2626         my ($age_epoch, $time_now) = @_;
2627         return "unknown" unless defined $age_epoch;
2628         return "<?gitweb age_string $age_epoch?>" if $cache_mode_active;
2629         defined $time_now or $time_now = time;
2630         my $age = $time_now - $age_epoch;
2631         my $age_str;
2632
2633         if ($age > 60*60*24*365*2) {
2634                 $age_str = (int $age/60/60/24/365);
2635                 $age_str .= " years ago";
2636         } elsif ($age > 60*60*24*(365/12)*2) {
2637                 $age_str = int $age/60/60/24/(365/12);
2638                 $age_str .= " months ago";
2639         } elsif ($age > 60*60*24*7*2) {
2640                 $age_str = int $age/60/60/24/7;
2641                 $age_str .= " weeks ago";
2642         } elsif ($age > 60*60*24*2) {
2643                 $age_str = int $age/60/60/24;
2644                 $age_str .= " days ago";
2645         } elsif ($age > 60*60*2) {
2646                 $age_str = int $age/60/60;
2647                 $age_str .= " hours ago";
2648         } elsif ($age > 60*2) {
2649                 $age_str = int $age/60;
2650                 $age_str .= " min ago";
2651         } elsif ($age > 2) {
2652                 $age_str = int $age;
2653                 $age_str .= " sec ago";
2654         } else {
2655                 $age_str .= " right now";
2656         }
2657         return $age_str;
2658 }
2659
2660 # returns age_string if the age is <= 2 weeks otherwise an absolute date
2661 # this is typically shown to the user directly with the age_string_age as a title
2662 sub age_string_date {
2663         my ($age_epoch, $time_now) = @_;
2664         return "unknown" unless defined $age_epoch;
2665         return "<?gitweb age_string_date $age_epoch?>" if $cache_mode_active;
2666         defined $time_now or $time_now = time;
2667         my $age = $time_now - $age_epoch;
2668
2669         if ($age > 60*60*24*7*2) {
2670                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2671                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2672         } else {
2673                 return age_string($age_epoch, $time_now);
2674         }
2675 }
2676
2677 # returns an absolute date if the age is <= 2 weeks otherwise age_string
2678 # this is typically used for the 'title' attribute so it will show as a tooltip
2679 sub age_string_age {
2680         my ($age_epoch, $time_now) = @_;
2681         return "unknown" unless defined $age_epoch;
2682         return "<?gitweb age_string_age $age_epoch?>" if $cache_mode_active;
2683         defined $time_now or $time_now = time;
2684         my $age = $time_now - $age_epoch;
2685
2686         if ($age > 60*60*24*7*2) {
2687                 return age_string($age_epoch, $time_now);
2688         } else {
2689                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2690                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2691         }
2692 }
2693
2694 use constant {
2695         S_IFINVALID => 0030000,
2696         S_IFGITLINK => 0160000,
2697 };
2698
2699 # submodule/subproject, a commit object reference
2700 sub S_ISGITLINK {
2701         my $mode = shift;
2702
2703         return (($mode & S_IFMT) == S_IFGITLINK)
2704 }
2705
2706 # convert file mode in octal to symbolic file mode string
2707 sub mode_str {
2708         my $mode = oct shift;
2709
2710         if (S_ISGITLINK($mode)) {
2711                 return 'm---------';
2712         } elsif (S_ISDIR($mode & S_IFMT)) {
2713                 return 'drwxr-xr-x';
2714         } elsif (S_ISLNK($mode)) {
2715                 return 'lrwxrwxrwx';
2716         } elsif (S_ISREG($mode)) {
2717                 # git cares only about the executable bit
2718                 if ($mode & S_IXUSR) {
2719                         return '-rwxr-xr-x';
2720                 } else {
2721                         return '-rw-r--r--';
2722                 };
2723         } else {
2724                 return '----------';
2725         }
2726 }
2727
2728 # convert file mode in octal to file type string
2729 sub file_type {
2730         my $mode = shift;
2731
2732         if ($mode !~ m/^[0-7]+$/) {
2733                 return $mode;
2734         } else {
2735                 $mode = oct $mode;
2736         }
2737
2738         if (S_ISGITLINK($mode)) {
2739                 return "submodule";
2740         } elsif (S_ISDIR($mode & S_IFMT)) {
2741                 return "directory";
2742         } elsif (S_ISLNK($mode)) {
2743                 return "symlink";
2744         } elsif (S_ISREG($mode)) {
2745                 return "file";
2746         } else {
2747                 return "unknown";
2748         }
2749 }
2750
2751 # convert file mode in octal to file type description string
2752 sub file_type_long {
2753         my $mode = shift;
2754
2755         if ($mode !~ m/^[0-7]+$/) {
2756                 return $mode;
2757         } else {
2758                 $mode = oct $mode;
2759         }
2760
2761         if (S_ISGITLINK($mode)) {
2762                 return "submodule";
2763         } elsif (S_ISDIR($mode & S_IFMT)) {
2764                 return "directory";
2765         } elsif (S_ISLNK($mode)) {
2766                 return "symlink";
2767         } elsif (S_ISREG($mode)) {
2768                 if ($mode & S_IXUSR) {
2769                         return "executable";
2770                 } else {
2771                         return "file";
2772                 };
2773         } else {
2774                 return "unknown";
2775         }
2776 }
2777
2778
2779 ## ----------------------------------------------------------------------
2780 ## functions returning short HTML fragments, or transforming HTML fragments
2781 ## which don't belong to other sections
2782
2783 # format line of commit message.
2784 sub format_log_line_html {
2785         my $line = shift;
2786
2787         $line = esc_html($line, -nbsp=>1);
2788         $line =~ s{
2789         \b
2790         (
2791             # The output of "git describe", e.g. v2.10.0-297-gf6727b0
2792             # or hadoop-20160921-113441-20-g094fb7d
2793             (?<!-) # see strbuf_check_tag_ref(). Tags can't start with -
2794             [A-Za-z0-9.-]+
2795             (?!\.) # refs can't end with ".", see check_refname_format()
2796             -g[0-9a-fA-F]{7,40}
2797             |
2798             # Just a normal looking Git SHA1
2799             [0-9a-fA-F]{7,40}
2800         )
2801         \b
2802     }{
2803                 $cgi->a({-href => href(action=>"object", hash=>$1),
2804                                         -class => "text"}, $1);
2805         }egx unless $line =~ /^\s*git-svn-id:/;
2806
2807         return $line;
2808 }
2809
2810 # format marker of refs pointing to given object
2811
2812 # the destination action is chosen based on object type and current context:
2813 # - for annotated tags, we choose the tag view unless it's the current view
2814 #   already, in which case we go to shortlog view
2815 # - for other refs, we keep the current view if we're in history, shortlog or
2816 #   log view, and select shortlog otherwise
2817 sub format_ref_marker {
2818         my ($refs, $id) = @_;
2819         my $markers = '';
2820
2821         if (defined $refs->{$id}) {
2822                 foreach my $ref (@{$refs->{$id}}) {
2823                         # this code exploits the fact that non-lightweight tags are the
2824                         # only indirect objects, and that they are the only objects for which
2825                         # we want to use tag instead of shortlog as action
2826                         my ($type, $name) = qw();
2827                         my $indirect = ($ref =~ s/\^\{\}$//);
2828                         # e.g. tags/v2.6.11 or heads/next
2829                         if ($ref =~ m!^(.*?)s?/(.*)$!) {
2830                                 $type = $1;
2831                                 $name = $2;
2832                         } else {
2833                                 $type = "ref";
2834                                 $name = $ref;
2835                         }
2836
2837                         my $class = $type;
2838                         $class .= " indirect" if $indirect;
2839
2840                         my $dest_action = "shortlog";
2841
2842                         if ($indirect) {
2843                                 $dest_action = "tag" unless $action eq "tag";
2844                         } elsif ($action =~ /^(history|(short)?log)$/) {
2845                                 $dest_action = $action;
2846                         }
2847
2848                         my $dest = "";
2849                         $dest .= "refs/" unless $ref =~ m!^refs/!;
2850                         $dest .= $ref;
2851
2852                         my $link = $cgi->a({
2853                                 -href => href(
2854                                         action=>$dest_action,
2855                                         hash=>$dest
2856                                 )}, esc_html($name));
2857
2858                         $markers .= "<span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2859                                 $link . "</span>";
2860                 }
2861         }
2862
2863         if ($markers) {
2864                 return '<span class="refs">'. $markers . '</span>';
2865         } else {
2866                 return "";
2867         }
2868 }
2869
2870 # format, perhaps shortened and with markers, title line
2871 sub format_subject_html {
2872         my ($long, $short, $href, $extra) = @_;
2873         $extra = '' unless defined($extra);
2874
2875         if (length($short) < length($long)) {
2876                 {
2877                         use bytes;
2878                         $long =~ s/[[:cntrl:]]/?/g;
2879                 }
2880                 return $cgi->a({-href => $href, -class => "list subject",
2881                                 -title => to_utf8($long)},
2882                        esc_html($short)) . $extra;
2883         } else {
2884                 return $cgi->a({-href => $href, -class => "list subject"},
2885                        esc_html($long)) . $extra;
2886         }
2887 }
2888
2889 # Rather than recomputing the url for an email multiple times, we cache it
2890 # after the first hit. This gives a visible benefit in views where the avatar
2891 # for the same email is used repeatedly (e.g. shortlog).
2892 # The cache is shared by all avatar engines (currently gravatar only), which
2893 # are free to use it as preferred. Since only one avatar engine is used for any
2894 # given page, there's no risk for cache conflicts.
2895 our %avatar_cache = ();
2896
2897 # Compute the picon url for a given email, by using the picon search service over at
2898 # http://www.cs.indiana.edu/picons/search.html
2899 sub picon_url {
2900         my $email = lc shift;
2901         if (!$avatar_cache{$email}) {
2902                 my ($user, $domain) = split('@', $email);
2903                 $avatar_cache{$email} =
2904                         "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2905                         "$domain/$user/" .
2906                         "users+domains+unknown/up/single";
2907         }
2908         return $avatar_cache{$email};
2909 }
2910
2911 # Compute the gravatar url for a given email, if it's not in the cache already.
2912 # Gravatar stores only the part of the URL before the size, since that's the
2913 # one computationally more expensive. This also allows reuse of the cache for
2914 # different sizes (for this particular engine).
2915 sub gravatar_url {
2916         my $email = lc shift;
2917         my $size = shift;
2918         $avatar_cache{$email} ||=
2919                 "//www.gravatar.com/avatar/" .
2920                         Digest::MD5::md5_hex($email) . "?s=";
2921         return $avatar_cache{$email} . $size;
2922 }
2923
2924 # Insert an avatar for the given $email at the given $size if the feature
2925 # is enabled.
2926 sub git_get_avatar {
2927         my ($email, %opts) = @_;
2928         my $pre_white  = ($opts{-pad_before} ? "&#160;" : "");
2929         my $post_white = ($opts{-pad_after}  ? "&#160;" : "");
2930         $opts{-size} ||= 'default';
2931         my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2932         my $url = "";
2933         if ($git_avatar eq 'gravatar') {
2934                 $url = gravatar_url($email, $size);
2935         } elsif ($git_avatar eq 'picon') {
2936                 $url = picon_url($email);
2937         }
2938         # Other providers can be added by extending the if chain, defining $url
2939         # as needed. If no variant puts something in $url, we assume avatars
2940         # are completely disabled/unavailable.
2941         if ($url) {
2942                 return $pre_white .
2943                        "<img width=\"$size\" " .
2944                             "class=\"avatar\" " .
2945                             "src=\"".esc_url($url)."\" " .
2946                             "alt=\"\" " .
2947                        "/>" . $post_white;
2948         } else {
2949                 return "";
2950         }
2951 }
2952
2953 sub format_search_author {
2954         my ($author, $searchtype, $displaytext) = @_;
2955         my $have_search = gitweb_check_feature('search');
2956
2957         if ($have_search) {
2958                 my $performed = "";
2959                 if ($searchtype eq 'author') {
2960                         $performed = "authored";
2961                 } elsif ($searchtype eq 'committer') {
2962                         $performed = "committed";
2963                 }
2964
2965                 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2966                                 searchtext=>$author,
2967                                 searchtype=>$searchtype), class=>"list",
2968                                 title=>"Search for commits $performed by $author"},
2969                                 $displaytext);
2970
2971         } else {
2972                 return $displaytext;
2973         }
2974 }
2975
2976 # format the author name of the given commit with the given tag
2977 # the author name is chopped and escaped according to the other
2978 # optional parameters (see chop_str).
2979 sub format_author_html {
2980         my $tag = shift;
2981         my $co = shift;
2982         my $author = chop_and_escape_str($co->{'author_name'}, @_);
2983         return "<$tag class=\"author\">" .
2984                format_search_author($co->{'author_name'}, "author",
2985                        git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2986                        $author) .
2987                "</$tag>";
2988 }
2989
2990 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
2991 sub format_git_diff_header_line {
2992         my $line = shift;
2993         my $diffinfo = shift;
2994         my ($from, $to) = @_;
2995
2996         if ($diffinfo->{'nparents'}) {
2997                 # combined diff
2998                 $line =~ s!^(diff (.*?) )"?.*$!$1!;
2999                 if ($to->{'href'}) {
3000                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
3001                                          esc_path($to->{'file'}));
3002                 } else { # file was deleted (no href)
3003                         $line .= esc_path($to->{'file'});
3004                 }
3005         } else {
3006                 # "ordinary" diff
3007                 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
3008                 if ($from->{'href'}) {
3009                         $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
3010                                          'a/' . esc_path($from->{'file'}));
3011                 } else { # file was added (no href)
3012                         $line .= 'a/' . esc_path($from->{'file'});
3013                 }
3014                 $line .= ' ';
3015                 if ($to->{'href'}) {
3016                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
3017                                          'b/' . esc_path($to->{'file'}));
3018                 } else { # file was deleted
3019                         $line .= 'b/' . esc_path($to->{'file'});
3020                 }
3021         }
3022
3023         return "<div class=\"diff header\">$line</div>\n";
3024 }
3025
3026 # format extended diff header line, before patch itself
3027 sub format_extended_diff_header_line {
3028         my $line = shift;
3029         my $diffinfo = shift;
3030         my ($from, $to) = @_;
3031
3032         # match <path>
3033         if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
3034                 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
3035                                        esc_path($from->{'file'}));
3036         }
3037         if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
3038                 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3039                                  esc_path($to->{'file'}));
3040         }
3041         # match single <mode>
3042         if ($line =~ m/\s(\d{6})$/) {
3043                 $line .= '<span class="info"> (' .
3044                          file_type_long($1) .
3045                          ')</span>';
3046         }
3047         # match <hash>
3048         if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
3049                 # can match only for combined diff
3050                 $line = 'index ';
3051                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3052                         if ($from->{'href'}[$i]) {
3053                                 $line .= $cgi->a({-href=>$from->{'href'}[$i],
3054                                                   -class=>"hash"},
3055                                                  substr($diffinfo->{'from_id'}[$i],0,7));
3056                         } else {
3057                                 $line .= '0' x 7;
3058                         }
3059                         # separator
3060                         $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
3061                 }
3062                 $line .= '..';
3063                 if ($to->{'href'}) {
3064                         $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
3065                                          substr($diffinfo->{'to_id'},0,7));
3066                 } else {
3067                         $line .= '0' x 7;
3068                 }
3069
3070         } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
3071                 # can match only for ordinary diff
3072                 my ($from_link, $to_link);
3073                 if ($from->{'href'}) {
3074                         $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
3075                                              substr($diffinfo->{'from_id'},0,7));
3076                 } else {
3077                         $from_link = '0' x 7;
3078                 }
3079                 if ($to->{'href'}) {
3080                         $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
3081                                            substr($diffinfo->{'to_id'},0,7));
3082                 } else {
3083                         $to_link = '0' x 7;
3084                 }
3085                 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
3086                 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
3087         }
3088
3089         return $line . "<br/>\n";
3090 }
3091
3092 # format from-file/to-file diff header
3093 sub format_diff_from_to_header {
3094         my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
3095         my $line;
3096         my $result = '';
3097
3098         $line = $from_line;
3099         #assert($line =~ m/^---/) if DEBUG;
3100         # no extra formatting for "^--- /dev/null"
3101         if (! $diffinfo->{'nparents'}) {
3102                 # ordinary (single parent) diff
3103                 if ($line =~ m!^--- "?a/!) {
3104                         if ($from->{'href'}) {
3105                                 $line = '--- a/' .
3106                                         $cgi->a({-href=>$from->{'href'}, -class=>"path"},
3107                                                 esc_path($from->{'file'}));
3108                         } else {
3109                                 $line = '--- a/' .
3110                                         esc_path($from->{'file'});
3111                         }
3112                 }
3113                 $result .= qq!<div class="diff from_file">$line</div>\n!;
3114
3115         } else {
3116                 # combined diff (merge commit)
3117                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3118                         if ($from->{'href'}[$i]) {
3119                                 $line = '--- ' .
3120                                         $cgi->a({-href=>href(action=>"blobdiff",
3121                                                              hash_parent=>$diffinfo->{'from_id'}[$i],
3122                                                              hash_parent_base=>$parents[$i],
3123                                                              file_parent=>$from->{'file'}[$i],
3124                                                              hash=>$diffinfo->{'to_id'},
3125                                                              hash_base=>$hash,
3126                                                              file_name=>$to->{'file'}),
3127                                                  -class=>"path",
3128                                                  -title=>"diff" . ($i+1)},
3129                                                 $i+1) .
3130                                         '/' .
3131                                         $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
3132                                                 esc_path($from->{'file'}[$i]));
3133                         } else {
3134                                 $line = '--- /dev/null';
3135                         }
3136                         $result .= qq!<div class="diff from_file">$line</div>\n!;
3137                 }
3138         }
3139
3140         $line = $to_line;
3141         #assert($line =~ m/^\+\+\+/) if DEBUG;
3142         # no extra formatting for "^+++ /dev/null"
3143         if ($line =~ m!^\+\+\+ "?b/!) {
3144                 if ($to->{'href'}) {
3145                         $line = '+++ b/' .
3146                                 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3147                                         esc_path($to->{'file'}));
3148                 } else {
3149                         $line = '+++ b/' .
3150                                 esc_path($to->{'file'});
3151                 }
3152         }
3153         $result .= qq!<div class="diff to_file">$line</div>\n!;
3154
3155         return $result;
3156 }
3157
3158 # create note for patch simplified by combined diff
3159 sub format_diff_cc_simplified {
3160         my ($diffinfo, @parents) = @_;
3161         my $result = '';
3162
3163         $result .= "<div class=\"diff header\">" .
3164                    "diff --cc ";
3165         if (!is_deleted($diffinfo)) {
3166                 $result .= $cgi->a({-href => href(action=>"blob",
3167                                                   hash_base=>$hash,
3168                                                   hash=>$diffinfo->{'to_id'},
3169                                                   file_name=>$diffinfo->{'to_file'}),
3170                                     -class => "path"},
3171                                    esc_path($diffinfo->{'to_file'}));
3172         } else {
3173                 $result .= esc_path($diffinfo->{'to_file'});
3174         }
3175         $result .= "</div>\n" . # class="diff header"
3176                    "<div class=\"diff nodifferences\">" .
3177                    "Simple merge" .
3178                    "</div>\n"; # class="diff nodifferences"
3179
3180         return $result;
3181 }
3182
3183 sub diff_line_class {
3184         my ($line, $from, $to) = @_;
3185
3186         # ordinary diff
3187         my $num_sign = 1;
3188         # combined diff
3189         if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
3190                 $num_sign = scalar @{$from->{'href'}};
3191         }
3192
3193         my @diff_line_classifier = (
3194                 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
3195                 { regexp => qr/^\\/,               class => "incomplete"  },
3196                 { regexp => qr/^ {$num_sign}/,     class => "ctx" },
3197                 # classifier for context must come before classifier add/rem,
3198                 # or we would have to use more complicated regexp, for example
3199                 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
3200                 { regexp => qr/^[+ ]{$num_sign}/,   class => "add" },
3201                 { regexp => qr/^[- ]{$num_sign}/,   class => "rem" },
3202         );
3203         for my $clsfy (@diff_line_classifier) {
3204                 return $clsfy->{'class'}
3205                         if ($line =~ $clsfy->{'regexp'});
3206         }
3207
3208         # fallback
3209         return "";
3210 }
3211
3212 # assumes that $from and $to are defined and correctly filled,
3213 # and that $line holds a line of chunk header for unified diff
3214 sub format_unidiff_chunk_header {
3215         my ($line, $from, $to) = @_;
3216
3217         my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
3218                 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
3219
3220         $from_lines = 0 unless defined $from_lines;
3221         $to_lines   = 0 unless defined $to_lines;
3222
3223         if ($from->{'href'}) {
3224                 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
3225                                      -class=>"list"}, $from_text);
3226         }
3227         if ($to->{'href'}) {
3228                 $to_text   = $cgi->a({-href=>"$to->{'href'}#l$to_start",
3229                                      -class=>"list"}, $to_text);
3230         }
3231         $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
3232                 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3233         return $line;
3234 }
3235
3236 # assumes that $from and $to are defined and correctly filled,
3237 # and that $line holds a line of chunk header for combined diff
3238 sub format_cc_diff_chunk_header {
3239         my ($line, $from, $to) = @_;
3240
3241         my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
3242         my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
3243
3244         @from_text = split(' ', $ranges);
3245         for (my $i = 0; $i < @from_text; ++$i) {
3246                 ($from_start[$i], $from_nlines[$i]) =
3247                         (split(',', substr($from_text[$i], 1)), 0);
3248         }
3249
3250         $to_text   = pop @from_text;
3251         $to_start  = pop @from_start;
3252         $to_nlines = pop @from_nlines;
3253
3254         $line = "<span class=\"chunk_info\">$prefix ";
3255         for (my $i = 0; $i < @from_text; ++$i) {
3256                 if ($from->{'href'}[$i]) {
3257                         $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
3258                                           -class=>"list"}, $from_text[$i]);
3259                 } else {
3260                         $line .= $from_text[$i];
3261                 }
3262                 $line .= " ";
3263         }
3264         if ($to->{'href'}) {
3265                 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
3266                                   -class=>"list"}, $to_text);
3267         } else {
3268                 $line .= $to_text;
3269         }
3270         $line .= " $prefix</span>" .
3271                  "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3272         return $line;
3273 }
3274
3275 # process patch (diff) line (not to be used for diff headers),
3276 # returning HTML-formatted (but not wrapped) line.
3277 # If the line is passed as a reference, it is treated as HTML and not
3278 # esc_html()'ed.
3279 sub format_diff_line {
3280         my ($line, $diff_class, $from, $to) = @_;
3281
3282         if (ref($line)) {
3283                 $line = $$line;
3284         } else {
3285                 chomp $line;
3286                 $line = untabify($line);
3287
3288                 if ($from && $to && $line =~ m/^\@{2} /) {
3289                         $line = format_unidiff_chunk_header($line, $from, $to);
3290                 } elsif ($from && $to && $line =~ m/^\@{3}/) {
3291                         $line = format_cc_diff_chunk_header($line, $from, $to);
3292                 } else {
3293                         $line = esc_html($line, -nbsp=>1);
3294                 }
3295         }
3296
3297         my $diff_classes = "diff diff_body";
3298         $diff_classes .= " $diff_class" if ($diff_class);
3299         $line = "<div class=\"$diff_classes\">$line</div>\n";
3300
3301         return $line;
3302 }
3303
3304 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
3305 # linked.  Pass the hash of the tree/commit to snapshot.
3306 sub format_snapshot_links {
3307         my ($hash) = @_;
3308         my $num_fmts = @snapshot_fmts;
3309         if ($num_fmts > 1) {
3310                 # A parenthesized list of links bearing format names.
3311                 # e.g. "snapshot (_tar.gz_ _zip_)"
3312                 return "snapshot (" . join(' ', map
3313                         $cgi->a({
3314                                 -href => href(
3315                                         action=>"snapshot",
3316                                         hash=>$hash,
3317                                         snapshot_format=>$_
3318                                 )
3319                         }, $known_snapshot_formats{$_}{'display'})
3320                 , @snapshot_fmts) . ")";
3321         } elsif ($num_fmts == 1) {
3322                 # A single "snapshot" link whose tooltip bears the format name.
3323                 # i.e. "_snapshot_"
3324                 my ($fmt) = @snapshot_fmts;
3325                 return
3326                         $cgi->a({
3327                                 -href => href(
3328                                         action=>"snapshot",
3329                                         hash=>$hash,
3330                                         snapshot_format=>$fmt
3331                                 ),
3332                                 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
3333                         }, "snapshot");
3334         } else { # $num_fmts == 0
3335                 return undef;
3336         }
3337 }
3338
3339 ## ......................................................................
3340 ## functions returning values to be passed, perhaps after some
3341 ## transformation, to other functions; e.g. returning arguments to href()
3342
3343 # returns hash to be passed to href to generate gitweb URL
3344 # in -title key it returns description of link
3345 sub get_feed_info {
3346         my $format = shift || 'Atom';
3347         my %res = (action => lc($format));
3348         my $matched_ref = 0;
3349
3350         # feed links are possible only for project views
3351         return unless (defined $project);
3352         # some views should link to OPML, or to generic project feed,
3353         # or don't have specific feed yet (so they should use generic)
3354         return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
3355
3356         my $branch = undef;
3357         # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
3358         # (fullname) to differentiate from tag links; this also makes
3359         # possible to detect branch links
3360         for my $ref (get_branch_refs()) {
3361                 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
3362                     (defined $hash      && $hash      =~ m!^refs/\Q$ref\E/(.*)$!)) {
3363                         $branch = $1;
3364                         $matched_ref = $ref;
3365                         last;
3366                 }
3367         }
3368         # find log type for feed description (title)
3369         my $type = 'log';
3370         if (defined $file_name) {
3371                 $type  = "history of $file_name";
3372                 $type .= "/" if ($action eq 'tree');
3373                 $type .= " on '$branch'" if (defined $branch);
3374         } else {
3375                 $type = "log of $branch" if (defined $branch);
3376         }
3377
3378         $res{-title} = $type;
3379         $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
3380         $res{'file_name'} = $file_name;
3381
3382         return %res;
3383 }
3384
3385 ## ----------------------------------------------------------------------
3386 ## git utility subroutines, invoking git commands
3387
3388 # returns path to the core git executable and the --git-dir parameter as list
3389 sub git_cmd {
3390         $number_of_git_cmds++;
3391         return $GIT, '--git-dir='.$git_dir;
3392 }
3393
3394 # opens a "-|" cmd pipe handle with 2>/dev/null and returns it
3395 sub cmd_pipe {
3396
3397         # In order to be compatible with FCGI mode we must use POSIX
3398         # and access the STDERR_FILENO file descriptor directly
3399
3400         use POSIX qw(STDERR_FILENO dup dup2);
3401
3402         open(my $null, '>', File::Spec->devnull) or die "couldn't open devnull: $!";
3403         (my $saveerr = dup(STDERR_FILENO)) or die "couldn't dup STDERR: $!";
3404         my $dup2ok = dup2(fileno($null), STDERR_FILENO);
3405         close($null) or !$dup2ok or die "couldn't close NULL: $!";
3406         $dup2ok or POSIX::close($saveerr), die "couldn't dup NULL to STDERR: $!";
3407         my $result = open(my $fd, "-|", @_);
3408         $dup2ok = dup2($saveerr, STDERR_FILENO);
3409         POSIX::close($saveerr) or !$dup2ok or die "couldn't close SAVEERR: $!";
3410         $dup2ok or die "couldn't dup SAVERR to STDERR: $!";
3411
3412         return $result ? $fd : undef;
3413 }
3414
3415 # opens a "-|" git_cmd pipe handle with 2>/dev/null and returns it
3416 sub git_cmd_pipe {
3417         return cmd_pipe git_cmd(), @_;
3418 }
3419
3420 # quote the given arguments for passing them to the shell
3421 # quote_command("command", "arg 1", "arg with ' and ! characters")
3422 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
3423 # Try to avoid using this function wherever possible.
3424 sub quote_command {
3425         return join(' ',
3426                 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
3427 }
3428
3429 # get HEAD ref of given project as hash
3430 sub git_get_head_hash {
3431         return git_get_full_hash(shift, 'HEAD');
3432 }
3433
3434 sub git_get_full_hash {
3435         return git_get_hash(@_);
3436 }
3437
3438 sub git_get_short_hash {
3439         return git_get_hash(@_, '--short=7');
3440 }
3441
3442 sub git_get_hash {
3443         my ($project, $hash, @options) = @_;
3444         my $o_git_dir = $git_dir;
3445         my $retval = undef;
3446         $git_dir = "$projectroot/$project";
3447         if (defined(my $fd = git_cmd_pipe 'rev-parse',
3448             '--verify', '-q', @options, $hash)) {
3449                 $retval = <$fd>;
3450                 chomp $retval if defined $retval;
3451                 close $fd;
3452         }
3453         if (defined $o_git_dir) {
3454                 $git_dir = $o_git_dir;
3455         }
3456         return $retval;
3457 }
3458
3459 # get type of given object
3460 sub git_get_type {
3461         my $hash = shift;
3462
3463         defined(my $fd = git_cmd_pipe "cat-file", '-t', $hash) or return;
3464         my $type = <$fd>;
3465         close $fd or return;
3466         chomp $type;
3467         return $type;
3468 }
3469
3470 # repository configuration
3471 our $config_file = '';
3472 our %config;
3473
3474 # store multiple values for single key as anonymous array reference
3475 # single values stored directly in the hash, not as [ <value> ]
3476 sub hash_set_multi {
3477         my ($hash, $key, $value) = @_;
3478
3479         if (!exists $hash->{$key}) {
3480                 $hash->{$key} = $value;
3481         } elsif (!ref $hash->{$key}) {
3482                 $hash->{$key} = [ $hash->{$key}, $value ];
3483         } else {
3484                 push @{$hash->{$key}}, $value;
3485         }
3486 }
3487
3488 # return hash of git project configuration
3489 # optionally limited to some section, e.g. 'gitweb'
3490 sub git_parse_project_config {
3491         my $section_regexp = shift;
3492         my %config;
3493
3494         local $/ = "\0";
3495
3496         defined(my $fh = git_cmd_pipe "config", '-z', '-l')
3497                 or return;
3498
3499         while (my $keyval = to_utf8(scalar <$fh>)) {
3500                 chomp $keyval;
3501                 my ($key, $value) = split(/\n/, $keyval, 2);
3502
3503                 hash_set_multi(\%config, $key, $value)
3504                         if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
3505         }
3506         close $fh;
3507
3508         return %config;
3509 }
3510
3511 # convert config value to boolean: 'true' or 'false'
3512 # no value, number > 0, 'true' and 'yes' values are true
3513 # rest of values are treated as false (never as error)
3514 sub config_to_bool {
3515         my $val = shift;
3516
3517         return 1 if !defined $val;             # section.key
3518
3519         # strip leading and trailing whitespace
3520         $val =~ s/^\s+//;
3521         $val =~ s/\s+$//;
3522
3523         return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
3524                 ($val =~ /^(?:true|yes)$/i));  # section.key = true
3525 }
3526
3527 # convert config value to simple decimal number
3528 # an optional value suffix of 'k', 'm', or 'g' will cause the value
3529 # to be multiplied by 1024, 1048576, or 1073741824
3530 sub config_to_int {
3531         my $val = shift;
3532
3533         # strip leading and trailing whitespace
3534         $val =~ s/^\s+//;
3535         $val =~ s/\s+$//;
3536
3537         if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
3538                 $unit = lc($unit);
3539                 # unknown unit is treated as 1
3540                 return $num * ($unit eq 'g' ? 1073741824 :
3541                                $unit eq 'm' ?    1048576 :
3542                                $unit eq 'k' ?       1024 : 1);
3543         }
3544         return $val;
3545 }
3546
3547 # convert config value to array reference, if needed
3548 sub config_to_multi {
3549         my $val = shift;
3550
3551         return ref($val) ? $val : (defined($val) ? [ $val ] : []);
3552 }
3553
3554 sub git_get_project_config {
3555         my ($key, $type) = @_;
3556
3557         return unless defined $git_dir;
3558
3559         # key sanity check
3560         return unless ($key);
3561         # only subsection, if exists, is case sensitive,
3562         # and not lowercased by 'git config -z -l'
3563         if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
3564                 $lo =~ s/_//g;
3565                 $key = join(".", lc($hi), $mi, lc($lo));
3566                 return if ($lo =~ /\W/ || $hi =~ /\W/);
3567         } else {
3568                 $key = lc($key);
3569                 $key =~ s/_//g;
3570                 return if ($key =~ /\W/);
3571         }
3572         $key =~ s/^gitweb\.//;
3573
3574         # type sanity check
3575         if (defined $type) {
3576                 $type =~ s/^--//;
3577                 $type = undef
3578                         unless ($type eq 'bool' || $type eq 'int');
3579         }
3580
3581         # get config
3582         if (!defined $config_file ||
3583             $config_file ne "$git_dir/config") {
3584                 %config = git_parse_project_config('gitweb');
3585                 $config_file = "$git_dir/config";
3586         }
3587
3588         # check if config variable (key) exists
3589         return unless exists $config{"gitweb.$key"};
3590
3591         # ensure given type
3592         if (!defined $type) {
3593                 return $config{"gitweb.$key"};
3594         } elsif ($type eq 'bool') {
3595                 # backward compatibility: 'git config --bool' returns true/false
3596                 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
3597         } elsif ($type eq 'int') {
3598                 return config_to_int($config{"gitweb.$key"});
3599         }
3600         return $config{"gitweb.$key"};
3601 }
3602
3603 # get hash of given path at given ref
3604 sub git_get_hash_by_path {
3605         my $base = shift;
3606         my $path = shift || return undef;
3607         my $type = shift;
3608
3609         $path =~ s,/+$,,;
3610
3611         defined(my $fd = git_cmd_pipe "ls-tree", $base, "--", $path)
3612                 or die_error(500, "Open git-ls-tree failed");
3613         my $line = to_utf8(scalar <$fd>);
3614         close $fd or return undef;
3615
3616         if (!defined $line) {
3617                 # there is no tree or hash given by $path at $base
3618                 return undef;
3619         }
3620
3621         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3622         $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
3623         if (defined $type && $type ne $2) {
3624                 # type doesn't match
3625                 return undef;
3626         }
3627         return $3;
3628 }
3629
3630 # get path of entry with given hash at given tree-ish (ref)
3631 # used to get 'from' filename for combined diff (merge commit) for renames
3632 sub git_get_path_by_hash {
3633         my $base = shift || return;
3634         my $hash = shift || return;
3635
3636         local $/ = "\0";
3637
3638         defined(my $fd = git_cmd_pipe "ls-tree", '-r', '-t', '-z', $base)
3639                 or return undef;
3640         while (my $line = to_utf8(scalar <$fd>)) {
3641                 chomp $line;
3642
3643                 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423  gitweb'
3644                 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f  gitweb/README'
3645                 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
3646                         close $fd;
3647                         return $1;
3648                 }
3649         }
3650         close $fd;
3651         return undef;
3652 }
3653
3654 ## ......................................................................
3655 ## git utility functions, directly accessing git repository
3656
3657 # get the value of config variable either from file named as the variable
3658 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
3659 # configuration variable in the repository config file.
3660 sub git_get_file_or_project_config {
3661         my ($path, $name) = @_;
3662
3663         $git_dir = "$projectroot/$path";
3664         open my $fd, '<', "$git_dir/$name"
3665                 or return git_get_project_config($name);
3666         my $conf = to_utf8(scalar <$fd>);
3667         close $fd;
3668         if (defined $conf) {
3669                 chomp $conf;
3670         }
3671         return $conf;
3672 }
3673
3674 sub git_get_project_description {
3675         my $path = shift;
3676         return git_get_file_or_project_config($path, 'description');
3677 }
3678
3679 sub git_get_project_category {
3680         my $path = shift;
3681         return git_get_file_or_project_config($path, 'category');
3682 }
3683
3684
3685 # supported formats:
3686 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
3687 #   - if its contents is a number, use it as tag weight,
3688 #   - otherwise add a tag with weight 1
3689 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
3690 #   the same value multiple times increases tag weight
3691 # * `gitweb.ctag' multi-valued repo config variable
3692 sub git_get_project_ctags {
3693         my $project = shift;
3694         my $ctags = {};
3695
3696         $git_dir = "$projectroot/$project";
3697         if (opendir my $dh, "$git_dir/ctags") {
3698                 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
3699                 foreach my $tagfile (@files) {
3700                         open my $ct, '<', $tagfile
3701                                 or next;
3702                         my $val = <$ct>;
3703                         chomp $val if $val;
3704                         close $ct;
3705
3706                         (my $ctag = $tagfile) =~ s#.*/##;
3707                         $ctag = to_utf8($ctag);
3708                         if ($val =~ /^\d+$/) {
3709                                 $ctags->{$ctag} = $val;
3710                         } else {
3711                                 $ctags->{$ctag} = 1;
3712                         }
3713                 }
3714                 closedir $dh;
3715
3716         } elsif (open my $fh, '<', "$git_dir/ctags") {
3717                 while (my $line = to_utf8(scalar <$fh>)) {
3718                         chomp $line;
3719                         $ctags->{$line}++ if $line;
3720                 }
3721                 close $fh;
3722
3723         } else {
3724                 my $taglist = config_to_multi(git_get_project_config('ctag'));
3725                 foreach my $tag (@$taglist) {
3726                         $ctags->{$tag}++;
3727                 }
3728         }
3729
3730         return $ctags;
3731 }
3732
3733 # return hash, where keys are content tags ('ctags'),
3734 # and values are sum of weights of given tag in every project
3735 sub git_gather_all_ctags {
3736         my $projects = shift;
3737         my $ctags = {};
3738
3739         foreach my $p (@$projects) {
3740                 foreach my $ct (keys %{$p->{'ctags'}}) {
3741                         $ctags->{$ct} += $p->{'ctags'}->{$ct};
3742                 }
3743         }
3744
3745         return $ctags;
3746 }
3747
3748 sub git_populate_project_tagcloud {
3749         my ($ctags, $action) = @_;
3750
3751         # First, merge different-cased tags; tags vote on casing
3752         my %ctags_lc;
3753         foreach (keys %$ctags) {
3754                 $ctags_lc{lc $_}->{count} += $ctags->{$_};
3755                 if (not $ctags_lc{lc $_}->{topcount}
3756                     or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
3757                         $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
3758                         $ctags_lc{lc $_}->{topname} = $_;
3759                 }
3760         }
3761
3762         my $cloud;
3763         my $matched = $input_params{'ctag_filter'};
3764         if (eval { require HTML::TagCloud; 1; }) {
3765                 $cloud = HTML::TagCloud->new;
3766                 foreach my $ctag (sort keys %ctags_lc) {
3767                         # Pad the title with spaces so that the cloud looks
3768                         # less crammed.
3769                         my $title = esc_html($ctags_lc{$ctag}->{topname});
3770                         $title =~ s/ /&#160;/g;
3771                         $title =~ s/^/&#160;/g;
3772                         $title =~ s/$/&#160;/g;
3773                         if (defined $matched && $matched eq $ctag) {
3774                                 $title = qq(<span class="match">$title</span>);
3775                         }
3776                         $cloud->add($title, href(-replay=>1, action=>$action, ctag_filter=>$ctag),
3777                                     $ctags_lc{$ctag}->{count});
3778                 }
3779         } else {
3780                 $cloud = {};
3781                 foreach my $ctag (keys %ctags_lc) {
3782                         my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3783                         if (defined $matched && $matched eq $ctag) {
3784                                 $title = qq(<span class="match">$title</span>);
3785                         }
3786                         $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3787                         $cloud->{$ctag}{ctag} =
3788                                 $cgi->a({-href=>href(-replay=>1, action=>$action, ctag_filter=>$ctag)}, $title);
3789                 }
3790         }
3791         return $cloud;
3792 }
3793
3794 sub git_show_project_tagcloud {
3795         my ($cloud, $count) = @_;
3796         if (ref $cloud eq 'HTML::TagCloud') {
3797                 return $cloud->html_and_css($count);
3798         } else {
3799                 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3800                 return
3801                         '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3802                         join (', ', map {
3803                                 $cloud->{$_}->{'ctag'}
3804                         } splice(@tags, 0, $count)) .
3805                         '</div>';
3806         }
3807 }
3808
3809 sub git_get_project_url_list {
3810         my $path = shift;
3811
3812         $git_dir = "$projectroot/$path";
3813         open my $fd, '<', "$git_dir/cloneurl"
3814                 or return wantarray ?
3815                 @{ config_to_multi(git_get_project_config('url')) } :
3816                    config_to_multi(git_get_project_config('url'));
3817         my @git_project_url_list = map { chomp; to_utf8($_) } <$fd>;
3818         close $fd;
3819
3820         return wantarray ? @git_project_url_list : \@git_project_url_list;
3821 }
3822
3823 sub git_get_projects_list {
3824         my $filter = shift;
3825         my $paranoid = shift;
3826         my @list;
3827         defined($filter) or $filter = "";
3828
3829         if (-d $projects_list) {
3830                 # search in directory
3831                 my $dir = $projects_list;
3832                 # remove the trailing "/"
3833                 $dir =~ s!/+$!!;
3834                 my $pfxlen = length("$dir");
3835                 my $pfxdepth = ($dir =~ tr!/!!);
3836                 # when filtering, search only given subdirectory
3837                 if ($filter ne "" && !$paranoid) {
3838                         $dir .= "/$filter";
3839                         $dir =~ s!/+$!!;
3840                 }
3841
3842                 File::Find::find({
3843                         follow_fast => 1, # follow symbolic links
3844                         follow_skip => 2, # ignore duplicates
3845                         dangling_symlinks => 0, # ignore dangling symlinks, silently
3846                         wanted => sub {
3847                                 # global variables
3848                                 our $project_maxdepth;
3849                                 our $projectroot;
3850                                 # skip project-list toplevel, if we get it.
3851                                 return if (m!^[/.]$!);
3852                                 # only directories can be git repositories
3853                                 return unless (-d $_);
3854                                 # don't traverse too deep (Find is super slow on os x)
3855                                 # $project_maxdepth excludes depth of $projectroot
3856                                 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3857                                         $File::Find::prune = 1;
3858                                         return;
3859                                 }
3860
3861                                 my $path = substr($File::Find::name, $pfxlen + 1);
3862                                 # paranoidly only filter here
3863                                 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3864                                         next;
3865                                 }
3866                                 # we check related file in $projectroot
3867                                 if (check_export_ok("$projectroot/$path")) {
3868                                         push @list, { path => $path };
3869                                         $File::Find::prune = 1;
3870                                 }
3871                         },
3872                 }, "$dir");
3873
3874         } elsif (-f $projects_list) {
3875                 # read from file(url-encoded):
3876                 # 'git%2Fgit.git Linus+Torvalds'
3877                 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3878                 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3879                 open my $fd, '<', $projects_list or return;
3880         PROJECT:
3881                 while (my $line = <$fd>) {
3882                         chomp $line;
3883                         my ($path, $owner) = split ' ', $line;
3884                         $path = unescape($path);
3885                         $owner = unescape($owner);
3886                         if (!defined $path) {
3887                                 next;
3888                         }
3889                         # if $filter is rpovided, check if $path begins with $filter
3890                         if ($filter ne "" && $path !~ m!^\Q$filter\E/!) {
3891                                 next;
3892                         }
3893                         if (check_export_ok("$projectroot/$path")) {
3894                                 my $pr = {
3895                                         path => $path
3896                                 };
3897                                 if ($owner) {
3898                                         $pr->{'owner'} = to_utf8($owner);
3899                                 }
3900                                 push @list, $pr;
3901                         }
3902                 }
3903                 close $fd;
3904         }
3905         return @list;
3906 }
3907
3908 # written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
3909 # as side effects it sets 'forks' field to list of forks for forked projects
3910 sub filter_forks_from_projects_list {
3911         my $projects = shift;
3912
3913         my %trie; # prefix tree of directories (path components)
3914         # generate trie out of those directories that might contain forks
3915         foreach my $pr (@$projects) {
3916                 my $path = $pr->{'path'};
3917                 $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
3918                 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3919                 next if ($path eq "");    # skip '.git' repository: tests, git-instaweb
3920                 next unless (-d "$projectroot/$path"); # containing directory exists
3921                 $pr->{'forks'} = [];      # there can be 0 or more forks of project
3922
3923                 # add to trie
3924                 my @dirs = split('/', $path);
3925                 # walk the trie, until either runs out of components or out of trie
3926                 my $ref = \%trie;
3927                 while (scalar @dirs &&
3928                        exists($ref->{$dirs[0]})) {
3929                         $ref = $ref->{shift @dirs};
3930                 }
3931                 # create rest of trie structure from rest of components
3932                 foreach my $dir (@dirs) {
3933                         $ref = $ref->{$dir} = {};
3934                 }
3935                 # create end marker, store $pr as a data
3936                 $ref->{''} = $pr if (!exists $ref->{''});
3937         }
3938
3939         # filter out forks, by finding shortest prefix match for paths
3940         my @filtered;
3941  PROJECT:
3942         foreach my $pr (@$projects) {
3943                 # trie lookup
3944                 my $ref = \%trie;
3945         DIR:
3946                 foreach my $dir (split('/', $pr->{'path'})) {
3947                         if (exists $ref->{''}) {
3948                                 # found [shortest] prefix, is a fork - skip it
3949                                 push @{$ref->{''}{'forks'}}, $pr;
3950                                 next PROJECT;
3951                         }
3952                         if (!exists $ref->{$dir}) {
3953                                 # not in trie, cannot have prefix, not a fork
3954                                 push @filtered, $pr;
3955                                 next PROJECT;
3956                         }
3957                         # If the dir is there, we just walk one step down the trie.
3958                         $ref = $ref->{$dir};
3959                 }
3960                 # we ran out of trie
3961                 # (shouldn't happen: it's either no match, or end marker)
3962                 push @filtered, $pr;
3963         }
3964
3965         return @filtered;
3966 }
3967
3968 # note: fill_project_list_info must be run first,
3969 # for 'descr_long' and 'ctags' to be filled
3970 sub search_projects_list {
3971         my ($projlist, %opts) = @_;
3972         my $tagfilter  = $opts{'tagfilter'};
3973         my $search_re = $opts{'search_regexp'};
3974
3975         return @$projlist
3976                 unless ($tagfilter || $search_re);
3977
3978         # searching projects require filling to be run before it;
3979         fill_project_list_info($projlist,
3980                                $tagfilter  ? 'ctags' : (),
3981                                $search_re ? ('path', 'descr') : ());
3982         my @projects;
3983  PROJECT:
3984         foreach my $pr (@$projlist) {
3985
3986                 if ($tagfilter) {
3987                         next unless ref($pr->{'ctags'}) eq 'HASH';
3988                         next unless
3989                                 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3990                 }
3991
3992                 if ($search_re) {
3993                         my $path = $pr->{'path'};
3994                         $path =~ s/\.git$//; # should not be included in search
3995                         next unless
3996                                 $path =~ /$search_re/ ||
3997                                 $pr->{'descr_long'} =~ /$search_re/;
3998                 }
3999
4000                 push @projects, $pr;
4001         }
4002
4003         return @projects;
4004 }
4005
4006 our $gitweb_project_owner = undef;
4007 sub git_get_project_list_from_file {
4008
4009         return if (defined $gitweb_project_owner);
4010
4011         $gitweb_project_owner = {};
4012         # read from file (url-encoded):
4013         # 'git%2Fgit.git Linus+Torvalds'
4014         # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
4015         # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
4016         if (-f $projects_list) {
4017                 open(my $fd, '<', $projects_list);
4018                 while (my $line = <$fd>) {
4019                         chomp $line;
4020                         my ($pr, $ow) = split ' ', $line;
4021                         $pr = unescape($pr);
4022                         $ow = unescape($ow);
4023                         $gitweb_project_owner->{$pr} = to_utf8($ow);
4024                 }
4025                 close $fd;
4026         }
4027 }
4028
4029 sub git_get_project_owner {
4030         my $proj = shift;
4031         my $owner;
4032
4033         return undef unless $proj;
4034         $git_dir = "$projectroot/$proj";
4035
4036         if (defined $project && $proj eq $project) {
4037                 $owner = git_get_project_config('owner');
4038         }
4039         if (!defined $owner && !defined $gitweb_project_owner) {
4040                 git_get_project_list_from_file();
4041         }
4042         if (!defined $owner && exists $gitweb_project_owner->{$proj}) {
4043                 $owner = $gitweb_project_owner->{$proj};
4044         }
4045         if (!defined $owner && (!defined $project || $proj ne $project)) {
4046                 $owner = git_get_project_config('owner');
4047         }
4048         if (!defined $owner) {
4049                 $owner = get_file_owner("$git_dir");
4050         }
4051
4052         return $owner;
4053 }
4054
4055 sub parse_activity_date {
4056         my $dstr = shift;
4057
4058         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
4059                 # Unix timestamp
4060                 return 0 + $1;
4061         }
4062         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt _](\d{1,2}):(\d{2}):(\d{2})(?:[ _]?([Zz]|(?:[-+]\d{1,2}:?\d{2})))?\s*$/) {
4063                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
4064                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, 0+$Y);
4065                 defined($z) && $z ne '' or $z = 'Z';
4066                 $z =~ s/://;
4067                 substr($z,1,0) = '0' if length($z) == 4;
4068                 my $off = 0;
4069                 if (uc($z) ne 'Z') {
4070                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
4071                         $off = -$off if substr($z,0,1) eq '-';
4072                 }
4073                 return $seconds - $off;
4074         }
4075         return undef;
4076 }
4077
4078 # If $quick is true only look at $lastactivity_file
4079 sub git_get_last_activity {
4080         my ($path, $quick) = @_;
4081         my $fd;
4082
4083         $git_dir = "$projectroot/$path";
4084         if ($lastactivity_file && open($fd, "<", "$git_dir/$lastactivity_file")) {
4085                 my $activity = <$fd>;
4086                 close $fd;
4087                 return (undef) unless defined $activity;
4088                 chomp $activity;
4089                 return (undef) if $activity eq '';
4090                 if (my $timestamp = parse_activity_date($activity)) {
4091                         return ($timestamp);
4092                 }
4093         }
4094         return (undef) if $quick;
4095         defined($fd = git_cmd_pipe 'for-each-ref',
4096              '--format=%(committer)',
4097              '--sort=-committerdate',
4098              '--count=1',
4099              map { "refs/$_" } get_branch_refs ()) or return;
4100         my $most_recent = <$fd>;
4101         close $fd or return (undef);
4102         if (defined $most_recent &&
4103             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
4104                 my $timestamp = $1;
4105                 return ($timestamp);
4106         }
4107         return (undef);
4108 }
4109
4110 # Implementation note: when a single remote is wanted, we cannot use 'git
4111 # remote show -n' because that command always work (assuming it's a remote URL
4112 # if it's not defined), and we cannot use 'git remote show' because that would
4113 # try to make a network roundtrip. So the only way to find if that particular
4114 # remote is defined is to walk the list provided by 'git remote -v' and stop if
4115 # and when we find what we want.
4116 sub git_get_remotes_list {
4117         my $wanted = shift;
4118         my %remotes = ();
4119
4120         my $fd = git_cmd_pipe 'remote', '-v';
4121         return unless $fd;
4122         while (my $remote = to_utf8(scalar <$fd>)) {
4123                 chomp $remote;
4124                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
4125                 next if $wanted and not $remote eq $wanted;
4126                 my ($url, $key) = ($1, $2);
4127
4128                 $remotes{$remote} ||= { 'heads' => [] };
4129                 $remotes{$remote}{$key} = $url;
4130         }
4131         close $fd or return;
4132         return wantarray ? %remotes : \%remotes;
4133 }
4134
4135 # Takes a hash of remotes as first parameter and fills it by adding the
4136 # available remote heads for each of the indicated remotes.
4137 sub fill_remote_heads {
4138         my $remotes = shift;
4139         my @heads = map { "remotes/$_" } keys %$remotes;
4140         my @remoteheads = git_get_heads_list(undef, @heads);
4141         foreach my $remote (keys %$remotes) {
4142                 $remotes->{$remote}{'heads'} = [ grep {
4143                         $_->{'name'} =~ s!^$remote/!!
4144                         } @remoteheads ];
4145         }
4146 }
4147
4148 sub git_get_references {
4149         my $type = shift || "";
4150         my %refs;
4151         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
4152         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
4153         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
4154                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
4155                 or return;
4156
4157         while (my $line = to_utf8(scalar <$fd>)) {
4158                 chomp $line;
4159                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
4160                         if (defined $refs{$1}) {
4161                                 push @{$refs{$1}}, $2;
4162                         } else {
4163                                 $refs{$1} = [ $2 ];
4164                         }
4165                 }
4166         }
4167         close $fd or return;
4168         return \%refs;
4169 }
4170
4171 sub git_get_rev_name_tags {
4172         my $hash = shift || return undef;
4173
4174         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
4175                 or return;
4176         my $name_rev = to_utf8(scalar <$fd>);
4177         close $fd;
4178
4179         if ($name_rev =~ m|^$hash tags/(.*)$|) {
4180                 return $1;
4181         } else {
4182                 # catches also '$hash undefined' output
4183                 return undef;
4184         }
4185 }
4186
4187 ## ----------------------------------------------------------------------
4188 ## parse to hash functions
4189
4190 sub parse_date {
4191         my $epoch = shift;
4192         my $tz = shift || "-0000";
4193
4194         my %date;
4195         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
4196         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
4197         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
4198         $date{'hour'} = $hour;
4199         $date{'minute'} = $min;
4200         $date{'mday'} = $mday;
4201         $date{'day'} = $days[$wday];
4202         $date{'month'} = $months[$mon];
4203         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
4204                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
4205         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
4206                              $mday, $months[$mon], $hour ,$min;
4207         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
4208                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
4209
4210         my ($tz_sign, $tz_hour, $tz_min) =
4211                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
4212         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
4213         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
4214         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
4215         $date{'hour_local'} = $hour;
4216         $date{'minute_local'} = $min;
4217         $date{'mday_local'} = $mday;
4218         $date{'tz_local'} = $tz;
4219         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
4220                                   1900+$year, $mon+1, $mday,
4221                                   $hour, $min, $sec, $tz);
4222         return %date;
4223 }
4224
4225 sub parse_file_date {
4226         my $file = shift;
4227         my $mtime = (stat("$projectroot/$project/$file"))[9];
4228         return () unless defined $mtime;
4229         my ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
4230         my $tzoffset = timegm($sec,$min,$hour,$mday,$mon,$year+1900) - $mtime;
4231         my $tzstring = '+';
4232         if ($tzoffset <= 0) {
4233                 $tzstring = '-';
4234                 $tzoffset *= -1;
4235         }
4236         $tzoffset = int($tzoffset/60);
4237         $tzstring .= sprintf("%02d%02d", int($tzoffset/60), $tzoffset%60);
4238         return parse_date($mtime, $tzstring);
4239 }
4240
4241 sub parse_tag {
4242         my $tag_id = shift;
4243         my %tag;
4244         my @comment;
4245
4246         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
4247         $tag{'id'} = $tag_id;
4248         while (my $line = to_utf8(scalar <$fd>)) {
4249                 chomp $line;
4250                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
4251                         $tag{'object'} = $1;
4252                 } elsif ($line =~ m/^type (.+)$/) {
4253                         $tag{'type'} = $1;
4254                 } elsif ($line =~ m/^tag (.+)$/) {
4255                         $tag{'name'} = $1;
4256                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
4257                         $tag{'author'} = $1;
4258                         $tag{'author_epoch'} = $2;
4259                         $tag{'author_tz'} = $3;
4260                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4261                                 $tag{'author_name'}  = $1;
4262                                 $tag{'author_email'} = $2;
4263                         } else {
4264                                 $tag{'author_name'} = $tag{'author'};
4265                         }
4266                 } elsif ($line =~ m/--BEGIN/) {
4267                         push @comment, $line;
4268                         last;
4269                 } elsif ($line eq "") {
4270                         last;
4271                 }
4272         }
4273         push @comment, map(to_utf8($_), <$fd>);
4274         $tag{'comment'} = \@comment;
4275         close $fd or return;
4276         if (!defined $tag{'name'}) {
4277                 return
4278         };
4279         return %tag
4280 }
4281
4282 sub parse_commit_text {
4283         my ($commit_text, $withparents) = @_;
4284         my @commit_lines = split '\n', $commit_text;
4285         my %co;
4286
4287         pop @commit_lines; # Remove '\0'
4288
4289         if (! @commit_lines) {
4290                 return;
4291         }
4292
4293         my $header = shift @commit_lines;
4294         if ($header !~ m/^[0-9a-fA-F]{40}/) {
4295                 return;
4296         }
4297         ($co{'id'}, my @parents) = split ' ', $header;
4298         while (my $line = shift @commit_lines) {
4299                 last if $line eq "\n";
4300                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
4301                         $co{'tree'} = $1;
4302                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
4303                         push @parents, $1;
4304                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
4305                         $co{'author'} = to_utf8($1);
4306                         $co{'author_epoch'} = $2;
4307                         $co{'author_tz'} = $3;
4308                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4309                                 $co{'author_name'}  = $1;
4310                                 $co{'author_email'} = $2;
4311                         } else {
4312                                 $co{'author_name'} = $co{'author'};
4313                         }
4314                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
4315                         $co{'committer'} = to_utf8($1);
4316                         $co{'committer_epoch'} = $2;
4317                         $co{'committer_tz'} = $3;
4318                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
4319                                 $co{'committer_name'}  = $1;
4320                                 $co{'committer_email'} = $2;
4321                         } else {
4322                                 $co{'committer_name'} = $co{'committer'};
4323                         }
4324                 }
4325         }
4326         if (!defined $co{'tree'}) {
4327                 return;
4328         };
4329         $co{'parents'} = \@parents;
4330         $co{'parent'} = $parents[0];
4331
4332         @commit_lines = map to_utf8($_), @commit_lines;
4333         foreach my $title (@commit_lines) {
4334                 $title =~ s/^    //;
4335                 if ($title ne "") {
4336                         $co{'title'} = chop_str($title, 80, 5);
4337                         # remove leading stuff of merges to make the interesting part visible
4338                         if (length($title) > 50) {
4339                                 $title =~ s/^Automatic //;
4340                                 $title =~ s/^merge (of|with) /Merge ... /i;
4341                                 if (length($title) > 50) {
4342                                         $title =~ s/(http|rsync):\/\///;
4343                                 }
4344                                 if (length($title) > 50) {
4345                                         $title =~ s/(master|www|rsync)\.//;
4346                                 }
4347                                 if (length($title) > 50) {
4348                                         $title =~ s/kernel.org:?//;
4349                                 }
4350                                 if (length($title) > 50) {
4351                                         $title =~ s/\/pub\/scm//;
4352                                 }
4353                         }
4354                         $co{'title_short'} = chop_str($title, 50, 5);
4355                         last;
4356                 }
4357         }
4358         if (! defined $co{'title'} || $co{'title'} eq "") {
4359                 $co{'title'} = $co{'title_short'} = '(no commit message)';
4360         }
4361         # remove added spaces
4362         foreach my $line (@commit_lines) {
4363                 $line =~ s/^    //;
4364         }
4365         $co{'comment'} = \@commit_lines;
4366
4367         my $age_epoch = $co{'committer_epoch'};
4368         $co{'age_epoch'} = $age_epoch;
4369         my $time_now = time;
4370         $co{'age_string'} = age_string($age_epoch, $time_now);
4371         $co{'age_string_date'} = age_string_date($age_epoch, $time_now);
4372         $co{'age_string_age'} = age_string_age($age_epoch, $time_now);
4373         return %co;
4374 }
4375
4376 sub parse_commit {
4377         my ($commit_id) = @_;
4378         my %co;
4379
4380         local $/ = "\0";
4381
4382         defined(my $fd = git_cmd_pipe "rev-list",
4383                 "--parents",
4384                 "--header",
4385                 "--max-count=1",
4386                 $commit_id,
4387                 "--")
4388                 or die_error(500, "Open git-rev-list failed");
4389         %co = parse_commit_text(<$fd>, 1);
4390         close $fd;
4391
4392         return %co;
4393 }
4394
4395 sub parse_commits {
4396         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
4397         my @cos;
4398
4399         $maxcount ||= 1;
4400         $skip ||= 0;
4401
4402         local $/ = "\0";
4403
4404         defined(my $fd = git_cmd_pipe "rev-list",
4405                 "--header",
4406                 @args,
4407                 ("--max-count=" . $maxcount),
4408                 ("--skip=" . $skip),
4409                 @extra_options,
4410                 $commit_id,
4411                 "--",
4412                 ($filename ? ($filename) : ()))
4413                 or die_error(500, "Open git-rev-list failed");
4414         while (my $line = <$fd>) {
4415                 my %co = parse_commit_text($line);
4416                 push @cos, \%co;
4417         }
4418         close $fd;
4419
4420         return wantarray ? @cos : \@cos;
4421 }
4422
4423 # parse line of git-diff-tree "raw" output
4424 sub parse_difftree_raw_line {
4425         my $line = shift;
4426         my %res;
4427
4428         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
4429         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
4430         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
4431                 $res{'from_mode'} = $1;
4432                 $res{'to_mode'} = $2;
4433                 $res{'from_id'} = $3;
4434                 $res{'to_id'} = $4;
4435                 $res{'status'} = $5;
4436                 $res{'similarity'} = $6;
4437                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
4438                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
4439                 } else {
4440                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
4441                 }
4442         }
4443         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
4444         # combined diff (for merge commit)
4445         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
4446                 $res{'nparents'}  = length($1);
4447                 $res{'from_mode'} = [ split(' ', $2) ];
4448                 $res{'to_mode'} = pop @{$res{'from_mode'}};
4449                 $res{'from_id'} = [ split(' ', $3) ];
4450                 $res{'to_id'} = pop @{$res{'from_id'}};
4451                 $res{'status'} = [ split('', $4) ];
4452                 $res{'to_file'} = unquote($5);
4453         }
4454         # 'c512b523472485aef4fff9e57b229d9d243c967f'
4455         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
4456                 $res{'commit'} = $1;
4457         }
4458
4459         return wantarray ? %res : \%res;
4460 }
4461
4462 # wrapper: return parsed line of git-diff-tree "raw" output
4463 # (the argument might be raw line, or parsed info)
4464 sub parsed_difftree_line {
4465         my $line_or_ref = shift;
4466
4467         if (ref($line_or_ref) eq "HASH") {
4468                 # pre-parsed (or generated by hand)
4469                 return $line_or_ref;
4470         } else {
4471                 return parse_difftree_raw_line($line_or_ref);
4472         }
4473 }
4474
4475 # parse line of git-ls-tree output
4476 sub parse_ls_tree_line {
4477         my $line = shift;
4478         my %opts = @_;
4479         my %res;
4480
4481         if ($opts{'-l'}) {
4482                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
4483                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
4484
4485                 $res{'mode'} = $1;
4486                 $res{'type'} = $2;
4487                 $res{'hash'} = $3;
4488                 $res{'size'} = $4;
4489                 if ($opts{'-z'}) {
4490                         $res{'name'} = $5;
4491                 } else {
4492                         $res{'name'} = unquote($5);
4493                 }
4494         } else {
4495                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
4496                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
4497
4498                 $res{'mode'} = $1;
4499                 $res{'type'} = $2;
4500                 $res{'hash'} = $3;
4501                 if ($opts{'-z'}) {
4502                         $res{'name'} = $4;
4503                 } else {
4504                         $res{'name'} = unquote($4);
4505                 }
4506         }
4507
4508         return wantarray ? %res : \%res;
4509 }
4510
4511 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4512 sub parse_from_to_diffinfo {
4513         my ($diffinfo, $from, $to, @parents) = @_;
4514
4515         if ($diffinfo->{'nparents'}) {
4516                 # combined diff
4517                 $from->{'file'} = [];
4518                 $from->{'href'} = [];
4519                 fill_from_file_info($diffinfo, @parents)
4520                         unless exists $diffinfo->{'from_file'};
4521                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4522                         $from->{'file'}[$i] =
4523                                 defined $diffinfo->{'from_file'}[$i] ?
4524                                         $diffinfo->{'from_file'}[$i] :
4525                                         $diffinfo->{'to_file'};
4526                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4527                                 $from->{'href'}[$i] = href(action=>"blob",
4528                                                            hash_base=>$parents[$i],
4529                                                            hash=>$diffinfo->{'from_id'}[$i],
4530                                                            file_name=>$from->{'file'}[$i]);
4531                         } else {
4532                                 $from->{'href'}[$i] = undef;
4533                         }
4534                 }
4535         } else {
4536                 # ordinary (not combined) diff
4537                 $from->{'file'} = $diffinfo->{'from_file'};
4538                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4539                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4540                                                hash=>$diffinfo->{'from_id'},
4541                                                file_name=>$from->{'file'});
4542                 } else {
4543                         delete $from->{'href'};
4544                 }
4545         }
4546
4547         $to->{'file'} = $diffinfo->{'to_file'};
4548         if (!is_deleted($diffinfo)) { # file exists in result
4549                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4550                                      hash=>$diffinfo->{'to_id'},
4551                                      file_name=>$to->{'file'});
4552         } else {
4553                 delete $to->{'href'};
4554         }
4555 }
4556
4557 ## ......................................................................
4558 ## parse to array of hashes functions
4559
4560 sub git_get_heads_list {
4561         my ($limit, @classes) = @_;
4562         @classes = get_branch_refs() unless @classes;
4563         my @patterns = map { "refs/$_" } @classes;
4564         my @headslist;
4565
4566         defined(my $fd = git_cmd_pipe 'for-each-ref',
4567                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4568                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4569                 @patterns)
4570                 or return;
4571         while (my $line = to_utf8(scalar <$fd>)) {
4572                 my %ref_item;
4573
4574                 chomp $line;
4575                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4576                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4577                 my ($committer, $epoch, $tz) =
4578                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4579                 $ref_item{'fullname'}  = $name;
4580                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4581                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4582                 $ref_item{'name'} = $name;
4583                 # for refs neither in 'heads' nor 'remotes' we want to
4584                 # show their ref dir
4585                 my $ref_dir = (defined $1) ? $1 : '';
4586                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4587                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4588                 }
4589
4590                 $ref_item{'id'}    = $hash;
4591                 $ref_item{'title'} = $title || '(no commit message)';
4592                 $ref_item{'epoch'} = $epoch;
4593                 if ($epoch) {
4594                         $ref_item{'age'} = age_string($ref_item{'epoch'});
4595                 } else {
4596                         $ref_item{'age'} = "unknown";
4597                 }
4598
4599                 push @headslist, \%ref_item;
4600         }
4601         close $fd;
4602
4603         return wantarray ? @headslist : \@headslist;
4604 }
4605
4606 sub git_get_tags_list {
4607         my $limit = shift;
4608         my @tagslist;
4609         my $all = shift || 0;
4610         my $order = shift || $default_refs_order;
4611         my $sortkey = $all && $order eq 'name' ? 'refname' : '-creatordate';
4612
4613         defined(my $fd = git_cmd_pipe 'for-each-ref',
4614                 ($limit ? '--count='.($limit+1) : ()), "--sort=$sortkey",
4615                 '--format=%(objectname) %(objecttype) %(refname) '.
4616                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4617                 ($all ? 'refs' : 'refs/tags'))
4618                 or return;
4619         while (my $line = to_utf8(scalar <$fd>)) {
4620                 my %ref_item;
4621
4622                 chomp $line;
4623                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4624                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4625                 my ($creator, $epoch, $tz) =
4626                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4627                 $ref_item{'fullname'} = $name;
4628                 $name =~ s!^refs/!! if $all;
4629                 $name =~ s!^refs/tags/!! unless $all;
4630
4631                 $ref_item{'type'} = $type;
4632                 $ref_item{'id'} = $id;
4633                 $ref_item{'name'} = $name;
4634                 if ($type eq "tag") {
4635                         $ref_item{'subject'} = $title;
4636                         $ref_item{'reftype'} = $reftype;
4637                         $ref_item{'refid'}   = $refid;
4638                 } else {
4639                         $ref_item{'reftype'} = $type;
4640                         $ref_item{'refid'}   = $id;
4641                 }
4642
4643                 if ($type eq "tag" || $type eq "commit") {
4644                         $ref_item{'epoch'} = $epoch;
4645                         if ($epoch) {
4646                                 $ref_item{'age'} = age_string($ref_item{'epoch'});
4647                         } else {
4648                                 $ref_item{'age'} = "unknown";
4649                         }
4650                 }
4651
4652                 push @tagslist, \%ref_item;
4653         }
4654         close $fd;
4655
4656         return wantarray ? @tagslist : \@tagslist;
4657 }
4658
4659 ## ----------------------------------------------------------------------
4660 ## filesystem-related functions
4661
4662 sub get_file_owner {
4663         my $path = shift;
4664
4665         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4666         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4667         if (!defined $gcos) {
4668                 return undef;
4669         }
4670         my $owner = $gcos;
4671         $owner =~ s/[,;].*$//;
4672         return to_utf8($owner);
4673 }
4674
4675 # assume that file exists
4676 sub insert_file {
4677         my $filename = shift;
4678
4679         open my $fd, '<', $filename;
4680         while (<$fd>) {
4681                 print to_utf8($_);
4682         }
4683         close $fd;
4684 }
4685
4686 # return undef on failure
4687 sub collect_output {
4688         defined(my $fd = cmd_pipe @_) or return undef;
4689         if (eof $fd) {
4690                 close $fd;
4691                 return undef;
4692         }
4693         my $result = join('', map({ to_utf8($_) } <$fd>));
4694         close $fd or return undef;
4695         return $result;
4696 }
4697
4698 # return undef on failure
4699 # return '' if only comments
4700 sub collect_html_file {
4701         my $filename = shift;
4702
4703         open my $fd, '<', $filename or return undef;
4704         my $result = join('', map({ to_utf8($_) } <$fd>));
4705         close $fd or return undef;
4706         return undef unless defined($result);
4707         my $test = $result;
4708         $test =~ s/<!--(?:[^-]|(?:-(?!-)))*-->//gs;
4709         $test =~ s/\s+//s;
4710         return $test eq '' ? '' : $result;
4711 }
4712
4713 ## ......................................................................
4714 ## mimetype related functions
4715
4716 sub mimetype_guess_file {
4717         my $filename = shift;
4718         my $mimemap = shift;
4719         my $rawmode = shift;
4720         -r $mimemap or return undef;
4721
4722         my %mimemap;
4723         open(my $mh, '<', $mimemap) or return undef;
4724         while (<$mh>) {
4725                 next if m/^#/; # skip comments
4726                 my ($mimetype, @exts) = split(/\s+/);
4727                 foreach my $ext (@exts) {
4728                         $mimemap{$ext} = $mimetype;
4729                 }
4730         }
4731         close($mh);
4732
4733         my ($ext, $ans);
4734         $ext = $1 if $filename =~ /\.([^.]*)$/;
4735         $ans = $mimemap{$ext} if $ext;
4736         if (defined $ans) {
4737                 my $l = lc($ans);
4738                 $ans = 'text/html' if $l eq 'application/xhtml+xml';
4739                 if (!$rawmode) {
4740                         $ans = 'text/xml' if $l =~ m!^application/[^\s:;,=]+\+xml$! ||
4741                                              $l eq 'image/svg+xml' ||
4742                                              $l eq 'application/xml-dtd' ||
4743                                              $l eq 'application/xml-external-parsed-entity';
4744                 }
4745         }
4746         return $ans;
4747 }
4748
4749 sub mimetype_guess {
4750         my $filename = shift;
4751         my $rawmode = shift;
4752         my $mime;
4753         $filename =~ /\./ or return undef;
4754
4755         if ($mimetypes_file) {
4756                 my $file = $mimetypes_file;
4757                 if ($file !~ m!^/!) { # if it is relative path
4758                         # it is relative to project
4759                         $file = "$projectroot/$project/$file";
4760                 }
4761                 $mime = mimetype_guess_file($filename, $file, $rawmode);
4762         }
4763         $mime ||= mimetype_guess_file($filename, '/etc/mime.types', $rawmode);
4764         return $mime;
4765 }
4766
4767 sub blob_mimetype {
4768         my $fd = shift;
4769         my $filename = shift;
4770         my $rawmode = shift;
4771         my $mime;
4772
4773         # The -T/-B file operators produce the wrong result unless a perlio
4774         # layer is present when the file handle is a pipe that delivers less
4775         # than 512 bytes of data before reaching EOF.
4776         #
4777         # If we are running in a Perl that uses the stdio layer rather than the
4778         # unix+perlio layers we will end up adding a perlio layer on top of the
4779         # stdio layer and get a second level of buffering.  This is harmless
4780         # and it makes the -T/-B file operators work properly in all cases.
4781
4782         binmode $fd, ":perlio" or die_error(500, "Adding perlio layer failed")
4783                 unless grep /^perlio$/, PerlIO::get_layers($fd);
4784
4785         $mime = mimetype_guess($filename, $rawmode) if defined $filename;
4786
4787         if (!$mime && $filename) {
4788                 if ($filename =~ m/\.html?$/i) {
4789                         $mime = 'text/html';
4790                 } elsif ($filename =~ m/\.xht(?:ml)?$/i) {
4791                         $mime = 'text/html';
4792                 } elsif ($filename =~ m/\.te?xt?$/i) {
4793                         $mime = 'text/plain';
4794                 } elsif ($filename =~ m/\.(?:markdown|md)$/i) {
4795                         $mime = 'text/plain';
4796                 } elsif ($filename =~ m/\.png$/i) {
4797                         $mime = 'image/png';
4798                 } elsif ($filename =~ m/\.gif$/i) {
4799                         $mime = 'image/gif';
4800                 } elsif ($filename =~ m/\.jpe?g$/i) {
4801                         $mime = 'image/jpeg';
4802                 } elsif ($filename =~ m/\.svgz?$/i) {
4803                         $mime = 'image/svg+xml';
4804                 }
4805         }
4806
4807         # just in case
4808         return $default_blob_plain_mimetype || 'application/octet-stream' unless $fd || $mime;
4809
4810         $mime = -T $fd ? 'text/plain' : 'application/octet-stream' unless $mime;
4811
4812         return $mime;
4813 }
4814
4815 sub is_ascii {
4816         use bytes;
4817         my $data = shift;
4818         return scalar($data =~ /^[\x00-\x7f]*$/);
4819 }
4820
4821 sub is_valid_utf8 {
4822         my $data = shift;
4823         return utf8::decode($data);
4824 }
4825
4826 sub extract_html_charset {
4827         return undef unless $_[0] && "$_[0]</head>" =~ m#<head(?:\s+[^>]*)?(?<!/)>(.*?)</head\s*>#is;
4828         my $head = $1;
4829         return $2 if $head =~ m#<meta\s+charset\s*=\s*(['"])\s*([a-z0-9(:)_.+-]+)\s*\1\s*/?>#is;
4830         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) {
4831                 my %kv = (lc($1) => $3, lc($4) => $6);
4832                 my ($he, $c) = (lc($kv{'http-equiv'}), $kv{'content'});
4833                 return $1 if $he && $c && $he eq 'content-type' &&
4834                         $c =~ m!\s*text/html\s*;\s*charset\s*=\s*([a-z0-9(:)_.+-]+)\s*$!is;
4835         }
4836         return undef;
4837 }
4838
4839 sub blob_contenttype {
4840         my ($fd, $file_name, $type) = @_;
4841
4842         $type ||= blob_mimetype($fd, $file_name, 1);
4843         return $type unless $type =~ m!^text/.+!i;
4844         my ($leader, $charset, $htmlcharset);
4845         if ($fd && read($fd, $leader, 32768)) {{
4846                 $charset='US-ASCII' if is_ascii($leader);
4847                 return ("$type; charset=UTF-8", $leader) if !$charset && is_valid_utf8($leader);
4848                 $charset='ISO-8859-1' unless $charset;
4849                 $htmlcharset = extract_html_charset($leader) if $type eq 'text/html';
4850                 if ($htmlcharset && $charset ne 'US-ASCII') {
4851                         $htmlcharset = undef if $htmlcharset =~ /^(?:utf-8|us-ascii)$/i
4852                 }
4853         }}
4854         return ("$type; charset=$htmlcharset", $leader) if $htmlcharset;
4855         my $defcharset = $default_text_plain_charset || '';
4856         $defcharset =~ s/^\s+//;
4857         $defcharset =~ s/\s+$//;
4858         $defcharset = '' if $charset && $charset ne 'US-ASCII' && $defcharset =~ /^(?:utf-8|us-ascii)$/i;
4859         return ("$type; charset=" . ($defcharset || 'ISO-8859-1'), $leader);
4860 }
4861
4862 # peek the first upto 128 bytes off a file handle
4863 sub peek128bytes {
4864         my $fd = shift;
4865
4866         use IO::Handle;
4867         use bytes;
4868
4869         my $prefix128;
4870         return '' unless $fd && read($fd, $prefix128, 128);
4871
4872         # In the general case, we're guaranteed only to be able to ungetc one
4873         # character (provided, of course, we actually got a character first).
4874         #
4875         # However, we know:
4876         #
4877         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4878         #    already been called at least once on the file handle before us
4879         #
4880         # 2) we have an $fd positioned at the start of the input stream and
4881         #    therefore know we were positioned at a buffer boundary before
4882         #    reading the initial upto 128 bytes
4883         #
4884         # 3) the buffer size is at least 512 bytes
4885         #
4886         # 4) we are careful to only unget raw bytes
4887         #
4888         # 5) we are attempting to unget exactly the same number of bytes we got
4889         #
4890         # Given the above conditions we will ALWAYS be able to safely unget
4891         # the $prefix128 value we just got.
4892         #
4893         # In fact, we could read up to 511 bytes and still be sure.
4894         # (Reading 512 might pop us into the next internal buffer, but probably
4895         # not since that could break the always able to unget at least the one
4896         # you just got guarantee.)
4897
4898         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4899
4900         return $prefix128;
4901 }
4902
4903 # guess file syntax for syntax highlighting; return undef if no highlighting
4904 # the name of syntax can (in the future) depend on syntax highlighter used
4905 sub guess_file_syntax {
4906         my ($fd, $mimetype, $file_name) = @_;
4907         return undef unless $fd && defined $file_name &&
4908                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4909         my $basename = basename($file_name, '.in');
4910         return $highlight_basename{$basename}
4911                 if exists $highlight_basename{$basename};
4912
4913         # Peek to see if there's a shebang or xml line.
4914         # We always operate on bytes when testing this.
4915         {
4916                 use bytes;
4917                 my $shebang = peek128bytes($fd);
4918                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4919                         foreach my $key (keys %highlight_shebang) {
4920                                 my $ar = ref($highlight_shebang{$key}) ?
4921                                         $highlight_shebang{$key} :
4922                                         [$highlight_shebang{key}];
4923                                 map {return $key if $shebang =~ /$_/} @$ar;
4924                         }
4925                 }
4926                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4927         }
4928
4929         $basename =~ /\.([^.]*)$/;
4930         my $ext = $1 or return undef;
4931         return $highlight_ext{$ext}
4932                 if exists $highlight_ext{$ext};
4933
4934         return undef;
4935 }
4936
4937 # run highlighter and return FD of its output,
4938 # or return original FD if no highlighting
4939 sub run_highlighter {
4940         my ($fd, $syntax) = @_;
4941         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4942
4943         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4944                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4945                 $to_utf8_pipe_command.
4946                 quote_command($highlight_bin).
4947                 " --replace-tabs=8 --fragment --syntax $syntax")
4948                 or die_error(500, "Couldn't open file or run syntax highlighter");
4949         if (eof $hifd) {
4950                 # just in case, should not happen as we tested !eof($fd) above
4951                 return $fd if close($hifd);
4952
4953                 # should not happen
4954                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4955
4956                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4957                 # instead of dying horribly on this, just skip the highlighting
4958                 # but do output a message about it to STDERR that will end up in the log
4959                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4960                         sprintf("child exit status 0x%x\n", $?);
4961                 return $fd
4962         }
4963         close $fd;
4964         return ($hifd, 1);
4965 }
4966
4967 ## ======================================================================
4968 ## functions printing HTML: header, footer, error page
4969
4970 sub get_page_title {
4971         my $title = to_utf8($site_name);
4972
4973         unless (defined $project) {
4974                 if (defined $project_filter) {
4975                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4976                 }
4977                 return $title;
4978         }
4979         $title .= " - " . to_utf8($project);
4980
4981         return $title unless (defined $action);
4982         my $action_print = $action eq 'blame_incremental' ? 'blame' : $action;
4983         $title .= "/$action_print"; # $action is US-ASCII (7bit ASCII)
4984
4985         return $title unless (defined $file_name);
4986         $title .= " - " . esc_path($file_name);
4987         if ($action eq "tree" && $file_name !~ m|/$|) {
4988                 $title .= "/";
4989         }
4990
4991         return $title;
4992 }
4993
4994 sub get_content_type_html {
4995         # We do not ever emit application/xhtml+xml since that gives us
4996         # no benefits and it makes many browsers (e.g. Firefox) exceedingly
4997         # strict, which is troublesome for example when showing user-supplied
4998         # README.html files.
4999         return 'text/html';
5000 }
5001
5002 sub print_feed_meta {
5003         if (defined $project) {
5004                 my %href_params = get_feed_info();
5005                 if (!exists $href_params{'-title'}) {
5006                         $href_params{'-title'} = 'log';
5007                 }
5008
5009                 foreach my $format (qw(RSS Atom)) {
5010                         my $type = lc($format);
5011                         my %link_attr = (
5012                                 '-rel' => 'alternate',
5013                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
5014                                 '-type' => "application/$type+xml"
5015                         );
5016
5017                         $href_params{'extra_options'} = undef;
5018                         $href_params{'action'} = $type;
5019                         $link_attr{'-href'} = href(%href_params);
5020                         print "<link ".
5021                               "rel=\"$link_attr{'-rel'}\" ".
5022                               "title=\"$link_attr{'-title'}\" ".
5023                               "href=\"$link_attr{'-href'}\" ".
5024                               "type=\"$link_attr{'-type'}\" ".
5025                               "/>\n";
5026
5027                         $href_params{'extra_options'} = '--no-merges';
5028                         $link_attr{'-href'} = href(%href_params);
5029                         $link_attr{'-title'} .= ' (no merges)';
5030                         print "<link ".
5031                               "rel=\"$link_attr{'-rel'}\" ".
5032                               "title=\"$link_attr{'-title'}\" ".
5033                               "href=\"$link_attr{'-href'}\" ".
5034                               "type=\"$link_attr{'-type'}\" ".
5035                               "/>\n";
5036                 }
5037
5038         } else {
5039                 printf('<link rel="alternate" title="%s projects list" '.
5040                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
5041                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
5042                 printf('<link rel="alternate" title="%s projects feeds" '.
5043                        'href="%s" type="text/x-opml" />'."\n",
5044                        esc_attr($site_name), href(project=>undef, action=>"opml"));
5045         }
5046 }
5047
5048 sub print_header_links {
5049         my $status = shift;
5050
5051         # print out each stylesheet that exist, providing backwards capability
5052         # for those people who defined $stylesheet in a config file
5053         if (defined $stylesheet) {
5054                 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
5055         } else {
5056                 foreach my $stylesheet (@stylesheets) {
5057                         next unless $stylesheet;
5058                         print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
5059                 }
5060         }
5061         print_feed_meta()
5062                 if ($status eq '200 OK');
5063         if (defined $favicon) {
5064                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
5065         }
5066 }
5067
5068 sub print_nav_breadcrumbs_path {
5069         my $dirprefix = undef;
5070         while (my $part = shift) {
5071                 $dirprefix .= "/" if defined $dirprefix;
5072                 $dirprefix .= $part;
5073                 print $cgi->a({-href => href(project => undef,
5074                                              project_filter => $dirprefix,
5075                                              action => "project_list")},
5076                               esc_html($part)) . " / ";
5077         }
5078 }
5079
5080 sub print_nav_breadcrumbs {
5081         my %opts = @_;
5082
5083         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
5084                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
5085         }
5086         if (defined $project) {
5087                 my @dirname = split '/', $project;
5088                 my $projectbasename = pop @dirname;
5089                 print_nav_breadcrumbs_path(@dirname);
5090                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
5091                 if (defined $action) {
5092                         my $action_print = $action ;
5093                         $action_print = 'blame' if $action_print eq 'blame_incremental';
5094                         if (defined $opts{-action_extra}) {
5095                                 $action_print = $cgi->a({-href => href(action=>$action)},
5096                                         $action);
5097                         }
5098                         print " / $action_print";
5099                 }
5100                 if (defined $opts{-action_extra}) {
5101                         print " / $opts{-action_extra}";
5102                 }
5103                 print "\n";
5104         } elsif (defined $project_filter) {
5105                 print_nav_breadcrumbs_path(split '/', $project_filter);
5106         }
5107 }
5108
5109 sub print_search_form {
5110         if (!defined $searchtext) {
5111                 $searchtext = "";
5112         }
5113         my $search_hash;
5114         if (defined $hash_base) {
5115                 $search_hash = $hash_base;
5116         } elsif (defined $hash) {
5117                 $search_hash = $hash;
5118         } else {
5119                 $search_hash = "HEAD";
5120         }
5121         # We can't use href() here because we need to encode the
5122         # URL parameters into the form, not into the action link.
5123         my $action = $my_uri;
5124         my $use_pathinfo = gitweb_check_feature('pathinfo');
5125         if ($use_pathinfo) {
5126                 # See notes about doubled / in href()
5127                 $action =~ s,/$,,;
5128                 $action .= "/".esc_path_info($project);
5129         }
5130         $cgi->start_form(-method => "get", -action => $action);
5131         print sprintf(qq/<form method="%s" action="%s" enctype="%s">\n/,
5132               "get", CGI::escapeHTML($action), &CGI::URL_ENCODED) .
5133               "<div class=\"search\">\n" .
5134               (!$use_pathinfo &&
5135               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
5136               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
5137               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
5138               $cgi->popup_menu(-name => 'st', -default => 'commit',
5139                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
5140               " " . $cgi->a({-href => href(action=>"search_help"),
5141                              -title => "search help" }, "?") . " search:\n",
5142               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
5143               "<span title=\"Extended regular expression\">" .
5144               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5145                              -checked => $search_use_regexp) .
5146               "</span>" .
5147               "</div>" .
5148               $cgi->end_form() . "\n";
5149 }
5150
5151 sub git_header_html {
5152         my $status = shift || "200 OK";
5153         my $expires = shift;
5154         my %opts = @_;
5155
5156         my $title = get_page_title();
5157         my $content_type = get_content_type_html();
5158         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
5159                            -status=> $status, -expires => $expires)
5160                 unless ($opts{'-no_http_header'});
5161         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
5162         print <<EOF;
5163 <?xml version="1.0" encoding="utf-8"?>
5164 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
5165 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
5166 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
5167 <!-- git core binaries version $git_version -->
5168 <head>
5169 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
5170 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
5171 <meta name="robots" content="index, nofollow"/>
5172 <title>$title</title>
5173 <script type="text/javascript">/* <![CDATA[ */
5174 function fixBlameLinks() {
5175         var allLinks = document.getElementsByTagName("a");
5176         for (var i = 0; i < allLinks.length; i++) {
5177                 var link = allLinks.item(i);
5178                 if (link.className == 'blamelink')
5179                         link.href = link.href.replace("/blame/", "/blame_incremental/");
5180         }
5181 }
5182 /* ]]> */</script>
5183 EOF
5184         # the stylesheet, favicon etc urls won't work correctly with path_info
5185         # unless we set the appropriate base URL
5186         if ($ENV{'PATH_INFO'}) {
5187                 print "<base href=\"".esc_url($base_url)."\" />\n";
5188         }
5189         print_header_links($status);
5190
5191         if (defined $site_html_head_string) {
5192                 print to_utf8($site_html_head_string);
5193         }
5194
5195         print "</head>\n" .
5196               "<body>\n";
5197
5198         if (defined $site_header && -f $site_header) {
5199                 insert_file($site_header);
5200         }
5201
5202         print "<div class=\"page_header\">\n";
5203         if (defined $logo) {
5204                 print $cgi->a({-href => esc_url($logo_url),
5205                                -title => $logo_label},
5206                               $cgi->img({-src => esc_url($logo),
5207                                          -width => 72, -height => 27,
5208                                          -alt => "git",
5209                                          -class => "logo"}));
5210         }
5211         print_nav_breadcrumbs(%opts);
5212         print "</div>\n";
5213
5214         my $have_search = gitweb_check_feature('search');
5215         if (defined $project && $have_search) {
5216                 print_search_form();
5217         }
5218 }
5219
5220 sub compute_timed_interval {
5221         return "<?gitweb compute_timed_interval?>" if $cache_mode_active;
5222         return tv_interval($t0, [ gettimeofday() ]);
5223 }
5224
5225 sub compute_commands_count {
5226         return "<?gitweb compute_commands_count?>" if $cache_mode_active;
5227         my $s = $number_of_git_cmds == 1 ? '' : 's';
5228         return '<span id="generating_cmd">'.
5229                 $number_of_git_cmds.
5230                 "</span> git command$s";
5231 }
5232
5233 sub git_footer_html {
5234         my $feed_class = 'rss_logo';
5235
5236         print "<div class=\"page_footer\">\n";
5237         if (defined $project) {
5238                 my $descr = git_get_project_description($project);
5239                 if (defined $descr) {
5240                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
5241                 }
5242
5243                 my %href_params = get_feed_info();
5244                 if (!%href_params) {
5245                         $feed_class .= ' generic';
5246                 }
5247                 $href_params{'-title'} ||= 'log';
5248
5249                 foreach my $format (qw(RSS Atom)) {
5250                         $href_params{'action'} = lc($format);
5251                         print $cgi->a({-href => href(%href_params),
5252                                       -title => "$href_params{'-title'} $format feed",
5253                                       -class => $feed_class}, $format)."\n";
5254                 }
5255
5256         } else {
5257                 print $cgi->a({-href => href(project=>undef, action=>"opml",
5258                                              project_filter => $project_filter),
5259                               -class => $feed_class}, "OPML") . " ";
5260                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
5261                                              project_filter => $project_filter),
5262                               -class => $feed_class}, "TXT") . "\n";
5263         }
5264         print "</div>\n"; # class="page_footer"
5265
5266         if (defined $t0 && gitweb_check_feature('timed')) {
5267                 print "<div id=\"generating_info\">\n";
5268                 print 'This page took '.
5269                       '<span id="generating_time" class="time_span">'.
5270                       compute_timed_interval().
5271                       ' seconds </span>'.
5272                       ' and '.
5273                       compute_commands_count().
5274                       " to generate.\n";
5275                 print "</div>\n"; # class="page_footer"
5276         }
5277
5278         if (defined $site_footer && -f $site_footer) {
5279                 insert_file($site_footer);
5280         }
5281
5282         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
5283         if (defined $action &&
5284             $action eq 'blame_incremental') {
5285                 print qq!<script type="text/javascript">\n!.
5286                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
5287                       qq!           "!. href() .qq!");\n!.
5288                       qq!</script>\n!;
5289         } else {
5290                 my ($jstimezone, $tz_cookie, $datetime_class) =
5291                         gitweb_get_feature('javascript-timezone');
5292
5293                 print qq!<script type="text/javascript">\n!.
5294                       qq!window.onload = function () {\n!;
5295                 if (gitweb_check_feature('blame_incremental')) {
5296                         print qq!       fixBlameLinks();\n!;
5297                 }
5298                 if (gitweb_check_feature('javascript-actions')) {
5299                         print qq!       fixLinks();\n!;
5300                 }
5301                 if ($jstimezone && $tz_cookie && $datetime_class) {
5302                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
5303                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
5304                 }
5305                 print qq!};\n!.
5306                       qq!</script>\n!;
5307         }
5308
5309         print "</body>\n" .
5310               "</html>";
5311 }
5312
5313 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
5314 # Example: die_error(404, 'Hash not found')
5315 # By convention, use the following status codes (as defined in RFC 2616):
5316 # 400: Invalid or missing CGI parameters, or
5317 #      requested object exists but has wrong type.
5318 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
5319 #      this server or project.
5320 # 404: Requested object/revision/project doesn't exist.
5321 # 500: The server isn't configured properly, or
5322 #      an internal error occurred (e.g. failed assertions caused by bugs), or
5323 #      an unknown error occurred (e.g. the git binary died unexpectedly).
5324 # 503: The server is currently unavailable (because it is overloaded,
5325 #      or down for maintenance).  Generally, this is a temporary state.
5326 sub die_error {
5327         my $status = shift || 500;
5328         my $error = esc_html(shift) || "Internal Server Error";
5329         my $extra = shift;
5330         my %opts = @_;
5331
5332         my %http_responses = (
5333                 400 => '400 Bad Request',
5334                 403 => '403 Forbidden',
5335                 404 => '404 Not Found',
5336                 500 => '500 Internal Server Error',
5337                 503 => '503 Service Unavailable',
5338         );
5339         git_header_html($http_responses{$status}, undef, %opts);
5340         print <<EOF;
5341 <div class="page_body">
5342 <br /><br />
5343 $status - $error
5344 <br />
5345 EOF
5346         if (defined $extra) {
5347                 print "<hr />\n" .
5348                       "$extra\n";
5349         }
5350         print "</div>\n";
5351
5352         git_footer_html();
5353         CORE::die
5354                 unless ($opts{'-error_handler'});
5355 }
5356
5357 ## ----------------------------------------------------------------------
5358 ## functions printing or outputting HTML: navigation
5359
5360 sub git_print_page_nav {
5361         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
5362         $extra = '' if !defined $extra; # pager or formats
5363
5364         my @navs = qw(summary log commit commitdiff tree refs);
5365         if ($suppress) {
5366                 my %omit;
5367                 if (ref($suppress) eq 'ARRAY') {
5368                         %omit = map { ($_ => 1) } @$suppress;
5369                 } else {
5370                         %omit = ($suppress => 1);
5371                 }
5372                 @navs = grep { !$omit{$_} } @navs;
5373         }
5374
5375         my %arg = map { $_ => {action=>$_} } @navs;
5376         if (defined $head) {
5377                 for (qw(commit commitdiff)) {
5378                         $arg{$_}{'hash'} = $head;
5379                 }
5380                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
5381                         $arg{'log'}{'hash'} = $head;
5382                 }
5383         }
5384
5385         $arg{'log'}{'action'} = 'shortlog';
5386         if ($current eq 'log') {
5387                 $current = 'shortlog';
5388         } elsif ($current eq 'shortlog') {
5389                 $current = 'log';
5390         }
5391         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
5392         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
5393
5394         my @actions = gitweb_get_feature('actions');
5395         my $escname =~ esc_param($project);
5396         my $minesc = $project;
5397         $minesc =~ s/([\x00-\x1F\x7F-\xFF <>"#%{}|\\^`?&=;])/sprintf("%%%02X",ord($1))/gse;
5398         my %repl = (
5399                 '%' => '%',
5400                 'n' => $minesc,          # project name with minimal required escapes
5401                 'f' => $git_dir,         # project path within filesystem
5402                 'h' => $treehead || '',  # current hash ('h' parameter)
5403                 'b' => $treebase || '',  # hash base ('hb' parameter)
5404                 'e' => $escname,         # project name with CGI-safe escapes
5405         );
5406         while (@actions) {
5407                 my ($label, $link, $pos) = splice(@actions,0,3);
5408                 # insert
5409                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
5410                 # munch munch
5411                 $link =~ s/%([%nfhbe])/$repl{$1}/g;
5412                 $arg{$label}{'_href'} = $link;
5413         }
5414
5415         print "<div class=\"page_nav\">\n" .
5416                 (join " | ",
5417                  map { $_ eq $current ?
5418                        $_ : $cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_")
5419                  } @navs);
5420         print "<br/>\n$extra<br/>\n" .
5421               "</div>\n";
5422 }
5423
5424 # returns a submenu for the nagivation of the refs views (tags, heads,
5425 # remotes) with the current view disabled and the remotes view only
5426 # available if the feature is enabled
5427 sub format_ref_views {
5428         my ($current) = @_;
5429         my @ref_views = qw{tags heads};
5430         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
5431         return join " | ", map {
5432                 $_ eq $current ? $_ :
5433                 $cgi->a({-href => href(action=>$_)}, $_)
5434         } @ref_views
5435 }
5436
5437 sub format_paging_nav {
5438         my ($action, $page, $has_next_link) = @_;
5439         my $paging_nav;
5440
5441
5442         if ($page > 0) {
5443                 $paging_nav .=
5444                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first") .
5445                         " &#183; " .
5446                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
5447                                  -accesskey => "p", -title => "Alt-p"}, "prev");
5448         } else {
5449                 $paging_nav .= "first &#183; prev";
5450         }
5451
5452         if ($has_next_link) {
5453                 $paging_nav .= " &#183; " .
5454                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
5455                                  -accesskey => "n", -title => "Alt-n"}, "next");
5456         } else {
5457                 $paging_nav .= " &#183; next";
5458         }
5459
5460         return $paging_nav;
5461 }
5462
5463 sub format_log_nav {
5464         my ($action, $page, $has_next_link) = @_;
5465         my $paging_nav;
5466
5467         if ($action eq 'shortlog') {
5468                 $paging_nav .= 'shortlog';
5469         } else {
5470                 $paging_nav .= $cgi->a({-href => href(action=>'shortlog', -replay=>1)}, 'shortlog');
5471         }
5472         $paging_nav .= ' | ';
5473         if ($action eq 'log') {
5474                 $paging_nav .= 'fulllog';
5475         } else {
5476                 $paging_nav .= $cgi->a({-href => href(action=>'log', -replay=>1)}, 'fulllog');
5477         }
5478
5479         $paging_nav .= " | " . format_paging_nav($action, $page, $has_next_link);
5480         return $paging_nav;
5481 }
5482
5483 ## ......................................................................
5484 ## functions printing or outputting HTML: div
5485
5486 sub git_print_header_div {
5487         my ($action, $title, $hash, $hash_base, $extra) = @_;
5488         my %args = ();
5489         defined $extra or $extra = '';
5490
5491         $args{'action'} = $action;
5492         $args{'hash'} = $hash if $hash;
5493         $args{'hash_base'} = $hash_base if $hash_base;
5494
5495         my $link1 = $cgi->a({-href => href(%args), -class => "title"},
5496                             $title ? $title : $action);
5497         my $link2 = $cgi->a({-href => href(%args), -class => "cover"}, "");
5498         print "<div class=\"header\">\n" . '<span class="title">' .
5499               $link1 . $extra . $link2 . '</span>' . "\n</div>\n";
5500 }
5501
5502 sub format_repo_url {
5503         my ($name, $url) = @_;
5504         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
5505 }
5506
5507 # Group output by placing it in a DIV element and adding a header.
5508 # Options for start_div() can be provided by passing a hash reference as the
5509 # first parameter to the function.
5510 # Options to git_print_header_div() can be provided by passing an array
5511 # reference. This must follow the options to start_div if they are present.
5512 # The content can be a scalar, which is output as-is, a scalar reference, which
5513 # is output after html escaping, an IO handle passed either as *handle or
5514 # *handle{IO}, or a function reference. In the latter case all following
5515 # parameters will be taken as argument to the content function call.
5516 sub git_print_section {
5517         my ($div_args, $header_args, $content);
5518         my $arg = shift;
5519         if (ref($arg) eq 'HASH') {
5520                 $div_args = $arg;
5521                 $arg = shift;
5522         }
5523         if (ref($arg) eq 'ARRAY') {
5524                 $header_args = $arg;
5525                 $arg = shift;
5526         }
5527         $content = $arg;
5528
5529         print $cgi->start_div($div_args);
5530         git_print_header_div(@$header_args);
5531
5532         if (ref($content) eq 'CODE') {
5533                 $content->(@_);
5534         } elsif (ref($content) eq 'SCALAR') {
5535                 print esc_html($$content);
5536         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
5537                 while (<$content>) {
5538                         print to_utf8($_);
5539                 }
5540         } elsif (!ref($content) && defined($content)) {
5541                 print $content;
5542         }
5543
5544         print $cgi->end_div;
5545 }
5546
5547 sub format_timestamp_html {
5548         my $date = shift;
5549         my $useatnight = shift;
5550         defined($useatnight) or $useatnight = 1;
5551         my $strtime = $date->{'rfc2822'};
5552
5553         my (undef, undef, $datetime_class) =
5554                 gitweb_get_feature('javascript-timezone');
5555         if ($datetime_class) {
5556                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
5557         }
5558
5559         my $localtime_format = '(%d %02d:%02d %s)';
5560         if ($useatnight && $date->{'hour_local'} < 6) {
5561                 $localtime_format = '(%d <span class="atnight">%02d:%02d</span> %s)';
5562         }
5563         $strtime .= ' ' .
5564                     sprintf($localtime_format, $date->{'mday_local'},
5565                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
5566
5567         return $strtime;
5568 }
5569
5570 sub format_lastrefresh_row {
5571         return "<?gitweb format_lastrefresh_row?>" if $cache_mode_active;
5572         my %rd = parse_file_date('.last_refresh');
5573         if (defined $rd{'rfc2822'}) {
5574                 return "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td>" .
5575                        "<td>".format_timestamp_html(\%rd,0)."</td></tr>";
5576         }
5577         return "";
5578 }
5579
5580 # Outputs the author name and date in long form
5581 sub git_print_authorship {
5582         my $co = shift;
5583         my %opts = @_;
5584         my $tag = $opts{-tag} || 'div';
5585         my $author = $co->{'author_name'};
5586
5587         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
5588         print "<$tag class=\"author_date\">" .
5589               format_search_author($author, "author", esc_html($author)) .
5590               " [".format_timestamp_html(\%ad)."]".
5591               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
5592               "</$tag>\n";
5593 }
5594
5595 # Outputs table rows containing the full author or committer information,
5596 # in the format expected for 'commit' view (& similar).
5597 # Parameters are a commit hash reference, followed by the list of people
5598 # to output information for. If the list is empty it defaults to both
5599 # author and committer.
5600 sub git_print_authorship_rows {
5601         my $co = shift;
5602         # too bad we can't use @people = @_ || ('author', 'committer')
5603         my @people = @_;
5604         @people = ('author', 'committer') unless @people;
5605         foreach my $who (@people) {
5606                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
5607                 print "<tr><td>$who</td><td>" .
5608                       format_search_author($co->{"${who}_name"}, $who,
5609                                            esc_html($co->{"${who}_name"})) . " " .
5610                       format_search_author($co->{"${who}_email"}, $who,
5611                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
5612                       "</td><td rowspan=\"2\">" .
5613                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
5614                       "</td></tr>\n" .
5615                       "<tr>" .
5616                       "<td></td><td>" .
5617                       format_timestamp_html(\%wd) .
5618                       "</td>" .
5619                       "</tr>\n";
5620         }
5621 }
5622
5623 sub git_print_page_path {
5624         my $name = shift;
5625         my $type = shift;
5626         my $hb = shift;
5627
5628
5629         print "<div class=\"page_path\">";
5630         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
5631                       -title => 'tree root'}, to_utf8("[$project]"));
5632         print " / ";
5633         if (defined $name) {
5634                 my @dirname = split '/', $name;
5635                 my $basename = pop @dirname;
5636                 my $fullname = '';
5637
5638                 foreach my $dir (@dirname) {
5639                         $fullname .= ($fullname ? '/' : '') . $dir;
5640                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
5641                                                      hash_base=>$hb),
5642                                       -title => $fullname}, esc_path($dir));
5643                         print " / ";
5644                 }
5645                 if (defined $type && $type eq 'blob') {
5646                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
5647                                                      hash_base=>$hb),
5648                                       -title => $name}, esc_path($basename));
5649                 } elsif (defined $type && $type eq 'tree') {
5650                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
5651                                                      hash_base=>$hb),
5652                                       -title => $name}, esc_path($basename));
5653                         print " / ";
5654                 } else {
5655                         print esc_path($basename);
5656                 }
5657         }
5658         print "<br/></div>\n";
5659 }
5660
5661 sub git_print_log {
5662         my $log = shift;
5663         my %opts = @_;
5664
5665         if ($opts{'-remove_title'}) {
5666                 # remove title, i.e. first line of log
5667                 shift @$log;
5668         }
5669         # remove leading empty lines
5670         while (defined $log->[0] && $log->[0] eq "") {
5671                 shift @$log;
5672         }
5673
5674         # print log
5675         my $skip_blank_line = 0;
5676         foreach my $line (@$log) {
5677                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5678                         if (! $opts{'-remove_signoff'}) {
5679                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5680                                 $skip_blank_line = 1;
5681                         }
5682                         next;
5683                 }
5684
5685                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5686                         if (! $opts{'-remove_signoff'}) {
5687                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5688                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5689                                         "</span><br/>\n";
5690                                 $skip_blank_line = 1;
5691                         }
5692                         next;
5693                 }
5694
5695                 # print only one empty line
5696                 # do not print empty line after signoff
5697                 if ($line eq "") {
5698                         next if ($skip_blank_line);
5699                         $skip_blank_line = 1;
5700                 } else {
5701                         $skip_blank_line = 0;
5702                 }
5703
5704                 print format_log_line_html($line) . "<br/>\n";
5705         }
5706
5707         if ($opts{'-final_empty_line'}) {
5708                 # end with single empty line
5709                 print "<br/>\n" unless $skip_blank_line;
5710         }
5711 }
5712
5713 # return link target (what link points to)
5714 sub git_get_link_target {
5715         my $hash = shift;
5716         my $link_target;
5717
5718         # read link
5719         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5720                 or return;
5721         {
5722                 local $/ = undef;
5723                 $link_target = to_utf8(scalar <$fd>);
5724         }
5725         close $fd
5726                 or return;
5727
5728         return $link_target;
5729 }
5730
5731 # given link target, and the directory (basedir) the link is in,
5732 # return target of link relative to top directory (top tree);
5733 # return undef if it is not possible (including absolute links).
5734 sub normalize_link_target {
5735         my ($link_target, $basedir) = @_;
5736
5737         # absolute symlinks (beginning with '/') cannot be normalized
5738         return if (substr($link_target, 0, 1) eq '/');
5739
5740         # normalize link target to path from top (root) tree (dir)
5741         my $path;
5742         if ($basedir) {
5743                 $path = $basedir . '/' . $link_target;
5744         } else {
5745                 # we are in top (root) tree (dir)
5746                 $path = $link_target;
5747         }
5748
5749         # remove //, /./, and /../
5750         my @path_parts;
5751         foreach my $part (split('/', $path)) {
5752                 # discard '.' and ''
5753                 next if (!$part || $part eq '.');
5754                 # handle '..'
5755                 if ($part eq '..') {
5756                         if (@path_parts) {
5757                                 pop @path_parts;
5758                         } else {
5759                                 # link leads outside repository (outside top dir)
5760                                 return;
5761                         }
5762                 } else {
5763                         push @path_parts, $part;
5764                 }
5765         }
5766         $path = join('/', @path_parts);
5767
5768         return $path;
5769 }
5770
5771 # print tree entry (row of git_tree), but without encompassing <tr> element
5772 sub git_print_tree_entry {
5773         my ($t, $basedir, $hash_base, $have_blame) = @_;
5774
5775         my %base_key = ();
5776         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5777
5778         # The format of a table row is: mode list link.  Where mode is
5779         # the mode of the entry, list is the name of the entry, an href,
5780         # and link is the action links of the entry.
5781
5782         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5783         if (exists $t->{'size'}) {
5784                 print "<td class=\"size\">$t->{'size'}</td>\n";
5785         }
5786         if ($t->{'type'} eq "blob") {
5787                 print "<td class=\"list\">" .
5788                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5789                                                file_name=>"$basedir$t->{'name'}", %base_key),
5790                                 -class => "list"}, esc_path($t->{'name'}));
5791                 if (S_ISLNK(oct $t->{'mode'})) {
5792                         my $link_target = git_get_link_target($t->{'hash'});
5793                         if ($link_target) {
5794                                 my $norm_target = normalize_link_target($link_target, $basedir);
5795                                 if (defined $norm_target) {
5796                                         print " -> " .
5797                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5798                                                                      file_name=>$norm_target),
5799                                                        -title => $norm_target}, esc_path($link_target));
5800                                 } else {
5801                                         print " -> " . esc_path($link_target);
5802                                 }
5803                         }
5804                 }
5805                 print "</td>\n";
5806                 print "<td class=\"link\">";
5807                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5808                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5809                               "blob");
5810                 if ($have_blame) {
5811                         print " | " .
5812                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5813                                                      file_name=>"$basedir$t->{'name'}", %base_key),
5814                                       -class => "blamelink"},
5815                                       "blame");
5816                 }
5817                 if (defined $hash_base) {
5818                         print " | " .
5819                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5820                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5821                                       "history");
5822                 }
5823                 print " | " .
5824                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5825                                                file_name=>"$basedir$t->{'name'}")},
5826                                 "raw");
5827                 print "</td>\n";
5828
5829         } elsif ($t->{'type'} eq "tree") {
5830                 print "<td class=\"list\">";
5831                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5832                                              file_name=>"$basedir$t->{'name'}",
5833                                              %base_key)},
5834                               esc_path($t->{'name'}));
5835                 print "</td>\n";
5836                 print "<td class=\"link\">";
5837                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5838                                              file_name=>"$basedir$t->{'name'}",
5839                                              %base_key)},
5840                               "tree");
5841                 if (defined $hash_base) {
5842                         print " | " .
5843                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5844                                                      file_name=>"$basedir$t->{'name'}")},
5845                                       "history");
5846                 }
5847                 print "</td>\n";
5848         } else {
5849                 # unknown object: we can only present history for it
5850                 # (this includes 'commit' object, i.e. submodule support)
5851                 print "<td class=\"list\">" .
5852                       esc_path($t->{'name'}) .
5853                       "</td>\n";
5854                 print "<td class=\"link\">";
5855                 if (defined $hash_base) {
5856                         print $cgi->a({-href => href(action=>"history",
5857                                                      hash_base=>$hash_base,
5858                                                      file_name=>"$basedir$t->{'name'}")},
5859                                       "history");
5860                 }
5861                 print "</td>\n";
5862         }
5863 }
5864
5865 ## ......................................................................
5866 ## functions printing large fragments of HTML
5867
5868 # get pre-image filenames for merge (combined) diff
5869 sub fill_from_file_info {
5870         my ($diff, @parents) = @_;
5871
5872         $diff->{'from_file'} = [ ];
5873         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5874         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5875                 if ($diff->{'status'}[$i] eq 'R' ||
5876                     $diff->{'status'}[$i] eq 'C') {
5877                         $diff->{'from_file'}[$i] =
5878                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5879                 }
5880         }
5881
5882         return $diff;
5883 }
5884
5885 # is current raw difftree line of file deletion
5886 sub is_deleted {
5887         my $diffinfo = shift;
5888
5889         return $diffinfo->{'to_id'} eq ('0' x 40);
5890 }
5891
5892 # does patch correspond to [previous] difftree raw line
5893 # $diffinfo  - hashref of parsed raw diff format
5894 # $patchinfo - hashref of parsed patch diff format
5895 #              (the same keys as in $diffinfo)
5896 sub is_patch_split {
5897         my ($diffinfo, $patchinfo) = @_;
5898
5899         return defined $diffinfo && defined $patchinfo
5900                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5901 }
5902
5903
5904 sub git_difftree_body {
5905         my ($difftree, $hash, @parents) = @_;
5906         my ($parent) = $parents[0];
5907         my $have_blame = gitweb_check_feature('blame');
5908         print "<div class=\"list_head\">\n";
5909         if ($#{$difftree} > 10) {
5910                 print(($#{$difftree} + 1) . " files changed:\n");
5911         }
5912         print "</div>\n";
5913
5914         print "<table class=\"" .
5915               (@parents > 1 ? "combined " : "") .
5916               "diff_tree\">\n";
5917
5918         # header only for combined diff in 'commitdiff' view
5919         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5920         if ($has_header) {
5921                 # table header
5922                 print "<thead><tr>\n" .
5923                        "<th></th><th></th>\n"; # filename, patchN link
5924                 for (my $i = 0; $i < @parents; $i++) {
5925                         my $par = $parents[$i];
5926                         print "<th>" .
5927                               $cgi->a({-href => href(action=>"commitdiff",
5928                                                      hash=>$hash, hash_parent=>$par),
5929                                        -title => 'commitdiff to parent number ' .
5930                                                   ($i+1) . ': ' . substr($par,0,7)},
5931                                       $i+1) .
5932                               "&#160;</th>\n";
5933                 }
5934                 print "</tr></thead>\n<tbody>\n";
5935         }
5936
5937         my $alternate = 1;
5938         my $patchno = 0;
5939         foreach my $line (@{$difftree}) {
5940                 my $diff = parsed_difftree_line($line);
5941
5942                 if ($alternate) {
5943                         print "<tr class=\"dark\">\n";
5944                 } else {
5945                         print "<tr class=\"light\">\n";
5946                 }
5947                 $alternate ^= 1;
5948
5949                 if (exists $diff->{'nparents'}) { # combined diff
5950
5951                         fill_from_file_info($diff, @parents)
5952                                 unless exists $diff->{'from_file'};
5953
5954                         if (!is_deleted($diff)) {
5955                                 # file exists in the result (child) commit
5956                                 print "<td>" .
5957                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5958                                                              file_name=>$diff->{'to_file'},
5959                                                              hash_base=>$hash),
5960                                               -class => "list"}, esc_path($diff->{'to_file'})) .
5961                                       "</td>\n";
5962                         } else {
5963                                 print "<td>" .
5964                                       esc_path($diff->{'to_file'}) .
5965                                       "</td>\n";
5966                         }
5967
5968                         if ($action eq 'commitdiff') {
5969                                 # link to patch
5970                                 $patchno++;
5971                                 print "<td class=\"link\">" .
5972                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
5973                                               "patch") .
5974                                       " | " .
5975                                       "</td>\n";
5976                         }
5977
5978                         my $has_history = 0;
5979                         my $not_deleted = 0;
5980                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5981                                 my $hash_parent = $parents[$i];
5982                                 my $from_hash = $diff->{'from_id'}[$i];
5983                                 my $from_path = $diff->{'from_file'}[$i];
5984                                 my $status = $diff->{'status'}[$i];
5985
5986                                 $has_history ||= ($status ne 'A');
5987                                 $not_deleted ||= ($status ne 'D');
5988
5989                                 if ($status eq 'A') {
5990                                         print "<td  class=\"link\" align=\"right\"> | </td>\n";
5991                                 } elsif ($status eq 'D') {
5992                                         print "<td class=\"link\">" .
5993                                               $cgi->a({-href => href(action=>"blob",
5994                                                                      hash_base=>$hash,
5995                                                                      hash=>$from_hash,
5996                                                                      file_name=>$from_path)},
5997                                                       "blob" . ($i+1)) .
5998                                               " | </td>\n";
5999                                 } else {
6000                                         if ($diff->{'to_id'} eq $from_hash) {
6001                                                 print "<td class=\"link nochange\">";
6002                                         } else {
6003                                                 print "<td class=\"link\">";
6004                                         }
6005                                         print $cgi->a({-href => href(action=>"blobdiff",
6006                                                                      hash=>$diff->{'to_id'},
6007                                                                      hash_parent=>$from_hash,
6008                                                                      hash_base=>$hash,
6009                                                                      hash_parent_base=>$hash_parent,
6010                                                                      file_name=>$diff->{'to_file'},
6011                                                                      file_parent=>$from_path)},
6012                                                       "diff" . ($i+1)) .
6013                                               " | </td>\n";
6014                                 }
6015                         }
6016
6017                         print "<td class=\"link\">";
6018                         if ($not_deleted) {
6019                                 print $cgi->a({-href => href(action=>"blob",
6020                                                              hash=>$diff->{'to_id'},
6021                                                              file_name=>$diff->{'to_file'},
6022                                                              hash_base=>$hash)},
6023                                               "blob");
6024                                 print " | " if ($has_history);
6025                         }
6026                         if ($has_history) {
6027                                 print $cgi->a({-href => href(action=>"history",
6028                                                              file_name=>$diff->{'to_file'},
6029                                                              hash_base=>$hash)},
6030                                               "history");
6031                         }
6032                         print "</td>\n";
6033
6034                         print "</tr>\n";
6035                         next; # instead of 'else' clause, to avoid extra indent
6036                 }
6037                 # else ordinary diff
6038
6039                 my ($to_mode_oct, $to_mode_str, $to_file_type);
6040                 my ($from_mode_oct, $from_mode_str, $from_file_type);
6041                 if ($diff->{'to_mode'} ne ('0' x 6)) {
6042                         $to_mode_oct = oct $diff->{'to_mode'};
6043                         if (S_ISREG($to_mode_oct)) { # only for regular file
6044                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
6045                         }
6046                         $to_file_type = file_type($diff->{'to_mode'});
6047                 }
6048                 if ($diff->{'from_mode'} ne ('0' x 6)) {
6049                         $from_mode_oct = oct $diff->{'from_mode'};
6050                         if (S_ISREG($from_mode_oct)) { # only for regular file
6051                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
6052                         }
6053                         $from_file_type = file_type($diff->{'from_mode'});
6054                 }
6055
6056                 if ($diff->{'status'} eq "A") { # created
6057                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
6058                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
6059                         $mode_chng   .= "]</span>";
6060                         print "<td>";
6061                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6062                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6063                                       -class => "list"}, esc_path($diff->{'file'}));
6064                         print "</td>\n";
6065                         print "<td>$mode_chng</td>\n";
6066                         print "<td class=\"link\">";
6067                         if ($action eq 'commitdiff') {
6068                                 # link to patch
6069                                 $patchno++;
6070                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6071                                               "patch") .
6072                                       " | ";
6073                         }
6074                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6075                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6076                                       "blob");
6077                         print "</td>\n";
6078
6079                 } elsif ($diff->{'status'} eq "D") { # deleted
6080                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
6081                         print "<td>";
6082                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
6083                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
6084                                        -class => "list"}, esc_path($diff->{'file'}));
6085                         print "</td>\n";
6086                         print "<td>$mode_chng</td>\n";
6087                         print "<td class=\"link\">";
6088                         if ($action eq 'commitdiff') {
6089                                 # link to patch
6090                                 $patchno++;
6091                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6092                                               "patch") .
6093                                       " | ";
6094                         }
6095                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
6096                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
6097                                       "blob") . " | ";
6098                         if ($have_blame) {
6099                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
6100                                                              file_name=>$diff->{'file'}),
6101                                               -class => "blamelink"},
6102                                               "blame") . " | ";
6103                         }
6104                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
6105                                                      file_name=>$diff->{'file'})},
6106                                       "history");
6107                         print "</td>\n";
6108
6109                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
6110                         my $mode_chnge = "";
6111                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6112                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
6113                                 if ($from_file_type ne $to_file_type) {
6114                                         $mode_chnge .= " from $from_file_type to $to_file_type";
6115                                 }
6116                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
6117                                         if ($from_mode_str && $to_mode_str) {
6118                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
6119                                         } elsif ($to_mode_str) {
6120                                                 $mode_chnge .= " mode: $to_mode_str";
6121                                         }
6122                                 }
6123                                 $mode_chnge .= "]</span>\n";
6124                         }
6125                         print "<td>";
6126                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6127                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6128                                       -class => "list"}, esc_path($diff->{'file'}));
6129                         print "</td>\n";
6130                         print "<td>$mode_chnge</td>\n";
6131                         print "<td class=\"link\">";
6132                         if ($action eq 'commitdiff') {
6133                                 # link to patch
6134                                 $patchno++;
6135                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6136                                               "patch") .
6137                                       " | ";
6138                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6139                                 # "commit" view and modified file (not onlu mode changed)
6140                                 print $cgi->a({-href => href(action=>"blobdiff",
6141                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6142                                                              hash_base=>$hash, hash_parent_base=>$parent,
6143                                                              file_name=>$diff->{'file'})},
6144                                               "diff") .
6145                                       " | ";
6146                         }
6147                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6148                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6149                                        "blob") . " | ";
6150                         if ($have_blame) {
6151                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6152                                                              file_name=>$diff->{'file'}),
6153                                               -class => "blamelink"},
6154                                               "blame") . " | ";
6155                         }
6156                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6157                                                      file_name=>$diff->{'file'})},
6158                                       "history");
6159                         print "</td>\n";
6160
6161                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
6162                         my %status_name = ('R' => 'moved', 'C' => 'copied');
6163                         my $nstatus = $status_name{$diff->{'status'}};
6164                         my $mode_chng = "";
6165                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6166                                 # mode also for directories, so we cannot use $to_mode_str
6167                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
6168                         }
6169                         print "<td>" .
6170                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
6171                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
6172                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
6173                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
6174                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
6175                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
6176                                       -class => "list"}, esc_path($diff->{'from_file'})) .
6177                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
6178                               "<td class=\"link\">";
6179                         if ($action eq 'commitdiff') {
6180                                 # link to patch
6181                                 $patchno++;
6182                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6183                                               "patch") .
6184                                       " | ";
6185                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6186                                 # "commit" view and modified file (not only pure rename or copy)
6187                                 print $cgi->a({-href => href(action=>"blobdiff",
6188                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6189                                                              hash_base=>$hash, hash_parent_base=>$parent,
6190                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
6191                                               "diff") .
6192                                       " | ";
6193                         }
6194                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6195                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
6196                                       "blob") . " | ";
6197                         if ($have_blame) {
6198                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6199                                                              file_name=>$diff->{'to_file'}),
6200                                               -class => "blamelink"},
6201                                               "blame") . " | ";
6202                         }
6203                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6204                                                     file_name=>$diff->{'to_file'})},
6205                                       "history");
6206                         print "</td>\n";
6207
6208                 } # we should not encounter Unmerged (U) or Unknown (X) status
6209                 print "</tr>\n";
6210         }
6211         print "</tbody>" if $has_header;
6212         print "</table>\n";
6213 }
6214
6215 # Print context lines and then rem/add lines in a side-by-side manner.
6216 sub print_sidebyside_diff_lines {
6217         my ($ctx, $rem, $add) = @_;
6218
6219         # print context block before add/rem block
6220         if (@$ctx) {
6221                 print join '',
6222                         '<div class="chunk_block ctx">',
6223                                 '<div class="old">',
6224                                 @$ctx,
6225                                 '</div>',
6226                                 '<div class="new">',
6227                                 @$ctx,
6228                                 '</div>',
6229                         '</div>';
6230         }
6231
6232         if (!@$add) {
6233                 # pure removal
6234                 print join '',
6235                         '<div class="chunk_block rem">',
6236                                 '<div class="old">',
6237                                 @$rem,
6238                                 '</div>',
6239                         '</div>';
6240         } elsif (!@$rem) {
6241                 # pure addition
6242                 print join '',
6243                         '<div class="chunk_block add">',
6244                                 '<div class="new">',
6245                                 @$add,
6246                                 '</div>',
6247                         '</div>';
6248         } else {
6249                 print join '',
6250                         '<div class="chunk_block chg">',
6251                                 '<div class="old">',
6252                                 @$rem,
6253                                 '</div>',
6254                                 '<div class="new">',
6255                                 @$add,
6256                                 '</div>',
6257                         '</div>';
6258         }
6259 }
6260
6261 # Print context lines and then rem/add lines in inline manner.
6262 sub print_inline_diff_lines {
6263         my ($ctx, $rem, $add) = @_;
6264
6265         print @$ctx, @$rem, @$add;
6266 }
6267
6268 # Format removed and added line, mark changed part and HTML-format them.
6269 # Implementation is based on contrib/diff-highlight
6270 sub format_rem_add_lines_pair {
6271         my ($rem, $add, $num_parents) = @_;
6272
6273         # We need to untabify lines before split()'ing them;
6274         # otherwise offsets would be invalid.
6275         chomp $rem;
6276         chomp $add;
6277         $rem = untabify($rem);
6278         $add = untabify($add);
6279
6280         my @rem = split(//, $rem);
6281         my @add = split(//, $add);
6282         my ($esc_rem, $esc_add);
6283         # Ignore leading +/- characters for each parent.
6284         my ($prefix_len, $suffix_len) = ($num_parents, 0);
6285         my ($prefix_has_nonspace, $suffix_has_nonspace);
6286
6287         my $shorter = (@rem < @add) ? @rem : @add;
6288         while ($prefix_len < $shorter) {
6289                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
6290
6291                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
6292                 $prefix_len++;
6293         }
6294
6295         while ($prefix_len + $suffix_len < $shorter) {
6296                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
6297
6298                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
6299                 $suffix_len++;
6300         }
6301
6302         # Mark lines that are different from each other, but have some common
6303         # part that isn't whitespace.  If lines are completely different, don't
6304         # mark them because that would make output unreadable, especially if
6305         # diff consists of multiple lines.
6306         if ($prefix_has_nonspace || $suffix_has_nonspace) {
6307                 $esc_rem = esc_html_hl_regions($rem, 'marked',
6308                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
6309                 $esc_add = esc_html_hl_regions($add, 'marked',
6310                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
6311         } else {
6312                 $esc_rem = esc_html($rem, -nbsp=>1);
6313                 $esc_add = esc_html($add, -nbsp=>1);
6314         }
6315
6316         return format_diff_line(\$esc_rem, 'rem'),
6317                format_diff_line(\$esc_add, 'add');
6318 }
6319
6320 # HTML-format diff context, removed and added lines.
6321 sub format_ctx_rem_add_lines {
6322         my ($ctx, $rem, $add, $num_parents) = @_;
6323         my (@new_ctx, @new_rem, @new_add);
6324         my $can_highlight = 0;
6325         my $is_combined = ($num_parents > 1);
6326
6327         # Highlight if every removed line has a corresponding added line.
6328         if (@$add > 0 && @$add == @$rem) {
6329                 $can_highlight = 1;
6330
6331                 # Highlight lines in combined diff only if the chunk contains
6332                 # diff between the same version, e.g.
6333                 #
6334                 #    - a
6335                 #   -  b
6336                 #    + c
6337                 #   +  d
6338                 #
6339                 # Otherwise the highlightling would be confusing.
6340                 if ($is_combined) {
6341                         for (my $i = 0; $i < @$add; $i++) {
6342                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
6343                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
6344
6345                                 $prefix_rem =~ s/-/+/g;
6346
6347                                 if ($prefix_rem ne $prefix_add) {
6348                                         $can_highlight = 0;
6349                                         last;
6350                                 }
6351                         }
6352                 }
6353         }
6354
6355         if ($can_highlight) {
6356                 for (my $i = 0; $i < @$add; $i++) {
6357                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
6358                                 $rem->[$i], $add->[$i], $num_parents);
6359                         push @new_rem, $line_rem;
6360                         push @new_add, $line_add;
6361                 }
6362         } else {
6363                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
6364                 @new_add = map { format_diff_line($_, 'add') } @$add;
6365         }
6366
6367         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
6368
6369         return (\@new_ctx, \@new_rem, \@new_add);
6370 }
6371
6372 # Print context lines and then rem/add lines.
6373 sub print_diff_lines {
6374         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
6375         my $is_combined = $num_parents > 1;
6376
6377         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
6378                 $num_parents);
6379
6380         if ($diff_style eq 'sidebyside' && !$is_combined) {
6381                 print_sidebyside_diff_lines($ctx, $rem, $add);
6382         } else {
6383                 # default 'inline' style and unknown styles
6384                 print_inline_diff_lines($ctx, $rem, $add);
6385         }
6386 }
6387
6388 sub print_diff_chunk {
6389         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
6390         my (@ctx, @rem, @add);
6391
6392         # The class of the previous line.
6393         my $prev_class = '';
6394
6395         return unless @chunk;
6396
6397         # incomplete last line might be among removed or added lines,
6398         # or both, or among context lines: find which
6399         for (my $i = 1; $i < @chunk; $i++) {
6400                 if ($chunk[$i][0] eq 'incomplete') {
6401                         $chunk[$i][0] = $chunk[$i-1][0];
6402                 }
6403         }
6404
6405         # guardian
6406         push @chunk, ["", ""];
6407
6408         foreach my $line_info (@chunk) {
6409                 my ($class, $line) = @$line_info;
6410
6411                 # print chunk headers
6412                 if ($class && $class eq 'chunk_header') {
6413                         print format_diff_line($line, $class, $from, $to);
6414                         next;
6415                 }
6416
6417                 ## print from accumulator when have some add/rem lines or end
6418                 # of chunk (flush context lines), or when have add and rem
6419                 # lines and new block is reached (otherwise add/rem lines could
6420                 # be reordered)
6421                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
6422                     (@rem && @add && $class ne $prev_class)) {
6423                         print_diff_lines(\@ctx, \@rem, \@add,
6424                                          $diff_style, $num_parents);
6425                         @ctx = @rem = @add = ();
6426                 }
6427
6428                 ## adding lines to accumulator
6429                 # guardian value
6430                 last unless $line;
6431                 # rem, add or change
6432                 if ($class eq 'rem') {
6433                         push @rem, $line;
6434                 } elsif ($class eq 'add') {
6435                         push @add, $line;
6436                 }
6437                 # context line
6438                 if ($class eq 'ctx') {
6439                         push @ctx, $line;
6440                 }
6441
6442                 $prev_class = $class;
6443         }
6444 }
6445
6446 sub git_patchset_body {
6447         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
6448         my ($hash_parent) = $hash_parents[0];
6449
6450         my $is_combined = (@hash_parents > 1);
6451         my $patch_idx = 0;
6452         my $patch_number = 0;
6453         my $patch_line;
6454         my $diffinfo;
6455         my $to_name;
6456         my (%from, %to);
6457         my @chunk; # for side-by-side diff
6458
6459         print "<div class=\"patchset\">\n";
6460
6461         # skip to first patch
6462         while ($patch_line = to_utf8(scalar <$fd>)) {
6463                 chomp $patch_line;
6464
6465                 last if ($patch_line =~ m/^diff /);
6466         }
6467
6468  PATCH:
6469         while ($patch_line) {
6470
6471                 # parse "git diff" header line
6472                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
6473                         # $1 is from_name, which we do not use
6474                         $to_name = unquote($2);
6475                         $to_name =~ s!^b/!!;
6476                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
6477                         # $1 is 'cc' or 'combined', which we do not use
6478                         $to_name = unquote($2);
6479                 } else {
6480                         $to_name = undef;
6481                 }
6482
6483                 # check if current patch belong to current raw line
6484                 # and parse raw git-diff line if needed
6485                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
6486                         # this is continuation of a split patch
6487                         print "<div class=\"patch cont\">\n";
6488                 } else {
6489                         # advance raw git-diff output if needed
6490                         $patch_idx++ if defined $diffinfo;
6491
6492                         # read and prepare patch information
6493                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6494
6495                         # compact combined diff output can have some patches skipped
6496                         # find which patch (using pathname of result) we are at now;
6497                         if ($is_combined) {
6498                                 while ($to_name ne $diffinfo->{'to_file'}) {
6499                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6500                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
6501                                               "</div>\n";  # class="patch"
6502
6503                                         $patch_idx++;
6504                                         $patch_number++;
6505
6506                                         last if $patch_idx > $#$difftree;
6507                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6508                                 }
6509                         }
6510
6511                         # modifies %from, %to hashes
6512                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
6513
6514                         # this is first patch for raw difftree line with $patch_idx index
6515                         # we index @$difftree array from 0, but number patches from 1
6516                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
6517                 }
6518
6519                 # git diff header
6520                 #assert($patch_line =~ m/^diff /) if DEBUG;
6521                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
6522                 $patch_number++;
6523                 # print "git diff" header
6524                 print format_git_diff_header_line($patch_line, $diffinfo,
6525                                                   \%from, \%to);
6526
6527                 # print extended diff header
6528                 print "<div class=\"diff extended_header\">\n";
6529         EXTENDED_HEADER:
6530                 while ($patch_line = to_utf8(scalar<$fd>)) {
6531                         chomp $patch_line;
6532
6533                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
6534
6535                         print format_extended_diff_header_line($patch_line, $diffinfo,
6536                                                                \%from, \%to);
6537                 }
6538                 print "</div>\n"; # class="diff extended_header"
6539
6540                 # from-file/to-file diff header
6541                 if (! $patch_line) {
6542                         print "</div>\n"; # class="patch"
6543                         last PATCH;
6544                 }
6545                 next PATCH if ($patch_line =~ m/^diff /);
6546                 #assert($patch_line =~ m/^---/) if DEBUG;
6547
6548                 my $last_patch_line = $patch_line;
6549                 $patch_line = to_utf8(scalar <$fd>);
6550                 chomp $patch_line;
6551                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
6552
6553                 print format_diff_from_to_header($last_patch_line, $patch_line,
6554                                                  $diffinfo, \%from, \%to,
6555                                                  @hash_parents);
6556
6557                 # the patch itself
6558         LINE:
6559                 while ($patch_line = to_utf8(scalar <$fd>)) {
6560                         chomp $patch_line;
6561
6562                         next PATCH if ($patch_line =~ m/^diff /);
6563
6564                         my $class = diff_line_class($patch_line, \%from, \%to);
6565
6566                         if ($class eq 'chunk_header') {
6567                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6568                                 @chunk = ();
6569                         }
6570
6571                         push @chunk, [ $class, $patch_line ];
6572                 }
6573
6574         } continue {
6575                 if (@chunk) {
6576                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6577                         @chunk = ();
6578                 }
6579                 print "</div>\n"; # class="patch"
6580         }
6581
6582         # for compact combined (--cc) format, with chunk and patch simplification
6583         # the patchset might be empty, but there might be unprocessed raw lines
6584         for (++$patch_idx if $patch_number > 0;
6585              $patch_idx < @$difftree;
6586              ++$patch_idx) {
6587                 # read and prepare patch information
6588                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6589
6590                 # generate anchor for "patch" links in difftree / whatchanged part
6591                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6592                       format_diff_cc_simplified($diffinfo, @hash_parents) .
6593                       "</div>\n";  # class="patch"
6594
6595                 $patch_number++;
6596         }
6597
6598         if ($patch_number == 0) {
6599                 if (@hash_parents > 1) {
6600                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
6601                 } else {
6602                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
6603                 }
6604         }
6605
6606         print "</div>\n"; # class="patchset"
6607 }
6608
6609 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6610
6611 sub git_project_search_form {
6612         my ($searchtext, $search_use_regexp) = @_;
6613
6614         my $limit = '';
6615         if ($project_filter) {
6616                 $limit = " in '$project_filter'";
6617         }
6618
6619         print "<div class=\"projsearch\">\n";
6620         $cgi->start_form(-method => 'get', -action => $my_uri);
6621         print sprintf(qq/<form method="%s" action="%s" enctype="%s">\n/,
6622               'get', CGI::escapeHTML($my_uri), &CGI::URL_ENCODED) .
6623               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
6624         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
6625                 if (defined $project_filter);
6626         print $cgi->textfield(-name => 's', -value => $searchtext,
6627                               -title => "Search project by name and description$limit",
6628                               -size => 60) . "\n" .
6629               "<span title=\"Extended regular expression\">" .
6630               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
6631                              -checked => $search_use_regexp) .
6632               "</span>\n" .
6633               $cgi->submit(-name => 'btnS', -value => 'Search') .
6634               $cgi->end_form() . "\n" .
6635               "<span class=\"projectlist_link\">" .
6636               $cgi->a({-href => href(project => undef, searchtext => undef,
6637                                      action => 'project_list',
6638                                      project_filter => $project_filter)},
6639                       esc_html("List all projects$limit")) . "</span><br />\n";
6640         print "<span class=\"projectlist_link\">" .
6641               $cgi->a({-href => href(project => undef, searchtext => undef,
6642                                      action => 'project_list',
6643                                      project_filter => undef)},
6644                       esc_html("List all projects")) . "</span>\n" if $project_filter;
6645         print "</div>\n";
6646 }
6647
6648 # entry for given @keys needs filling if at least one of keys in list
6649 # is not present in %$project_info
6650 sub project_info_needs_filling {
6651         my ($project_info, @keys) = @_;
6652
6653         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
6654         foreach my $key (@keys) {
6655                 if (!exists $project_info->{$key}) {
6656                         return 1;
6657                 }
6658         }
6659         return;
6660 }
6661
6662 sub git_cache_file_format {
6663         return GITWEB_CACHE_FORMAT .
6664                 (gitweb_check_feature('forks') ? " (forks)" : "");
6665 }
6666
6667 sub git_retrieve_cache_file {
6668         my $cache_file = shift;
6669
6670         use Storable qw(retrieve);
6671
6672         if ((my $dump = eval { retrieve($cache_file) })) {
6673                 return $$dump[1] if
6674                         ref($dump) eq 'ARRAY' &&
6675                         @$dump == 2 &&
6676                         ref($$dump[1]) eq 'ARRAY' &&
6677                         @{$$dump[1]} == 2 &&
6678                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
6679                         ref(${$$dump[1]}[1]) eq 'HASH' &&
6680                         $$dump[0] eq git_cache_file_format();
6681         }
6682
6683         return undef;
6684 }
6685
6686 sub git_store_cache_file {
6687         my ($cache_file, $cachedata) = @_;
6688
6689         use File::Basename qw(dirname);
6690         use File::stat;
6691         use POSIX qw(:fcntl_h);
6692         use Storable qw(store_fd);
6693
6694         my $result = undef;
6695         my $cache_d = dirname($cache_file);
6696         my $mask = umask();
6697         umask($mask & ~0070) if $cache_grpshared;
6698         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6699             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6700                 store_fd([git_cache_file_format(), $cachedata], $fd);
6701                 close $fd;
6702                 rename "$cache_file.lock", $cache_file;
6703                 $result = stat($cache_file)->mtime;
6704         }
6705         umask($mask) if $cache_grpshared;
6706         return $result;
6707 }
6708
6709 sub verify_cached_project {
6710         my ($hashref, $path) = @_;
6711         return undef unless $path;
6712         delete $$hashref{$path}, return undef unless is_valid_project($path);
6713         return $$hashref{$path} if exists $$hashref{$path};
6714
6715         # A valid project was requested but it's not yet in the cache
6716         # Manufacture a minimal project entry (path, name, description)
6717         # Also provide age, but only if it's available via $lastactivity_file
6718
6719         my %proj = ('path' => $path);
6720         my $val = git_get_project_description($path);
6721         defined $val or $val = '';
6722         $proj{'descr_long'} = $val;
6723         $proj{'descr'} = chop_str($val, $projects_list_description_width, 5);
6724         unless ($omit_owner) {
6725                 $val = git_get_project_owner($path);
6726                 defined $val or $val = '';
6727                 $proj{'owner'} = $val;
6728         }
6729         unless ($omit_age_column) {
6730                 ($val) = git_get_last_activity($path, 1);
6731                 $proj{'age_epoch'} = $val if defined $val;
6732         }
6733         $$hashref{$path} = \%proj;
6734         return \%proj;
6735 }
6736
6737 sub git_filter_cached_projects {
6738         my ($cache, $projlist, $verify) = @_;
6739         my $hashref = $$cache[1];
6740         my $sub = $verify ?
6741                 sub {verify_cached_project($hashref, $_[0])} :
6742                 sub {$$hashref{$_[0]}};
6743         return map {
6744                 my $c = &$sub($_->{'path'});
6745                 defined $c ? ($_ = $c) : ()
6746         } @$projlist;
6747 }
6748
6749 # fills project list info (age, description, owner, category, forks, etc.)
6750 # for each project in the list, removing invalid projects from
6751 # returned list, or fill only specified info.
6752 #
6753 # Invalid projects are removed from the returned list if and only if you
6754 # ask 'age_epoch' to be filled, because they are the only fields
6755 # that run unconditionally git command that requires repository, and
6756 # therefore do always check if project repository is invalid.
6757 #
6758 # USAGE:
6759 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6760 #   ensures that 'descr_long' and 'ctags' fields are filled
6761 # * @project_list = fill_project_list_info(\@project_list)
6762 #   ensures that all fields are filled (and invalid projects removed)
6763 #
6764 # NOTE: modifies $projlist, but does not remove entries from it
6765 sub fill_project_list_info {
6766         my ($projlist, @wanted_keys) = @_;
6767
6768         my $rebuild = @wanted_keys && $wanted_keys[0] eq 'rebuild-cache' && shift @wanted_keys;
6769         return fill_project_list_info_uncached($projlist, @wanted_keys)
6770                 unless $projlist_cache_lifetime && $projlist_cache_lifetime > 0;
6771
6772         use File::stat;
6773
6774         my $cache_lifetime = $rebuild ? 0 : $projlist_cache_lifetime;
6775         my $cache_file = "$cache_dir/$projlist_cache_name";
6776
6777         my @projects;
6778         my $stale = 0;
6779         my $now = time();
6780         my $cache_mtime;
6781         if ($cache_lifetime && -f $cache_file) {
6782                 $cache_mtime = stat($cache_file)->mtime;
6783                 $cache_dump = undef if $cache_mtime &&
6784                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6785         }
6786         if (defined $cache_mtime && # caching is on and $cache_file exists
6787             $cache_mtime + $cache_lifetime*60 > $now &&
6788             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6789                 # Cache hit.
6790                 $cache_dump_mtime = $cache_mtime;
6791                 $stale = $now - $cache_mtime;
6792                 my $verify = ($action eq 'summary' || $action eq 'forks') &&
6793                         gitweb_check_feature('forks');
6794                 @projects = git_filter_cached_projects($cache_dump, $projlist, $verify);
6795
6796         } else { # Cache miss.
6797                 if (defined $cache_mtime) {
6798                         # Postpone timeout by two minutes so that we get
6799                         # enough time to do our job, or to be more exact
6800                         # make cache expire after two minutes from now.
6801                         my $time = $now - $cache_lifetime*60 + 120;
6802                         utime $time, $time, $cache_file;
6803                 }
6804                 my @all_projects = git_get_projects_list();
6805                 my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6806                         fill_project_list_info_uncached(\@all_projects);
6807                 map { $all_projects_filled{$_->{'path'}} = $_ }
6808                         filter_forks_from_projects_list([values(%all_projects_filled)])
6809                         if gitweb_check_feature('forks');
6810                 $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6811                                \%all_projects_filled];
6812                 $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6813                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6814         }
6815
6816         if ($cache_lifetime && $stale > 0) {
6817                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6818                         unless $shown_stale_message;
6819                 $shown_stale_message = 1;
6820         }
6821
6822         return @projects;
6823 }
6824
6825 sub fill_project_list_info_uncached {
6826         my ($projlist, @wanted_keys) = @_;
6827         my @projects;
6828         my $filter_set = sub { return @_; };
6829         if (@wanted_keys) {
6830                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6831                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6832         }
6833
6834         my $show_ctags = gitweb_check_feature('ctags');
6835  PROJECT:
6836         foreach my $pr (@$projlist) {
6837                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6838                         my (@activity) = git_get_last_activity($pr->{'path'});
6839                         unless (@activity) {
6840                                 next PROJECT;
6841                         }
6842                         ($pr->{'age_epoch'}) = @activity;
6843                 }
6844                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6845                         my $descr = git_get_project_description($pr->{'path'}) || "";
6846                         $descr = to_utf8($descr);
6847                         $pr->{'descr_long'} = $descr;
6848                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6849                 }
6850                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6851                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6852                 }
6853                 if ($show_ctags &&
6854                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6855                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6856                 }
6857                 if ($projects_list_group_categories &&
6858                     project_info_needs_filling($pr, $filter_set->('category'))) {
6859                         my $cat = git_get_project_category($pr->{'path'}) ||
6860                                                            $project_list_default_category;
6861                         $pr->{'category'} = to_utf8($cat);
6862                 }
6863
6864                 push @projects, $pr;
6865         }
6866
6867         return @projects;
6868 }
6869
6870 sub sort_projects_list {
6871         my ($projlist, $order) = @_;
6872
6873         sub order_str {
6874                 my $key = shift;
6875                 return sub { lc($a->{$key}) cmp lc($b->{$key}) };
6876         }
6877
6878         sub order_reverse_num_then_undef {
6879                 my $key = shift;
6880                 return sub {
6881                         defined $a->{$key} ?
6882                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6883                                 (defined $b->{$key} ? 1 : 0)
6884                 };
6885         }
6886
6887         my %orderings = (
6888                 project => order_str('path'),
6889                 descr => order_str('descr_long'),
6890                 owner => order_str('owner'),
6891                 age => order_reverse_num_then_undef('age_epoch'),
6892         );
6893
6894         my $ordering = $orderings{$order};
6895         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6896 }
6897
6898 # returns a hash of categories, containing the list of project
6899 # belonging to each category
6900 sub build_projlist_by_category {
6901         my ($projlist, $from, $to) = @_;
6902         my %categories;
6903
6904         $from = 0 unless defined $from;
6905         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6906
6907         for (my $i = $from; $i <= $to; $i++) {
6908                 my $pr = $projlist->[$i];
6909                 push @{$categories{ $pr->{'category'} }}, $pr;
6910         }
6911
6912         return wantarray ? %categories : \%categories;
6913 }
6914
6915 # print 'sort by' <th> element, generating 'sort by $name' replay link
6916 # if that order is not selected
6917 sub print_sort_th {
6918         print format_sort_th(@_);
6919 }
6920
6921 sub format_sort_th {
6922         my ($name, $order, $header) = @_;
6923         my $sort_th = "";
6924         $header ||= ucfirst($name);
6925
6926         if ($order eq $name) {
6927                 $sort_th .= "<th>$header</th>\n";
6928         } else {
6929                 $sort_th .= "<th>" .
6930                             $cgi->a({-href => href(-replay=>1, order=>$name),
6931                                      -class => "header"}, $header) .
6932                             "</th>\n";
6933         }
6934
6935         return $sort_th;
6936 }
6937
6938 sub git_project_list_rows {
6939         my ($projlist, $from, $to, $check_forks) = @_;
6940
6941         $from = 0 unless defined $from;
6942         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6943
6944         my $now = time;
6945         my $alternate = 1;
6946         for (my $i = $from; $i <= $to; $i++) {
6947                 my $pr = $projlist->[$i];
6948
6949                 if ($alternate) {
6950                         print "<tr class=\"dark\">\n";
6951                 } else {
6952                         print "<tr class=\"light\">\n";
6953                 }
6954                 $alternate ^= 1;
6955
6956                 if ($check_forks) {
6957                         print "<td>";
6958                         if ($pr->{'forks'}) {
6959                                 my $nforks = scalar @{$pr->{'forks'}};
6960                                 my $s = $nforks == 1 ? '' : 's';
6961                                 if ($nforks > 0) {
6962                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
6963                                                        -title => "$nforks fork$s"}, "+");
6964                                 } else {
6965                                         print $cgi->span({-title => "$nforks fork$s"}, "+");
6966                                 }
6967                         }
6968                         print "</td>\n";
6969                 }
6970                 my $path = $pr->{'path'};
6971                 my $dotgit = $path =~ s/\.git$// ? '.git' : '';
6972                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6973                                         -class => "list"},
6974                                        esc_html_match_hl($path, $search_regexp).$dotgit) .
6975                       "</td>\n" .
6976                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6977                                         -class => "list",
6978                                         -title => $pr->{'descr_long'}},
6979                                         $search_regexp
6980                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
6981                                                                     $pr->{'descr'}, $search_regexp)
6982                                         : esc_html($pr->{'descr'})) .
6983                       "</td>\n";
6984                 unless ($omit_owner) {
6985                         print "<td><i>" . ($owner_link_hook
6986                                           ? $cgi->a({-href => $owner_link_hook->($pr->{'owner'}), -class => "list"},
6987                                                     chop_and_escape_str($pr->{'owner'}, 15))
6988                                           : chop_and_escape_str($pr->{'owner'}, 15)) . "</i></td>\n";
6989                 }
6990                 unless ($omit_age_column) {
6991                         my ($age_epoch, $age_string) = ($pr->{'age_epoch'});
6992                         $age_string = defined $age_epoch ? age_string($age_epoch, $now) : "No commits";
6993                         print "<td class=\"". age_class($age_epoch, $now) . "\">" . $age_string . "</td>\n";
6994                 }
6995                 print"<td class=\"link\">" .
6996                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . " | " .
6997                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "log") . " | " .
6998                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
6999                       ($pr->{'forks'} ? " | " . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
7000                       "</td>\n" .
7001                       "</tr>\n";
7002         }
7003 }
7004
7005 sub git_project_list_body {
7006         # actually uses global variable $project
7007         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action, $keep_top) = @_;
7008         my @projects = @$projlist;
7009
7010         my $check_forks = gitweb_check_feature('forks');
7011         my $show_ctags  = gitweb_check_feature('ctags');
7012         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
7013         $check_forks = undef
7014                 if ($tagfilter || $search_regexp);
7015
7016         # filtering out forks before filling info allows us to do less work
7017         if ($check_forks) {
7018                 @projects = filter_forks_from_projects_list(\@projects);
7019                 push @projects, { 'path' => "$project_filter.git" }
7020                         if $project_filter && $keep_top && is_valid_project("$project_filter.git");
7021         }
7022         # search_projects_list pre-fills required info
7023         @projects = search_projects_list(\@projects,
7024                                          'search_regexp' => $search_regexp,
7025                                          'tagfilter'  => $tagfilter)
7026                 if ($tagfilter || $search_regexp);
7027         # fill the rest
7028         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
7029         push @all_fields, 'age_epoch' unless($omit_age_column);
7030         push @all_fields, 'owner' unless($omit_owner);
7031         @projects = fill_project_list_info(\@projects, @all_fields);
7032
7033         $order ||= $default_projects_order;
7034         $from = 0 unless defined $from;
7035         $to = $#projects if (!defined $to || $#projects < $to);
7036
7037         # short circuit
7038         if ($from > $to) {
7039                 print "<center>\n".
7040                       "<b>No such projects found</b><br />\n".
7041                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
7042                       "</center>\n<br />\n";
7043                 return;
7044         }
7045
7046         @projects = sort_projects_list(\@projects, $order);
7047
7048         if ($show_ctags) {
7049                 my $ctags = git_gather_all_ctags(\@projects);
7050                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
7051                 print git_show_project_tagcloud($cloud, 64);
7052         }
7053
7054         print "<table class=\"project_list\">\n";
7055         unless ($no_header) {
7056                 print "<tr>\n";
7057                 if ($check_forks) {
7058                         print "<th></th>\n";
7059                 }
7060                 print_sort_th('project', $order, 'Project');
7061                 print_sort_th('descr', $order, 'Description');
7062                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
7063                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
7064                 print "<th></th>\n" . # for links
7065                       "</tr>\n";
7066         }
7067
7068         if ($projects_list_group_categories) {
7069                 # only display categories with projects in the $from-$to window
7070                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
7071                 my %categories = build_projlist_by_category(\@projects, $from, $to);
7072                 foreach my $cat (sort keys %categories) {
7073                         unless ($cat eq "") {
7074                                 print "<tr>\n";
7075                                 if ($check_forks) {
7076                                         print "<td></td>\n";
7077                                 }
7078                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
7079                                 print "</tr>\n";
7080                         }
7081
7082                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
7083                 }
7084         } else {
7085                 git_project_list_rows(\@projects, $from, $to, $check_forks);
7086         }
7087
7088         if (defined $extra) {
7089                 print "<tr>\n";
7090                 if ($check_forks) {
7091                         print "<td></td>\n";
7092                 }
7093                 print "<td colspan=\"5\">$extra</td>\n" .
7094                       "</tr>\n";
7095         }
7096         print "</table>\n";
7097 }
7098
7099 sub git_log_body {
7100         # uses global variable $project
7101         my ($commitlist, $from, $to, $refs, $extra) = @_;
7102
7103         $from = 0 unless defined $from;
7104         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7105
7106         for (my $i = 0; $i <= $to; $i++) {
7107                 my %co = %{$commitlist->[$i]};
7108                 next if !%co;
7109                 my $commit = $co{'id'};
7110                 my $ref = format_ref_marker($refs, $commit);
7111                 git_print_header_div('commit',
7112                                "<span class=\"age\">$co{'age_string'}</span>" .
7113                                esc_html($co{'title'}),
7114                                $commit, undef, $ref);
7115                 print "<div class=\"title_text\">\n" .
7116                       "<div class=\"log_link\">\n" .
7117                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
7118                       " | " .
7119                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
7120                       " | " .
7121                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
7122                       "<br/>\n" .
7123                       "</div>\n";
7124                       git_print_authorship(\%co, -tag => 'span');
7125                       print "<br/>\n</div>\n";
7126
7127                 print "<div class=\"log_body\">\n";
7128                 git_print_log($co{'comment'}, -final_empty_line=> 1);
7129                 print "</div>\n";
7130         }
7131         if ($extra) {
7132                 print "<div class=\"page_nav\">\n";
7133                 print "$extra\n";
7134                 print "</div>\n";
7135         }
7136 }
7137
7138 sub git_shortlog_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         print "<table class=\"shortlog\">\n";
7146         my $alternate = 1;
7147         for (my $i = $from; $i <= $to; $i++) {
7148                 my %co = %{$commitlist->[$i]};
7149                 my $commit = $co{'id'};
7150                 my $ref = format_ref_marker($refs, $commit);
7151                 if ($alternate) {
7152                         print "<tr class=\"dark\">\n";
7153                 } else {
7154                         print "<tr class=\"light\">\n";
7155                 }
7156                 $alternate ^= 1;
7157                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
7158                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7159                       format_author_html('td', \%co, 10) . "<td>";
7160                 print format_subject_html($co{'title'}, $co{'title_short'},
7161                                           href(action=>"commit", hash=>$commit), $ref);
7162                 print "</td>\n" .
7163                       "<td class=\"link\">" .
7164                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . " | " .
7165                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . " | " .
7166                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
7167                 my $snapshot_links = format_snapshot_links($commit);
7168                 if (defined $snapshot_links) {
7169                         print " | " . $snapshot_links;
7170                 }
7171                 print "</td>\n" .
7172                       "</tr>\n";
7173         }
7174         if (defined $extra) {
7175                 print "<tr>\n" .
7176                       "<td colspan=\"4\">$extra</td>\n" .
7177                       "</tr>\n";
7178         }
7179         print "</table>\n";
7180 }
7181
7182 sub git_history_body {
7183         # Warning: assumes constant type (blob or tree) during history
7184         my ($commitlist, $from, $to, $refs, $extra,
7185             $file_name, $file_hash, $ftype) = @_;
7186
7187         $from = 0 unless defined $from;
7188         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
7189
7190         print "<table class=\"history\">\n";
7191         my $alternate = 1;
7192         for (my $i = $from; $i <= $to; $i++) {
7193                 my %co = %{$commitlist->[$i]};
7194                 if (!%co) {
7195                         next;
7196                 }
7197                 my $commit = $co{'id'};
7198
7199                 my $ref = format_ref_marker($refs, $commit);
7200
7201                 if ($alternate) {
7202                         print "<tr class=\"dark\">\n";
7203                 } else {
7204                         print "<tr class=\"light\">\n";
7205                 }
7206                 $alternate ^= 1;
7207                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7208         # shortlog:   format_author_html('td', \%co, 10)
7209                       format_author_html('td', \%co, 15, 3) . "<td>";
7210                 # originally git_history used chop_str($co{'title'}, 50)
7211                 print format_subject_html($co{'title'}, $co{'title_short'},
7212                                           href(action=>"commit", hash=>$commit), $ref);
7213                 print "</td>\n" .
7214                       "<td class=\"link\">" .
7215                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . " | " .
7216                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
7217
7218                 if ($ftype eq 'blob') {
7219                         my $blob_current = $file_hash;
7220                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
7221                         if (defined $blob_current && defined $blob_parent &&
7222                                         $blob_current ne $blob_parent) {
7223                                 print " | " .
7224                                         $cgi->a({-href => href(action=>"blobdiff",
7225                                                                hash=>$blob_current, hash_parent=>$blob_parent,
7226                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
7227                                                                file_name=>$file_name)},
7228                                                 "diff to current");
7229                         }
7230                 }
7231                 print "</td>\n" .
7232                       "</tr>\n";
7233         }
7234         if (defined $extra) {
7235                 print "<tr>\n" .
7236                       "<td colspan=\"4\">$extra</td>\n" .
7237                       "</tr>\n";
7238         }
7239         print "</table>\n";
7240 }
7241
7242 sub git_tags_body {
7243         # uses global variable $project
7244         my ($taglist, $from, $to, $extra, $head_at, $full, $order) = @_;
7245         $from = 0 unless defined $from;
7246         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
7247         $order ||= $default_refs_order;
7248
7249         print "<table class=\"tags\">\n";
7250         if ($full) {
7251                 print "<tr class=\"tags_header\">\n";
7252                 print_sort_th('age', $order, 'Last Change');
7253                 print_sort_th('name', $order, 'Name');
7254                 print "<th></th>\n" . # for comment
7255                       "<th></th>\n" . # for tag
7256                       "<th></th>\n" . # for links
7257                       "</tr>\n";
7258         }
7259         my $alternate = 1;
7260         for (my $i = $from; $i <= $to; $i++) {
7261                 my $entry = $taglist->[$i];
7262                 my %tag = %$entry;
7263                 my $comment = $tag{'subject'};
7264                 my $comment_short;
7265                 if (defined $comment) {
7266                         $comment_short = chop_str($comment, 30, 5);
7267                 }
7268                 my $curr = defined $head_at && $tag{'id'} eq $head_at;
7269                 if ($alternate) {
7270                         print "<tr class=\"dark\">\n";
7271                 } else {
7272                         print "<tr class=\"light\">\n";
7273                 }
7274                 $alternate ^= 1;
7275                 if (defined $tag{'age'}) {
7276                         print "<td><i>$tag{'age'}</i></td>\n";
7277                 } else {
7278                         print "<td></td>\n";
7279                 }
7280                 print(($curr ? "<td class=\"current_head\">" : "<td>") .
7281                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
7282                                -class => "list name"}, esc_html($tag{'name'})) .
7283                       "</td>\n" .
7284                       "<td>");
7285                 if (defined $comment) {
7286                         print format_subject_html($comment, $comment_short,
7287                                                   href(action=>"tag", hash=>$tag{'id'}));
7288                 }
7289                 print "</td>\n" .
7290                       "<td class=\"selflink\">";
7291                 if ($tag{'type'} eq "tag") {
7292                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
7293                 } else {
7294                         print "&#160;";
7295                 }
7296                 print "</td>\n" .
7297                       "<td class=\"link\">" . " | " .
7298                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
7299                 if ($tag{'reftype'} eq "commit") {
7300                         print " | " . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "log");
7301                         print " | " . $cgi->a({-href => href(action=>"tree", hash=>$tag{'fullname'})}, "tree") if $full;
7302                 } elsif ($tag{'reftype'} eq "blob") {
7303                         print " | " . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
7304                 }
7305                 print "</td>\n" .
7306                       "</tr>";
7307         }
7308         if (defined $extra) {
7309                 print "<tr>\n" .
7310                       "<td colspan=\"5\">$extra</td>\n" .
7311                       "</tr>\n";
7312         }
7313         print "</table>\n";
7314 }
7315
7316 sub git_heads_body {
7317         # uses global variable $project
7318         my ($headlist, $head_at, $from, $to, $extra) = @_;
7319         $from = 0 unless defined $from;
7320         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
7321
7322         print "<table class=\"heads\">\n";
7323         my $alternate = 1;
7324         for (my $i = $from; $i <= $to; $i++) {
7325                 my $entry = $headlist->[$i];
7326                 my %ref = %$entry;
7327                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
7328                 if ($alternate) {
7329                         print "<tr class=\"dark\">\n";
7330                 } else {
7331                         print "<tr class=\"light\">\n";
7332                 }
7333                 $alternate ^= 1;
7334                 print "<td><i>$ref{'age'}</i></td>\n" .
7335                       ($curr ? "<td class=\"current_head\">" : "<td>") .
7336                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
7337                                -class => "list name"},esc_html($ref{'name'})) .
7338                       "</td>\n" .
7339                       "<td class=\"link\">" .
7340                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "log") . " | " .
7341                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
7342                       "</td>\n" .
7343                       "</tr>";
7344         }
7345         if (defined $extra) {
7346                 print "<tr>\n" .
7347                       "<td colspan=\"3\">$extra</td>\n" .
7348                       "</tr>\n";
7349         }
7350         print "</table>\n";
7351 }
7352
7353 # Display a single remote block
7354 sub git_remote_block {
7355         my ($remote, $rdata, $limit, $head) = @_;
7356
7357         my $heads = $rdata->{'heads'};
7358         my $fetch = $rdata->{'fetch'};
7359         my $push = $rdata->{'push'};
7360
7361         my $urls_table = "<table class=\"projects_list\">\n" ;
7362
7363         if (defined $fetch) {
7364                 if ($fetch eq $push) {
7365                         $urls_table .= format_repo_url("URL", $fetch);
7366                 } else {
7367                         $urls_table .= format_repo_url("Fetch&#160;URL", $fetch);
7368                         $urls_table .= format_repo_url("Push&#160;URL", $push) if defined $push;
7369                 }
7370         } elsif (defined $push) {
7371                 $urls_table .= format_repo_url("Push&#160;URL", $push);
7372         } else {
7373                 $urls_table .= format_repo_url("", "No remote URL");
7374         }
7375
7376         $urls_table .= "</table>\n";
7377
7378         my $dots;
7379         if (defined $limit && $limit < @$heads) {
7380                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
7381         }
7382
7383         print $urls_table;
7384         git_heads_body($heads, $head, 0, $limit, $dots);
7385 }
7386
7387 # Display a list of remote names with the respective fetch and push URLs
7388 sub git_remotes_list {
7389         my ($remotedata, $limit) = @_;
7390         print "<table class=\"heads\">\n";
7391         my $alternate = 1;
7392         my @remotes = sort keys %$remotedata;
7393
7394         my $limited = $limit && $limit < @remotes;
7395
7396         $#remotes = $limit - 1 if $limited;
7397
7398         while (my $remote = shift @remotes) {
7399                 my $rdata = $remotedata->{$remote};
7400                 my $fetch = $rdata->{'fetch'};
7401                 my $push = $rdata->{'push'};
7402                 if ($alternate) {
7403                         print "<tr class=\"dark\">\n";
7404                 } else {
7405                         print "<tr class=\"light\">\n";
7406                 }
7407                 $alternate ^= 1;
7408                 print "<td>" .
7409                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
7410                                -class=> "list name"},esc_html($remote)) .
7411                       "</td>";
7412                 print "<td class=\"link\">" .
7413                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
7414                       " | " .
7415                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
7416                       "</td>";
7417
7418                 print "</tr>\n";
7419         }
7420
7421         if ($limited) {
7422                 print "<tr>\n" .
7423                       "<td colspan=\"3\">" .
7424                       $cgi->a({-href => href(action=>"remotes")}, "...") .
7425                       "</td>\n" . "</tr>\n";
7426         }
7427
7428         print "</table>";
7429 }
7430
7431 # Display remote heads grouped by remote, unless there are too many
7432 # remotes, in which case we only display the remote names
7433 sub git_remotes_body {
7434         my ($remotedata, $limit, $head) = @_;
7435         if ($limit and $limit < keys %$remotedata) {
7436                 git_remotes_list($remotedata, $limit);
7437         } else {
7438                 fill_remote_heads($remotedata);
7439                 while (my ($remote, $rdata) = each %$remotedata) {
7440                         git_print_section({-class=>"remote", -id=>$remote},
7441                                 ["remotes", $remote, $remote], sub {
7442                                         git_remote_block($remote, $rdata, $limit, $head);
7443                                 });
7444                 }
7445         }
7446 }
7447
7448 sub git_search_message {
7449         my %co = @_;
7450
7451         my $greptype;
7452         if ($searchtype eq 'commit') {
7453                 $greptype = "--grep=";
7454         } elsif ($searchtype eq 'author') {
7455                 $greptype = "--author=";
7456         } elsif ($searchtype eq 'committer') {
7457                 $greptype = "--committer=";
7458         }
7459         $greptype .= $searchtext;
7460         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
7461                                        $greptype, '--regexp-ignore-case',
7462                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
7463
7464         my $paging_nav = '';
7465         if ($page > 0) {
7466                 $paging_nav .=
7467                         $cgi->a({-href => href(-replay=>1, page=>undef)},
7468                                 "first") .
7469                         " &#183; " .
7470                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
7471                                  -accesskey => "p", -title => "Alt-p"}, "prev");
7472         } else {
7473                 $paging_nav .= "first &#183; prev";
7474         }
7475         my $next_link = '';
7476         if ($#commitlist >= 100) {
7477                 $next_link =
7478                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7479                                  -accesskey => "n", -title => "Alt-n"}, "next");
7480                 $paging_nav .= " &#183; $next_link";
7481         } else {
7482                 $paging_nav .= " &#183; next";
7483         }
7484
7485         git_header_html();
7486
7487         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav);
7488         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7489         if ($page == 0 && !@commitlist) {
7490                 print "<p>No match.</p>\n";
7491         } else {
7492                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
7493         }
7494
7495         git_footer_html();
7496 }
7497
7498 sub git_search_changes {
7499         my %co = @_;
7500
7501         local $/ = "\n";
7502         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
7503                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
7504                 ($search_use_regexp ? '--pickaxe-regex' : ()))
7505                         or die_error(500, "Open git-log failed");
7506
7507         git_header_html();
7508
7509         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7510         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7511
7512         print "<table class=\"pickaxe search\">\n";
7513         my $alternate = 1;
7514         undef %co;
7515         my @files;
7516         while (my $line = to_utf8(scalar <$fd>)) {
7517                 chomp $line;
7518                 next unless $line;
7519
7520                 my %set = parse_difftree_raw_line($line);
7521                 if (defined $set{'commit'}) {
7522                         # finish previous commit
7523                         if (%co) {
7524                                 print "</td>\n" .
7525                                       "<td class=\"link\">" .
7526                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7527                                               "commit") .
7528                                       " | " .
7529                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7530                                                              hash_base=>$co{'id'})},
7531                                               "tree") .
7532                                       "</td>\n" .
7533                                       "</tr>\n";
7534                         }
7535
7536                         if ($alternate) {
7537                                 print "<tr class=\"dark\">\n";
7538                         } else {
7539                                 print "<tr class=\"light\">\n";
7540                         }
7541                         $alternate ^= 1;
7542                         %co = parse_commit($set{'commit'});
7543                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
7544                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7545                               "<td><i>$author</i></td>\n" .
7546                               "<td>" .
7547                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7548                                       -class => "list subject"},
7549                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
7550                 } elsif (defined $set{'to_id'}) {
7551                         next if ($set{'to_id'} =~ m/^0{40}$/);
7552
7553                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
7554                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
7555                                       -class => "list"},
7556                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
7557                               "<br/>\n";
7558                 }
7559         }
7560         close $fd;
7561
7562         # finish last commit (warning: repetition!)
7563         if (%co) {
7564                 print "</td>\n" .
7565                       "<td class=\"link\">" .
7566                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7567                               "commit") .
7568                       " | " .
7569                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7570                                              hash_base=>$co{'id'})},
7571                               "tree") .
7572                       "</td>\n" .
7573                       "</tr>\n";
7574         }
7575
7576         print "</table>\n";
7577
7578         git_footer_html();
7579 }
7580
7581 sub git_search_files {
7582         my %co = @_;
7583
7584         local $/ = "\n";
7585         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
7586                 $search_use_regexp ? ('-E', '-i') : '-F',
7587                 $searchtext, $co{'tree'})
7588                         or die_error(500, "Open git-grep failed");
7589
7590         git_header_html();
7591
7592         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7593         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7594
7595         print "<table class=\"grep_search\">\n";
7596         my $alternate = 1;
7597         my $matches = 0;
7598         my $lastfile = '';
7599         my $file_href;
7600         while (my $line = to_utf8(scalar <$fd>)) {
7601                 chomp $line;
7602                 my ($file, $lno, $ltext, $binary);
7603                 last if ($matches++ > 1000);
7604                 if ($line =~ /^Binary file (.+) matches$/) {
7605                         $file = $1;
7606                         $binary = 1;
7607                 } else {
7608                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
7609                         $file =~ s/^$co{'tree'}://;
7610                 }
7611                 if ($file ne $lastfile) {
7612                         $lastfile and print "</td></tr>\n";
7613                         if ($alternate++) {
7614                                 print "<tr class=\"dark\">\n";
7615                         } else {
7616                                 print "<tr class=\"light\">\n";
7617                         }
7618                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
7619                                           file_name=>$file);
7620                         print "<td class=\"list\">".
7621                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
7622                         print "</td><td>\n";
7623                         $lastfile = $file;
7624                 }
7625                 if ($binary) {
7626                         print "<div class=\"binary\">Binary file</div>\n";
7627                 } else {
7628                         $ltext = untabify($ltext);
7629                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
7630                                 $ltext = esc_html($1, -nbsp=>1);
7631                                 $ltext .= '<span class="match">';
7632                                 $ltext .= esc_html($2, -nbsp=>1);
7633                                 $ltext .= '</span>';
7634                                 $ltext .= esc_html($3, -nbsp=>1);
7635                         } else {
7636                                 $ltext = esc_html($ltext, -nbsp=>1);
7637                         }
7638                         print "<div class=\"pre\">" .
7639                                 $cgi->a({-href => $file_href.'#l'.$lno,
7640                                         -class => "linenr"}, sprintf('%4i ', $lno)) .
7641                                 $ltext . "</div>\n";
7642                 }
7643         }
7644         if ($lastfile) {
7645                 print "</td></tr>\n";
7646                 if ($matches > 1000) {
7647                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
7648                 }
7649         } else {
7650                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
7651         }
7652         close $fd;
7653
7654         print "</table>\n";
7655
7656         git_footer_html();
7657 }
7658
7659 sub git_search_grep_body {
7660         my ($commitlist, $from, $to, $extra) = @_;
7661         $from = 0 unless defined $from;
7662         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7663
7664         print "<table class=\"commit_search\">\n";
7665         my $alternate = 1;
7666         for (my $i = $from; $i <= $to; $i++) {
7667                 my %co = %{$commitlist->[$i]};
7668                 if (!%co) {
7669                         next;
7670                 }
7671                 my $commit = $co{'id'};
7672                 if ($alternate) {
7673                         print "<tr class=\"dark\">\n";
7674                 } else {
7675                         print "<tr class=\"light\">\n";
7676                 }
7677                 $alternate ^= 1;
7678                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7679                       format_author_html('td', \%co, 15, 5) .
7680                       "<td>" .
7681                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7682                                -class => "list subject"},
7683                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
7684                 my $comment = $co{'comment'};
7685                 foreach my $line (@$comment) {
7686                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
7687                                 my ($lead, $match, $trail) = ($1, $2, $3);
7688                                 $match = chop_str($match, 70, 5, 'center');
7689                                 my $contextlen = int((80 - length($match))/2);
7690                                 $contextlen = 30 if ($contextlen > 30);
7691                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
7692                                 $trail = chop_str($trail, $contextlen, 10, 'right');
7693
7694                                 $lead  = esc_html($lead);
7695                                 $match = esc_html($match);
7696                                 $trail = esc_html($trail);
7697
7698                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
7699                         }
7700                 }
7701                 print "</td>\n" .
7702                       "<td class=\"link\">" .
7703                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7704                       " | " .
7705                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7706                       " | " .
7707                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7708                 print "</td>\n" .
7709                       "</tr>\n";
7710         }
7711         if (defined $extra) {
7712                 print "<tr>\n" .
7713                       "<td colspan=\"3\">$extra</td>\n" .
7714                       "</tr>\n";
7715         }
7716         print "</table>\n";
7717 }
7718
7719 ## ======================================================================
7720 ## ======================================================================
7721 ## actions
7722
7723 sub git_project_list_load {
7724         my $empty_list_ok = shift;
7725         my $order = $input_params{'order'};
7726         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7727                 die_error(400, "Unknown order parameter");
7728         }
7729
7730         my @list = git_get_projects_list($project_filter, $strict_export);
7731         if ($project_filter && (!@list || !gitweb_check_feature('forks'))) {
7732                 push @list, { 'path' => "$project_filter.git" }
7733                         if is_valid_project("$project_filter.git");
7734         }
7735         if (!@list) {
7736                 die_error(404, "No projects found") unless $empty_list_ok;
7737         }
7738
7739         return (\@list, $order);
7740 }
7741
7742 sub git_frontpage {
7743         my ($projlist, $order);
7744
7745         if ($frontpage_no_project_list) {
7746                 $project = undef;
7747                 $project_filter = undef;
7748         } else {
7749                 ($projlist, $order) = git_project_list_load(1);
7750         }
7751         git_header_html();
7752         if (defined $home_text && -f $home_text) {
7753                 print "<div class=\"index_include\">\n";
7754                 insert_file($home_text);
7755                 print "</div>\n";
7756         }
7757         git_project_search_form($searchtext, $search_use_regexp);
7758         if ($frontpage_no_project_list) {
7759                 my $show_ctags = gitweb_check_feature('ctags');
7760                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7761                         my @projects = git_get_projects_list($project_filter, $strict_export);
7762                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7763                         @projects = fill_project_list_info(\@projects, 'ctags');
7764                         my $ctags = git_gather_all_ctags(\@projects);
7765                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7766                         print git_show_project_tagcloud($cloud, 64);
7767                 }
7768         } else {
7769                 git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7770         }
7771         git_footer_html();
7772 }
7773
7774 sub git_project_list {
7775         my ($projlist, $order) = git_project_list_load();
7776         git_header_html();
7777         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7778                 print "<div class=\"index_include\">\n";
7779                 insert_file($home_text);
7780                 print "</div>\n";
7781         }
7782         git_project_search_form();
7783         git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7784         git_footer_html();
7785 }
7786
7787 sub git_forks {
7788         my $order = $input_params{'order'};
7789         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7790                 die_error(400, "Unknown order parameter");
7791         }
7792
7793         my $filter = $project;
7794         $filter =~ s/\.git$//;
7795         my @list = git_get_projects_list($filter);
7796         if (!@list) {
7797                 die_error(404, "No forks found");
7798         }
7799
7800         git_header_html();
7801         git_print_page_nav('','');
7802         git_print_header_div('summary', "$project forks");
7803         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7804         git_footer_html();
7805 }
7806
7807 sub git_project_index {
7808         my @projects = git_get_projects_list($project_filter, $strict_export);
7809         if (!@projects) {
7810                 die_error(404, "No projects found");
7811         }
7812
7813         print $cgi->header(
7814                 -type => 'text/plain',
7815                 -charset => 'utf-8',
7816                 -content_disposition => 'inline; filename="index.aux"');
7817
7818         foreach my $pr (@projects) {
7819                 if (!exists $pr->{'owner'}) {
7820                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7821                 }
7822
7823                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7824                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7825                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7826                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7827                 $path  =~ s/ /\+/g;
7828                 $owner =~ s/ /\+/g;
7829
7830                 print "$path $owner\n";
7831         }
7832 }
7833
7834 sub git_summary {
7835         my $descr = git_get_project_description($project) || "none";
7836         my %co = parse_commit("HEAD");
7837         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7838         my $head = $co{'id'};
7839         my $remote_heads = gitweb_check_feature('remote_heads');
7840
7841         my $owner = git_get_project_owner($project);
7842         my $homepage = git_get_project_config('homepage');
7843         my $base_url = git_get_project_config('baseurl');
7844
7845         my $refs = git_get_references();
7846         # These get_*_list functions return one more to allow us to see if
7847         # there are more ...
7848         my @taglist  = git_get_tags_list(16);
7849         my @headlist = git_get_heads_list(16);
7850         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7851         my @forklist;
7852         my $check_forks = gitweb_check_feature('forks');
7853
7854         if ($check_forks) {
7855                 # find forks of a project
7856                 my $filter = $project;
7857                 $filter =~ s/\.git$//;
7858                 @forklist = git_get_projects_list($filter);
7859                 # filter out forks of forks
7860                 @forklist = filter_forks_from_projects_list(\@forklist)
7861                         if (@forklist);
7862         }
7863
7864         git_header_html();
7865         git_print_page_nav('summary','', $head);
7866
7867         if ($check_forks and $project =~ m#/#) {
7868                 my $xproject = $project; $xproject =~ s#/[^/]+$#.git#; #
7869                 if (is_valid_project($xproject) && -f "$projectroot/$project/objects/info/alternates" && -s _) {
7870                         my $r = $cgi->a({-href=> href(project => $xproject, action => 'summary')}, $xproject);
7871                         print <<EOT;
7872 <div class="forkinfo">
7873 This project is a fork of the $r project. If you have that one
7874 already cloned locally, you can use
7875 <pre>git clone --reference /path/to/your/$xproject/incarnation mirror_URL</pre>
7876 to save bandwidth during cloning.
7877 </div>
7878 EOT
7879                 }
7880         }
7881
7882         print "<div class=\"title\">&#160;</div>\n";
7883         print "<table class=\"projects_list\">\n" .
7884               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7885         if ($homepage) {
7886                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7887         }
7888         if ($base_url) {
7889                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7890         }
7891         if ($owner and not $omit_owner) {
7892                 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . ($owner_link_hook
7893                         ? $cgi->a({-href => $owner_link_hook->($owner)}, email_obfuscate($owner))
7894                         : email_obfuscate($owner)) . "</td></tr>\n";
7895         }
7896         if (defined $cd{'rfc2822'}) {
7897                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7898                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7899         }
7900         print format_lastrefresh_row(), "\n";
7901
7902         # use per project git URL list in $projectroot/$project/cloneurl
7903         # or make project git URL from git base URL and project name
7904         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7905         my $url_class = "metadata_url";
7906         my @url_list = git_get_project_url_list($project);
7907         unless (@url_list) {
7908                 @url_list = @git_base_url_list;
7909                 if ((git_get_project_config("showpush", '--bool')||'false') eq "true" ||
7910                     -f "$projectroot/$project/.nofetch") {
7911                         my $pushidx = @url_list;
7912                         foreach (@git_base_push_urls) {
7913                                 if ($https_hint_html && !ref($_) && $_ =~ /^https:/i) {
7914                                         push(@url_list, [$_, $https_hint_html]);
7915                                 } else {
7916                                         push(@url_list, $_);
7917                                 }
7918                         }
7919                         if ($#url_list >= $pushidx) {
7920                                 my $pushtag = "push&#160;URL";
7921                                 my $classtag = "metadata_pushurl";
7922                                 if (ref($url_list[$pushidx])) {
7923                                         $url_list[$pushidx] = [
7924                                                 ${$url_list[$pushidx]}[0],
7925                                                 ${$url_list[$pushidx]}[1],
7926                                                 $pushtag,
7927                                                 $classtag];
7928                                 } else {
7929                                         $url_list[$pushidx] = [
7930                                                 $url_list[$pushidx],
7931                                                 undef,
7932                                                 $pushtag,
7933                                                 $classtag];
7934                                 }
7935                         }
7936                 } else {
7937                         push(@url_list, @git_base_mirror_urls);
7938                 }
7939                 for (my $i=0; $i<=$#url_list; ++$i) {
7940                         if (ref($url_list[$i])) {
7941                                 $url_list[$i] = [
7942                                         ${$url_list[$i]}[0] . "/$project",
7943                                         ${$url_list[$i]}[1],
7944                                         ${$url_list[$i]}[2],
7945                                         ${$url_list[$i]}[3]];
7946                         } else {
7947                                 $url_list[$i] .= "/$project";
7948                         }
7949                 }
7950         }
7951         foreach (@url_list) {
7952                 next unless $_;
7953                 my $git_url;
7954                 my $html_hint = "";
7955                 my $next_tag = undef;
7956                 my $next_class = undef;
7957                 if (ref($_)) {
7958                         $git_url = $$_[0];
7959                         $html_hint = "&#160;" . $$_[1] if defined($$_[1]);
7960                         $next_tag = $$_[2];
7961                         $next_class = $$_[3];
7962                 } else {
7963                         $git_url = $_;
7964                 }
7965                 next unless $git_url;
7966                 $url_class = $next_class if $next_class;
7967                 $url_tag = $next_tag if $next_tag;
7968                 print "<tr class=\"$url_class\"><td>$url_tag</td><td>$git_url$html_hint</td></tr>\n";
7969                 $url_tag = "";
7970         }
7971
7972         if (defined($git_base_bundles_url) && -d "$projectroot/$project/bundles") {
7973                 my $projname = $project;
7974                 $projname =~ s|^.*/||;
7975                 my $url = "$git_base_bundles_url/$project/bundles";
7976                 print format_repo_url(
7977                         "bundle&#160;info",
7978                         "<a rel='nofollow' href='$url'>$projname downloadable bundles</a>");
7979         }
7980
7981         # Tag cloud
7982         my $show_ctags = gitweb_check_feature('ctags');
7983         if ($show_ctags) {
7984                 my $ctags = git_get_project_ctags($project);
7985                 if (%$ctags || $show_ctags !~ /^\d+$/) {
7986                         # without ability to add tags, don't show if there are none
7987                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7988                         print "<tr id=\"metadata_ctags\">" .
7989                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
7990                         print "</td>\n<td>" unless %$ctags;
7991                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
7992                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
7993                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
7994                               unless $show_ctags =~ /^\d+$/;
7995                         print "</td>\n<td>" if %$ctags;
7996                         print git_show_project_tagcloud($cloud, 48)."</td>" .
7997                               "</tr>\n";
7998                 }
7999         }
8000
8001         print "</table>\n";
8002
8003         # If XSS prevention is on, we don't include README.html.
8004         # TODO: Allow a readme in some safe format.
8005         if (!$prevent_xss) {
8006                 my $readme_name = "readme";
8007                 my $readme;
8008                 if (-s "$projectroot/$project/README.html") {
8009                         $readme = collect_html_file("$projectroot/$project/README.html");
8010                 } else {
8011                         $readme = collect_output($git_automatic_readme_html, "$projectroot/$project");
8012                         if ($readme && $readme =~ /^<!-- README NAME: ((?:[^-]|(?:-(?!-)))+) -->/) {
8013                                 $readme_name = $1;
8014                                 $readme =~ s/^<!--(?:[^-]|(?:-(?!-)))*-->\n?//;
8015                         }
8016                 }
8017                 if (defined($readme)) {
8018                         $readme =~ s/^\s+//s;
8019                         $readme =~ s/\s+$//s;
8020                         print "<div class=\"title\">$readme_name</div>\n",
8021                               "<div class=\"readme\">\n",
8022                               $readme,
8023                               "\n</div>\n"
8024                         if $readme ne '';
8025                 }
8026         }
8027
8028         # we need to request one more than 16 (0..15) to check if
8029         # those 16 are all
8030         my @commitlist = $head ? parse_commits($head, 17) : ();
8031         if (@commitlist) {
8032                 git_print_header_div('shortlog');
8033                 git_shortlog_body(\@commitlist, 0, 15, $refs,
8034                                   $#commitlist <=  15 ? undef :
8035                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
8036         }
8037
8038         if (@taglist) {
8039                 git_print_header_div('tags');
8040                 git_tags_body(\@taglist, 0, 15,
8041                               $#taglist <=  15 ? undef :
8042                               $cgi->a({-href => href(action=>"tags")}, "..."));
8043         }
8044
8045         if (@headlist) {
8046                 git_print_header_div('heads');
8047                 git_heads_body(\@headlist, $head, 0, 15,
8048                                $#headlist <= 15 ? undef :
8049                                $cgi->a({-href => href(action=>"heads")}, "..."));
8050         }
8051
8052         if (%remotedata) {
8053                 git_print_header_div('remotes');
8054                 git_remotes_body(\%remotedata, 15, $head);
8055         }
8056
8057         if (@forklist) {
8058                 git_print_header_div('forks');
8059                 git_project_list_body(\@forklist, 'age', 0, 15,
8060                                       $#forklist <= 15 ? undef :
8061                                       $cgi->a({-href => href(action=>"forks")}, "..."),
8062                                       'no_header', 'forks');
8063         }
8064
8065         git_footer_html();
8066 }
8067
8068 sub git_tag {
8069         my %tag = parse_tag($hash);
8070
8071         if (! %tag) {
8072                 die_error(404, "Unknown tag object");
8073         }
8074
8075         my $fullhash;
8076         $fullhash = $hash if $hash =~ m/^[0-9a-fA-F]{40}$/;
8077         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8078
8079         my $obj = $tag{'object'};
8080         git_header_html();
8081         if ($tag{'type'} eq 'commit') {
8082                 git_print_page_nav('','', $obj,undef,$obj);
8083                 git_print_header_div('commit', esc_html($tag{'name'}), $hash);
8084         } else {
8085                 if ($tag{'type'} eq 'tree') {
8086                         git_print_page_nav('',['commit','commitdiff'], undef,undef,$obj);
8087                 } else {
8088                         git_print_page_nav('',['commit','commitdiff','tree'], undef,undef,undef);
8089                 }
8090                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8091         }
8092         print "<div class=\"title_text\">\n" .
8093               "<table class=\"object_header\">\n" .
8094               "<tr><td>tag</td><td class=\"sha1\">$fullhash</td></tr>\n" .
8095               "<tr>\n" .
8096               "<td>object</td>\n" .
8097               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
8098                                $tag{'object'}) . "</td>\n" .
8099               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
8100                                               $tag{'type'}) . "</td>\n" .
8101               "</tr>\n";
8102         if (defined($tag{'author'})) {
8103                 git_print_authorship_rows(\%tag, 'author');
8104         }
8105         print "</table>\n\n" .
8106               "</div>\n";
8107         print "<div class=\"page_body\">";
8108         my $comment = $tag{'comment'};
8109         foreach my $line (@$comment) {
8110                 chomp $line;
8111                 print esc_html($line, -nbsp=>1) . "<br/>\n";
8112         }
8113         print "</div>\n";
8114         git_footer_html();
8115 }
8116
8117 sub git_blame_common {
8118         my $format = shift || 'porcelain';
8119         if ($format eq 'porcelain' && $input_params{'javascript'}) {
8120                 $format = 'incremental';
8121                 $action = 'blame_incremental'; # for page title etc
8122         }
8123
8124         # permissions
8125         gitweb_check_feature('blame')
8126                 or die_error(403, "Blame view not allowed");
8127
8128         # error checking
8129         die_error(400, "No file name given") unless $file_name;
8130         $hash_base ||= git_get_head_hash($project);
8131         die_error(404, "Couldn't find base commit") unless $hash_base;
8132         my %co = parse_commit($hash_base)
8133                 or die_error(404, "Commit not found");
8134         my $ftype = "blob";
8135         if (!defined $hash) {
8136                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
8137                         or die_error(404, "Error looking up file");
8138         } else {
8139                 $ftype = git_get_type($hash);
8140                 if ($ftype !~ "blob") {
8141                         die_error(400, "Object is not a blob");
8142                 }
8143         }
8144
8145         my $fd;
8146         if ($format eq 'incremental') {
8147                 # get file contents (as base)
8148                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
8149                         or die_error(500, "Open git-cat-file failed");
8150         } elsif ($format eq 'data') {
8151                 # run git-blame --incremental
8152                 defined($fd = git_cmd_pipe "blame", "--incremental",
8153                         $hash_base, "--", $file_name)
8154                         or die_error(500, "Open git-blame --incremental failed");
8155         } else {
8156                 # run git-blame --porcelain
8157                 defined($fd = git_cmd_pipe "blame", '-p',
8158                         $hash_base, '--', $file_name)
8159                         or die_error(500, "Open git-blame --porcelain failed");
8160         }
8161
8162         # incremental blame data returns early
8163         if ($format eq 'data') {
8164                 print $cgi->header(
8165                         -type=>"text/plain", -charset => "utf-8",
8166                         -status=> "200 OK");
8167                 local $| = 1; # output autoflush
8168                 while (<$fd>) {
8169                         print to_utf8($_);
8170                 }
8171                 close $fd
8172                         or print "ERROR $!\n";
8173
8174                 print 'END';
8175                 if (defined $t0 && gitweb_check_feature('timed')) {
8176                         print ' '.
8177                               tv_interval($t0, [ gettimeofday() ]).
8178                               ' '.$number_of_git_cmds;
8179                 }
8180                 print "\n";
8181
8182                 return;
8183         }
8184
8185         # page header
8186         git_header_html();
8187         my $formats_nav =
8188                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
8189                         "blob");
8190         $formats_nav .=
8191                 " | " .
8192                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8193                         "history") .
8194                 " | " .
8195                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
8196                         "HEAD");
8197         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8198         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8199         git_print_page_path($file_name, $ftype, $hash_base);
8200
8201         # page body
8202         if ($format eq 'incremental') {
8203                 print "<noscript>\n<div class=\"error\"><center><b>\n".
8204                       "This page requires JavaScript to run.\n Use ".
8205                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
8206                               'this page').
8207                       " instead.\n".
8208                       "</b></center></div>\n</noscript>\n";
8209
8210                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
8211         }
8212
8213         print qq!<div class="page_body">\n!;
8214         print qq!<div id="progress_info">... / ...</div>\n!
8215                 if ($format eq 'incremental');
8216         print qq!<table id="blame_table" class="blame" width="100%">\n!.
8217               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
8218               qq!<thead>\n!.
8219               qq!<tr><th nowrap="nowrap" style="white-space:nowrap">!.
8220               qq!Commit&#160;<a href="javascript:extra_blame_columns()" id="columns_expander" !.
8221               qq!title="toggles blame author information display">[+]</a></th>!.
8222               qq!<th class="extra_column">Author</th><th class="extra_column">Date</th>!.
8223               qq!<th>Line</th><th width="100%">Data</th></tr>\n!.
8224               qq!</thead>\n!.
8225               qq!<tbody>\n!;
8226
8227         my @rev_color = qw(light dark);
8228         my $num_colors = scalar(@rev_color);
8229         my $current_color = 0;
8230
8231         if ($format eq 'incremental') {
8232                 my $color_class = $rev_color[$current_color];
8233
8234                 #contents of a file
8235                 my $linenr = 0;
8236         LINE:
8237                 while (my $line = to_utf8(scalar <$fd>)) {
8238                         chomp $line;
8239                         $linenr++;
8240
8241                         print qq!<tr id="l$linenr" class="$color_class">!.
8242                               qq!<td class="sha1"><a href=""> </a></td>!.
8243                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8244                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8245                               qq!<td class="linenr">!.
8246                               qq!<a class="linenr" href="">$linenr</a></td>!;
8247                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
8248                         print qq!</tr>\n!;
8249                 }
8250
8251         } else { # porcelain, i.e. ordinary blame
8252                 my %metainfo = (); # saves information about commits
8253
8254                 # blame data
8255         LINE:
8256                 while (my $line = to_utf8(scalar <$fd>)) {
8257                         chomp $line;
8258                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
8259                         # no <lines in group> for subsequent lines in group of lines
8260                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
8261                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
8262                         if (!exists $metainfo{$full_rev}) {
8263                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
8264                         }
8265                         my $meta = $metainfo{$full_rev};
8266                         my $data;
8267                         while ($data = to_utf8(scalar <$fd>)) {
8268                                 chomp $data;
8269                                 last if ($data =~ s/^\t//); # contents of line
8270                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
8271                                         $meta->{$1} = $2 unless exists $meta->{$1};
8272                                 }
8273                                 if ($data =~ /^previous /) {
8274                                         $meta->{'nprevious'}++;
8275                                 }
8276                         }
8277                         my $short_rev = substr($full_rev, 0, 8);
8278                         my $author = $meta->{'author'};
8279                         my %date =
8280                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
8281                         my $date = $date{'iso-tz'};
8282                         if ($group_size) {
8283                                 $current_color = ($current_color + 1) % $num_colors;
8284                         }
8285                         my $tr_class = $rev_color[$current_color];
8286                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
8287                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
8288                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
8289                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
8290                         if ($group_size) {
8291                                 my $rowspan = $group_size > 1 ? " rowspan=\"$group_size\"" : "";
8292                                 print "<td class=\"sha1\"";
8293                                 print " title=\"". esc_html($author) . ", $date\"";
8294                                 print "$rowspan>";
8295                                 print $cgi->a({-href => href(action=>"commit",
8296                                                              hash=>$full_rev,
8297                                                              file_name=>$file_name)},
8298                                               esc_html($short_rev));
8299                                 if ($group_size >= 2) {
8300                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
8301                                         if (@author_initials) {
8302                                                 print "<br />" .
8303                                                       esc_html(join('', @author_initials));
8304                                                 #           or join('.', ...)
8305                                         }
8306                                 }
8307                                 print "</td>\n";
8308                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". esc_html($author) . "</td>";
8309                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". $date . "</td>";
8310                         }
8311                         # 'previous' <sha1 of parent commit> <filename at commit>
8312                         if (exists $meta->{'previous'} &&
8313                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
8314                                 $meta->{'parent'} = $1;
8315                                 $meta->{'file_parent'} = unquote($2);
8316                         }
8317                         my $linenr_commit =
8318                                 exists($meta->{'parent'}) ?
8319                                 $meta->{'parent'} : $full_rev;
8320                         my $linenr_filename =
8321                                 exists($meta->{'file_parent'}) ?
8322                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
8323                         my $blamed = href(action => 'blame',
8324                                           file_name => $linenr_filename,
8325                                           hash_base => $linenr_commit);
8326                         print "<td class=\"linenr\">";
8327                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
8328                                         -class => "linenr" },
8329                                       esc_html($lineno));
8330                         print "</td>";
8331                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
8332                         print "</tr>\n";
8333                 } # end while
8334
8335         }
8336
8337         # footer
8338         print "</tbody>\n".
8339               "</table>\n"; # class="blame"
8340         print "</div>\n";   # class="blame_body"
8341         close $fd
8342                 or print "Reading blob failed\n";
8343
8344         git_footer_html();
8345 }
8346
8347 sub git_blame {
8348         git_blame_common();
8349 }
8350
8351 sub git_blame_incremental {
8352         git_blame_common('incremental');
8353 }
8354
8355 sub git_blame_data {
8356         git_blame_common('data');
8357 }
8358
8359 sub git_tags {
8360         my $head = git_get_head_hash($project);
8361         git_header_html();
8362         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
8363         git_print_header_div('summary', $project);
8364
8365         my @tagslist = git_get_tags_list();
8366         if (@tagslist) {
8367                 git_tags_body(\@tagslist);
8368         }
8369         git_footer_html();
8370 }
8371
8372 sub git_refs {
8373         my $order = $input_params{'order'};
8374         if (defined $order && $order !~ m/age|name/) {
8375                 die_error(400, "Unknown order parameter");
8376         }
8377
8378         my $head = git_get_head_hash($project);
8379         git_header_html();
8380         git_print_page_nav('','', $head,undef,$head,format_ref_views('refs'));
8381         git_print_header_div('summary', $project);
8382
8383         my @refslist = git_get_tags_list(undef, 1, $order);
8384         if (@refslist) {
8385                 git_tags_body(\@refslist, undef, undef, undef, $head, 1, $order);
8386         }
8387         git_footer_html();
8388 }
8389
8390 sub git_heads {
8391         my $head = git_get_head_hash($project);
8392         git_header_html();
8393         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
8394         git_print_header_div('summary', $project);
8395
8396         my @headslist = git_get_heads_list();
8397         if (@headslist) {
8398                 git_heads_body(\@headslist, $head);
8399         }
8400         git_footer_html();
8401 }
8402
8403 # used both for single remote view and for list of all the remotes
8404 sub git_remotes {
8405         gitweb_check_feature('remote_heads')
8406                 or die_error(403, "Remote heads view is disabled");
8407
8408         my $head = git_get_head_hash($project);
8409         my $remote = $input_params{'hash'};
8410
8411         my $remotedata = git_get_remotes_list($remote);
8412         die_error(500, "Unable to get remote information") unless defined $remotedata;
8413
8414         unless (%$remotedata) {
8415                 die_error(404, defined $remote ?
8416                         "Remote $remote not found" :
8417                         "No remotes found");
8418         }
8419
8420         git_header_html(undef, undef, -action_extra => $remote);
8421         git_print_page_nav('', '',  $head, undef, $head,
8422                 format_ref_views($remote ? '' : 'remotes'));
8423
8424         fill_remote_heads($remotedata);
8425         if (defined $remote) {
8426                 git_print_header_div('remotes', "$remote remote for $project");
8427                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
8428         } else {
8429                 git_print_header_div('summary', "$project remotes");
8430                 git_remotes_body($remotedata, undef, $head);
8431         }
8432
8433         git_footer_html();
8434 }
8435
8436 sub git_blob_plain {
8437         my $type = shift;
8438         my $expires;
8439
8440         if (!defined $hash) {
8441                 if (defined $file_name) {
8442                         my $base = $hash_base || git_get_head_hash($project);
8443                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8444                                 or die_error(404, "Cannot find file");
8445                 } else {
8446                         die_error(400, "No file name defined");
8447                 }
8448         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8449                 # blobs defined by non-textual hash id's can be cached
8450                 $expires = "+1d";
8451         }
8452
8453         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8454                 or die_error(500, "Open git-cat-file blob '$hash' failed");
8455         binmode($fd);
8456
8457         # content-type (can include charset)
8458         my $leader;
8459         ($type, $leader) = blob_contenttype($fd, $file_name, $type);
8460
8461         # "save as" filename, even when no $file_name is given
8462         my $save_as = "$hash";
8463         if (defined $file_name) {
8464                 $save_as = $file_name;
8465         } elsif ($type =~ m/^text\//) {
8466                 $save_as .= '.txt';
8467         }
8468
8469         # With XSS prevention on, blobs of all types except a few known safe
8470         # ones are served with "Content-Disposition: attachment" to make sure
8471         # they don't run in our security domain.  For certain image types,
8472         # blob view writes an <img> tag referring to blob_plain view, and we
8473         # want to be sure not to break that by serving the image as an
8474         # attachment (though Firefox 3 doesn't seem to care).
8475         my $sandbox = $prevent_xss &&
8476                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
8477
8478         # serve text/* as text/plain
8479         if ($prevent_xss &&
8480             ($type =~ m!^text/[a-z]+\b(.*)$! ||
8481              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
8482                 my $rest = $1;
8483                 $rest = defined $rest ? $rest : '';
8484                 $type = "text/plain$rest";
8485         }
8486
8487         print $cgi->header(
8488                 -type => $type,
8489                 -expires => $expires,
8490                 -content_disposition =>
8491                         ($sandbox ? 'attachment' : 'inline')
8492                         . '; filename="' . $save_as . '"');
8493         binmode STDOUT, ':raw';
8494         $fcgi_raw_mode = 1;
8495         print $leader if defined $leader;
8496         my $buf;
8497         while (read($fd, $buf, 32768)) {
8498                 print $buf;
8499         }
8500         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8501         $fcgi_raw_mode = 0;
8502         close $fd;
8503 }
8504
8505 sub git_blob {
8506         my $expires;
8507
8508         if (!defined $hash) {
8509                 if (defined $file_name) {
8510                         my $base = $hash_base || git_get_head_hash($project);
8511                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8512                                 or die_error(404, "Cannot find file");
8513                 } else {
8514                         die_error(400, "No file name defined");
8515                 }
8516         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8517                 # blobs defined by non-textual hash id's can be cached
8518                 $expires = "+1d";
8519         }
8520         my $fullhash = git_get_full_hash($project, "$hash^{blob}");
8521         die_error(404, "No such blob") unless defined($fullhash);
8522
8523         my $have_blame = gitweb_check_feature('blame');
8524         defined(my $fd = git_cmd_pipe "cat-file", "blob", $fullhash)
8525                 or die_error(500, "Couldn't cat $file_name, $hash");
8526         binmode($fd);
8527         my $mimetype = blob_mimetype($fd, $file_name);
8528         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
8529         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
8530                 close $fd;
8531                 return git_blob_plain($mimetype);
8532         }
8533         # we can have blame only for text/* mimetype
8534         $have_blame &&= ($mimetype =~ m!^text/!);
8535
8536         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
8537         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
8538         my $highlight_mode_active;
8539         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
8540
8541         git_header_html(undef, $expires);
8542         my $formats_nav = '';
8543         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8544                 if (defined $file_name) {
8545                         if ($have_blame) {
8546                                 $formats_nav .=
8547                                         $cgi->a({-href => href(action=>"blame", -replay=>1),
8548                                                 -class => "blamelink"},
8549                                                 "blame") .
8550                                         " | ";
8551                         }
8552                         $formats_nav .=
8553                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8554                                         "history") .
8555                                 " | " .
8556                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8557                                         "raw") .
8558                                 " | " .
8559                                 $cgi->a({-href => href(action=>"blob",
8560                                                        hash_base=>"HEAD", file_name=>$file_name)},
8561                                         "HEAD");
8562                 } else {
8563                         $formats_nav .=
8564                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8565                                         "raw");
8566                 }
8567                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8568                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8569         } else {
8570                 git_print_page_nav('',['commit','commitdiff','tree'], undef,undef,undef);
8571                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8572         }
8573         git_print_page_path($file_name, "blob", $hash_base);
8574         print "<div class=\"title_text\">\n" .
8575               "<table class=\"object_header\">\n";
8576         print "<tr><td>blob</td><td class=\"sha1\">$fullhash</td></tr>\n";
8577         print "</table>".
8578               "</div>\n";
8579         print "<div class=\"page_body\">\n";
8580         if ($mimetype =~ m!^image/!) {
8581                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
8582                 if ($file_name) {
8583                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
8584                 }
8585                 print qq! src="! .
8586                       href(action=>"blob_plain", hash=>$hash,
8587                            hash_base=>$hash_base, file_name=>$file_name) .
8588                       qq!" />\n!;
8589                 close $fd; # ignore likely EPIPE error from child
8590         } else {
8591                 my $nr;
8592                 while (my $line = to_utf8(scalar <$fd>)) {
8593                         chomp $line;
8594                         $nr++;
8595                         $line = untabify($line);
8596                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i </a>%s</div>\n!,
8597                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
8598                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
8599                 }
8600                 close $fd
8601                         or print "Reading blob failed.\n";
8602         }
8603         print "</div>";
8604         git_footer_html();
8605 }
8606
8607 sub git_tree {
8608         if (!defined $hash_base) {
8609                 $hash_base = "HEAD";
8610         }
8611         if (!defined $hash) {
8612                 if (defined $file_name) {
8613                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
8614                 } else {
8615                         $hash = $hash_base;
8616                 }
8617         }
8618         die_error(404, "No such tree") unless defined($hash);
8619         my $fullhash = git_get_full_hash($project, "$hash^{tree}");
8620         die_error(404, "No such tree") unless defined($fullhash);
8621
8622         my $show_sizes = gitweb_check_feature('show-sizes');
8623         my $have_blame = gitweb_check_feature('blame');
8624
8625         my @entries = ();
8626         {
8627                 local $/ = "\0";
8628                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
8629                         ($show_sizes ? '-l' : ()), @extra_options, $fullhash)
8630                         or die_error(500, "Open git-ls-tree failed");
8631                 @entries = map { chomp; to_utf8($_) } <$fd>;
8632                 close $fd
8633                         or die_error(404, "Reading tree failed");
8634         }
8635
8636         git_header_html();
8637         my $basedir = '';
8638         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8639                 my $refs = git_get_references();
8640                 my $ref = format_ref_marker($refs, $co{'id'});
8641                 my @views_nav = ();
8642                 if (defined $file_name) {
8643                         push @views_nav,
8644                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8645                                         "history"),
8646                                 $cgi->a({-href => href(action=>"tree",
8647                                                        hash_base=>"HEAD", file_name=>$file_name)},
8648                                         "HEAD"),
8649                 }
8650                 my $snapshot_links = format_snapshot_links($hash);
8651                 if (defined $snapshot_links) {
8652                         # FIXME: Should be available when we have no hash base as well.
8653                         push @views_nav, $snapshot_links;
8654                 }
8655                 git_print_page_nav('tree','', $hash_base, undef, undef,
8656                                    join(' | ', @views_nav));
8657                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base, undef, $ref);
8658         } else {
8659                 git_print_page_nav('tree',['commit','commitdiff'], undef,undef,$hash_base);
8660                 undef $hash_base;
8661                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8662         }
8663         if (defined $file_name) {
8664                 $basedir = $file_name;
8665                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
8666                         $basedir .= '/';
8667                 }
8668                 git_print_page_path($file_name, 'tree', $hash_base);
8669         }
8670         print "<div class=\"title_text\">\n" .
8671               "<table class=\"object_header\">\n";
8672         print "<tr><td>tree</td><td class=\"sha1\">$fullhash</td></tr>\n";
8673         print "</table>".
8674               "</div>\n";
8675         print "<div class=\"page_body\">\n";
8676         print "<table class=\"tree\">\n";
8677         my $alternate = 1;
8678         # '..' (top directory) link if possible
8679         if (defined $hash_base &&
8680             defined $file_name && $file_name =~ m![^/]+$!) {
8681                 if ($alternate) {
8682                         print "<tr class=\"dark\">\n";
8683                 } else {
8684                         print "<tr class=\"light\">\n";
8685                 }
8686                 $alternate ^= 1;
8687
8688                 my $up = $file_name;
8689                 $up =~ s!/?[^/]+$!!;
8690                 undef $up unless $up;
8691                 # based on git_print_tree_entry
8692                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
8693                 print '<td class="size">&#160;</td>'."\n" if $show_sizes;
8694                 print '<td class="list">';
8695                 print $cgi->a({-href => href(action=>"tree",
8696                                              hash_base=>$hash_base,
8697                                              file_name=>$up)},
8698                               "..");
8699                 print "</td>\n";
8700                 print "<td class=\"link\"></td>\n";
8701
8702                 print "</tr>\n";
8703         }
8704         foreach my $line (@entries) {
8705                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
8706
8707                 if ($alternate) {
8708                         print "<tr class=\"dark\">\n";
8709                 } else {
8710                         print "<tr class=\"light\">\n";
8711                 }
8712                 $alternate ^= 1;
8713
8714                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
8715
8716                 print "</tr>\n";
8717         }
8718         print "</table>\n" .
8719               "</div>";
8720         git_footer_html();
8721 }
8722
8723 sub sanitize_for_filename {
8724     my $name = shift;
8725
8726     $name =~ s!/!-!g;
8727     $name =~ s/[^[:alnum:]_.-]//g;
8728
8729     return $name;
8730 }
8731
8732 sub snapshot_name {
8733         my ($project, $hash) = @_;
8734
8735         # path/to/project.git  -> project
8736         # path/to/project/.git -> project
8737         my $name = to_utf8($project);
8738         $name =~ s,([^/])/*\.git$,$1,;
8739         $name = sanitize_for_filename(basename($name));
8740
8741         my $ver = $hash;
8742         if ($hash =~ /^[0-9a-fA-F]+$/) {
8743                 # shorten SHA-1 hash
8744                 my $full_hash = git_get_full_hash($project, $hash);
8745                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
8746                         $ver = git_get_short_hash($project, $hash);
8747                 }
8748         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
8749                 # tags don't need shortened SHA-1 hash
8750                 $ver = $1;
8751         } else {
8752                 # branches and other need shortened SHA-1 hash
8753                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
8754                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
8755                         my $ref_dir = (defined $1) ? $1 : '';
8756                         $ver = $2;
8757
8758                         $ref_dir = sanitize_for_filename($ref_dir);
8759                         # for refs neither in heads nor remotes we want to
8760                         # add a ref dir to archive name
8761                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
8762                                 $ver = $ref_dir . '-' . $ver;
8763                         }
8764                 }
8765                 $ver .= '-' . git_get_short_hash($project, $hash);
8766         }
8767         # special case of sanitization for filename - we change
8768         # slashes to dots instead of dashes
8769         # in case of hierarchical branch names
8770         $ver =~ s!/!.!g;
8771         $ver =~ s/[^[:alnum:]_.-]//g;
8772
8773         # name = project-version_string
8774         $name = "$name-$ver";
8775
8776         return wantarray ? ($name, $name) : $name;
8777 }
8778
8779 sub exit_if_unmodified_since {
8780         my ($latest_epoch) = @_;
8781         our $cgi;
8782
8783         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
8784         if (defined $if_modified) {
8785                 my $since;
8786                 if (eval { require HTTP::Date; 1; }) {
8787                         $since = HTTP::Date::str2time($if_modified);
8788                 } elsif (eval { require Time::ParseDate; 1; }) {
8789                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
8790                 }
8791                 if (defined $since && $latest_epoch <= $since) {
8792                         my %latest_date = parse_date($latest_epoch);
8793                         print $cgi->header(
8794                                 -last_modified => $latest_date{'rfc2822'},
8795                                 -status => '304 Not Modified');
8796                         CORE::die;
8797                 }
8798         }
8799 }
8800
8801 sub git_snapshot {
8802         my $format = $input_params{'snapshot_format'};
8803         if (!@snapshot_fmts) {
8804                 die_error(403, "Snapshots not allowed");
8805         }
8806         # default to first supported snapshot format
8807         $format ||= $snapshot_fmts[0];
8808         if ($format !~ m/^[a-z0-9]+$/) {
8809                 die_error(400, "Invalid snapshot format parameter");
8810         } elsif (!exists($known_snapshot_formats{$format})) {
8811                 die_error(400, "Unknown snapshot format");
8812         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
8813                 die_error(403, "Snapshot format not allowed");
8814         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
8815                 die_error(403, "Unsupported snapshot format");
8816         }
8817
8818         my $type = git_get_type("$hash^{}");
8819         if (!$type) {
8820                 die_error(404, 'Object does not exist');
8821         }  elsif ($type eq 'blob') {
8822                 die_error(400, 'Object is not a tree-ish');
8823         }
8824
8825         my ($name, $prefix) = snapshot_name($project, $hash);
8826         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
8827
8828         my %co = parse_commit($hash);
8829         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
8830
8831         my @cmd = (
8832                 git_cmd(), 'archive',
8833                 "--format=$known_snapshot_formats{$format}{'format'}",
8834                 "--prefix=$prefix/", $hash);
8835         if (exists $known_snapshot_formats{$format}{'compressor'}) {
8836                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
8837                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
8838         }
8839
8840         $filename =~ s/(["\\])/\\$1/g;
8841         my %latest_date;
8842         if (%co) {
8843                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
8844         }
8845
8846         print $cgi->header(
8847                 -type => $known_snapshot_formats{$format}{'type'},
8848                 -content_disposition => 'inline; filename="' . $filename . '"',
8849                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8850                 -status => '200 OK');
8851
8852         defined(my $fd = cmd_pipe @cmd)
8853                 or die_error(500, "Execute git-archive failed");
8854         binmode($fd);
8855         binmode STDOUT, ':raw';
8856         $fcgi_raw_mode = 1;
8857         my $buf;
8858         while (read($fd, $buf, 32768)) {
8859                 print $buf;
8860         }
8861         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8862         $fcgi_raw_mode = 0;
8863         close $fd;
8864 }
8865
8866 sub git_log_generic {
8867         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8868
8869         my $head = git_get_head_hash($project);
8870         if (!defined $base) {
8871                 $base = $head;
8872         }
8873         if (!defined $page) {
8874                 $page = 0;
8875         }
8876         my $refs = git_get_references();
8877
8878         my $commit_hash = $base;
8879         if (defined $parent) {
8880                 $commit_hash = "$parent..$base";
8881         }
8882         my @commitlist =
8883                 parse_commits($commit_hash, 101, (100 * $page),
8884                               defined $file_name ? ($file_name, "--full-history") : ());
8885
8886         my $ftype;
8887         if (!defined $file_hash && defined $file_name) {
8888                 # some commits could have deleted file in question,
8889                 # and not have it in tree, but one of them has to have it
8890                 for (my $i = 0; $i < @commitlist; $i++) {
8891                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8892                         last if defined $file_hash;
8893                 }
8894         }
8895         if (defined $file_hash) {
8896                 $ftype = git_get_type($file_hash);
8897         }
8898         if (defined $file_name && !defined $ftype) {
8899                 die_error(500, "Unknown type of object");
8900         }
8901         my %co;
8902         if (defined $file_name) {
8903                 %co = parse_commit($base)
8904                         or die_error(404, "Unknown commit object");
8905         }
8906
8907
8908         my $paging_nav = format_log_nav($fmt_name, $page, $#commitlist >= 100);
8909         my $next_link = '';
8910         if ($#commitlist >= 100) {
8911                 $next_link =
8912                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8913                                  -accesskey => "n", -title => "Alt-n"}, "next");
8914         }
8915         my ($patch_max) = gitweb_get_feature('patches');
8916         if ($patch_max && !defined $file_name) {
8917                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8918                         $paging_nav .= " &#183; " .
8919                                 $cgi->a({-href => href(action=>"patches", -replay=>1)},
8920                                         "patches");
8921                 }
8922         }
8923
8924         {
8925                 local $action = 'log';
8926                 git_header_html();
8927         }
8928         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8929         if (defined $file_name) {
8930                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8931         } else {
8932                 git_print_header_div('summary', $project)
8933         }
8934         git_print_page_path($file_name, $ftype, $hash_base)
8935                 if (defined $file_name);
8936
8937         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8938                      $file_name, $file_hash, $ftype);
8939
8940         git_footer_html();
8941 }
8942
8943 sub git_log {
8944         git_log_generic('log', \&git_log_body,
8945                         $hash, $hash_parent);
8946 }
8947
8948 sub git_commit {
8949         $hash ||= $hash_base || "HEAD";
8950         my %co = parse_commit($hash)
8951             or die_error(404, "Unknown commit object");
8952
8953         my $parent  = $co{'parent'};
8954         my $parents = $co{'parents'}; # listref
8955
8956         # we need to prepare $formats_nav before any parameter munging
8957         my $formats_nav;
8958         if (!defined $parent) {
8959                 # --root commitdiff
8960                 $formats_nav .= '(initial)';
8961         } elsif (@$parents == 1) {
8962                 # single parent commit
8963                 $formats_nav .=
8964                         '(parent: ' .
8965                         $cgi->a({-href => href(action=>"commit",
8966                                                hash=>$parent)},
8967                                 esc_html(substr($parent, 0, 7))) .
8968                         ')';
8969         } else {
8970                 # merge commit
8971                 $formats_nav .=
8972                         '(merge: ' .
8973                         join(' ', map {
8974                                 $cgi->a({-href => href(action=>"commit",
8975                                                        hash=>$_)},
8976                                         esc_html(substr($_, 0, 7)));
8977                         } @$parents ) .
8978                         ')';
8979         }
8980         if (gitweb_check_feature('patches') && @$parents <= 1) {
8981                 $formats_nav .= " | " .
8982                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
8983                                 "patch");
8984         }
8985
8986         if (!defined $parent) {
8987                 $parent = "--root";
8988         }
8989         my @difftree;
8990         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
8991                 @diff_opts,
8992                 (@$parents <= 1 ? $parent : '-c'),
8993                 $hash, "--")
8994                 or die_error(500, "Open git-diff-tree failed");
8995         @difftree = map { chomp; to_utf8($_) } <$fd>;
8996         close $fd or die_error(404, "Reading git-diff-tree failed");
8997
8998         # non-textual hash id's can be cached
8999         my $expires;
9000         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9001                 $expires = "+1d";
9002         }
9003         my $refs = git_get_references();
9004         my $ref = format_ref_marker($refs, $co{'id'});
9005
9006         git_header_html(undef, $expires);
9007         git_print_page_nav('commit', '',
9008                            $hash, $co{'tree'}, $hash,
9009                            $formats_nav);
9010
9011         if (defined $co{'parent'}) {
9012                 git_print_header_div('commitdiff', esc_html($co{'title'}), $hash, undef, $ref);
9013         } else {
9014                 git_print_header_div('tree', esc_html($co{'title'}), $co{'tree'}, $hash, $ref);
9015         }
9016         print "<div class=\"title_text\">\n" .
9017               "<table class=\"object_header\">\n";
9018         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
9019         git_print_authorship_rows(\%co);
9020         print "<tr>" .
9021               "<td>tree</td>" .
9022               "<td class=\"sha1\">" .
9023               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
9024                        class => "list"}, $co{'tree'}) .
9025               "</td>" .
9026               "<td class=\"link\">" .
9027               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
9028                       "tree");
9029         my $snapshot_links = format_snapshot_links($hash);
9030         if (defined $snapshot_links) {
9031                 print " | " . $snapshot_links;
9032         }
9033         print "</td>" .
9034               "</tr>\n";
9035
9036         foreach my $par (@$parents) {
9037                 print "<tr>" .
9038                       "<td>parent</td>" .
9039                       "<td class=\"sha1\">" .
9040                       $cgi->a({-href => href(action=>"commit", hash=>$par),
9041                                class => "list"}, $par) .
9042                       "</td>" .
9043                       "<td class=\"link\">" .
9044                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
9045                       " | " .
9046                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
9047                       "</td>" .
9048                       "</tr>\n";
9049         }
9050         print "</table>".
9051               "</div>\n";
9052
9053         print "<div class=\"page_body\">\n";
9054         git_print_log($co{'comment'});
9055         print "</div>\n";
9056
9057         git_difftree_body(\@difftree, $hash, @$parents);
9058
9059         git_footer_html();
9060 }
9061
9062 sub git_object {
9063         # object is defined by:
9064         # - hash or hash_base alone
9065         # - hash_base and file_name
9066         my $type;
9067
9068         # - hash or hash_base alone
9069         if ($hash || ($hash_base && !defined $file_name)) {
9070                 my $object_id = $hash || $hash_base;
9071
9072                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
9073                         or die_error(404, "Object does not exist");
9074                 $type = <$fd>;
9075                 defined $type && chomp $type;
9076                 close $fd
9077                         or die_error(404, "Object does not exist");
9078
9079         # - hash_base and file_name
9080         } elsif ($hash_base && defined $file_name) {
9081                 $file_name =~ s,/+$,,;
9082
9083                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
9084                         or die_error(404, "Base object does not exist");
9085
9086                 # here errors should not happen
9087                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
9088                         or die_error(500, "Open git-ls-tree failed");
9089                 my $line = to_utf8(scalar <$fd>);
9090                 close $fd;
9091
9092                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
9093                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
9094                         die_error(404, "File or directory for given base does not exist");
9095                 }
9096                 $type = $2;
9097                 $hash = $3;
9098         } else {
9099                 die_error(400, "Not enough information to find object");
9100         }
9101
9102         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
9103                                           hash=>$hash, hash_base=>$hash_base,
9104                                           file_name=>$file_name),
9105                              -status => '302 Found');
9106 }
9107
9108 sub git_blobdiff {
9109         my $format = shift || 'html';
9110         my $diff_style = $input_params{'diff_style'} || 'inline';
9111
9112         my $fd;
9113         my @difftree;
9114         my %diffinfo;
9115         my $expires;
9116
9117         # preparing $fd and %diffinfo for git_patchset_body
9118         # new style URI
9119         if (defined $hash_base && defined $hash_parent_base) {
9120                 if (defined $file_name) {
9121                         # read raw output
9122                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9123                                 $hash_parent_base, $hash_base,
9124                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
9125                                 or die_error(500, "Open git-diff-tree failed");
9126                         @difftree = map { chomp; to_utf8($_) } <$fd>;
9127                         close $fd
9128                                 or die_error(404, "Reading git-diff-tree failed");
9129                         @difftree
9130                                 or die_error(404, "Blob diff not found");
9131
9132                 } elsif (defined $hash &&
9133                          $hash =~ /[0-9a-fA-F]{40}/) {
9134                         # try to find filename from $hash
9135
9136                         # read filtered raw output
9137                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9138                                 $hash_parent_base, $hash_base, "--")
9139                                 or die_error(500, "Open git-diff-tree failed");
9140                         @difftree =
9141                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
9142                                 # $hash == to_id
9143                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
9144                                 map { chomp; to_utf8($_) } <$fd>;
9145                         close $fd
9146                                 or die_error(404, "Reading git-diff-tree failed");
9147                         @difftree
9148                                 or die_error(404, "Blob diff not found");
9149
9150                 } else {
9151                         die_error(400, "Missing one of the blob diff parameters");
9152                 }
9153
9154                 if (@difftree > 1) {
9155                         die_error(400, "Ambiguous blob diff specification");
9156                 }
9157
9158                 %diffinfo = parse_difftree_raw_line($difftree[0]);
9159                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
9160                 $file_name   ||= $diffinfo{'to_file'};
9161
9162                 $hash_parent ||= $diffinfo{'from_id'};
9163                 $hash        ||= $diffinfo{'to_id'};
9164
9165                 # non-textual hash id's can be cached
9166                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
9167                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
9168                         $expires = '+1d';
9169                 }
9170
9171                 # open patch output
9172                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9173                         '-p', ($format eq 'html' ? "--full-index" : ()),
9174                         $hash_parent_base, $hash_base,
9175                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
9176                         or die_error(500, "Open git-diff-tree failed");
9177         }
9178
9179         # old/legacy style URI -- not generated anymore since 1.4.3.
9180         if (!%diffinfo) {
9181                 die_error('404 Not Found', "Missing one of the blob diff parameters")
9182         }
9183
9184         # header
9185         if ($format eq 'html') {
9186                 my $formats_nav =
9187                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
9188                                 "raw");
9189                 $formats_nav .= diff_style_nav($diff_style);
9190                 git_header_html(undef, $expires);
9191                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
9192                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
9193                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
9194                 } else {
9195                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
9196                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
9197                 }
9198                 if (defined $file_name) {
9199                         git_print_page_path($file_name, "blob", $hash_base);
9200                 } else {
9201                         print "<div class=\"page_path\"></div>\n";
9202                 }
9203
9204         } elsif ($format eq 'plain') {
9205                 print $cgi->header(
9206                         -type => 'text/plain',
9207                         -charset => 'utf-8',
9208                         -expires => $expires,
9209                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
9210
9211                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9212
9213         } else {
9214                 die_error(400, "Unknown blobdiff format");
9215         }
9216
9217         # patch
9218         if ($format eq 'html') {
9219                 print "<div class=\"page_body\">\n";
9220
9221                 git_patchset_body($fd, $diff_style,
9222                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
9223                 close $fd;
9224
9225                 print "</div>\n"; # class="page_body"
9226                 git_footer_html();
9227
9228         } else {
9229                 while (my $line = to_utf8(scalar <$fd>)) {
9230                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
9231                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
9232
9233                         print $line;
9234
9235                         last if $line =~ m!^\+\+\+!;
9236                 }
9237                 while (<$fd>) {
9238                         print to_utf8($_);
9239                 }
9240                 close $fd;
9241         }
9242 }
9243
9244 sub git_blobdiff_plain {
9245         git_blobdiff('plain');
9246 }
9247
9248 # assumes that it is added as later part of already existing navigation,
9249 # so it returns "| foo | bar" rather than just "foo | bar"
9250 sub diff_style_nav {
9251         my ($diff_style, $is_combined) = @_;
9252         $diff_style ||= 'inline';
9253
9254         return "" if ($is_combined);
9255
9256         my @styles = (inline => 'inline', 'sidebyside' => 'side by side');
9257         my %styles = @styles;
9258         @styles =
9259                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
9260
9261         return join '',
9262                 map { " | ".$_ }
9263                 map {
9264                         $_ eq $diff_style ? $styles{$_} :
9265                         $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_})
9266                 } @styles;
9267 }
9268
9269 sub git_commitdiff {
9270         my %params = @_;
9271         my $format = $params{-format} || 'html';
9272         my $diff_style = $input_params{'diff_style'} || 'inline';
9273
9274         my ($patch_max) = gitweb_get_feature('patches');
9275         if ($format eq 'patch') {
9276                 die_error(403, "Patch view not allowed") unless $patch_max;
9277         }
9278
9279         $hash ||= $hash_base || "HEAD";
9280         my %co = parse_commit($hash)
9281             or die_error(404, "Unknown commit object");
9282
9283         # choose format for commitdiff for merge
9284         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
9285                 $hash_parent = '--cc';
9286         }
9287         # we need to prepare $formats_nav before almost any parameter munging
9288         my $formats_nav;
9289         if ($format eq 'html') {
9290                 $formats_nav =
9291                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
9292                                 "raw");
9293                 if ($patch_max && @{$co{'parents'}} <= 1) {
9294                         $formats_nav .= " | " .
9295                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
9296                                         "patch");
9297                 }
9298                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
9299
9300                 if (defined $hash_parent &&
9301                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
9302                         # commitdiff with two commits given
9303                         my $hash_parent_short = $hash_parent;
9304                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
9305                                 $hash_parent_short = substr($hash_parent, 0, 7);
9306                         }
9307                         $formats_nav .=
9308                                 ' (from';
9309                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
9310                                 if ($co{'parents'}[$i] eq $hash_parent) {
9311                                         $formats_nav .= ' parent ' . ($i+1);
9312                                         last;
9313                                 }
9314                         }
9315                         $formats_nav .= ': ' .
9316                                 $cgi->a({-href => href(-replay=>1,
9317                                                        hash=>$hash_parent, hash_base=>undef)},
9318                                         esc_html($hash_parent_short)) .
9319                                 ')';
9320                 } elsif (!$co{'parent'}) {
9321                         # --root commitdiff
9322                         $formats_nav .= ' (initial)';
9323                 } elsif (scalar @{$co{'parents'}} == 1) {
9324                         # single parent commit
9325                         $formats_nav .=
9326                                 ' (parent: ' .
9327                                 $cgi->a({-href => href(-replay=>1,
9328                                                        hash=>$co{'parent'}, hash_base=>undef)},
9329                                         esc_html(substr($co{'parent'}, 0, 7))) .
9330                                 ')';
9331                 } else {
9332                         # merge commit
9333                         if ($hash_parent eq '--cc') {
9334                                 $formats_nav .= ' | ' .
9335                                         $cgi->a({-href => href(-replay=>1,
9336                                                                hash=>$hash, hash_parent=>'-c')},
9337                                                 'combined');
9338                         } else { # $hash_parent eq '-c'
9339                                 $formats_nav .= ' | ' .
9340                                         $cgi->a({-href => href(-replay=>1,
9341                                                                hash=>$hash, hash_parent=>'--cc')},
9342                                                 'compact');
9343                         }
9344                         $formats_nav .=
9345                                 ' (merge: ' .
9346                                 join(' ', map {
9347                                         $cgi->a({-href => href(-replay=>1,
9348                                                                hash=>$_, hash_base=>undef)},
9349                                                 esc_html(substr($_, 0, 7)));
9350                                 } @{$co{'parents'}} ) .
9351                                 ')';
9352                 }
9353         }
9354
9355         my $hash_parent_param = $hash_parent;
9356         if (!defined $hash_parent_param) {
9357                 # --cc for multiple parents, --root for parentless
9358                 $hash_parent_param =
9359                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
9360         }
9361
9362         # read commitdiff
9363         my $fd;
9364         my @difftree;
9365         if ($format eq 'html') {
9366                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9367                         "--no-commit-id", "--patch-with-raw", "--full-index",
9368                         $hash_parent_param, $hash, "--")
9369                         or die_error(500, "Open git-diff-tree failed");
9370
9371                 while (my $line = to_utf8(scalar <$fd>)) {
9372                         chomp $line;
9373                         # empty line ends raw part of diff-tree output
9374                         last unless $line;
9375                         push @difftree, scalar parse_difftree_raw_line($line);
9376                 }
9377
9378         } elsif ($format eq 'plain') {
9379                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9380                         '-p', $hash_parent_param, $hash, "--")
9381                         or die_error(500, "Open git-diff-tree failed");
9382         } elsif ($format eq 'patch') {
9383                 # For commit ranges, we limit the output to the number of
9384                 # patches specified in the 'patches' feature.
9385                 # For single commits, we limit the output to a single patch,
9386                 # diverging from the git-format-patch default.
9387                 my @commit_spec = ();
9388                 if ($hash_parent) {
9389                         if ($patch_max > 0) {
9390                                 push @commit_spec, "-$patch_max";
9391                         }
9392                         push @commit_spec, '-n', "$hash_parent..$hash";
9393                 } else {
9394                         if ($params{-single}) {
9395                                 push @commit_spec, '-1';
9396                         } else {
9397                                 if ($patch_max > 0) {
9398                                         push @commit_spec, "-$patch_max";
9399                                 }
9400                                 push @commit_spec, "-n";
9401                         }
9402                         push @commit_spec, '--root', $hash;
9403                 }
9404                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
9405                         '--encoding=utf8', '--stdout', @commit_spec)
9406                         or die_error(500, "Open git-format-patch failed");
9407         } else {
9408                 die_error(400, "Unknown commitdiff format");
9409         }
9410
9411         # non-textual hash id's can be cached
9412         my $expires;
9413         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9414                 $expires = "+1d";
9415         }
9416
9417         # write commit message
9418         if ($format eq 'html') {
9419                 my $refs = git_get_references();
9420                 my $ref = format_ref_marker($refs, $co{'id'});
9421
9422                 git_header_html(undef, $expires);
9423                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
9424                 git_print_header_div('commit', esc_html($co{'title'}), $hash, undef, $ref);
9425                 print "<div class=\"title_text\">\n" .
9426                       "<table class=\"object_header\">\n";
9427                 git_print_authorship_rows(\%co);
9428                 print "</table>".
9429                       "</div>\n";
9430                 print "<div class=\"page_body\">\n";
9431                 if (@{$co{'comment'}} > 1) {
9432                         print "<div class=\"log\">\n";
9433                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
9434                         print "</div>\n"; # class="log"
9435                 }
9436
9437         } elsif ($format eq 'plain') {
9438                 my $refs = git_get_references("tags");
9439                 my $tagname = git_get_rev_name_tags($hash);
9440                 my $filename = basename($project) . "-$hash.patch";
9441
9442                 print $cgi->header(
9443                         -type => 'text/plain',
9444                         -charset => 'utf-8',
9445                         -expires => $expires,
9446                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9447                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
9448                 print "From: " . to_utf8($co{'author'}) . "\n";
9449                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
9450                 print "Subject: " . to_utf8($co{'title'}) . "\n";
9451
9452                 print "X-Git-Tag: $tagname\n" if $tagname;
9453                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9454
9455                 foreach my $line (@{$co{'comment'}}) {
9456                         print to_utf8($line) . "\n";
9457                 }
9458                 print "---\n\n";
9459         } elsif ($format eq 'patch') {
9460                 my $filename = basename($project) . "-$hash.patch";
9461
9462                 print $cgi->header(
9463                         -type => 'text/plain',
9464                         -charset => 'utf-8',
9465                         -expires => $expires,
9466                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9467         }
9468
9469         # write patch
9470         if ($format eq 'html') {
9471                 my $use_parents = !defined $hash_parent ||
9472                         $hash_parent eq '-c' || $hash_parent eq '--cc';
9473                 git_difftree_body(\@difftree, $hash,
9474                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9475                 print "<br/>\n";
9476
9477                 git_patchset_body($fd, $diff_style,
9478                                   \@difftree, $hash,
9479                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9480                 close $fd;
9481                 print "</div>\n"; # class="page_body"
9482                 git_footer_html();
9483
9484         } elsif ($format eq 'plain') {
9485                 while (<$fd>) {
9486                         print to_utf8($_);
9487                 }
9488                 close $fd
9489                         or print "Reading git-diff-tree failed\n";
9490         } elsif ($format eq 'patch') {
9491                 while (<$fd>) {
9492                         print to_utf8($_);
9493                 }
9494                 close $fd
9495                         or print "Reading git-format-patch failed\n";
9496         }
9497 }
9498
9499 sub git_commitdiff_plain {
9500         git_commitdiff(-format => 'plain');
9501 }
9502
9503 # format-patch-style patches
9504 sub git_patch {
9505         git_commitdiff(-format => 'patch', -single => 1);
9506 }
9507
9508 sub git_patches {
9509         git_commitdiff(-format => 'patch');
9510 }
9511
9512 sub git_history {
9513         git_log_generic('history', \&git_history_body,
9514                         $hash_base, $hash_parent_base,
9515                         $file_name, $hash);
9516 }
9517
9518 sub git_search {
9519         $searchtype ||= 'commit';
9520
9521         # check if appropriate features are enabled
9522         gitweb_check_feature('search')
9523                 or die_error(403, "Search is disabled");
9524         if ($searchtype eq 'pickaxe') {
9525                 # pickaxe may take all resources of your box and run for several minutes
9526                 # with every query - so decide by yourself how public you make this feature
9527                 gitweb_check_feature('pickaxe')
9528                         or die_error(403, "Pickaxe search is disabled");
9529         }
9530         if ($searchtype eq 'grep') {
9531                 # grep search might be potentially CPU-intensive, too
9532                 gitweb_check_feature('grep')
9533                         or die_error(403, "Grep search is disabled");
9534         }
9535         if ($search_use_regexp) {
9536                 # regular expression search can be disabled to avoid potentially
9537                 # malicious regular expressions
9538                 gitweb_check_feature('regexp')
9539                         or die_error(403, "Regular expression search is disabled");
9540         }
9541
9542         if (!defined $searchtext) {
9543                 die_error(400, "Text field is empty");
9544         }
9545         if (!defined $hash) {
9546                 $hash = git_get_head_hash($project);
9547         }
9548         my %co = parse_commit($hash);
9549         if (!%co) {
9550                 die_error(404, "Unknown commit object");
9551         }
9552         if (!defined $page) {
9553                 $page = 0;
9554         }
9555
9556         if ($searchtype eq 'commit' ||
9557             $searchtype eq 'author' ||
9558             $searchtype eq 'committer') {
9559                 git_search_message(%co);
9560         } elsif ($searchtype eq 'pickaxe') {
9561                 git_search_changes(%co);
9562         } elsif ($searchtype eq 'grep') {
9563                 git_search_files(%co);
9564         } else {
9565                 die_error(400, "Unknown search type");
9566         }
9567 }
9568
9569 sub git_search_help {
9570         git_header_html();
9571         git_print_page_nav('','', $hash,$hash,$hash);
9572         print <<EOT;
9573 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
9574 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
9575 the pattern entered is recognized as the POSIX extended
9576 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
9577 insensitive).</p>
9578 <dl>
9579 <dt><b>commit</b></dt>
9580 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
9581 EOT
9582         my $have_grep = gitweb_check_feature('grep');
9583         if ($have_grep) {
9584                 print <<EOT;
9585 <dt><b>grep</b></dt>
9586 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
9587     a different one) are searched for the given pattern. On large trees, this search can take
9588 a while and put some strain on the server, so please use it with some consideration. Note that
9589 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
9590 case-sensitive.</dd>
9591 EOT
9592         }
9593         print <<EOT;
9594 <dt><b>author</b></dt>
9595 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
9596 <dt><b>committer</b></dt>
9597 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
9598 EOT
9599         my $have_pickaxe = gitweb_check_feature('pickaxe');
9600         if ($have_pickaxe) {
9601                 print <<EOT;
9602 <dt><b>pickaxe</b></dt>
9603 <dd>All commits that caused the string to appear or disappear from any file (changes that
9604 added, removed or "modified" the string) will be listed. This search can take a while and
9605 takes a lot of strain on the server, so please use it wisely. Note that since you may be
9606 interested even in changes just changing the case as well, this search is case sensitive.</dd>
9607 EOT
9608         }
9609         print "</dl>\n";
9610         git_footer_html();
9611 }
9612
9613 sub git_shortlog {
9614         git_log_generic('shortlog', \&git_shortlog_body,
9615                         $hash, $hash_parent);
9616 }
9617
9618 ## ......................................................................
9619 ## feeds (RSS, Atom; OPML)
9620
9621 sub git_feed {
9622         my $format = shift || 'atom';
9623         my $have_blame = gitweb_check_feature('blame');
9624
9625         # Atom: http://www.atomenabled.org/developers/syndication/
9626         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
9627         if ($format ne 'rss' && $format ne 'atom') {
9628                 die_error(400, "Unknown web feed format");
9629         }
9630
9631         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
9632         my $head = $hash || 'HEAD';
9633         my @commitlist = parse_commits($head, 150, 0, $file_name);
9634
9635         my %latest_commit;
9636         my %latest_date;
9637         my $content_type = "application/$format+xml";
9638         if (defined $cgi->http('HTTP_ACCEPT') &&
9639                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
9640                 # browser (feed reader) prefers text/xml
9641                 $content_type = 'text/xml';
9642         }
9643         if (defined($commitlist[0])) {
9644                 %latest_commit = %{$commitlist[0]};
9645                 my $latest_epoch = $latest_commit{'committer_epoch'};
9646                 exit_if_unmodified_since($latest_epoch);
9647                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
9648         }
9649         print $cgi->header(
9650                 -type => $content_type,
9651                 -charset => 'utf-8',
9652                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
9653                 -status => '200 OK');
9654
9655         # Optimization: skip generating the body if client asks only
9656         # for Last-Modified date.
9657         return if ($cgi->request_method() eq 'HEAD');
9658
9659         # header variables
9660         my $title = "$site_name - $project/$action";
9661         my $feed_type = 'log';
9662         if (defined $hash) {
9663                 $title .= " - '$hash'";
9664                 $feed_type = 'branch log';
9665                 if (defined $file_name) {
9666                         $title .= " :: $file_name";
9667                         $feed_type = 'history';
9668                 }
9669         } elsif (defined $file_name) {
9670                 $title .= " - $file_name";
9671                 $feed_type = 'history';
9672         }
9673         $title .= " $feed_type";
9674         $title = esc_html($title);
9675         my $descr = git_get_project_description($project);
9676         if (defined $descr) {
9677                 $descr = esc_html($descr);
9678         } else {
9679                 $descr = "$project " .
9680                          ($format eq 'rss' ? 'RSS' : 'Atom') .
9681                          " feed";
9682         }
9683         my $owner = git_get_project_owner($project);
9684         $owner = esc_html($owner);
9685
9686         #header
9687         my $alt_url;
9688         if (defined $file_name) {
9689                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
9690         } elsif (defined $hash) {
9691                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
9692         } else {
9693                 $alt_url = href(-full=>1, action=>"summary");
9694         }
9695         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
9696         if ($format eq 'rss') {
9697                 print <<XML;
9698 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
9699 <channel>
9700 XML
9701                 print "<title>$title</title>\n" .
9702                       "<link>$alt_url</link>\n" .
9703                       "<description>$descr</description>\n" .
9704                       "<language>en</language>\n" .
9705                       # project owner is responsible for 'editorial' content
9706                       "<managingEditor>$owner</managingEditor>\n";
9707                 if (defined $logo || defined $favicon) {
9708                         # prefer the logo to the favicon, since RSS
9709                         # doesn't allow both
9710                         my $img = esc_url($logo || $favicon);
9711                         print "<image>\n" .
9712                               "<url>$img</url>\n" .
9713                               "<title>$title</title>\n" .
9714                               "<link>$alt_url</link>\n" .
9715                               "</image>\n";
9716                 }
9717                 if (%latest_date) {
9718                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
9719                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
9720                 }
9721                 print "<generator>gitweb v.$version/$git_version</generator>\n";
9722         } elsif ($format eq 'atom') {
9723                 print <<XML;
9724 <feed xmlns="http://www.w3.org/2005/Atom">
9725 XML
9726                 print "<title>$title</title>\n" .
9727                       "<subtitle>$descr</subtitle>\n" .
9728                       '<link rel="alternate" type="text/html" href="' .
9729                       $alt_url . '" />' . "\n" .
9730                       '<link rel="self" type="' . $content_type . '" href="' .
9731                       $cgi->self_url() . '" />' . "\n" .
9732                       "<id>" . href(-full=>1) . "</id>\n" .
9733                       # use project owner for feed author
9734                       '<author><name>'. email_obfuscate($owner) . '</name></author>\n';
9735                 if (defined $favicon) {
9736                         print "<icon>" . esc_url($favicon) . "</icon>\n";
9737                 }
9738                 if (defined $logo) {
9739                         # not twice as wide as tall: 72 x 27 pixels
9740                         print "<logo>" . esc_url($logo) . "</logo>\n";
9741                 }
9742                 if (! %latest_date) {
9743                         # dummy date to keep the feed valid until commits trickle in:
9744                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
9745                 } else {
9746                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
9747                 }
9748                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
9749         }
9750
9751         # contents
9752         for (my $i = 0; $i <= $#commitlist; $i++) {
9753                 my %co = %{$commitlist[$i]};
9754                 my $commit = $co{'id'};
9755                 # we read 150, we always show 30 and the ones more recent than 48 hours
9756                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
9757                         last;
9758                 }
9759                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
9760
9761                 # get list of changed files
9762                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9763                         $co{'parent'} || "--root",
9764                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
9765                         or next;
9766                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
9767                 close $fd
9768                         or next;
9769
9770                 # print element (entry, item)
9771                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
9772                 if ($format eq 'rss') {
9773                         print "<item>\n" .
9774                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
9775                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
9776                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
9777                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
9778                               "<link>$co_url</link>\n" .
9779                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
9780                               "<content:encoded>" .
9781                               "<![CDATA[\n";
9782                 } elsif ($format eq 'atom') {
9783                         print "<entry>\n" .
9784                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
9785                               "<updated>$cd{'iso-8601'}</updated>\n" .
9786                               "<author>\n" .
9787                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
9788                         if ($co{'author_email'}) {
9789                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
9790                         }
9791                         print "</author>\n" .
9792                               # use committer for contributor
9793                               "<contributor>\n" .
9794                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
9795                         if ($co{'committer_email'}) {
9796                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
9797                         }
9798                         print "</contributor>\n" .
9799                               "<published>$cd{'iso-8601'}</published>\n" .
9800                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
9801                               "<id>$co_url</id>\n" .
9802                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
9803                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
9804                 }
9805                 my $comment = $co{'comment'};
9806                 print "<pre>\n";
9807                 foreach my $line (@$comment) {
9808                         $line = esc_html($line);
9809                         print "$line\n";
9810                 }
9811                 print "</pre><ul>\n";
9812                 foreach my $difftree_line (@difftree) {
9813                         my %difftree = parse_difftree_raw_line($difftree_line);
9814                         next if !$difftree{'from_id'};
9815
9816                         my $file = $difftree{'file'} || $difftree{'to_file'};
9817
9818                         print "<li>" .
9819                               "[" .
9820                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
9821                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
9822                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
9823                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
9824                                       -title => "diff"}, 'D');
9825                         if ($have_blame) {
9826                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
9827                                                              file_name=>$file, hash_base=>$commit),
9828                                               -class => "blamelink",
9829                                               -title => "blame"}, 'B');
9830                         }
9831                         # if this is not a feed of a file history
9832                         if (!defined $file_name || $file_name ne $file) {
9833                                 print $cgi->a({-href => href(-full=>1, action=>"history",
9834                                                              file_name=>$file, hash=>$commit),
9835                                               -title => "history"}, 'H');
9836                         }
9837                         $file = esc_path($file);
9838                         print "] ".
9839                               "$file</li>\n";
9840                 }
9841                 if ($format eq 'rss') {
9842                         print "</ul>]]>\n" .
9843                               "</content:encoded>\n" .
9844                               "</item>\n";
9845                 } elsif ($format eq 'atom') {
9846                         print "</ul>\n</div>\n" .
9847                               "</content>\n" .
9848                               "</entry>\n";
9849                 }
9850         }
9851
9852         # end of feed
9853         if ($format eq 'rss') {
9854                 print "</channel>\n</rss>\n";
9855         } elsif ($format eq 'atom') {
9856                 print "</feed>\n";
9857         }
9858 }
9859
9860 sub git_rss {
9861         git_feed('rss');
9862 }
9863
9864 sub git_atom {
9865         git_feed('atom');
9866 }
9867
9868 sub git_opml {
9869         my @list = git_get_projects_list($project_filter, $strict_export);
9870         if (!@list) {
9871                 die_error(404, "No projects found");
9872         }
9873
9874         print $cgi->header(
9875                 -type => 'text/xml',
9876                 -charset => 'utf-8',
9877                 -content_disposition => 'inline; filename="opml.xml"');
9878
9879         my $title = esc_html($site_name);
9880         my $filter = " within subdirectory ";
9881         if (defined $project_filter) {
9882                 $filter .= esc_html($project_filter);
9883         } else {
9884                 $filter = "";
9885         }
9886         print <<XML;
9887 <?xml version="1.0" encoding="utf-8"?>
9888 <opml version="1.0">
9889 <head>
9890   <title>$title OPML Export$filter</title>
9891 </head>
9892 <body>
9893 <outline text="git RSS feeds">
9894 XML
9895
9896         foreach my $pr (@list) {
9897                 my %proj = %$pr;
9898                 my $head = git_get_head_hash($proj{'path'});
9899                 if (!defined $head) {
9900                         next;
9901                 }
9902                 $git_dir = "$projectroot/$proj{'path'}";
9903                 my %co = parse_commit($head);
9904                 if (!%co) {
9905                         next;
9906                 }
9907
9908                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9909                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9910                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9911                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9912         }
9913         print <<XML;
9914 </outline>
9915 </body>
9916 </opml>
9917 XML
9918 }