gitweb/gitweb.perl

   1 #!/usr/bin/perl
   2
   3 # gitweb - simple web interface to track changes in git repositories
   4 #
   5 # (C) 2005-2006, Kay Sievers <kay.sievers@vrfy.org>
   6 # (C) 2005, Christian Gierke
   7 #
   8 # This program is licensed under the GPLv2
   9
  10 use 5.008;
  11 use strict;
  12 use warnings;
  13 use CGI qw(:standard :escapeHTML -nosticky);
  14 use CGI::Util qw(unescape);
  15 use CGI::Carp qw(fatalsToBrowser set_message);
  16 use Encode;
  17 use Fcntl ':mode';
  18 use File::Find qw();
  19 use File::Basename qw(basename);
  20 use File::Spec;
  21 use Time::HiRes qw(gettimeofday tv_interval);
  22 use Time::Local;
  23 use constant GITWEB_CACHE_FORMAT => "Gitweb Cache Format 3";
  24 binmode STDOUT, ':utf8';
  25
  26 if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
  27         eval 'sub CGI::multi_param { CGI::param(@_) }'
  28 }
  29
  30 our $t0 = [ gettimeofday() ];
  31 our $number_of_git_cmds = 0;
  32 our ($mdotsep, $barsep, $spcsep);
  33
  34 BEGIN {
  35         *mdotsep = \'<span class="mdotsep">&#160;&#183;&#160;</span>';
  36         *barsep = \'<span class="barsep">&#160;|&#160;</span>';
  37         *spcsep = \'<span class="spcsep">&#160</span>';
  38         CGI->compile() if $ENV{'MOD_PERL'};
  39 }
  40
  41 our $version = "++GIT_VERSION++";
  42
  43 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
  44 sub evaluate_uri {
  45         our $cgi;
  46
  47         our $my_url = $cgi->url();
  48         our $my_uri = $cgi->url(-absolute => 1);
  49
  50         # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
  51         # needed and used only for URLs with nonempty PATH_INFO
  52         # This must be an absolute URL (i.e. no scheme, host or port), NOT a full one
  53         our $base_url = $my_uri || '/';
  54
  55         # When the script is used as DirectoryIndex, the URL does not contain the name
  56         # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
  57         # have to do it ourselves. We make $path_info global because it's also used
  58         # later on.
  59         #
  60         # Another issue with the script being the DirectoryIndex is that the resulting
  61         # $my_url data is not the full script URL: this is good, because we want
  62         # generated links to keep implying the script name if it wasn't explicitly
  63         # indicated in the URL we're handling, but it means that $my_url cannot be used
  64         # as base URL.
  65         # Therefore, if we needed to strip PATH_INFO, then we know that we have
  66         # to build the base URL ourselves:
  67         our $path_info = decode_utf8($ENV{"PATH_INFO"});
  68         if ($path_info) {
  69                 # $path_info has already been URL-decoded by the web server, but
  70                 # $my_url and $my_uri have not. URL-decode them so we can properly
  71                 # strip $path_info.
  72                 $my_url = unescape($my_url);
  73                 $my_uri = unescape($my_uri);
  74                 if ($my_url =~ s,\Q$path_info\E$,, &&
  75                     $my_uri =~ s,\Q$path_info\E$,, &&
  76                     defined $ENV{'SCRIPT_NAME'}) {
  77                         $base_url = $ENV{'SCRIPT_NAME'} || '/';
  78                 }
  79         }
  80
  81         # target of the home link on top of all pages
  82         our $home_link = $my_uri || "/";
  83 }
  84
  85 # core git executable to use
  86 # this can just be "git" if your webserver has a sensible PATH
  87 our $GIT = "++GIT_BINDIR++/git";
  88
  89 # absolute fs-path which will be prepended to the project path
  90 #our $projectroot = "/pub/scm";
  91 our $projectroot = "++GITWEB_PROJECTROOT++";
  92
  93 # fs traversing limit for getting project list
  94 # the number is relative to the projectroot
  95 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
  96
  97 # string of the home link on top of all pages
  98 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
  99
 100 # extra breadcrumbs preceding the home link
 101 our @extra_breadcrumbs = ();
 102
 103 # name of your site or organization to appear in page titles
 104 # replace this with something more descriptive for clearer bookmarks
 105 our $site_name = "++GITWEB_SITENAME++"
 106                  || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
 107
 108 # html snippet to include in the <head> section of each page
 109 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
 110 # filename of html text to include at top of each page
 111 our $site_header = "++GITWEB_SITE_HEADER++";
 112 # html text to include at home page
 113 our $home_text = "++GITWEB_HOMETEXT++";
 114 # filename of html text to include at bottom of each page
 115 our $site_footer = "++GITWEB_SITE_FOOTER++";
 116
 117 # URI of stylesheets
 118 our @stylesheets = ("++GITWEB_CSS++");
 119 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
 120 our $stylesheet = undef;
 121 # URI of GIT logo (72x27 size)
 122 our $logo = "++GITWEB_LOGO++";
 123 # URI of GIT favicon, assumed to be image/png type
 124 our $favicon = "++GITWEB_FAVICON++";
 125 # URI of gitweb.js (JavaScript code for gitweb)
 126 our $javascript = "++GITWEB_JS++";
 127
 128 # URI and label (title) of GIT logo link
 129 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
 130 #our $logo_label = "git documentation";
 131 our $logo_url = "http://git-scm.com/";
 132 our $logo_label = "git homepage";
 133
 134 # source of projects list
 135 our $projects_list = "++GITWEB_LIST++";
 136
 137 # the width (in characters) of the projects list "Description" column
 138 our $projects_list_description_width = 25;
 139
 140 # group projects by category on the projects list
 141 # (enabled if this variable evaluates to true)
 142 our $projects_list_group_categories = 0;
 143
 144 # default category if none specified
 145 # (leave the empty string for no category)
 146 our $project_list_default_category = "";
 147
 148 # default order of projects list
 149 # valid values are none, project, descr, owner, and age
 150 our $default_projects_order = "project";
 151
 152 # default order of refs list
 153 # valid values are age and name
 154 our $default_refs_order = "age";
 155
 156 # show repository only if this file exists
 157 # (only effective if this variable evaluates to true)
 158 our $export_ok = "++GITWEB_EXPORT_OK++";
 159
 160 # don't generate age column on the projects list page
 161 our $omit_age_column = 0;
 162
 163 # use contents of this file (in iso, iso-strict or raw format) as
 164 # the last activity data if it exists and is a valid date
 165 our $lastactivity_file = undef;
 166
 167 # don't generate information about owners of repositories
 168 our $omit_owner=0;
 169
 170 # owner link hook given owner name (full and NOT obfuscated)
 171 # should return full URL-escaped link to attach to owner, for example:
 172 #    sub { return "/showowner.cgi?owner=".CGI::Util::escape($_[0]); }
 173 our $owner_link_hook = undef;
 174
 175 # show repository only if this subroutine returns true
 176 # when given the path to the project, for example:
 177 #    sub { return -e "$_[0]/git-daemon-export-ok"; }
 178 our $export_auth_hook = undef;
 179
 180 # only allow viewing of repositories also shown on the overview page
 181 our $strict_export = "++GITWEB_STRICT_EXPORT++";
 182
 183 # base URL for bundle info link shown on summary page, but only if
 184 # this config item is defined AND a 'bundles' subdirectory exists
 185 # in the project's repository.
 186 # i.e. full URL is "git_base_bundles_url/$project/bundles"
 187 our $git_base_bundles_url = undef;
 188
 189 # list of git base URLs used for URL to where fetch project from,
 190 # i.e. full URL is "$git_base_url/$project"
 191 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
 192
 193 # URLs designated for pushing new changes, extended by the
 194 # project name (i.e. "$git_base_push_url[0]/$project")
 195 our @git_base_push_urls = ();
 196
 197 # https hint html inserted right after any https push URL (undef for none)
 198 our $https_hint_html = undef;
 199
 200 # default blob_plain mimetype and default charset for text/plain blob
 201 our $default_blob_plain_mimetype = 'application/octet-stream';
 202 our $default_text_plain_charset  = undef;
 203
 204 # file to use for guessing MIME types before trying /etc/mime.types
 205 # (relative to the current git repository)
 206 our $mimetypes_file = undef;
 207
 208 # assume this charset if line contains non-UTF-8 characters;
 209 # it should be valid encoding (see Encoding::Supported(3pm) for list),
 210 # for which encoding all byte sequences are valid, for example
 211 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
 212 # could be even 'utf-8' for the old behavior)
 213 our $fallback_encoding = 'latin1';
 214
 215 # rename detection options for git-diff and git-diff-tree
 216 # - default is '-M', with the cost proportional to
 217 #   (number of removed files) * (number of new files).
 218 # - more costly is '-C' (which implies '-M'), with the cost proportional to
 219 #   (number of changed files + number of removed files) * (number of new files)
 220 # - even more costly is '-C', '--find-copies-harder' with cost
 221 #   (number of files in the original tree) * (number of new files)
 222 # - one might want to include '-B' option, e.g. '-B', '-M'
 223 our @diff_opts = ('-M'); # taken from git_commit
 224
 225 # cache directory (relative to $GIT_DIR) for project-specific html page caches.
 226 # the directory must exist and be writable by the process running gitweb.
 227 # additionally some actions must be selected for caching in %html_cache_actions
 228 # - default is 'htmlcache'
 229 our $html_cache_dir = 'htmlcache';
 230
 231 # which actions to cache in $html_cache_dir
 232 # if $html_cache_dir exists (relative to $GIT_DIR) and is writable by the
 233 # process running gitweb, then any actions selected here will have their output
 234 # cached and the cache file will be returned instead of regenerating the page
 235 # if it exists.  For this to be useful, an external process must create the
 236 # 'changed' file (if it does not already exist) in the $html_cache_dir whenever
 237 # the project information has been changed.  Alternatively it may create a
 238 # "$action.changed" file (if it does not exist) instead to limit the changes
 239 # to just "$action" instead of any action.  If 'changed' or "$action.changed"
 240 # exist, then the cached version will never be used for "$action" and a new
 241 # cache page will be regenerated (and the "changed" files removed as appropriate).
 242 #
 243 # Additionally if $projlist_cache_lifetime is > 0 AND the forks feature has been
 244 # enabled ('$feature{'forks'}{'default'} = [1];') then additionally an external
 245 # process must create the 'forkchange' file or update its timestamp if it already
 246 # exists whenever a fork is added to or removed from the project (as well as
 247 # create the 'changed' or "$action.changed" file).  Otherwise the "forks"
 248 # section on the summary page may remain out-of-date indefinately.
 249 #
 250 # - default is none
 251 #   currently only caching of the summary page is supported
 252 # - to enable caching of the summary page use:
 253 #   $html_cache_actions{'summary'} = 1;
 254 our %html_cache_actions = ();
 255
 256 # utility to automatically produce a default README.html if README.html is
 257 # enabled and it does not exist or is 0 bytes in length.  If this is set to an
 258 # executable utility that takes an absolute path to a .git directory as its
 259 # first argument and outputs an HTML fragment to use for README.html, then
 260 # it will be called when README.html is enabled but empty or missing.
 261 our $git_automatic_readme_html = undef;
 262
 263 # Disables features that would allow repository owners to inject script into
 264 # the gitweb domain.
 265 our $prevent_xss = 0;
 266
 267 # Path to a POSIX shell.  Needed to run $highlight_bin and a snapshot compressor.
 268 # Only used when highlight is enabled or snapshots with compressors are enabled.
 269 our $posix_shell_bin = "++POSIX_SHELL_BIN++";
 270
 271 # Path to the highlight executable to use (must be the one from
 272 # http://www.andre-simon.de due to assumptions about parameters and output).
 273 # Useful if highlight is not installed on your webserver's PATH.
 274 # [Default: highlight]
 275 our $highlight_bin = "++HIGHLIGHT_BIN++";
 276
 277 # Whether to include project list on the gitweb front page; 0 means yes,
 278 # 1 means no list but show tag cloud if enabled (all projects still need
 279 # to be scanned, unless the info is cached), 2 means no list and no tag cloud
 280 # (very fast)
 281 our $frontpage_no_project_list = 0;
 282
 283 # projects list cache for busy sites with many projects;
 284 # if you set this to non-zero, it will be used as the cached
 285 # index lifetime in minutes
 286 #
 287 # the cached list version is stored in $cache_dir/$cache_name and can
 288 # be tweaked by other scripts running with the same uid as gitweb -
 289 # use this ONLY at secure installations; only single gitweb project
 290 # root per system is supported, unless you tweak configuration!
 291 our $projlist_cache_lifetime = 0; # in minutes
 292 # FHS compliant $cache_dir would be "/var/cache/gitweb"
 293 our $cache_dir =
 294         (defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp').'/gitweb';
 295 our $projlist_cache_name = 'gitweb.index.cache';
 296 our $cache_grpshared = 0;
 297
 298 # information about snapshot formats that gitweb is capable of serving
 299 our %known_snapshot_formats = (
 300         # name => {
 301         #       'display' => display name,
 302         #       'type' => mime type,
 303         #       'suffix' => filename suffix,
 304         #       'format' => --format for git-archive,
 305         #       'compressor' => [compressor command and arguments]
 306         #                       (array reference, optional)
 307         #       'disabled' => boolean (optional)}
 308         #
 309         'tgz' => {
 310                 'display' => 'tar.gz',
 311                 'type' => 'application/x-gzip',
 312                 'suffix' => '.tar.gz',
 313                 'format' => 'tar',
 314                 'compressor' => ['gzip', '-n']},
 315
 316         'tbz2' => {
 317                 'display' => 'tar.bz2',
 318                 'type' => 'application/x-bzip2',
 319                 'suffix' => '.tar.bz2',
 320                 'format' => 'tar',
 321                 'compressor' => ['bzip2']},
 322
 323         'txz' => {
 324                 'display' => 'tar.xz',
 325                 'type' => 'application/x-xz',
 326                 'suffix' => '.tar.xz',
 327                 'format' => 'tar',
 328                 'compressor' => ['xz'],
 329                 'disabled' => 1},
 330
 331         'zip' => {
 332                 'display' => 'zip',
 333                 'type' => 'application/x-zip',
 334                 'suffix' => '.zip',
 335                 'format' => 'zip'},
 336 );
 337
 338 # Aliases so we understand old gitweb.snapshot values in repository
 339 # configuration.
 340 our %known_snapshot_format_aliases = (
 341         'gzip'  => 'tgz',
 342         'bzip2' => 'tbz2',
 343         'xz'    => 'txz',
 344
 345         # backward compatibility: legacy gitweb config support
 346         'x-gzip' => undef, 'gz' => undef,
 347         'x-bzip2' => undef, 'bz2' => undef,
 348         'x-zip' => undef, '' => undef,
 349 );
 350
 351 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
 352 # are changed, it may be appropriate to change these values too via
 353 # $GITWEB_CONFIG.
 354 our %avatar_size = (
 355         'default' => 16,
 356         'double'  => 32
 357 );
 358
 359 # Used to set the maximum load that we will still respond to gitweb queries.
 360 # If server load exceed this value then return "503 server busy" error.
 361 # If gitweb cannot determined server load, it is taken to be 0.
 362 # Leave it undefined (or set to 'undef') to turn off load checking.
 363 our $maxload = 300;
 364
 365 # configuration for 'highlight' (http://www.andre-simon.de/)
 366 # match by basename
 367 our %highlight_basename = (
 368         #'Program' => 'py',
 369         #'Library' => 'py',
 370         'SConstruct' => 'py', # SCons equivalent of Makefile
 371         'Makefile' => 'make',
 372         'makefile' => 'make',
 373         'GNUmakefile' => 'make',
 374         'BSDmakefile' => 'make',
 375 );
 376 # match by shebang regex
 377 our %highlight_shebang = (
 378         # Each entry has a key which is the syntax to use and
 379         # a value which is either a qr regex or an array of qr regexs to match
 380         # against the first 128 (less if the blob is shorter) BYTES of the blob.
 381         # We match /usr/bin/env items separately to require "/usr/bin/env" and
 382         # allow a limited subset of NAME=value items to appear.
 383         'awk'    => [ qr,^#!\s*/(?:\w+/)*(?:[gnm]?awk)(?:\s|$),mo,
 384                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[gnm]?awk)(?:\s|$),mo ],
 385         'make'   => [ qr,^#!\s*/(?:\w+/)*(?:g?make)(?:\s|$),mo,
 386                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:g?make)(?:\s|$),mo ],
 387         'php'    => [ qr,^#!\s*/(?:\w+/)*(?:php)(?:\s|$),mo,
 388                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:php)(?:\s|$),mo ],
 389         'pl'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 390                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 391         'py'     => [ qr,^#!\s*/(?:\w+/)*(?:python)(?:\s|$),mo,
 392                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:python)(?:\s|$),mo ],
 393         'sh'     => [ qr,^#!\s*/(?:\w+/)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo,
 394                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo ],
 395         'rb'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 396                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 397 );
 398 # match by extension
 399 our %highlight_ext = (
 400         # main extensions, defining name of syntax;
 401         # see files in /usr/share/highlight/langDefs/ directory
 402         (map { $_ => $_ } qw(
 403                 4gl a4c abnf abp ada agda ahk ampl amtrix applescript arc
 404                 arm as asm asp aspect ats au3 avenue awk bat bb bbcode bib
 405                 bms bnf boo c cb cfc chl clipper clojure clp cob cs css d
 406                 diff dot dylan e ebnf erl euphoria exp f90 flx for frink fs
 407                 go haskell hcl html httpd hx icl icn idl idlang ili
 408                 inc_luatex ini inp io iss j java js jsp lbn ldif lgt lhs
 409                 lisp lotos ls lsl lua ly make mel mercury mib miranda ml mo
 410                 mod2 mod3 mpl ms mssql n nas nbc nice nrx nsi nut nxc oberon
 411                 objc octave oorexx os oz pas php pike pl pl1 pov pro
 412                 progress ps ps1 psl pure py pyx q qmake qu r rb rebol rexx
 413                 rnc s sas sc scala scilab sh sma smalltalk sml sno spec spn
 414                 sql sybase tcl tcsh tex ttcn3 vala vb verilog vhd xml xpp y
 415                 yaiff znn)),
 416         # alternate extensions, see /etc/highlight/filetypes.conf
 417         (map { $_ => '4gl' } qw(informix)),
 418         (map { $_ => 'a4c' } qw(ascend)),
 419         (map { $_ => 'abp' } qw(abp4)),
 420         (map { $_ => 'ada' } qw(a adb ads gnad)),
 421         (map { $_ => 'ahk' } qw(autohotkey)),
 422         (map { $_ => 'ampl' } qw(dat run)),
 423         (map { $_ => 'amtrix' } qw(hnd s4 s4h s4t t4)),
 424         (map { $_ => 'as' } qw(actionscript)),
 425         (map { $_ => 'asm' } qw(29k 68s 68x a51 assembler x68 x86)),
 426         (map { $_ => 'asp' } qw(asa)),
 427         (map { $_ => 'aspect' } qw(was wud)),
 428         (map { $_ => 'ats' } qw(dats)),
 429         (map { $_ => 'au3' } qw(autoit)),
 430         (map { $_ => 'bat' } qw(cmd)),
 431         (map { $_ => 'bb' } qw(blitzbasic)),
 432         (map { $_ => 'bib' } qw(bibtex)),
 433         (map { $_ => 'c' } qw(c++ cc cpp cu cxx h hh hpp hxx)),
 434         (map { $_ => 'cb' } qw(clearbasic)),
 435         (map { $_ => 'cfc' } qw(cfm coldfusion)),
 436         (map { $_ => 'chl' } qw(chill)),
 437         (map { $_ => 'cob' } qw(cbl cobol)),
 438         (map { $_ => 'cs' } qw(csharp)),
 439         (map { $_ => 'diff' } qw(patch)),
 440         (map { $_ => 'dot' } qw(graphviz)),
 441         (map { $_ => 'e' } qw(eiffel se)),
 442         (map { $_ => 'erl' } qw(erlang hrl)),
 443         (map { $_ => 'euphoria' } qw(eu ew ex exu exw wxu)),
 444         (map { $_ => 'exp' } qw(express)),
 445         (map { $_ => 'f90' } qw(f95)),
 446         (map { $_ => 'flx' } qw(felix)),
 447         (map { $_ => 'for' } qw(f f77 ftn)),
 448         (map { $_ => 'fs' } qw(fsharp fsx)),
 449         (map { $_ => 'haskell' } qw(hs)),
 450         (map { $_ => 'html' } qw(htm xhtml)),
 451         (map { $_ => 'hx' } qw(haxe)),
 452         (map { $_ => 'icl' } qw(clean)),
 453         (map { $_ => 'icn' } qw(icon)),
 454         (map { $_ => 'ili' } qw(interlis)),
 455         (map { $_ => 'inp' } qw(fame)),
 456         (map { $_ => 'iss' } qw(innosetup)),
 457         (map { $_ => 'j' } qw(jasmin)),
 458         (map { $_ => 'java' } qw(groovy grv)),
 459         (map { $_ => 'lbn' } qw(luban)),
 460         (map { $_ => 'lgt' } qw(logtalk)),
 461         (map { $_ => 'lisp' } qw(cl clisp el lsp sbcl scom)),
 462         (map { $_ => 'ls' } qw(lotus)),
 463         (map { $_ => 'lsl' } qw(lindenscript)),
 464         (map { $_ => 'ly' } qw(lilypond)),
 465         (map { $_ => 'make' } qw(mak mk kmk)),
 466         (map { $_ => 'mel' } qw(maya)),
 467         (map { $_ => 'mib' } qw(smi snmp)),
 468         (map { $_ => 'ml' } qw(mli ocaml)),
 469         (map { $_ => 'mo' } qw(modelica)),
 470         (map { $_ => 'mod2' } qw(def mod)),
 471         (map { $_ => 'mod3' } qw(i3 m3)),
 472         (map { $_ => 'mpl' } qw(maple)),
 473         (map { $_ => 'n' } qw(nemerle)),
 474         (map { $_ => 'nas' } qw(nasal)),
 475         (map { $_ => 'nrx' } qw(netrexx)),
 476         (map { $_ => 'nsi' } qw(nsis)),
 477         (map { $_ => 'nut' } qw(squirrel)),
 478         (map { $_ => 'oberon' } qw(ooc)),
 479         (map { $_ => 'objc' } qw(M m mm)),
 480         (map { $_ => 'php' } qw(php3 php4 php5 php6)),
 481         (map { $_ => 'pike' } qw(pmod)),
 482         (map { $_ => 'pl' } qw(perl plex plx pm)),
 483         (map { $_ => 'pl1' } qw(bdy ff fp fpp rpp sf sp spb spe spp sps wf wp wpb wpp wps)),
 484         (map { $_ => 'progress' } qw(i p w)),
 485         (map { $_ => 'py' } qw(python)),
 486         (map { $_ => 'pyx' } qw(pyrex)),
 487         (map { $_ => 'rb' } qw(pp rjs ruby)),
 488         (map { $_ => 'rexx' } qw(rex rx the)),
 489         (map { $_ => 'sc' } qw(paradox)),
 490         (map { $_ => 'scilab' } qw(sce sci)),
 491         (map { $_ => 'sh' } qw(bash ebuild eclass ksh zsh)),
 492         (map { $_ => 'sma' } qw(small)),
 493         (map { $_ => 'smalltalk' } qw(gst sq st)),
 494         (map { $_ => 'sno' } qw(snobal)),
 495         (map { $_ => 'sybase' } qw(sp)),
 496         (map { $_ => 'tcl' } qw(itcl wish)),
 497         (map { $_ => 'tex' } qw(cls sty)),
 498         (map { $_ => 'vb' } qw(bas basic bi vbs)),
 499         (map { $_ => 'verilog' } qw(v)),
 500         (map { $_ => 'xml' } qw(dtd ecf ent hdr hub jnlp nrm plist resx sgm sgml svg tld vxml wml xsd xsl)),
 501         (map { $_ => 'y' } qw(bison)),
 502 );
 503
 504 # You define site-wide feature defaults here; override them with
 505 # $GITWEB_CONFIG as necessary.
 506 our %feature = (
 507         # feature => {
 508         #       'sub' => feature-sub (subroutine),
 509         #       'override' => allow-override (boolean),
 510         #       'default' => [ default options...] (array reference)}
 511         #
 512         # if feature is overridable (it means that allow-override has true value),
 513         # then feature-sub will be called with default options as parameters;
 514         # return value of feature-sub indicates if to enable specified feature
 515         #
 516         # if there is no 'sub' key (no feature-sub), then feature cannot be
 517         # overridden
 518         #
 519         # use gitweb_get_feature(<feature>) to retrieve the <feature> value
 520         # (an array) or gitweb_check_feature(<feature>) to check if <feature>
 521         # is enabled
 522
 523         # Enable the 'blame' blob view, showing the last commit that modified
 524         # each line in the file. This can be very CPU-intensive.
 525
 526         # To enable system wide have in $GITWEB_CONFIG
 527         # $feature{'blame'}{'default'} = [1];
 528         # To have project specific config enable override in $GITWEB_CONFIG
 529         # $feature{'blame'}{'override'} = 1;
 530         # and in project config gitweb.blame = 0|1;
 531         'blame' => {
 532                 'sub' => sub { feature_bool('blame', @_) },
 533                 'override' => 0,
 534                 'default' => [0]},
 535
 536         # Enable the 'incremental blame' blob view, which uses javascript to
 537         # incrementally show the revisions of lines as they are discovered
 538         # in the history. It is better for large histories, files and slow
 539         # servers, but requires javascript in the client and can slow down the
 540         # browser on large files.
 541
 542         # To enable system wide have in $GITWEB_CONFIG
 543         # $feature{'blame_incremental'}{'default'} = [1];
 544         # To have project specific config enable override in $GITWEB_CONFIG
 545         # $feature{'blame_incremental'}{'override'} = 1;
 546         # and in project config gitweb.blame_incremental = 0|1;
 547         'blame_incremental' => {
 548                 'sub' => sub { feature_bool('blame_incremental', @_) },
 549                 'override' => 0,
 550                 'default' => [0]},
 551
 552         # Enable the 'snapshot' link, providing a compressed archive of any
 553         # tree. This can potentially generate high traffic if you have large
 554         # project.
 555
 556         # Value is a list of formats defined in %known_snapshot_formats that
 557         # you wish to offer.
 558         # To disable system wide have in $GITWEB_CONFIG
 559         # $feature{'snapshot'}{'default'} = [];
 560         # To have project specific config enable override in $GITWEB_CONFIG
 561         # $feature{'snapshot'}{'override'} = 1;
 562         # and in project config, a comma-separated list of formats or "none"
 563         # to disable.  Example: gitweb.snapshot = tbz2,zip;
 564         'snapshot' => {
 565                 'sub' => \&feature_snapshot,
 566                 'override' => 0,
 567                 'default' => ['tgz']},
 568
 569         # Enable text search, which will list the commits which match author,
 570         # committer or commit text to a given string.  Enabled by default.
 571         # Project specific override is not supported.
 572         #
 573         # Note that this controls all search features, which means that if
 574         # it is disabled, then 'grep' and 'pickaxe' search would also be
 575         # disabled.
 576         'search' => {
 577                 'override' => 0,
 578                 'default' => [1]},
 579
 580         # Enable grep search, which will list the files in currently selected
 581         # tree containing the given string. Enabled by default. This can be
 582         # potentially CPU-intensive, of course.
 583         # Note that you need to have 'search' feature enabled too.
 584
 585         # To enable system wide have in $GITWEB_CONFIG
 586         # $feature{'grep'}{'default'} = [1];
 587         # To have project specific config enable override in $GITWEB_CONFIG
 588         # $feature{'grep'}{'override'} = 1;
 589         # and in project config gitweb.grep = 0|1;
 590         'grep' => {
 591                 'sub' => sub { feature_bool('grep', @_) },
 592                 'override' => 0,
 593                 'default' => [1]},
 594
 595         # Enable the pickaxe search, which will list the commits that modified
 596         # a given string in a file. This can be practical and quite faster
 597         # alternative to 'blame', but still potentially CPU-intensive.
 598         # Note that you need to have 'search' feature enabled too.
 599
 600         # To enable system wide have in $GITWEB_CONFIG
 601         # $feature{'pickaxe'}{'default'} = [1];
 602         # To have project specific config enable override in $GITWEB_CONFIG
 603         # $feature{'pickaxe'}{'override'} = 1;
 604         # and in project config gitweb.pickaxe = 0|1;
 605         'pickaxe' => {
 606                 'sub' => sub { feature_bool('pickaxe', @_) },
 607                 'override' => 0,
 608                 'default' => [1]},
 609
 610         # Enable showing size of blobs in a 'tree' view, in a separate
 611         # column, similar to what 'ls -l' does.  This cost a bit of IO.
 612
 613         # To disable system wide have in $GITWEB_CONFIG
 614         # $feature{'show-sizes'}{'default'} = [0];
 615         # To have project specific config enable override in $GITWEB_CONFIG
 616         # $feature{'show-sizes'}{'override'} = 1;
 617         # and in project config gitweb.showsizes = 0|1;
 618         'show-sizes' => {
 619                 'sub' => sub { feature_bool('showsizes', @_) },
 620                 'override' => 0,
 621                 'default' => [1]},
 622
 623         # Make gitweb use an alternative format of the URLs which can be
 624         # more readable and natural-looking: project name is embedded
 625         # directly in the path and the query string contains other
 626         # auxiliary information. All gitweb installations recognize
 627         # URL in either format; this configures in which formats gitweb
 628         # generates links.
 629
 630         # To enable system wide have in $GITWEB_CONFIG
 631         # $feature{'pathinfo'}{'default'} = [1];
 632         # Project specific override is not supported.
 633
 634         # Note that you will need to change the default location of CSS,
 635         # favicon, logo and possibly other files to an absolute URL. Also,
 636         # if gitweb.cgi serves as your indexfile, you will need to force
 637         # $my_uri to contain the script name in your $GITWEB_CONFIG (and you
 638         # will also likely want to set $home_link if you're setting $my_uri).
 639         'pathinfo' => {
 640                 'override' => 0,
 641                 'default' => [0]},
 642
 643         # Make gitweb consider projects in project root subdirectories
 644         # to be forks of existing projects. Given project $projname.git,
 645         # projects matching $projname/*.git will not be shown in the main
 646         # projects list, instead a '+' mark will be added to $projname
 647         # there and a 'forks' view will be enabled for the project, listing
 648         # all the forks. If project list is taken from a file, forks have
 649         # to be listed after the main project.
 650
 651         # To enable system wide have in $GITWEB_CONFIG
 652         # $feature{'forks'}{'default'} = [1];
 653         # Project specific override is not supported.
 654         'forks' => {
 655                 'override' => 0,
 656                 'default' => [0]},
 657
 658         # Insert custom links to the action bar of all project pages.
 659         # This enables you mainly to link to third-party scripts integrating
 660         # into gitweb; e.g. git-browser for graphical history representation
 661         # or custom web-based repository administration interface.
 662
 663         # The 'default' value consists of a list of triplets in the form
 664         # (label, link, position) where position is the label after which
 665         # to insert the link and link is a format string where %n expands
 666         # to the project name, %f to the project path within the filesystem,
 667         # %h to the current hash (h gitweb parameter) and %b to the current
 668         # hash base (hb gitweb parameter); %% expands to %.  %e expands to the
 669         # project name where all '+' characters have been replaced with '%2B'.
 670
 671         # To enable system wide have in $GITWEB_CONFIG e.g.
 672         # $feature{'actions'}{'default'} = [('graphiclog',
 673         #       '/git-browser/by-commit.html?r=%n', 'summary')];
 674         # Project specific override is not supported.
 675         'actions' => {
 676                 'override' => 0,
 677                 'default' => []},
 678
 679         # Allow gitweb scan project content tags of project repository,
 680         # and display the popular Web 2.0-ish "tag cloud" near the projects
 681         # list.  Note that this is something COMPLETELY different from the
 682         # normal Git tags.
 683
 684         # gitweb by itself can show existing tags, but it does not handle
 685         # tagging itself; you need to do it externally, outside gitweb.
 686         # The format is described in git_get_project_ctags() subroutine.
 687         # You may want to install the HTML::TagCloud Perl module to get
 688         # a pretty tag cloud instead of just a list of tags.
 689
 690         # To enable system wide have in $GITWEB_CONFIG
 691         # $feature{'ctags'}{'default'} = [1];
 692         # Project specific override is not supported.
 693
 694         # A value of 0 means no ctags display or editing.  A value of
 695         # 1 enables ctags display but never editing.  A non-empty value
 696         # that is not a string of digits enables ctags display AND the
 697         # ability to add tags using a form that uses method POST and
 698         # an action value set to the configured 'ctags' value.
 699         'ctags' => {
 700                 'override' => 0,
 701                 'default' => [0]},
 702
 703         # The maximum number of patches in a patchset generated in patch
 704         # view. Set this to 0 or undef to disable patch view, or to a
 705         # negative number to remove any limit.
 706
 707         # To disable system wide have in $GITWEB_CONFIG
 708         # $feature{'patches'}{'default'} = [0];
 709         # To have project specific config enable override in $GITWEB_CONFIG
 710         # $feature{'patches'}{'override'} = 1;
 711         # and in project config gitweb.patches = 0|n;
 712         # where n is the maximum number of patches allowed in a patchset.
 713         'patches' => {
 714                 'sub' => \&feature_patches,
 715                 'override' => 0,
 716                 'default' => [16]},
 717
 718         # Avatar support. When this feature is enabled, views such as
 719         # shortlog or commit will display an avatar associated with
 720         # the email of the committer(s) and/or author(s).
 721
 722         # Currently available providers are gravatar and picon.
 723         # If an unknown provider is specified, the feature is disabled.
 724
 725         # Gravatar depends on Digest::MD5.
 726         # Picon currently relies on the indiana.edu database.
 727
 728         # To enable system wide have in $GITWEB_CONFIG
 729         # $feature{'avatar'}{'default'} = ['<provider>'];
 730         # where <provider> is either gravatar or picon.
 731         # To have project specific config enable override in $GITWEB_CONFIG
 732         # $feature{'avatar'}{'override'} = 1;
 733         # and in project config gitweb.avatar = <provider>;
 734         'avatar' => {
 735                 'sub' => \&feature_avatar,
 736                 'override' => 0,
 737                 'default' => ['']},
 738
 739         # Enable displaying how much time and how many git commands
 740         # it took to generate and display page.  Disabled by default.
 741         # Project specific override is not supported.
 742         'timed' => {
 743                 'override' => 0,
 744                 'default' => [0]},
 745
 746         # Enable turning some links into links to actions which require
 747         # JavaScript to run (like 'blame_incremental').  Not enabled by
 748         # default.  Project specific override is currently not supported.
 749         'javascript-actions' => {
 750                 'override' => 0,
 751                 'default' => [0]},
 752
 753         # Enable and configure ability to change common timezone for dates
 754         # in gitweb output via JavaScript.  Enabled by default.
 755         # Project specific override is not supported.
 756         'javascript-timezone' => {
 757                 'override' => 0,
 758                 'default' => [
 759                         'local',     # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
 760                                      # or undef to turn off this feature
 761                         'gitweb_tz', # name of cookie where to store selected timezone
 762                         'datetime',  # CSS class used to mark up dates for manipulation
 763                 ]},
 764
 765         # Syntax highlighting support. This is based on Daniel Svensson's
 766         # and Sham Chukoury's work in gitweb-xmms2.git.
 767         # It requires the 'highlight' program present in $PATH,
 768         # and therefore is disabled by default.
 769
 770         # To enable system wide have in $GITWEB_CONFIG
 771         # $feature{'highlight'}{'default'} = [1];
 772
 773         'highlight' => {
 774                 'sub' => sub { feature_bool('highlight', @_) },
 775                 'override' => 0,
 776                 'default' => [0]},
 777
 778         # Enable displaying of remote heads in the heads list
 779
 780         # To enable system wide have in $GITWEB_CONFIG
 781         # $feature{'remote_heads'}{'default'} = [1];
 782         # To have project specific config enable override in $GITWEB_CONFIG
 783         # $feature{'remote_heads'}{'override'} = 1;
 784         # and in project config gitweb.remoteheads = 0|1;
 785         'remote_heads' => {
 786                 'sub' => sub { feature_bool('remote_heads', @_) },
 787                 'override' => 0,
 788                 'default' => [0]},
 789
 790         # Enable showing branches under other refs in addition to heads
 791
 792         # To set system wide extra branch refs have in $GITWEB_CONFIG
 793         # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
 794         # To have project specific config enable override in $GITWEB_CONFIG
 795         # $feature{'extra-branch-refs'}{'override'} = 1;
 796         # and in project config gitweb.extrabranchrefs = dirs of choice
 797         # Every directory is separated with whitespace.
 798
 799         'extra-branch-refs' => {
 800                 'sub' => \&feature_extra_branch_refs,
 801                 'override' => 0,
 802                 'default' => []},
 803 );
 804
 805 sub gitweb_get_feature {
 806         my ($name) = @_;
 807         return unless exists $feature{$name};
 808         my ($sub, $override, @defaults) = (
 809                 $feature{$name}{'sub'},
 810                 $feature{$name}{'override'},
 811                 @{$feature{$name}{'default'}});
 812         # project specific override is possible only if we have project
 813         our $git_dir; # global variable, declared later
 814         if (!$override || !defined $git_dir) {
 815                 return @defaults;
 816         }
 817         if (!defined $sub) {
 818                 warn "feature $name is not overridable";
 819                 return @defaults;
 820         }
 821         return $sub->(@defaults);
 822 }
 823
 824 # A wrapper to check if a given feature is enabled.
 825 # With this, you can say
 826 #
 827 #   my $bool_feat = gitweb_check_feature('bool_feat');
 828 #   gitweb_check_feature('bool_feat') or somecode;
 829 #
 830 # instead of
 831 #
 832 #   my ($bool_feat) = gitweb_get_feature('bool_feat');
 833 #   (gitweb_get_feature('bool_feat'))[0] or somecode;
 834 #
 835 sub gitweb_check_feature {
 836         return (gitweb_get_feature(@_))[0];
 837 }
 838
 839
 840 sub feature_bool {
 841         my $key = shift;
 842         my ($val) = git_get_project_config($key, '--bool');
 843
 844         if (!defined $val) {
 845                 return ($_[0]);
 846         } elsif ($val eq 'true') {
 847                 return (1);
 848         } elsif ($val eq 'false') {
 849                 return (0);
 850         }
 851 }
 852
 853 sub feature_snapshot {
 854         my (@fmts) = @_;
 855
 856         my ($val) = git_get_project_config('snapshot');
 857
 858         if ($val) {
 859                 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
 860         }
 861
 862         return @fmts;
 863 }
 864
 865 sub feature_patches {
 866         my @val = (git_get_project_config('patches', '--int'));
 867
 868         if (@val) {
 869                 return @val;
 870         }
 871
 872         return ($_[0]);
 873 }
 874
 875 sub feature_avatar {
 876         my @val = (git_get_project_config('avatar'));
 877
 878         return @val ? @val : @_;
 879 }
 880
 881 sub feature_extra_branch_refs {
 882         my (@branch_refs) = @_;
 883         my $values = git_get_project_config('extrabranchrefs');
 884
 885         if ($values) {
 886                 $values = config_to_multi ($values);
 887                 @branch_refs = ();
 888                 foreach my $value (@{$values}) {
 889                         push @branch_refs, split /\s+/, $value;
 890                 }
 891         }
 892
 893         return @branch_refs;
 894 }
 895
 896 # checking HEAD file with -e is fragile if the repository was
 897 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
 898 # and then pruned.
 899 sub check_head_link {
 900         my ($dir) = @_;
 901         return 0 unless -d "$dir/objects" && -x _;
 902         return 0 unless -d "$dir/refs" && -x _;
 903         my $headfile = "$dir/HEAD";
 904         return -l $headfile ?
 905                 readlink($headfile) =~ /^refs\/heads\// : -f $headfile;
 906 }
 907
 908 sub check_export_ok {
 909         my ($dir) = @_;
 910         return (check_head_link($dir) &&
 911                 (!$export_ok || -e "$dir/$export_ok") &&
 912                 (!$export_auth_hook || $export_auth_hook->($dir)));
 913 }
 914
 915 # process alternate names for backward compatibility
 916 # filter out unsupported (unknown) snapshot formats
 917 sub filter_snapshot_fmts {
 918         my @fmts = @_;
 919
 920         @fmts = map {
 921                 exists $known_snapshot_format_aliases{$_} ?
 922                        $known_snapshot_format_aliases{$_} : $_} @fmts;
 923         @fmts = grep {
 924                 exists $known_snapshot_formats{$_} &&
 925                 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
 926 }
 927
 928 sub filter_and_validate_refs {
 929         my @refs = @_;
 930         my %unique_refs = ();
 931
 932         foreach my $ref (@refs) {
 933                 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
 934                 # 'heads' are added implicitly in get_branch_refs().
 935                 $unique_refs{$ref} = 1 if ($ref ne 'heads');
 936         }
 937         return sort keys %unique_refs;
 938 }
 939
 940 # If it is set to code reference, it is code that it is to be run once per
 941 # request, allowing updating configurations that change with each request,
 942 # while running other code in config file only once.
 943 #
 944 # Otherwise, if it is false then gitweb would process config file only once;
 945 # if it is true then gitweb config would be run for each request.
 946 our $per_request_config = 1;
 947
 948 # If true and fileno STDIN is 0 and getsockname succeeds and getpeername fails
 949 # with ENOTCONN, then FCGI mode will be activated automatically in just the
 950 # same way as though the --fcgi option had been given instead.
 951 our $auto_fcgi = 0;
 952
 953 # read and parse gitweb config file given by its parameter.
 954 # returns true on success, false on recoverable error, allowing
 955 # to chain this subroutine, using first file that exists.
 956 # dies on errors during parsing config file, as it is unrecoverable.
 957 sub read_config_file {
 958         my $filename = shift;
 959         return unless defined $filename;
 960         # die if there are errors parsing config file
 961         if (-e $filename) {
 962                 do $filename;
 963                 die $@ if $@;
 964                 return 1;
 965         }
 966         return;
 967 }
 968
 969 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
 970 sub evaluate_gitweb_config {
 971         our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
 972         our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
 973         our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
 974
 975         # Protect against duplications of file names, to not read config twice.
 976         # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
 977         # there possibility of duplication of filename there doesn't matter.
 978         $GITWEB_CONFIG = ""        if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
 979         $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
 980
 981         # Common system-wide settings for convenience.
 982         # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
 983         read_config_file($GITWEB_CONFIG_COMMON);
 984
 985         # Use first config file that exists.  This means use the per-instance
 986         # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
 987         read_config_file($GITWEB_CONFIG) and return;
 988         read_config_file($GITWEB_CONFIG_SYSTEM);
 989 }
 990
 991 our $encode_object;
 992 our $to_utf8_pipe_command = '';
 993
 994 sub evaluate_encoding {
 995         my $requested = $fallback_encoding || 'ISO-8859-1';
 996         my $obj = Encode::find_encoding($requested) or
 997                 die_error(400, "Requested fallback encoding not found");
 998         if ($obj->name eq 'iso-8859-1') {
 999                 # Use Windows-1252 instead as required by the HTML 5 standard
1000                 my $altobj = Encode::find_encoding('Windows-1252');
1001                 $obj = $altobj if $altobj;
1002         }
1003         $encode_object = $obj;
1004         my $nm = lc($encode_object->name);
1005         unless ($nm eq 'cp1252' || $nm eq 'ascii' || $nm eq 'utf8' ||
1006                 $nm =~ /^utf-8/ || $nm =~ /^iso-8859-/) {
1007                 $to_utf8_pipe_command =
1008                   quote_command($^X, '-CO', '-MEncode=decode,FB_DEFAULT', '-pse',
1009                     '$_ = decode($fe, $_, FB_DEFAULT) if !utf8::decode($_);',
1010                     '--', "-fe=$fallback_encoding")." | ";
1011         }
1012 }
1013
1014 sub evaluate_email_obfuscate {
1015         # email obfuscation
1016         our $email;
1017         if (!$email && eval { require HTML::Email::Obfuscate; 1 }) {
1018                 $email = HTML::Email::Obfuscate->new(lite => 1);
1019         }
1020 }
1021
1022 # Get loadavg of system, to compare against $maxload.
1023 # Currently it requires '/proc/loadavg' present to get loadavg;
1024 # if it is not present it returns 0, which means no load checking.
1025 sub get_loadavg {
1026         if( -e '/proc/loadavg' ){
1027                 open my $fd, '<', '/proc/loadavg'
1028                         or return 0;
1029                 my @load = split(/\s+/, scalar <$fd>);
1030                 close $fd;
1031
1032                 # The first three columns measure CPU and IO utilization of the last one,
1033                 # five, and 10 minute periods.  The fourth column shows the number of
1034                 # currently running processes and the total number of processes in the m/n
1035                 # format.  The last column displays the last process ID used.
1036                 return $load[0] || 0;
1037         }
1038         # additional checks for load average should go here for things that don't export
1039         # /proc/loadavg
1040
1041         return 0;
1042 }
1043
1044 # version of the core git binary
1045 our $git_version;
1046 sub evaluate_git_version {
1047         our $git_version = $version;
1048 }
1049
1050 sub check_loadavg {
1051         if (defined $maxload && get_loadavg() > $maxload) {
1052                 die_error(503, "The load average on the server is too high");
1053         }
1054 }
1055
1056 # ======================================================================
1057 # input validation and dispatch
1058
1059 # input parameters can be collected from a variety of sources (presently, CGI
1060 # and PATH_INFO), so we define an %input_params hash that collects them all
1061 # together during validation: this allows subsequent uses (e.g. href()) to be
1062 # agnostic of the parameter origin
1063
1064 our %input_params = ();
1065
1066 # input parameters are stored with the long parameter name as key. This will
1067 # also be used in the href subroutine to convert parameters to their CGI
1068 # equivalent, and since the href() usage is the most frequent one, we store
1069 # the name -> CGI key mapping here, instead of the reverse.
1070 #
1071 # XXX: Warning: If you touch this, check the search form for updating,
1072 # too.
1073
1074 our @cgi_param_mapping = (
1075         project => "p",
1076         action => "a",
1077         file_name => "f",
1078         file_parent => "fp",
1079         hash => "h",
1080         hash_parent => "hp",
1081         hash_base => "hb",
1082         hash_parent_base => "hpb",
1083         page => "pg",
1084         order => "o",
1085         searchtext => "s",
1086         searchtype => "st",
1087         snapshot_format => "sf",
1088         ctag_filter => 't',
1089         extra_options => "opt",
1090         search_use_regexp => "sr",
1091         ctag => "by_tag",
1092         diff_style => "ds",
1093         project_filter => "pf",
1094         # this must be last entry (for manipulation from JavaScript)
1095         javascript => "js"
1096 );
1097 our %cgi_param_mapping = @cgi_param_mapping;
1098
1099 # we will also need to know the possible actions, for validation
1100 our %actions = (
1101         "blame" => \&git_blame,
1102         "blame_incremental" => \&git_blame_incremental,
1103         "blame_data" => \&git_blame_data,
1104         "blobdiff" => \&git_blobdiff,
1105         "blobdiff_plain" => \&git_blobdiff_plain,
1106         "blob" => \&git_blob,
1107         "blob_plain" => \&git_blob_plain,
1108         "commitdiff" => \&git_commitdiff,
1109         "commitdiff_plain" => \&git_commitdiff_plain,
1110         "commit" => \&git_commit,
1111         "forks" => \&git_forks,
1112         "heads" => \&git_heads,
1113         "history" => \&git_history,
1114         "log" => \&git_log,
1115         "patch" => \&git_patch,
1116         "patches" => \&git_patches,
1117         "refs" => \&git_refs,
1118         "remotes" => \&git_remotes,
1119         "rss" => \&git_rss,
1120         "atom" => \&git_atom,
1121         "search" => \&git_search,
1122         "search_help" => \&git_search_help,
1123         "shortlog" => \&git_shortlog,
1124         "summary" => \&git_summary,
1125         "tag" => \&git_tag,
1126         "tags" => \&git_tags,
1127         "tree" => \&git_tree,
1128         "snapshot" => \&git_snapshot,
1129         "object" => \&git_object,
1130         # those below don't need $project
1131         "opml" => \&git_opml,
1132         "frontpage" => \&git_frontpage,
1133         "project_list" => \&git_project_list,
1134         "project_index" => \&git_project_index,
1135 );
1136
1137 # the only actions we will allow to be cached
1138 my %supported_cache_actions;
1139 BEGIN {%supported_cache_actions = map {( $_ => 1 )} qw(summary)}
1140
1141 # finally, we have the hash of allowed extra_options for the commands that
1142 # allow them
1143 our %allowed_options = (
1144         "--no-merges" => [ qw(rss atom log shortlog history) ],
1145 );
1146
1147 # fill %input_params with the CGI parameters. All values except for 'opt'
1148 # should be single values, but opt can be an array. We should probably
1149 # build an array of parameters that can be multi-valued, but since for the time
1150 # being it's only this one, we just single it out
1151 sub evaluate_query_params {
1152         our $cgi;
1153
1154         while (my ($name, $symbol) = each %cgi_param_mapping) {
1155                 if ($symbol eq 'opt') {
1156                         $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
1157                 } else {
1158                         $input_params{$name} = decode_utf8($cgi->param($symbol));
1159                 }
1160         }
1161
1162         # Backwards compatibility - by_tag= <=> t=
1163         if ($input_params{'ctag'}) {
1164                 $input_params{'ctag_filter'} = $input_params{'ctag'};
1165         }
1166 }
1167
1168 # now read PATH_INFO and update the parameter list for missing parameters
1169 sub evaluate_path_info {
1170         return if defined $input_params{'project'};
1171         return if !$path_info;
1172         $path_info =~ s,^/+,,;
1173         return if !$path_info;
1174
1175         # find which part of PATH_INFO is project
1176         my $project = $path_info;
1177         $project =~ s,/+$,,;
1178         while ($project && !check_head_link("$projectroot/$project")) {
1179                 $project =~ s,/*[^/]*$,,;
1180         }
1181         return unless $project;
1182         $input_params{'project'} = $project;
1183
1184         # do not change any parameters if an action is given using the query string
1185         return if $input_params{'action'};
1186         $path_info =~ s,^\Q$project\E/*,,;
1187
1188         # next, check if we have an action
1189         my $action = $path_info;
1190         $action =~ s,/.*$,,;
1191         if (exists $actions{$action}) {
1192                 $path_info =~ s,^$action/*,,;
1193                 $input_params{'action'} = $action;
1194         }
1195
1196         # list of actions that want hash_base instead of hash, but can have no
1197         # pathname (f) parameter
1198         my @wants_base = (
1199                 'tree',
1200                 'history',
1201         );
1202
1203         # we want to catch, among others
1204         # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
1205         my ($parentrefname, $parentpathname, $refname, $pathname) =
1206                 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
1207
1208         # first, analyze the 'current' part
1209         if (defined $pathname) {
1210                 # we got "branch:filename" or "branch:dir/"
1211                 # we could use git_get_type(branch:pathname), but:
1212                 # - it needs $git_dir
1213                 # - it does a git() call
1214                 # - the convention of terminating directories with a slash
1215                 #   makes it superfluous
1216                 # - embedding the action in the PATH_INFO would make it even
1217                 #   more superfluous
1218                 $pathname =~ s,^/+,,;
1219                 if (!$pathname || substr($pathname, -1) eq "/") {
1220                         $input_params{'action'} ||= "tree";
1221                         $pathname =~ s,/$,,;
1222                 } else {
1223                         # the default action depends on whether we had parent info
1224                         # or not
1225                         if ($parentrefname) {
1226                                 $input_params{'action'} ||= "blobdiff_plain";
1227                         } else {
1228                                 $input_params{'action'} ||= "blob_plain";
1229                         }
1230                 }
1231                 $input_params{'hash_base'} ||= $refname;
1232                 $input_params{'file_name'} ||= $pathname;
1233         } elsif (defined $refname) {
1234                 # we got "branch". In this case we have to choose if we have to
1235                 # set hash or hash_base.
1236                 #
1237                 # Most of the actions without a pathname only want hash to be
1238                 # set, except for the ones specified in @wants_base that want
1239                 # hash_base instead. It should also be noted that hand-crafted
1240                 # links having 'history' as an action and no pathname or hash
1241                 # set will fail, but that happens regardless of PATH_INFO.
1242                 if (defined $parentrefname) {
1243                         # if there is parent let the default be 'shortlog' action
1244                         # (for http://git.example.com/repo.git/A..B links); if there
1245                         # is no parent, dispatch will detect type of object and set
1246                         # action appropriately if required (if action is not set)
1247                         $input_params{'action'} ||= "shortlog";
1248                 }
1249                 if ($input_params{'action'} &&
1250                     grep { $_ eq $input_params{'action'} } @wants_base) {
1251                         $input_params{'hash_base'} ||= $refname;
1252                 } else {
1253                         $input_params{'hash'} ||= $refname;
1254                 }
1255         }
1256
1257         # next, handle the 'parent' part, if present
1258         if (defined $parentrefname) {
1259                 # a missing pathspec defaults to the 'current' filename, allowing e.g.
1260                 # someproject/blobdiff/oldrev..newrev:/filename
1261                 if ($parentpathname) {
1262                         $parentpathname =~ s,^/+,,;
1263                         $parentpathname =~ s,/$,,;
1264                         $input_params{'file_parent'} ||= $parentpathname;
1265                 } else {
1266                         $input_params{'file_parent'} ||= $input_params{'file_name'};
1267                 }
1268                 # we assume that hash_parent_base is wanted if a path was specified,
1269                 # or if the action wants hash_base instead of hash
1270                 if (defined $input_params{'file_parent'} ||
1271                         grep { $_ eq $input_params{'action'} } @wants_base) {
1272                         $input_params{'hash_parent_base'} ||= $parentrefname;
1273                 } else {
1274                         $input_params{'hash_parent'} ||= $parentrefname;
1275                 }
1276         }
1277
1278         # for the snapshot action, we allow URLs in the form
1279         # $project/snapshot/$hash.ext
1280         # where .ext determines the snapshot and gets removed from the
1281         # passed $refname to provide the $hash.
1282         #
1283         # To be able to tell that $refname includes the format extension, we
1284         # require the following two conditions to be satisfied:
1285         # - the hash input parameter MUST have been set from the $refname part
1286         #   of the URL (i.e. they must be equal)
1287         # - the snapshot format MUST NOT have been defined already (e.g. from
1288         #   CGI parameter sf)
1289         # It's also useless to try any matching unless $refname has a dot,
1290         # so we check for that too
1291         if (defined $input_params{'action'} &&
1292                 $input_params{'action'} eq 'snapshot' &&
1293                 defined $refname && index($refname, '.') != -1 &&
1294                 $refname eq $input_params{'hash'} &&
1295                 !defined $input_params{'snapshot_format'}) {
1296                 # We loop over the known snapshot formats, checking for
1297                 # extensions. Allowed extensions are both the defined suffix
1298                 # (which includes the initial dot already) and the snapshot
1299                 # format key itself, with a prepended dot
1300                 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1301                         my $hash = $refname;
1302                         unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1303                                 next;
1304                         }
1305                         my $sfx = $1;
1306                         # a valid suffix was found, so set the snapshot format
1307                         # and reset the hash parameter
1308                         $input_params{'snapshot_format'} = $fmt;
1309                         $input_params{'hash'} = $hash;
1310                         # we also set the format suffix to the one requested
1311                         # in the URL: this way a request for e.g. .tgz returns
1312                         # a .tgz instead of a .tar.gz
1313                         $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1314                         last;
1315                 }
1316         }
1317 }
1318
1319 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1320      $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1321      $searchtext, $search_regexp, $project_filter);
1322 sub evaluate_and_validate_params {
1323         our $action = $input_params{'action'};
1324         if (defined $action) {
1325                 if (!is_valid_action($action)) {
1326                         die_error(400, "Invalid action parameter");
1327                 }
1328         }
1329
1330         # parameters which are pathnames
1331         our $project = $input_params{'project'};
1332         if (defined $project) {
1333                 if (!is_valid_project($project)) {
1334                         undef $project;
1335                         die_error(404, "No such project");
1336                 }
1337         }
1338
1339         our $project_filter = $input_params{'project_filter'};
1340         if (defined $project_filter) {
1341                 if (!is_valid_pathname($project_filter)) {
1342                         die_error(404, "Invalid project_filter parameter");
1343                 }
1344         }
1345
1346         our $file_name = $input_params{'file_name'};
1347         if (defined $file_name) {
1348                 if (!is_valid_pathname($file_name)) {
1349                         die_error(400, "Invalid file parameter");
1350                 }
1351         }
1352
1353         our $file_parent = $input_params{'file_parent'};
1354         if (defined $file_parent) {
1355                 if (!is_valid_pathname($file_parent)) {
1356                         die_error(400, "Invalid file parent parameter");
1357                 }
1358         }
1359
1360         # parameters which are refnames
1361         our $hash = $input_params{'hash'};
1362         if (defined $hash) {
1363                 if (!is_valid_refname($hash)) {
1364                         die_error(400, "Invalid hash parameter");
1365                 }
1366         }
1367
1368         our $hash_parent = $input_params{'hash_parent'};
1369         if (defined $hash_parent) {
1370                 if (!is_valid_refname($hash_parent)) {
1371                         die_error(400, "Invalid hash parent parameter");
1372                 }
1373         }
1374
1375         our $hash_base = $input_params{'hash_base'};
1376         if (defined $hash_base) {
1377                 if (!is_valid_refname($hash_base)) {
1378                         die_error(400, "Invalid hash base parameter");
1379                 }
1380         }
1381
1382         our @extra_options = @{$input_params{'extra_options'}};
1383         # @extra_options is always defined, since it can only be (currently) set from
1384         # CGI, and $cgi->param() returns the empty array in array context if the param
1385         # is not set
1386         foreach my $opt (@extra_options) {
1387                 if (not exists $allowed_options{$opt}) {
1388                         die_error(400, "Invalid option parameter");
1389                 }
1390                 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1391                         die_error(400, "Invalid option parameter for this action");
1392                 }
1393         }
1394
1395         our $hash_parent_base = $input_params{'hash_parent_base'};
1396         if (defined $hash_parent_base) {
1397                 if (!is_valid_refname($hash_parent_base)) {
1398                         die_error(400, "Invalid hash parent base parameter");
1399                 }
1400         }
1401
1402         # other parameters
1403         our $page = $input_params{'page'};
1404         if (defined $page) {
1405                 if ($page =~ m/[^0-9]/) {
1406                         die_error(400, "Invalid page parameter");
1407                 }
1408         }
1409
1410         our $searchtype = $input_params{'searchtype'};
1411         if (defined $searchtype) {
1412                 if ($searchtype =~ m/[^a-z]/) {
1413                         die_error(400, "Invalid searchtype parameter");
1414                 }
1415         }
1416
1417         our $search_use_regexp = $input_params{'search_use_regexp'};
1418
1419         our $searchtext = $input_params{'searchtext'};
1420         our $search_regexp = undef;
1421         if (defined $searchtext) {
1422                 if (length($searchtext) < 2) {
1423                         die_error(403, "At least two characters are required for search parameter");
1424                 }
1425                 if ($search_use_regexp) {
1426                         $search_regexp = $searchtext;
1427                         if (!eval { qr/$search_regexp/; 1; }) {
1428                                 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1429                                 die_error(400, "Invalid search regexp '$search_regexp'",
1430                                           esc_html($error));
1431                         }
1432                 } else {
1433                         $search_regexp = quotemeta $searchtext;
1434                 }
1435         }
1436 }
1437
1438 # path to the current git repository
1439 our $git_dir;
1440 sub evaluate_git_dir {
1441         our $git_dir = $project ? "$projectroot/$project" : undef;
1442 }
1443
1444 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1445 sub configure_gitweb_features {
1446         # list of supported snapshot formats
1447         our @snapshot_fmts = gitweb_get_feature('snapshot');
1448         @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1449
1450         # check that the avatar feature is set to a known provider name,
1451         # and for each provider check if the dependencies are satisfied.
1452         # if the provider name is invalid or the dependencies are not met,
1453         # reset $git_avatar to the empty string.
1454         our ($git_avatar) = gitweb_get_feature('avatar');
1455         if ($git_avatar eq 'gravatar') {
1456                 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1457         } elsif ($git_avatar eq 'picon') {
1458                 # no dependencies
1459         } else {
1460                 $git_avatar = '';
1461         }
1462
1463         our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1464         @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1465 }
1466
1467 sub get_branch_refs {
1468         return ('heads', @extra_branch_refs);
1469 }
1470
1471 # custom error handler: 'die <message>' is Internal Server Error
1472 sub handle_errors_html {
1473         my $msg = shift; # it is already HTML escaped
1474
1475         # to avoid infinite loop where error occurs in die_error,
1476         # change handler to default handler, disabling handle_errors_html
1477         set_message("Error occurred when inside die_error:\n$msg");
1478
1479         # you cannot jump out of die_error when called as error handler;
1480         # the subroutine set via CGI::Carp::set_message is called _after_
1481         # HTTP headers are already written, so it cannot write them itself
1482         die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1483 }
1484 set_message(\&handle_errors_html);
1485
1486 our $shown_stale_message = 0;
1487 our $cache_dump = undef;
1488 our $cache_dump_mtime = undef;
1489
1490 # dispatch
1491 my $cache_mode_active;
1492 sub dispatch {
1493         if (!defined $action) {
1494                 if (defined $hash) {
1495                         $action = git_get_type($hash);
1496                         $action or die_error(404, "Object does not exist");
1497                 } elsif (defined $hash_base && defined $file_name) {
1498                         $action = git_get_type("$hash_base:$file_name");
1499                         $action or die_error(404, "File or directory does not exist");
1500                 } elsif (defined $project) {
1501                         $action = 'summary';
1502                 } else {
1503                         $action = 'frontpage';
1504                 }
1505         }
1506         if (!defined($actions{$action})) {
1507                 die_error(400, "Unknown action");
1508         }
1509         if ($action !~ m/^(?:opml|frontpage|project_list|project_index)$/ &&
1510             !$project) {
1511                 die_error(400, "Project needed");
1512         }
1513
1514         my $defstyle = $stylesheet;
1515         local $stylesheet = $defstyle;
1516         if ($ENV{'HTTP_COOKIE'} && ";$ENV{'HTTP_COOKIE'};" =~ /;\s*style\s*=\s*([a-z][a-z0-9_-]*)\s*;/) {{
1517                 my $stylename = $1;
1518                 last unless $ENV{'DOCUMENT_ROOT'} && -r "$ENV{'DOCUMENT_ROOT'}/style/$stylename.css";
1519                 $stylesheet = "/style/$stylename.css";
1520         }}
1521
1522         my $cached_page = $supported_cache_actions{$action}
1523                 ? cached_action_page($action)
1524                 : undef;
1525         goto DUMPCACHE if $cached_page;
1526         local *SAVEOUT = *STDOUT;
1527         $cache_mode_active = $supported_cache_actions{$action}
1528                 ? cached_action_start($action)
1529                 : undef;
1530
1531         configure_gitweb_features();
1532         $actions{$action}->();
1533
1534         return unless $cache_mode_active;
1535
1536         $cached_page = cached_action_finish($action);
1537         *STDOUT = *SAVEOUT;
1538
1539         DUMPCACHE:
1540
1541         $cache_mode_active = 0;
1542         # Avoid any extra unwanted encoding steps as $cached_page is raw bytes
1543         binmode STDOUT, ':raw';
1544         our $fcgi_raw_mode = 1;
1545         print expand_gitweb_pi($cached_page, time);
1546         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
1547         $fcgi_raw_mode = 0;
1548 }
1549
1550 sub reset_timer {
1551         our $t0 = [ gettimeofday() ]
1552                 if defined $t0;
1553         our $number_of_git_cmds = 0;
1554 }
1555
1556 our $first_request = 1;
1557 our $evaluate_uri_force = undef;
1558 sub run_request {
1559         reset_timer();
1560
1561         # Only allow GET and HEAD methods
1562         if (!$ENV{'REQUEST_METHOD'} || ($ENV{'REQUEST_METHOD'} ne 'GET' && $ENV{'REQUEST_METHOD'} ne 'HEAD')) {
1563                 print <<EOT;
1564 Status: 405 Method Not Allowed
1565 Content-Type: text/plain
1566 Allow: GET,HEAD
1567
1568 405 Method Not Allowed
1569 EOT
1570                 return;
1571         }
1572
1573         evaluate_uri();
1574         &$evaluate_uri_force() if $evaluate_uri_force;
1575         if ($per_request_config) {
1576                 if (ref($per_request_config) eq 'CODE') {
1577                         $per_request_config->();
1578                 } elsif (!$first_request) {
1579                         evaluate_gitweb_config();
1580                         evaluate_email_obfuscate();
1581                 }
1582         }
1583         check_loadavg();
1584
1585         # $projectroot and $projects_list might be set in gitweb config file
1586         $projects_list ||= $projectroot;
1587
1588         evaluate_query_params();
1589         evaluate_path_info();
1590         evaluate_and_validate_params();
1591         evaluate_git_dir();
1592
1593         dispatch();
1594 }
1595
1596 our $is_last_request = sub { 1 };
1597 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1598 our $CGI = 'CGI';
1599 our $cgi;
1600 our $fcgi_mode = 0;
1601 our $fcgi_nproc_active = 0;
1602 our $fcgi_raw_mode = 0;
1603 sub is_fcgi {
1604         use Errno;
1605         my $stdinfno = fileno STDIN;
1606         return 0 unless defined $stdinfno && $stdinfno == 0;
1607         return 0 unless getsockname STDIN;
1608         return 0 if getpeername STDIN;
1609         return $!{ENOTCONN}?1:0;
1610 }
1611 sub configure_as_fcgi {
1612         return if $fcgi_mode;
1613
1614         require FCGI;
1615         require CGI::Fast;
1616
1617         # We have gone to great effort to make sure that all incoming data has
1618         # been converted from whatever format it was in into UTF-8.  We have
1619         # even taken care to make sure the output handle is in ':utf8' mode.
1620         # Now along comes FCGI and blows it with:
1621         #
1622         #     Use of wide characters in FCGI::Stream::PRINT is deprecated
1623         #      and will stop wprking[sic] in a future version of FCGI
1624         #
1625         # To fix this we replace FCGI::Stream::PRINT with our own routine that
1626         # first encodes everything and then calls the original routine, but
1627         # not if $fcgi_raw_mode is true (then we just call the original routine).
1628         #
1629         # Note that we could do this by using utf8::is_utf8 to check instead
1630         # of having a $fcgi_raw_mode global, but that would be slower to run
1631         # the test on each element and much slower than skipping the conversion
1632         # entirely when we know we're outputting raw bytes.
1633         my $orig = \&FCGI::Stream::PRINT;
1634         undef *FCGI::Stream::PRINT;
1635         *FCGI::Stream::PRINT = sub {
1636                 @_ = (shift, map {my $x=$_; utf8::encode($x); $x} @_)
1637                         unless $fcgi_raw_mode;
1638                 goto $orig;
1639         };
1640
1641         our $CGI = 'CGI::Fast';
1642
1643         $fcgi_mode = 1;
1644         $first_request = 0;
1645         my $request_number = 0;
1646         # let each child service 100 requests
1647         our $is_last_request = sub { ++$request_number >= 100 };
1648 }
1649 sub evaluate_argv {
1650         my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1651         configure_as_fcgi()
1652                 if $script_name =~ /\.fcgi$/ || ($auto_fcgi && is_fcgi());
1653
1654         my $nproc_sub = sub {
1655                 my ($arg, $val) = @_;
1656                 return unless eval { require FCGI::ProcManager; 1; };
1657                 $fcgi_nproc_active = 1;
1658                 my $proc_manager = FCGI::ProcManager->new({
1659                         n_processes => $val,
1660                 });
1661                 our $pre_listen_hook    = sub { $proc_manager->pm_manage()        };
1662                 our $pre_dispatch_hook  = sub { $proc_manager->pm_pre_dispatch()  };
1663                 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1664         };
1665         if (@ARGV) {
1666                 require Getopt::Long;
1667                 Getopt::Long::GetOptions(
1668                         'fastcgi|fcgi|f' => \&configure_as_fcgi,
1669                         'nproc|n=i' => $nproc_sub,
1670                 );
1671         };
1672         if (!$fcgi_nproc_active && defined $ENV{'GITWEB_FCGI_NPROC'} && $ENV{'GITWEB_FCGI_NPROC'} =~ /^\d+$/) {
1673                 &$nproc_sub('nproc', $ENV{'GITWEB_FCGI_NPROC'});
1674         }
1675 }
1676
1677 # Any "our" variable that could possibly influence correct handling of
1678 # a CGI request MUST be reset in this subroutine
1679 sub _reset_globals {
1680         # Note that $t0 and $number_of_git_commands are handled by reset_timer
1681         our %input_params = ();
1682         our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1683              $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1684              $searchtext, $search_regexp, $project_filter) = ();
1685         our $git_dir = undef;
1686         our (@snapshot_fmts, $git_avatar, @extra_branch_refs) = ();
1687         our %avatar_cache = ();
1688         our $config_file = '';
1689         our %config = ();
1690         our $gitweb_project_owner = undef;
1691         our $shown_stale_message = 0;
1692         our $fcgi_raw_mode = 0;
1693         keys %known_snapshot_formats; # reset 'each' iterator
1694 }
1695
1696 sub run {
1697         evaluate_gitweb_config();
1698         evaluate_encoding();
1699         evaluate_email_obfuscate();
1700         evaluate_git_version();
1701         my ($ml, $mi, $bu, $hl, $subroutine) = ($my_url, $my_uri, $base_url, $home_link, '');
1702         $subroutine .= '$my_url = $ml;' if defined $my_url && $my_url ne '';
1703         $subroutine .= '$my_uri = $mi;' if defined $my_uri; # this one can be ""
1704         $subroutine .= '$base_url = $bu;' if defined $base_url && $base_url ne '';
1705         $subroutine .= '$home_link = $hl;' if defined $home_link && $home_link ne '';
1706         $evaluate_uri_force = eval "sub {$subroutine}" if $subroutine;
1707         $first_request = 1;
1708         evaluate_argv();
1709
1710         $pre_listen_hook->()
1711                 if $pre_listen_hook;
1712
1713  REQUEST:
1714         while ($cgi = $CGI->new()) {
1715                 $pre_dispatch_hook->()
1716                         if $pre_dispatch_hook;
1717                 {
1718                         # most globals can simply be reset
1719                         _reset_globals;
1720
1721                         # evaluate_path_info corrupts %known_snapshot_formats
1722                         # so we need a deepish copy of it -- note that
1723                         # _reset_globals already took care of resetting its
1724                         # hash iterator that evaluate_path_info also leaves
1725                         # in an indeterminate state
1726                         my %formats = ();
1727                         while (my ($k,$v) = each(%known_snapshot_formats)) {
1728                                 $formats{$k} = {%{$known_snapshot_formats{$k}}};
1729                         }
1730                         local *known_snapshot_formats = \%formats;
1731
1732                         eval {run_request()};
1733                 }
1734                 $post_dispatch_hook->()
1735                         if $post_dispatch_hook;
1736                 $first_request = 0;
1737
1738                 last REQUEST if ($is_last_request->());
1739         }
1740
1741         1;
1742 }
1743
1744 run();
1745
1746 if (defined caller) {
1747         # wrapped in a subroutine processing requests,
1748         # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1749         return;
1750 } else {
1751         # pure CGI script, serving single request
1752         exit;
1753 }
1754
1755 ## ======================================================================
1756 ## action links
1757
1758 # possible values of extra options
1759 # -full => 0|1      - use absolute/full URL ($my_uri/$my_url as base)
1760 # -replay => 1      - start from a current view (replay with modifications)
1761 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1762 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1763 sub href {
1764         my %params = @_;
1765         # default is to use -absolute url() i.e. $my_uri
1766         my $href = $params{-full} ? $my_url : $my_uri;
1767
1768         # implicit -replay, must be first of implicit params
1769         $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1770
1771         $params{'project'} = $project unless exists $params{'project'};
1772
1773         if ($params{-replay}) {
1774                 while (my ($name, $symbol) = each %cgi_param_mapping) {
1775                         if (!exists $params{$name}) {
1776                                 $params{$name} = $input_params{$name};
1777                         }
1778                 }
1779         }
1780
1781         my $use_pathinfo = gitweb_check_feature('pathinfo');
1782         if (defined $params{'project'} &&
1783             (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1784                 # try to put as many parameters as possible in PATH_INFO:
1785                 #   - project name
1786                 #   - action
1787                 #   - hash_parent or hash_parent_base:/file_parent
1788                 #   - hash or hash_base:/filename
1789                 #   - the snapshot_format as an appropriate suffix
1790
1791                 # When the script is the root DirectoryIndex for the domain,
1792                 # $href here would be something like http://gitweb.example.com/
1793                 # Thus, we strip any trailing / from $href, to spare us double
1794                 # slashes in the final URL
1795                 $href =~ s,/$,,;
1796
1797                 # Then add the project name, if present
1798                 $href .= "/".esc_path_info($params{'project'});
1799                 delete $params{'project'};
1800
1801                 # since we destructively absorb parameters, we keep this
1802                 # boolean that remembers if we're handling a snapshot
1803                 my $is_snapshot = $params{'action'} eq 'snapshot';
1804
1805                 # Summary just uses the project path URL, any other action is
1806                 # added to the URL
1807                 if (defined $params{'action'}) {
1808                         $href .= "/".esc_path_info($params{'action'})
1809                                 unless $params{'action'} eq 'summary';
1810                         delete $params{'action'};
1811                 }
1812
1813                 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1814                 # stripping nonexistent or useless pieces
1815                 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1816                         || $params{'hash_parent'} || $params{'hash'});
1817                 if (defined $params{'hash_base'}) {
1818                         if (defined $params{'hash_parent_base'}) {
1819                                 $href .= esc_path_info($params{'hash_parent_base'});
1820                                 # skip the file_parent if it's the same as the file_name
1821                                 if (defined $params{'file_parent'}) {
1822                                         if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1823                                                 delete $params{'file_parent'};
1824                                         } elsif ($params{'file_parent'} !~ /\.\./) {
1825                                                 $href .= ":/".esc_path_info($params{'file_parent'});
1826                                                 delete $params{'file_parent'};
1827                                         }
1828                                 }
1829                                 $href .= "..";
1830                                 delete $params{'hash_parent'};
1831                                 delete $params{'hash_parent_base'};
1832                         } elsif (defined $params{'hash_parent'}) {
1833                                 $href .= esc_path_info($params{'hash_parent'}). "..";
1834                                 delete $params{'hash_parent'};
1835                         }
1836
1837                         $href .= esc_path_info($params{'hash_base'});
1838                         if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1839                                 $href .= ":/".esc_path_info($params{'file_name'});
1840                                 delete $params{'file_name'};
1841                         }
1842                         delete $params{'hash'};
1843                         delete $params{'hash_base'};
1844                 } elsif (defined $params{'hash'}) {
1845                         $href .= esc_path_info($params{'hash'});
1846                         delete $params{'hash'};
1847                 }
1848
1849                 # If the action was a snapshot, we can absorb the
1850                 # snapshot_format parameter too
1851                 if ($is_snapshot) {
1852                         my $fmt = $params{'snapshot_format'};
1853                         # snapshot_format should always be defined when href()
1854                         # is called, but just in case some code forgets, we
1855                         # fall back to the default
1856                         $fmt ||= $snapshot_fmts[0];
1857                         $href .= $known_snapshot_formats{$fmt}{'suffix'};
1858                         delete $params{'snapshot_format'};
1859                 }
1860         }
1861
1862         # now encode the parameters explicitly
1863         my @result = ();
1864         for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1865                 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1866                 if (defined $params{$name}) {
1867                         if (ref($params{$name}) eq "ARRAY") {
1868                                 foreach my $par (@{$params{$name}}) {
1869                                         push @result, $symbol . "=" . esc_param($par);
1870                                 }
1871                         } else {
1872                                 push @result, $symbol . "=" . esc_param($params{$name});
1873                         }
1874                 }
1875         }
1876         $href .= "?" . join(';', @result) if scalar @result;
1877
1878         # final transformation: trailing spaces must be escaped (URI-encoded)
1879         $href =~ s/(\s+)$/CGI::escape($1)/e;
1880
1881         if ($params{-anchor}) {
1882                 $href .= "#".esc_param($params{-anchor});
1883         }
1884
1885         return $href;
1886 }
1887
1888
1889 ## ======================================================================
1890 ## validation, quoting/unquoting and escaping
1891
1892 sub is_valid_action {
1893         my $input = shift;
1894         return undef unless exists $actions{$input};
1895         return 1;
1896 }
1897
1898 sub is_valid_project {
1899         my $input = shift;
1900
1901         return unless defined $input;
1902         if (!is_valid_pathname($input) ||
1903                 $input =~ m!^/*_! ||
1904                 $input =~ m!\.\.! ||
1905                 !($input =~ m!\.git/*$!) ||
1906                 $input =~ m!\.git/.*\.git/*$!i ||
1907                 !(-d "$projectroot/$input") ||
1908                 !check_export_ok("$projectroot/$input") ||
1909                 ($strict_export && !project_in_list($input))) {
1910                 return undef;
1911         } else {
1912                 return 1;
1913         }
1914 }
1915
1916 sub is_valid_pathname {
1917         my $input = shift;
1918
1919         return undef unless defined $input;
1920         # no '.' or '..' as elements of path, i.e. no '.' or '..'
1921         # at the beginning, at the end, and between slashes.
1922         # also this catches doubled slashes
1923         if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1924                 return undef;
1925         }
1926         # no null characters
1927         if ($input =~ m!\0!) {
1928                 return undef;
1929         }
1930         return 1;
1931 }
1932
1933 sub is_valid_ref_format {
1934         my $input = shift;
1935
1936         return undef unless defined $input;
1937         # restrictions on ref name according to git-check-ref-format
1938         if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1939                 return undef;
1940         }
1941         return 1;
1942 }
1943
1944 sub is_valid_refname {
1945         my $input = shift;
1946
1947         return undef unless defined $input;
1948         # textual hashes are O.K.
1949         if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1950                 return 1;
1951         }
1952         # it must be correct pathname
1953         is_valid_pathname($input) or return undef;
1954         # check git-check-ref-format restrictions
1955         is_valid_ref_format($input) or return undef;
1956         return 1;
1957 }
1958
1959 # decode sequences of octets in utf8 into Perl's internal form,
1960 # which is utf-8 with utf8 flag set if needed.  gitweb writes out
1961 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
1962 sub to_utf8 {
1963         my $str = shift;
1964         return undef unless defined $str;
1965
1966         if (utf8::is_utf8($str) || utf8::decode($str)) {
1967                 return $str;
1968         } else {
1969                 return $encode_object->decode($str, Encode::FB_DEFAULT);
1970         }
1971 }
1972
1973 # quote unsafe chars, but keep the slash, even when it's not
1974 # correct, but quoted slashes look too horrible in bookmarks
1975 sub esc_param {
1976         my $str = shift;
1977         return undef unless defined $str;
1978         $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
1979         $str =~ s/ /\+/g;
1980         return $str;
1981 }
1982
1983 # the quoting rules for path_info fragment are slightly different
1984 sub esc_path_info {
1985         my $str = shift;
1986         return undef unless defined $str;
1987
1988         # path_info doesn't treat '+' as space (specially), but '?' must be escaped
1989         $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
1990
1991         return $str;
1992 }
1993
1994 # quote unsafe chars in whole URL, so some characters cannot be quoted
1995 sub esc_url {
1996         my $str = shift;
1997         return undef unless defined $str;
1998         $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
1999         $str =~ s/ /\+/g;
2000         return $str;
2001 }
2002
2003 # quote unsafe characters in HTML attributes
2004 sub esc_attr {
2005
2006         # for XHTML conformance escaping '"' to '&quot;' is not enough
2007         return esc_html(@_);
2008 }
2009
2010 # replace invalid utf8 character with SUBSTITUTION sequence
2011 sub esc_html {
2012         my $str = shift;
2013         my %opts = @_;
2014
2015         return undef unless defined $str;
2016
2017         $str = to_utf8($str);
2018         $str = $cgi->escapeHTML($str);
2019         if ($opts{'-nbsp'}) {
2020                 $str =~ s/ /&#160;/g;
2021         }
2022         use bytes;
2023         $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
2024         return $str;
2025 }
2026
2027 # quote control characters and escape filename to HTML
2028 sub esc_path {
2029         my $str = shift;
2030         my %opts = @_;
2031
2032         return undef unless defined $str;
2033
2034         $str = to_utf8($str);
2035         $str = $cgi->escapeHTML($str);
2036         if ($opts{'-nbsp'}) {
2037                 $str =~ s/ /&#160;/g;
2038         }
2039         use bytes;
2040         $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
2041         return $str;
2042 }
2043
2044 # Sanitize for use in XHTML + application/xml+xhtm (valid XML 1.0)
2045 sub sanitize {
2046         my $str = shift;
2047
2048         return undef unless defined $str;
2049
2050         $str = to_utf8($str);
2051         use bytes;
2052         $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
2053         return $str;
2054 }
2055
2056 # Make control characters "printable", using character escape codes (CEC)
2057 sub quot_cec {
2058         my $cntrl = shift;
2059         my %opts = @_;
2060         my %es = ( # character escape codes, aka escape sequences
2061                 "\t" => '\t',   # tab            (HT)
2062                 "\n" => '\n',   # line feed      (LF)
2063                 "\r" => '\r',   # carrige return (CR)
2064                 "\f" => '\f',   # form feed      (FF)
2065                 "\b" => '\b',   # backspace      (BS)
2066                 "\a" => '\a',   # alarm (bell)   (BEL)
2067                 "\e" => '\e',   # escape         (ESC)
2068                 "\013" => '\v', # vertical tab   (VT)
2069                 "\000" => '\0', # nul character  (NUL)
2070         );
2071         my $chr = ( (exists $es{$cntrl})
2072                     ? $es{$cntrl}
2073                     : sprintf('\x%02x', ord($cntrl)) );
2074         if ($opts{-nohtml}) {
2075                 return $chr;
2076         } else {
2077                 return "<span class=\"cntrl\">$chr</span>";
2078         }
2079 }
2080
2081 # Alternatively use unicode control pictures codepoints,
2082 # Unicode "printable representation" (PR)
2083 sub quot_upr {
2084         my $cntrl = shift;
2085         my %opts = @_;
2086
2087         my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
2088         if ($opts{-nohtml}) {
2089                 return $chr;
2090         } else {
2091                 return "<span class=\"cntrl\">$chr</span>";
2092         }
2093 }
2094
2095 # git may return quoted and escaped filenames
2096 sub unquote {
2097         my $str = shift;
2098
2099         sub unq {
2100                 my $seq = shift;
2101                 my %es = ( # character escape codes, aka escape sequences
2102                         't' => "\t",   # tab            (HT, TAB)
2103                         'n' => "\n",   # newline        (NL)
2104                         'r' => "\r",   # return         (CR)
2105                         'f' => "\f",   # form feed      (FF)
2106                         'b' => "\b",   # backspace      (BS)
2107                         'a' => "\a",   # alarm (bell)   (BEL)
2108                         'e' => "\e",   # escape         (ESC)
2109                         'v' => "\013", # vertical tab   (VT)
2110                 );
2111
2112                 if ($seq =~ m/^[0-7]{1,3}$/) {
2113                         # octal char sequence
2114                         return chr(oct($seq));
2115                 } elsif (exists $es{$seq}) {
2116                         # C escape sequence, aka character escape code
2117                         return $es{$seq};
2118                 }
2119                 # quoted ordinary character
2120                 return $seq;
2121         }
2122
2123         if ($str =~ m/^"(.*)"$/) {
2124                 # needs unquoting
2125                 $str = $1;
2126                 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
2127         }
2128         return $str;
2129 }
2130
2131 # escape tabs (convert tabs to spaces)
2132 sub untabify {
2133         my $line = shift;
2134
2135         while ((my $pos = index($line, "\t")) != -1) {
2136                 if (my $count = (8 - ($pos % 8))) {
2137                         my $spaces = ' ' x $count;
2138                         $line =~ s/\t/$spaces/;
2139                 }
2140         }
2141
2142         return $line;
2143 }
2144
2145 sub project_in_list {
2146         my $project = shift;
2147         my @list = git_get_projects_list();
2148         return @list && scalar(grep { $_->{'path'} eq $project } @list);
2149 }
2150
2151 sub cached_page_precondition_check {
2152         my $action = shift;
2153         return 1 unless
2154                 $action eq 'summary' &&
2155                 $projlist_cache_lifetime > 0 &&
2156                 gitweb_check_feature('forks');
2157
2158         # Note that ALL the 'forkchange' logic is in this function.
2159         # It does NOT belong in cached_action_page NOR in cached_action_start
2160         # NOR in cached_action_finish.  None of those functions should know anything
2161         # about nor do anything to any of the 'forkchange'/"$action.forkchange" files.
2162
2163         # besides the basic 'changed' "$action.changed" check, we may only use
2164         # a summary cache if:
2165         #
2166         #   1) we are not using a project list cache file
2167         #   -OR-
2168         #   2) we are not using the 'forks' feature
2169         #   -OR-
2170         #   3) there is no 'forkchange' nor "$action.forkchange" file in $html_cache_dir
2171         #   -OR-
2172         #   4) there is no cache file ("$cache_dir/$projlist_cache_name")
2173         #   -OR-
2174         #   5) the OLDER of 'forkchange'/"$action.forkchange" is NEWER than the cache file
2175         #
2176         # Otherwise we must re-generate the cache because we've had a fork change
2177         # (either a fork was added or a fork was removed) AND the change has been
2178         # picked up in the cache file AND we've not got that in our cached copy
2179         #
2180         # For (5) regenerating the cached page wouldn't get us anything if the project
2181         # cache file is older than the 'forkchange'/"$action.forkchange" because the
2182         # forks information comes from the project cache file and it's clearly not
2183         # picked up the changes yet so we may continue to use a cached page until it does.
2184
2185         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2186         my $fc_mt = (stat("$htmlcd/forkchange"))[9];
2187         my $afc_mt = (stat("$htmlcd/$action.forkchange"))[9];
2188         return 1 unless defined($fc_mt) || defined($afc_mt);
2189         my $prj_mt = (stat("$cache_dir/$projlist_cache_name"))[9];
2190         return 1 unless $prj_mt;
2191         my $old_mt = $fc_mt;
2192         $old_mt = $afc_mt if !defined($old_mt) || (defined($afc_mt) && $afc_mt < $old_mt);
2193         return 1 if $old_mt > $prj_mt;
2194
2195         # We're going to regenerate the cached page because we know the project cache
2196         # has new fork information that we cannot possibly have in our cached copy.
2197         #
2198         # However, if both 'forkchange' and "$action.forkchange" exist and one of
2199         # them is older than the project cache and one of them is newer, we still
2200         # need to regenerate the page cache, but we will also need to do it again
2201         # in the future because there's yet another fork update not yet in the cache.
2202         #
2203         # So we make sure to touch "$action.changed" to force a cache regeneration
2204         # and then we remove either or both of 'forkchange'/"$action.forkchange" if
2205         # they're older than the project cache (they've served their purpose, we're
2206         # forcing a page regeneration by touching "$action.changed" but the project
2207         # cache was rebuilt since then so there are no more pending fork updates to
2208         # pick up in the future and they need to go).
2209
2210         # For best results, the external code that touches 'forkchange' should always
2211         # touch 'forkchange' and additionally touch 'summary.forkchange' but only
2212         # if it does not already exist.  That way the cached page will be regenerated
2213         # each time it's requested and ANY fork updates are available in the proj
2214         # cache rather than waiting until they all are before updating.
2215
2216         # Note that we take a shortcut here and will zap 'forkchange' since we know
2217         # that it only affects the 'summary' cache.  If, in the future, it affects
2218         # other cache types, it will first need to be propogated down to
2219         # "$action.forkchange" for those types before we zap it.
2220
2221         my $fd;
2222         open $fd, '>', "$htmlcd/$action.changed" and close $fd;
2223         $fc_mt=undef, unlink "$htmlcd/forkchange" if defined $fc_mt && $fc_mt < $prj_mt;
2224         $afc_mt=undef, unlink "$htmlcd/$action.forkchange" if defined $afc_mt && $afc_mt < $prj_mt;
2225
2226         # Now we propagate 'forkchange' to "$action.forkchange" if we have the
2227         # one and not the other.
2228
2229         if (defined $fc_mt && ! defined $afc_mt) {
2230                 open $fd, '>', "$htmlcd/$action.forkchange" and close $fd;
2231                 -e "$htmlcd/$action.forkchange" and
2232                 utime($fc_mt, $fc_mt, "$htmlcd/$action.forkchange") and
2233                 unlink "$htmlcd/forkchange";
2234         }
2235
2236         return 0;
2237 }
2238
2239 sub cached_action_page {
2240         my $action = shift;
2241
2242         return undef unless $action && $html_cache_actions{$action} && $html_cache_dir;
2243         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2244         return undef if -e "$htmlcd/changed" || -e "$htmlcd/$action.changed";
2245         return undef unless cached_page_precondition_check($action);
2246         open my $fd, '<', "$htmlcd/$action" or return undef;
2247         binmode $fd;
2248         local $/;
2249         my $cached_page = <$fd>;
2250         close $fd or return undef;
2251         return $cached_page;
2252 }
2253
2254 package Git::Gitweb::CacheFile;
2255
2256 sub TIEHANDLE {
2257         use POSIX qw(:fcntl_h);
2258         my $class = shift;
2259         my $cachefile = shift;
2260
2261         sysopen(my $self, $cachefile, O_WRONLY|O_CREAT|O_EXCL, 0664)
2262                 or return undef;
2263         $$self->{'cachefile'} = $cachefile;
2264         $$self->{'opened'} = 1;
2265         $$self->{'contents'} = '';
2266         return bless $self, $class;
2267 }
2268
2269 sub CLOSE {
2270         my $self = shift;
2271         if ($$self->{'opened'}) {
2272                 $$self->{'opened'} = 0;
2273                 my $result = close $self;
2274                 unlink $$self->{'cachefile'} unless $result;
2275                 return $result;
2276         }
2277         return 0;
2278 }
2279
2280 sub DESTROY {
2281         my $self = shift;
2282         if ($$self->{'opened'}) {
2283                 $self->CLOSE() and unlink $$self->{'cachefile'};
2284         }
2285 }
2286
2287 sub PRINT {
2288         my $self = shift;
2289         @_ = (map {my $x=$_; utf8::encode($x); $x} @_) unless $fcgi_raw_mode;
2290         print $self @_ if $$self->{'opened'};
2291         $$self->{'contents'} .= join('', @_);
2292         return 1;
2293 }
2294
2295 sub PRINTF {
2296         my $self = shift;
2297         my $template = shift;
2298         return $self->PRINT(sprintf $template, @_);
2299 }
2300
2301 sub contents {
2302         my $self = shift;
2303         return $$self->{'contents'};
2304 }
2305
2306 package main;
2307
2308 # Caller is responsible for preserving STDOUT beforehand if needed
2309 sub cached_action_start {
2310         my $action = shift;
2311
2312         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2313         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2314         return undef unless -d $htmlcd;
2315         if (-e "$htmlcd/changed") {
2316                 foreach my $cacheable (keys(%html_cache_actions)) {
2317                         next unless $supported_cache_actions{$cacheable} &&
2318                                     $html_cache_actions{$cacheable};
2319                         my $fd;
2320                         open $fd, '>', "$htmlcd/$cacheable.changed"
2321                         and close $fd;
2322                 }
2323                 unlink "$htmlcd/changed";
2324         }
2325         local *CACHEFILE;
2326         tie *CACHEFILE, 'Git::Gitweb::CacheFile', "$htmlcd/$action.lock"  or return undef;
2327         *STDOUT = *CACHEFILE;
2328         unlink "$htmlcd/$action", "$htmlcd/$action.changed";
2329         return 1;
2330 }
2331
2332 # Caller is responsible for restoring STDOUT afterward if needed
2333 sub cached_action_finish {
2334         my $action = shift;
2335
2336         use File::Spec;
2337
2338         my $obj = tied *STDOUT;
2339         return undef unless ref($obj) eq 'Git::Gitweb::CacheFile';
2340         my $cached_page = $obj->contents;
2341         (my $result = close(STDOUT)) or warn "couldn't close cache file on STDOUT: $!";
2342         # Do not leave STDOUT file descriptor invalid!
2343         local *NULL;
2344         open(NULL, '>', File::Spec->devnull) or die "couldn't open NULL to devnull: $!";
2345         *STDOUT = *NULL;
2346         return $cached_page unless $result;
2347         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2348         return $cached_page unless -d $htmlcd;
2349         unlink "$htmlcd/$action.lock" unless rename "$htmlcd/$action.lock", "$htmlcd/$action";
2350         return $cached_page;
2351 }
2352
2353 my %expand_pi_subs;
2354 BEGIN {%expand_pi_subs = (
2355         'age_string'               => \&age_string,
2356         'age_string_date'          => \&age_string_date,
2357         'age_string_age'           => \&age_string_age,
2358         'compute_timed_interval'   => \&compute_timed_interval,
2359         'compute_commands_count'   => \&compute_commands_count,
2360         'format_lastrefresh_row'   => \&format_lastrefresh_row,
2361         'compute_stylesheet_links' => \&compute_stylesheet_links,
2362 )}
2363
2364 # Expands any <?gitweb...> processing instructions and returns the result
2365 sub expand_gitweb_pi {
2366         my $page = shift;
2367         $page .= '';
2368         my @time_now = gettimeofday();
2369         $page =~ s{<\?gitweb(?:\s+([^\s>]+)([^>]*))?\s*\?>}
2370                   {defined($1) ?
2371                           (ref($expand_pi_subs{$1}) eq 'CODE' ?
2372                                   $expand_pi_subs{$1}->(split(' ',$2), @time_now) :
2373                                   '') :
2374                           '' }goes;
2375         return $page;
2376 }
2377
2378 ## ----------------------------------------------------------------------
2379 ## HTML aware string manipulation
2380
2381 # Try to chop given string on a word boundary between position
2382 # $len and $len+$add_len. If there is no word boundary there,
2383 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
2384 # (marking chopped part) would be longer than given string.
2385 sub chop_str {
2386         my $str = shift;
2387         my $len = shift;
2388         my $add_len = shift || 10;
2389         my $where = shift || 'right'; # 'left' | 'center' | 'right'
2390
2391         # Make sure perl knows it is utf8 encoded so we don't
2392         # cut in the middle of a utf8 multibyte char.
2393         $str = to_utf8($str);
2394
2395         # allow only $len chars, but don't cut a word if it would fit in $add_len
2396         # if it doesn't fit, cut it if it's still longer than the dots we would add
2397         # remove chopped character entities entirely
2398
2399         # when chopping in the middle, distribute $len into left and right part
2400         # return early if chopping wouldn't make string shorter
2401         if ($where eq 'center') {
2402                 return $str if ($len + 5 >= length($str)); # filler is length 5
2403                 $len = int($len/2);
2404         } else {
2405                 return $str if ($len + 4 >= length($str)); # filler is length 4
2406         }
2407
2408         # regexps: ending and beginning with word part up to $add_len
2409         my $endre = qr/.{$len}\w{0,$add_len}/;
2410         my $begre = qr/\w{0,$add_len}.{$len}/;
2411
2412         if ($where eq 'left') {
2413                 $str =~ m/^(.*?)($begre)$/;
2414                 my ($lead, $body) = ($1, $2);
2415                 if (length($lead) > 4) {
2416                         $lead = " ...";
2417                 }
2418                 return "$lead$body";
2419
2420         } elsif ($where eq 'center') {
2421                 $str =~ m/^($endre)(.*)$/;
2422                 my ($left, $str)  = ($1, $2);
2423                 $str =~ m/^(.*?)($begre)$/;
2424                 my ($mid, $right) = ($1, $2);
2425                 if (length($mid) > 5) {
2426                         $mid = " ... ";
2427                 }
2428                 return "$left$mid$right";
2429
2430         } else {
2431                 $str =~ m/^($endre)(.*)$/;
2432                 my $body = $1;
2433                 my $tail = $2;
2434                 if (length($tail) > 4) {
2435                         $tail = "... ";
2436                 }
2437                 return "$body$tail";
2438         }
2439 }
2440
2441 # pass-through email filter, obfuscating it when possible
2442 sub email_obfuscate {
2443         our $email;
2444         my ($str) = @_;
2445         if ($email) {
2446                 $str = $email->escape_html($str);
2447                 # Stock HTML::Email::Obfuscate version likes to produce
2448                 # invalid XHTML...
2449                 $str =~ s#<(/?)B>#<$1b>#g;
2450                 return $str;
2451         } else {
2452                 $str = esc_html($str);
2453                 $str =~ s/@/&#x40;/;
2454                 return $str;
2455         }
2456 }
2457
2458 # takes the same arguments as chop_str, but also wraps a <span> around the
2459 # result with a title attribute if it does get chopped. Additionally, the
2460 # string is HTML-escaped.
2461 sub chop_and_escape_str {
2462         my ($str) = @_;
2463
2464         my $chopped = chop_str(@_);
2465         $str = to_utf8($str);
2466         if ($chopped eq $str) {
2467                 return email_obfuscate($chopped);
2468         } else {
2469                 use bytes;
2470                 $str =~ s/[[:cntrl:]]/?/g;
2471                 return $cgi->span({-title=>$str}, email_obfuscate($chopped));
2472         }
2473 }
2474
2475 # Highlight selected fragments of string, using given CSS class,
2476 # and escape HTML.  It is assumed that fragments do not overlap.
2477 # Regions are passed as list of pairs (array references).
2478 #
2479 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
2480 # '<span class="mark">foo</span>bar'
2481 sub esc_html_hl_regions {
2482         my ($str, $css_class, @sel) = @_;
2483         my %opts = grep { ref($_) ne 'ARRAY' } @sel;
2484         @sel     = grep { ref($_) eq 'ARRAY' } @sel;
2485         return esc_html($str, %opts) unless @sel;
2486
2487         my $out = '';
2488         my $pos = 0;
2489
2490         for my $s (@sel) {
2491                 my ($begin, $end) = @$s;
2492
2493                 # Don't create empty <span> elements.
2494                 next if $end <= $begin;
2495
2496                 my $escaped = esc_html(substr($str, $begin, $end - $begin),
2497                                        %opts);
2498
2499                 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
2500                         if ($begin - $pos > 0);
2501                 $out .= $cgi->span({-class => $css_class}, $escaped);
2502
2503                 $pos = $end;
2504         }
2505         $out .= esc_html(substr($str, $pos), %opts)
2506                 if ($pos < length($str));
2507
2508         return $out;
2509 }
2510
2511 # return positions of beginning and end of each match
2512 sub matchpos_list {
2513         my ($str, $regexp) = @_;
2514         return unless (defined $str && defined $regexp);
2515
2516         my @matches;
2517         while ($str =~ /$regexp/g) {
2518                 push @matches, [$-[0], $+[0]];
2519         }
2520         return @matches;
2521 }
2522
2523 # highlight match (if any), and escape HTML
2524 sub esc_html_match_hl {
2525         my ($str, $regexp) = @_;
2526         return esc_html($str) unless defined $regexp;
2527
2528         my @matches = matchpos_list($str, $regexp);
2529         return esc_html($str) unless @matches;
2530
2531         return esc_html_hl_regions($str, 'match', @matches);
2532 }
2533
2534
2535 # highlight match (if any) of shortened string, and escape HTML
2536 sub esc_html_match_hl_chopped {
2537         my ($str, $chopped, $regexp) = @_;
2538         return esc_html_match_hl($str, $regexp) unless defined $chopped;
2539
2540         my @matches = matchpos_list($str, $regexp);
2541         return esc_html($chopped) unless @matches;
2542
2543         # filter matches so that we mark chopped string
2544         my $tail = "... "; # see chop_str
2545         unless ($chopped =~ s/\Q$tail\E$//) {
2546                 $tail = '';
2547         }
2548         my $chop_len = length($chopped);
2549         my $tail_len = length($tail);
2550         my @filtered;
2551
2552         for my $m (@matches) {
2553                 if ($m->[0] > $chop_len) {
2554                         push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
2555                         last;
2556                 } elsif ($m->[1] > $chop_len) {
2557                         push @filtered, [ $m->[0], $chop_len + $tail_len ];
2558                         last;
2559                 }
2560                 push @filtered, $m;
2561         }
2562
2563         return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
2564 }
2565
2566 ## ----------------------------------------------------------------------
2567 ## functions returning short strings
2568
2569 # CSS class for given age epoch value (in seconds)
2570 # and reference time (optional, defaults to now) as second value
2571 sub age_class {
2572         my ($age_epoch, $time_now) = @_;
2573         return "noage" unless defined $age_epoch;
2574         defined $time_now or $time_now = time;
2575         my $age = $time_now - $age_epoch;
2576
2577         if ($age < 60*60*2) {
2578                 return "age0";
2579         } elsif ($age < 60*60*24*2) {
2580                 return "age1";
2581         } else {
2582                 return "age2";
2583         }
2584 }
2585
2586 # convert age epoch in seconds to "nn units ago" string
2587 # reference time used is now unless second argument passed in
2588 # to get the old behavior, pass 0 as the first argument and
2589 # the time in seconds as the second
2590 sub age_string {
2591         my ($age_epoch, $time_now) = @_;
2592         return "unknown" unless defined $age_epoch;
2593         return "<?gitweb age_string $age_epoch?>" if $cache_mode_active;
2594         defined $time_now or $time_now = time;
2595         my $age = $time_now - $age_epoch;
2596         my $age_str;
2597
2598         if ($age > 60*60*24*365*2) {
2599                 $age_str = (int $age/60/60/24/365);
2600                 $age_str .= " years ago";
2601         } elsif ($age > 60*60*24*(365/12)*2) {
2602                 $age_str = int $age/60/60/24/(365/12);
2603                 $age_str .= " months ago";
2604         } elsif ($age > 60*60*24*7*2) {
2605                 $age_str = int $age/60/60/24/7;
2606                 $age_str .= " weeks ago";
2607         } elsif ($age > 60*60*24*2) {
2608                 $age_str = int $age/60/60/24;
2609                 $age_str .= " days ago";
2610         } elsif ($age > 60*60*2) {
2611                 $age_str = int $age/60/60;
2612                 $age_str .= " hours ago";
2613         } elsif ($age > 60*2) {
2614                 $age_str = int $age/60;
2615                 $age_str .= " min ago";
2616         } elsif ($age > 2) {
2617                 $age_str = int $age;
2618                 $age_str .= " sec ago";
2619         } else {
2620                 $age_str .= " right now";
2621         }
2622         return $age_str;
2623 }
2624
2625 # returns age_string if the age is <= 2 weeks otherwise an absolute date
2626 # this is typically shown to the user directly with the age_string_age as a title
2627 sub age_string_date {
2628         my ($age_epoch, $time_now) = @_;
2629         return "unknown" unless defined $age_epoch;
2630         return "<?gitweb age_string_date $age_epoch?>" if $cache_mode_active;
2631         defined $time_now or $time_now = time;
2632         my $age = $time_now - $age_epoch;
2633
2634         if ($age > 60*60*24*7*2) {
2635                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2636                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2637         } else {
2638                 return age_string($age_epoch, $time_now);
2639         }
2640 }
2641
2642 # returns an absolute date if the age is <= 2 weeks otherwise age_string
2643 # this is typically used for the 'title' attribute so it will show as a tooltip
2644 sub age_string_age {
2645         my ($age_epoch, $time_now) = @_;
2646         return "unknown" unless defined $age_epoch;
2647         return "<?gitweb age_string_age $age_epoch?>" if $cache_mode_active;
2648         defined $time_now or $time_now = time;
2649         my $age = $time_now - $age_epoch;
2650
2651         if ($age > 60*60*24*7*2) {
2652                 return age_string($age_epoch, $time_now);
2653         } else {
2654                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2655                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2656         }
2657 }
2658
2659 use constant {
2660         S_IFINVALID => 0030000,
2661         S_IFGITLINK => 0160000,
2662 };
2663
2664 # submodule/subproject, a commit object reference
2665 sub S_ISGITLINK {
2666         my $mode = shift;
2667
2668         return (($mode & S_IFMT) == S_IFGITLINK)
2669 }
2670
2671 # convert file mode in octal to symbolic file mode string
2672 sub mode_str {
2673         my $mode = oct shift;
2674
2675         if (S_ISGITLINK($mode)) {
2676                 return 'm---------';
2677         } elsif (S_ISDIR($mode & S_IFMT)) {
2678                 return 'drwxr-xr-x';
2679         } elsif (S_ISLNK($mode)) {
2680                 return 'lrwxrwxrwx';
2681         } elsif (S_ISREG($mode)) {
2682                 # git cares only about the executable bit
2683                 if ($mode & S_IXUSR) {
2684                         return '-rwxr-xr-x';
2685                 } else {
2686                         return '-rw-r--r--';
2687                 };
2688         } else {
2689                 return '----------';
2690         }
2691 }
2692
2693 # convert file mode in octal to file type string
2694 sub file_type {
2695         my $mode = shift;
2696
2697         if ($mode !~ m/^[0-7]+$/) {
2698                 return $mode;
2699         } else {
2700                 $mode = oct $mode;
2701         }
2702
2703         if (S_ISGITLINK($mode)) {
2704                 return "submodule";
2705         } elsif (S_ISDIR($mode & S_IFMT)) {
2706                 return "directory";
2707         } elsif (S_ISLNK($mode)) {
2708                 return "symlink";
2709         } elsif (S_ISREG($mode)) {
2710                 return "file";
2711         } else {
2712                 return "unknown";
2713         }
2714 }
2715
2716 # convert file mode in octal to file type description string
2717 sub file_type_long {
2718         my $mode = shift;
2719
2720         if ($mode !~ m/^[0-7]+$/) {
2721                 return $mode;
2722         } else {
2723                 $mode = oct $mode;
2724         }
2725
2726         if (S_ISGITLINK($mode)) {
2727                 return "submodule";
2728         } elsif (S_ISDIR($mode & S_IFMT)) {
2729                 return "directory";
2730         } elsif (S_ISLNK($mode)) {
2731                 return "symlink";
2732         } elsif (S_ISREG($mode)) {
2733                 if ($mode & S_IXUSR) {
2734                         return "executable";
2735                 } else {
2736                         return "file";
2737                 };
2738         } else {
2739                 return "unknown";
2740         }
2741 }
2742
2743
2744 ## ----------------------------------------------------------------------
2745 ## functions returning short HTML fragments, or transforming HTML fragments
2746 ## which don't belong to other sections
2747
2748 # format line of commit message.
2749 sub format_log_line_html {
2750         my $line = shift;
2751
2752         $line = esc_html($line, -nbsp=>1);
2753         $line =~ s{\b([0-9a-fA-F]{8,40})\b}{
2754                 $cgi->a({-href => href(action=>"object", hash=>$1),
2755                                         -class => "text"}, $1);
2756         }eg unless $line =~ /^\s*git-svn-id:/;
2757
2758         return $line;
2759 }
2760
2761 # format marker of refs pointing to given object
2762
2763 # the destination action is chosen based on object type and current context:
2764 # - for annotated tags, we choose the tag view unless it's the current view
2765 #   already, in which case we go to shortlog view
2766 # - for other refs, we keep the current view if we're in history, shortlog or
2767 #   log view, and select shortlog otherwise
2768 sub format_ref_marker {
2769         my ($refs, $id) = @_;
2770         my $markers = '';
2771
2772         if (defined $refs->{$id}) {
2773                 foreach my $ref (@{$refs->{$id}}) {
2774                         # this code exploits the fact that non-lightweight tags are the
2775                         # only indirect objects, and that they are the only objects for which
2776                         # we want to use tag instead of shortlog as action
2777                         my ($type, $name) = qw();
2778                         my $indirect = ($ref =~ s/\^\{\}$//);
2779                         # e.g. tags/v2.6.11 or heads/next
2780                         if ($ref =~ m!^(.*?)s?/(.*)$!) {
2781                                 $type = $1;
2782                                 $name = $2;
2783                         } else {
2784                                 $type = "ref";
2785                                 $name = $ref;
2786                         }
2787
2788                         my $class = $type;
2789                         $class .= " indirect" if $indirect;
2790
2791                         my $dest_action = "shortlog";
2792
2793                         if ($indirect) {
2794                                 $dest_action = "tag" unless $action eq "tag";
2795                         } elsif ($action =~ /^(history|(short)?log)$/) {
2796                                 $dest_action = $action;
2797                         }
2798
2799                         my $dest = "";
2800                         $dest .= "refs/" unless $ref =~ m!^refs/!;
2801                         $dest .= $ref;
2802
2803                         my $link = $cgi->a({
2804                                 -href => href(
2805                                         action=>$dest_action,
2806                                         hash=>$dest
2807                                 )}, $name);
2808
2809                         $markers .= "<span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2810                                 $link . "</span>";
2811                 }
2812         }
2813
2814         if ($markers) {
2815                 return '<span class="refs">'. $markers . '</span>';
2816         } else {
2817                 return "";
2818         }
2819 }
2820
2821 # format, perhaps shortened and with markers, title line
2822 sub format_subject_html {
2823         my ($long, $short, $href, $extra) = @_;
2824         $extra = '' unless defined($extra);
2825
2826         if (length($short) < length($long)) {
2827                 use bytes;
2828                 $long =~ s/[[:cntrl:]]/?/g;
2829                 return $cgi->a({-href => $href, -class => "list subject",
2830                                 -title => to_utf8($long)},
2831                        esc_html($short)) . $extra;
2832         } else {
2833                 return $cgi->a({-href => $href, -class => "list subject"},
2834                        esc_html($long)) . $extra;
2835         }
2836 }
2837
2838 # Rather than recomputing the url for an email multiple times, we cache it
2839 # after the first hit. This gives a visible benefit in views where the avatar
2840 # for the same email is used repeatedly (e.g. shortlog).
2841 # The cache is shared by all avatar engines (currently gravatar only), which
2842 # are free to use it as preferred. Since only one avatar engine is used for any
2843 # given page, there's no risk for cache conflicts.
2844 our %avatar_cache = ();
2845
2846 # Compute the picon url for a given email, by using the picon search service over at
2847 # http://www.cs.indiana.edu/picons/search.html
2848 sub picon_url {
2849         my $email = lc shift;
2850         if (!$avatar_cache{$email}) {
2851                 my ($user, $domain) = split('@', $email);
2852                 $avatar_cache{$email} =
2853                         "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2854                         "$domain/$user/" .
2855                         "users+domains+unknown/up/single";
2856         }
2857         return $avatar_cache{$email};
2858 }
2859
2860 # Compute the gravatar url for a given email, if it's not in the cache already.
2861 # Gravatar stores only the part of the URL before the size, since that's the
2862 # one computationally more expensive. This also allows reuse of the cache for
2863 # different sizes (for this particular engine).
2864 sub gravatar_url {
2865         my $email = lc shift;
2866         my $size = shift;
2867         $avatar_cache{$email} ||=
2868                 "//www.gravatar.com/avatar/" .
2869                         Digest::MD5::md5_hex($email) . "?s=";
2870         return $avatar_cache{$email} . $size;
2871 }
2872
2873 # Insert an avatar for the given $email at the given $size if the feature
2874 # is enabled.
2875 sub git_get_avatar {
2876         my ($email, %opts) = @_;
2877         my $pre_white  = ($opts{-pad_before} ? "&#160;" : "");
2878         my $post_white = ($opts{-pad_after}  ? "&#160;" : "");
2879         $opts{-size} ||= 'default';
2880         my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2881         my $url = "";
2882         if ($git_avatar eq 'gravatar') {
2883                 $url = gravatar_url($email, $size);
2884         } elsif ($git_avatar eq 'picon') {
2885                 $url = picon_url($email);
2886         }
2887         # Other providers can be added by extending the if chain, defining $url
2888         # as needed. If no variant puts something in $url, we assume avatars
2889         # are completely disabled/unavailable.
2890         if ($url) {
2891                 return $pre_white .
2892                        "<img width=\"$size\" " .
2893                             "class=\"avatar\" " .
2894                             "src=\"".esc_url($url)."\" " .
2895                             "alt=\"\" " .
2896                        "/>" . $post_white;
2897         } else {
2898                 return "";
2899         }
2900 }
2901
2902 sub format_search_author {
2903         my ($author, $searchtype, $displaytext) = @_;
2904         my $have_search = gitweb_check_feature('search');
2905
2906         if ($have_search) {
2907                 my $performed = "";
2908                 if ($searchtype eq 'author') {
2909                         $performed = "authored";
2910                 } elsif ($searchtype eq 'committer') {
2911                         $performed = "committed";
2912                 }
2913
2914                 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2915                                 searchtext=>$author,
2916                                 searchtype=>$searchtype), class=>"list",
2917                                 title=>"Search for commits $performed by $author"},
2918                                 $displaytext);
2919
2920         } else {
2921                 return $displaytext;
2922         }
2923 }
2924
2925 # format the author name of the given commit with the given tag
2926 # the author name is chopped and escaped according to the other
2927 # optional parameters (see chop_str).
2928 sub format_author_html {
2929         my $tag = shift;
2930         my $co = shift;
2931         my $author = chop_and_escape_str($co->{'author_name'}, @_);
2932         return "<$tag class=\"author\">" .
2933                format_search_author($co->{'author_name'}, "author",
2934                        git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2935                        $author) .
2936                "</$tag>";
2937 }
2938
2939 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
2940 sub format_git_diff_header_line {
2941         my $line = shift;
2942         my $diffinfo = shift;
2943         my ($from, $to) = @_;
2944
2945         if ($diffinfo->{'nparents'}) {
2946                 # combined diff
2947                 $line =~ s!^(diff (.*?) )"?.*$!$1!;
2948                 if ($to->{'href'}) {
2949                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2950                                          esc_path($to->{'file'}));
2951                 } else { # file was deleted (no href)
2952                         $line .= esc_path($to->{'file'});
2953                 }
2954         } else {
2955                 # "ordinary" diff
2956                 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
2957                 if ($from->{'href'}) {
2958                         $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
2959                                          'a/' . esc_path($from->{'file'}));
2960                 } else { # file was added (no href)
2961                         $line .= 'a/' . esc_path($from->{'file'});
2962                 }
2963                 $line .= ' ';
2964                 if ($to->{'href'}) {
2965                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2966                                          'b/' . esc_path($to->{'file'}));
2967                 } else { # file was deleted
2968                         $line .= 'b/' . esc_path($to->{'file'});
2969                 }
2970         }
2971
2972         return "<div class=\"diff header\">$line</div>\n";
2973 }
2974
2975 # format extended diff header line, before patch itself
2976 sub format_extended_diff_header_line {
2977         my $line = shift;
2978         my $diffinfo = shift;
2979         my ($from, $to) = @_;
2980
2981         # match <path>
2982         if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
2983                 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2984                                        esc_path($from->{'file'}));
2985         }
2986         if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
2987                 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2988                                  esc_path($to->{'file'}));
2989         }
2990         # match single <mode>
2991         if ($line =~ m/\s(\d{6})$/) {
2992                 $line .= '<span class="info"> (' .
2993                          file_type_long($1) .
2994                          ')</span>';
2995         }
2996         # match <hash>
2997         if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
2998                 # can match only for combined diff
2999                 $line = 'index ';
3000                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3001                         if ($from->{'href'}[$i]) {
3002                                 $line .= $cgi->a({-href=>$from->{'href'}[$i],
3003                                                   -class=>"hash"},
3004                                                  substr($diffinfo->{'from_id'}[$i],0,7));
3005                         } else {
3006                                 $line .= '0' x 7;
3007                         }
3008                         # separator
3009                         $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
3010                 }
3011                 $line .= '..';
3012                 if ($to->{'href'}) {
3013                         $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
3014                                          substr($diffinfo->{'to_id'},0,7));
3015                 } else {
3016                         $line .= '0' x 7;
3017                 }
3018
3019         } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
3020                 # can match only for ordinary diff
3021                 my ($from_link, $to_link);
3022                 if ($from->{'href'}) {
3023                         $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
3024                                              substr($diffinfo->{'from_id'},0,7));
3025                 } else {
3026                         $from_link = '0' x 7;
3027                 }
3028                 if ($to->{'href'}) {
3029                         $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
3030                                            substr($diffinfo->{'to_id'},0,7));
3031                 } else {
3032                         $to_link = '0' x 7;
3033                 }
3034                 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
3035                 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
3036         }
3037
3038         return $line . "<br/>\n";
3039 }
3040
3041 # format from-file/to-file diff header
3042 sub format_diff_from_to_header {
3043         my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
3044         my $line;
3045         my $result = '';
3046
3047         $line = $from_line;
3048         #assert($line =~ m/^---/) if DEBUG;
3049         # no extra formatting for "^--- /dev/null"
3050         if (! $diffinfo->{'nparents'}) {
3051                 # ordinary (single parent) diff
3052                 if ($line =~ m!^--- "?a/!) {
3053                         if ($from->{'href'}) {
3054                                 $line = '--- a/' .
3055                                         $cgi->a({-href=>$from->{'href'}, -class=>"path"},
3056                                                 esc_path($from->{'file'}));
3057                         } else {
3058                                 $line = '--- a/' .
3059                                         esc_path($from->{'file'});
3060                         }
3061                 }
3062                 $result .= qq!<div class="diff from_file">$line</div>\n!;
3063
3064         } else {
3065                 # combined diff (merge commit)
3066                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3067                         if ($from->{'href'}[$i]) {
3068                                 $line = '--- ' .
3069                                         $cgi->a({-href=>href(action=>"blobdiff",
3070                                                              hash_parent=>$diffinfo->{'from_id'}[$i],
3071                                                              hash_parent_base=>$parents[$i],
3072                                                              file_parent=>$from->{'file'}[$i],
3073                                                              hash=>$diffinfo->{'to_id'},
3074                                                              hash_base=>$hash,
3075                                                              file_name=>$to->{'file'}),
3076                                                  -class=>"path",
3077                                                  -title=>"diff" . ($i+1)},
3078                                                 $i+1) .
3079                                         '/' .
3080                                         $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
3081                                                 esc_path($from->{'file'}[$i]));
3082                         } else {
3083                                 $line = '--- /dev/null';
3084                         }
3085                         $result .= qq!<div class="diff from_file">$line</div>\n!;
3086                 }
3087         }
3088
3089         $line = $to_line;
3090         #assert($line =~ m/^\+\+\+/) if DEBUG;
3091         # no extra formatting for "^+++ /dev/null"
3092         if ($line =~ m!^\+\+\+ "?b/!) {
3093                 if ($to->{'href'}) {
3094                         $line = '+++ b/' .
3095                                 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3096                                         esc_path($to->{'file'}));
3097                 } else {
3098                         $line = '+++ b/' .
3099                                 esc_path($to->{'file'});
3100                 }
3101         }
3102         $result .= qq!<div class="diff to_file">$line</div>\n!;
3103
3104         return $result;
3105 }
3106
3107 # create note for patch simplified by combined diff
3108 sub format_diff_cc_simplified {
3109         my ($diffinfo, @parents) = @_;
3110         my $result = '';
3111
3112         $result .= "<div class=\"diff header\">" .
3113                    "diff --cc ";
3114         if (!is_deleted($diffinfo)) {
3115                 $result .= $cgi->a({-href => href(action=>"blob",
3116                                                   hash_base=>$hash,
3117                                                   hash=>$diffinfo->{'to_id'},
3118                                                   file_name=>$diffinfo->{'to_file'}),
3119                                     -class => "path"},
3120                                    esc_path($diffinfo->{'to_file'}));
3121         } else {
3122                 $result .= esc_path($diffinfo->{'to_file'});
3123         }
3124         $result .= "</div>\n" . # class="diff header"
3125                    "<div class=\"diff nodifferences\">" .
3126                    "Simple merge" .
3127                    "</div>\n"; # class="diff nodifferences"
3128
3129         return $result;
3130 }
3131
3132 sub diff_line_class {
3133         my ($line, $from, $to) = @_;
3134
3135         # ordinary diff
3136         my $num_sign = 1;
3137         # combined diff
3138         if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
3139                 $num_sign = scalar @{$from->{'href'}};
3140         }
3141
3142         my @diff_line_classifier = (
3143                 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
3144                 { regexp => qr/^\\/,               class => "incomplete"  },
3145                 { regexp => qr/^ {$num_sign}/,     class => "ctx" },
3146                 # classifier for context must come before classifier add/rem,
3147                 # or we would have to use more complicated regexp, for example
3148                 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
3149                 { regexp => qr/^[+ ]{$num_sign}/,   class => "add" },
3150                 { regexp => qr/^[- ]{$num_sign}/,   class => "rem" },
3151         );
3152         for my $clsfy (@diff_line_classifier) {
3153                 return $clsfy->{'class'}
3154                         if ($line =~ $clsfy->{'regexp'});
3155         }
3156
3157         # fallback
3158         return "";
3159 }
3160
3161 # assumes that $from and $to are defined and correctly filled,
3162 # and that $line holds a line of chunk header for unified diff
3163 sub format_unidiff_chunk_header {
3164         my ($line, $from, $to) = @_;
3165
3166         my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
3167                 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
3168
3169         $from_lines = 0 unless defined $from_lines;
3170         $to_lines   = 0 unless defined $to_lines;
3171
3172         if ($from->{'href'}) {
3173                 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
3174                                      -class=>"list"}, $from_text);
3175         }
3176         if ($to->{'href'}) {
3177                 $to_text   = $cgi->a({-href=>"$to->{'href'}#l$to_start",
3178                                      -class=>"list"}, $to_text);
3179         }
3180         $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
3181                 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3182         return $line;
3183 }
3184
3185 # assumes that $from and $to are defined and correctly filled,
3186 # and that $line holds a line of chunk header for combined diff
3187 sub format_cc_diff_chunk_header {
3188         my ($line, $from, $to) = @_;
3189
3190         my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
3191         my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
3192
3193         @from_text = split(' ', $ranges);
3194         for (my $i = 0; $i < @from_text; ++$i) {
3195                 ($from_start[$i], $from_nlines[$i]) =
3196                         (split(',', substr($from_text[$i], 1)), 0);
3197         }
3198
3199         $to_text   = pop @from_text;
3200         $to_start  = pop @from_start;
3201         $to_nlines = pop @from_nlines;
3202
3203         $line = "<span class=\"chunk_info\">$prefix ";
3204         for (my $i = 0; $i < @from_text; ++$i) {
3205                 if ($from->{'href'}[$i]) {
3206                         $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
3207                                           -class=>"list"}, $from_text[$i]);
3208                 } else {
3209                         $line .= $from_text[$i];
3210                 }
3211                 $line .= " ";
3212         }
3213         if ($to->{'href'}) {
3214                 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
3215                                   -class=>"list"}, $to_text);
3216         } else {
3217                 $line .= $to_text;
3218         }
3219         $line .= " $prefix</span>" .
3220                  "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3221         return $line;
3222 }
3223
3224 # process patch (diff) line (not to be used for diff headers),
3225 # returning HTML-formatted (but not wrapped) line.
3226 # If the line is passed as a reference, it is treated as HTML and not
3227 # esc_html()'ed.
3228 sub format_diff_line {
3229         my ($line, $diff_class, $from, $to) = @_;
3230
3231         if (ref($line)) {
3232                 $line = $$line;
3233         } else {
3234                 chomp $line;
3235                 $line = untabify($line);
3236
3237                 if ($from && $to && $line =~ m/^\@{2} /) {
3238                         $line = format_unidiff_chunk_header($line, $from, $to);
3239                 } elsif ($from && $to && $line =~ m/^\@{3}/) {
3240                         $line = format_cc_diff_chunk_header($line, $from, $to);
3241                 } else {
3242                         $line = esc_html($line, -nbsp=>1);
3243                 }
3244         }
3245
3246         my $diff_classes = "diff diff_body";
3247         $diff_classes .= " $diff_class" if ($diff_class);
3248         $line = "<div class=\"$diff_classes\">$line</div>\n";
3249
3250         return $line;
3251 }
3252
3253 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
3254 # linked.  Pass the hash of the tree/commit to snapshot.
3255 sub format_snapshot_links {
3256         my ($hash) = @_;
3257         my $num_fmts = @snapshot_fmts;
3258         if ($num_fmts > 1) {
3259                 # A parenthesized list of links bearing format names.
3260                 # e.g. "snapshot (_tar.gz_ _zip_)"
3261                 return "<span class=\"snapshots\">snapshot (" . join(' ', map
3262                         $cgi->a({
3263                                 -href => href(
3264                                         action=>"snapshot",
3265                                         hash=>$hash,
3266                                         snapshot_format=>$_
3267                                 )
3268                         }, $known_snapshot_formats{$_}{'display'})
3269                 , @snapshot_fmts) . ")</span>";
3270         } elsif ($num_fmts == 1) {
3271                 # A single "snapshot" link whose tooltip bears the format name.
3272                 # i.e. "_snapshot_"
3273                 my ($fmt) = @snapshot_fmts;
3274                 return "<span class=\"snapshots\">" .
3275                         $cgi->a({
3276                                 -href => href(
3277                                         action=>"snapshot",
3278                                         hash=>$hash,
3279                                         snapshot_format=>$fmt
3280                                 ),
3281                                 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
3282                         }, "snapshot") . "</span>";
3283         } else { # $num_fmts == 0
3284                 return undef;
3285         }
3286 }
3287
3288 ## ......................................................................
3289 ## functions returning values to be passed, perhaps after some
3290 ## transformation, to other functions; e.g. returning arguments to href()
3291
3292 # returns hash to be passed to href to generate gitweb URL
3293 # in -title key it returns description of link
3294 sub get_feed_info {
3295         my $format = shift || 'Atom';
3296         my %res = (action => lc($format));
3297         my $matched_ref = 0;
3298
3299         # feed links are possible only for project views
3300         return unless (defined $project);
3301         # some views should link to OPML, or to generic project feed,
3302         # or don't have specific feed yet (so they should use generic)
3303         return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
3304
3305         my $branch = undef;
3306         # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
3307         # (fullname) to differentiate from tag links; this also makes
3308         # possible to detect branch links
3309         for my $ref (get_branch_refs()) {
3310                 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
3311                     (defined $hash      && $hash      =~ m!^refs/\Q$ref\E/(.*)$!)) {
3312                         $branch = $1;
3313                         $matched_ref = $ref;
3314                         last;
3315                 }
3316         }
3317         # find log type for feed description (title)
3318         my $type = 'log';
3319         if (defined $file_name) {
3320                 $type  = "history of $file_name";
3321                 $type .= "/" if ($action eq 'tree');
3322                 $type .= " on '$branch'" if (defined $branch);
3323         } else {
3324                 $type = "log of $branch" if (defined $branch);
3325         }
3326
3327         $res{-title} = $type;
3328         $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
3329         $res{'file_name'} = $file_name;
3330
3331         return %res;
3332 }
3333
3334 ## ----------------------------------------------------------------------
3335 ## git utility subroutines, invoking git commands
3336
3337 # returns path to the core git executable and the --git-dir parameter as list
3338 sub git_cmd {
3339         $number_of_git_cmds++;
3340         return $GIT, '--git-dir='.$git_dir;
3341 }
3342
3343 # opens a "-|" cmd pipe handle with 2>/dev/null and returns it
3344 sub cmd_pipe {
3345
3346         # In order to be compatible with FCGI mode we must use POSIX
3347         # and access the STDERR_FILENO file descriptor directly
3348
3349         use POSIX qw(STDERR_FILENO dup dup2);
3350
3351         open(my $null, '>', File::Spec->devnull) or die "couldn't open devnull: $!";
3352         (my $saveerr = dup(STDERR_FILENO)) or die "couldn't dup STDERR: $!";
3353         my $dup2ok = dup2(fileno($null), STDERR_FILENO);
3354         close($null) or !$dup2ok or die "couldn't close NULL: $!";
3355         $dup2ok or POSIX::close($saveerr), die "couldn't dup NULL to STDERR: $!";
3356         my $result = open(my $fd, "-|", @_);
3357         $dup2ok = dup2($saveerr, STDERR_FILENO);
3358         POSIX::close($saveerr) or !$dup2ok or die "couldn't close SAVEERR: $!";
3359         $dup2ok or die "couldn't dup SAVERR to STDERR: $!";
3360
3361         return $result ? $fd : undef;
3362 }
3363
3364 # opens a "-|" git_cmd pipe handle with 2>/dev/null and returns it
3365 sub git_cmd_pipe {
3366         return cmd_pipe git_cmd(), @_;
3367 }
3368
3369 # quote the given arguments for passing them to the shell
3370 # quote_command("command", "arg 1", "arg with ' and ! characters")
3371 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
3372 # Try to avoid using this function wherever possible.
3373 sub quote_command {
3374         return join(' ',
3375                 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
3376 }
3377
3378 # get HEAD ref of given project as hash
3379 sub git_get_head_hash {
3380         return git_get_full_hash(shift, 'HEAD');
3381 }
3382
3383 sub git_get_full_hash {
3384         return git_get_hash(@_);
3385 }
3386
3387 sub git_get_short_hash {
3388         return git_get_hash(@_, '--short=7');
3389 }
3390
3391 sub git_get_hash {
3392         my ($project, $hash, @options) = @_;
3393         my $o_git_dir = $git_dir;
3394         my $retval = undef;
3395         $git_dir = "$projectroot/$project";
3396         if (defined(my $fd = git_cmd_pipe 'rev-parse',
3397             '--verify', '-q', @options, $hash)) {
3398                 $retval = <$fd>;
3399                 chomp $retval if defined $retval;
3400                 close $fd;
3401         }
3402         if (defined $o_git_dir) {
3403                 $git_dir = $o_git_dir;
3404         }
3405         return $retval;
3406 }
3407
3408 # get type of given object
3409 sub git_get_type {
3410         my $hash = shift;
3411
3412         defined(my $fd = git_cmd_pipe "cat-file", '-t', $hash) or return;
3413         my $type = <$fd>;
3414         close $fd or return;
3415         chomp $type;
3416         return $type;
3417 }
3418
3419 # repository configuration
3420 our $config_file = '';
3421 our %config;
3422
3423 # store multiple values for single key as anonymous array reference
3424 # single values stored directly in the hash, not as [ <value> ]
3425 sub hash_set_multi {
3426         my ($hash, $key, $value) = @_;
3427
3428         if (!exists $hash->{$key}) {
3429                 $hash->{$key} = $value;
3430         } elsif (!ref $hash->{$key}) {
3431                 $hash->{$key} = [ $hash->{$key}, $value ];
3432         } else {
3433                 push @{$hash->{$key}}, $value;
3434         }
3435 }
3436
3437 # return hash of git project configuration
3438 # optionally limited to some section, e.g. 'gitweb'
3439 sub git_parse_project_config {
3440         my $section_regexp = shift;
3441         my %config;
3442
3443         local $/ = "\0";
3444
3445         defined(my $fh = git_cmd_pipe "config", '-z', '-l')
3446                 or return;
3447
3448         while (my $keyval = to_utf8(scalar <$fh>)) {
3449                 chomp $keyval;
3450                 my ($key, $value) = split(/\n/, $keyval, 2);
3451
3452                 hash_set_multi(\%config, $key, $value)
3453                         if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
3454         }
3455         close $fh;
3456
3457         return %config;
3458 }
3459
3460 # convert config value to boolean: 'true' or 'false'
3461 # no value, number > 0, 'true' and 'yes' values are true
3462 # rest of values are treated as false (never as error)
3463 sub config_to_bool {
3464         my $val = shift;
3465
3466         return 1 if !defined $val;             # section.key
3467
3468         # strip leading and trailing whitespace
3469         $val =~ s/^\s+//;
3470         $val =~ s/\s+$//;
3471
3472         return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
3473                 ($val =~ /^(?:true|yes)$/i));  # section.key = true
3474 }
3475
3476 # convert config value to simple decimal number
3477 # an optional value suffix of 'k', 'm', or 'g' will cause the value
3478 # to be multiplied by 1024, 1048576, or 1073741824
3479 sub config_to_int {
3480         my $val = shift;
3481
3482         # strip leading and trailing whitespace
3483         $val =~ s/^\s+//;
3484         $val =~ s/\s+$//;
3485
3486         if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
3487                 $unit = lc($unit);
3488                 # unknown unit is treated as 1
3489                 return $num * ($unit eq 'g' ? 1073741824 :
3490                                $unit eq 'm' ?    1048576 :
3491                                $unit eq 'k' ?       1024 : 1);
3492         }
3493         return $val;
3494 }
3495
3496 # convert config value to array reference, if needed
3497 sub config_to_multi {
3498         my $val = shift;
3499
3500         return ref($val) ? $val : (defined($val) ? [ $val ] : []);
3501 }
3502
3503 sub git_get_project_config {
3504         my ($key, $type) = @_;
3505
3506         return unless defined $git_dir;
3507
3508         # key sanity check
3509         return unless ($key);
3510         # only subsection, if exists, is case sensitive,
3511         # and not lowercased by 'git config -z -l'
3512         if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
3513                 $lo =~ s/_//g;
3514                 $key = join(".", lc($hi), $mi, lc($lo));
3515                 return if ($lo =~ /\W/ || $hi =~ /\W/);
3516         } else {
3517                 $key = lc($key);
3518                 $key =~ s/_//g;
3519                 return if ($key =~ /\W/);
3520         }
3521         $key =~ s/^gitweb\.//;
3522
3523         # type sanity check
3524         if (defined $type) {
3525                 $type =~ s/^--//;
3526                 $type = undef
3527                         unless ($type eq 'bool' || $type eq 'int');
3528         }
3529
3530         # get config
3531         if (!defined $config_file ||
3532             $config_file ne "$git_dir/config") {
3533                 %config = git_parse_project_config('gitweb');
3534                 $config_file = "$git_dir/config";
3535         }
3536
3537         # check if config variable (key) exists
3538         return unless exists $config{"gitweb.$key"};
3539
3540         # ensure given type
3541         if (!defined $type) {
3542                 return $config{"gitweb.$key"};
3543         } elsif ($type eq 'bool') {
3544                 # backward compatibility: 'git config --bool' returns true/false
3545                 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
3546         } elsif ($type eq 'int') {
3547                 return config_to_int($config{"gitweb.$key"});
3548         }
3549         return $config{"gitweb.$key"};
3550 }
3551
3552 # get hash of given path at given ref
3553 sub git_get_hash_by_path {
3554         my $base = shift;
3555         my $path = shift || return undef;
3556         my $type = shift;
3557
3558         $path =~ s,/+$,,;
3559
3560         defined(my $fd = git_cmd_pipe "ls-tree", $base, "--", $path)
3561                 or die_error(500, "Open git-ls-tree failed");
3562         my $line = to_utf8(scalar <$fd>);
3563         close $fd or return undef;
3564
3565         if (!defined $line) {
3566                 # there is no tree or hash given by $path at $base
3567                 return undef;
3568         }
3569
3570         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3571         $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
3572         if (defined $type && $type ne $2) {
3573                 # type doesn't match
3574                 return undef;
3575         }
3576         return $3;
3577 }
3578
3579 # get path of entry with given hash at given tree-ish (ref)
3580 # used to get 'from' filename for combined diff (merge commit) for renames
3581 sub git_get_path_by_hash {
3582         my $base = shift || return;
3583         my $hash = shift || return;
3584
3585         local $/ = "\0";
3586
3587         defined(my $fd = git_cmd_pipe "ls-tree", '-r', '-t', '-z', $base)
3588                 or return undef;
3589         while (my $line = to_utf8(scalar <$fd>)) {
3590                 chomp $line;
3591
3592                 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423  gitweb'
3593                 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f  gitweb/README'
3594                 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
3595                         close $fd;
3596                         return $1;
3597                 }
3598         }
3599         close $fd;
3600         return undef;
3601 }
3602
3603 ## ......................................................................
3604 ## git utility functions, directly accessing git repository
3605
3606 # get the value of config variable either from file named as the variable
3607 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
3608 # configuration variable in the repository config file.
3609 sub git_get_file_or_project_config {
3610         my ($path, $name) = @_;
3611
3612         $git_dir = "$projectroot/$path";
3613         open my $fd, '<', "$git_dir/$name"
3614                 or return git_get_project_config($name);
3615         my $conf = to_utf8(scalar <$fd>);
3616         close $fd;
3617         if (defined $conf) {
3618                 chomp $conf;
3619         }
3620         return $conf;
3621 }
3622
3623 sub git_get_project_description {
3624         my $path = shift;
3625         return git_get_file_or_project_config($path, 'description');
3626 }
3627
3628 sub git_get_project_category {
3629         my $path = shift;
3630         return git_get_file_or_project_config($path, 'category');
3631 }
3632
3633
3634 # supported formats:
3635 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
3636 #   - if its contents is a number, use it as tag weight,
3637 #   - otherwise add a tag with weight 1
3638 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
3639 #   the same value multiple times increases tag weight
3640 # * `gitweb.ctag' multi-valued repo config variable
3641 sub git_get_project_ctags {
3642         my $project = shift;
3643         my $ctags = {};
3644
3645         $git_dir = "$projectroot/$project";
3646         if (opendir my $dh, "$git_dir/ctags") {
3647                 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
3648                 foreach my $tagfile (@files) {
3649                         open my $ct, '<', $tagfile
3650                                 or next;
3651                         my $val = <$ct>;
3652                         chomp $val if $val;
3653                         close $ct;
3654
3655                         (my $ctag = $tagfile) =~ s#.*/##;
3656                         $ctag = to_utf8($ctag);
3657                         if ($val =~ /^\d+$/) {
3658                                 $ctags->{$ctag} = $val;
3659                         } else {
3660                                 $ctags->{$ctag} = 1;
3661                         }
3662                 }
3663                 closedir $dh;
3664
3665         } elsif (open my $fh, '<', "$git_dir/ctags") {
3666                 while (my $line = to_utf8(scalar <$fh>)) {
3667                         chomp $line;
3668                         $ctags->{$line}++ if $line;
3669                 }
3670                 close $fh;
3671
3672         } else {
3673                 my $taglist = config_to_multi(git_get_project_config('ctag'));
3674                 foreach my $tag (@$taglist) {
3675                         $ctags->{$tag}++;
3676                 }
3677         }
3678
3679         return $ctags;
3680 }
3681
3682 # return hash, where keys are content tags ('ctags'),
3683 # and values are sum of weights of given tag in every project
3684 sub git_gather_all_ctags {
3685         my $projects = shift;
3686         my $ctags = {};
3687
3688         foreach my $p (@$projects) {
3689                 foreach my $ct (keys %{$p->{'ctags'}}) {
3690                         $ctags->{$ct} += $p->{'ctags'}->{$ct};
3691                 }
3692         }
3693
3694         return $ctags;
3695 }
3696
3697 sub git_populate_project_tagcloud {
3698         my ($ctags, $action) = @_;
3699
3700         # First, merge different-cased tags; tags vote on casing
3701         my %ctags_lc;
3702         foreach (keys %$ctags) {
3703                 $ctags_lc{lc $_}->{count} += $ctags->{$_};
3704                 if (not $ctags_lc{lc $_}->{topcount}
3705                     or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
3706                         $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
3707                         $ctags_lc{lc $_}->{topname} = $_;
3708                 }
3709         }
3710
3711         my $cloud;
3712         my $matched = $input_params{'ctag_filter'};
3713         if (eval { require HTML::TagCloud; 1; }) {
3714                 $cloud = HTML::TagCloud->new;
3715                 foreach my $ctag (sort keys %ctags_lc) {
3716                         # Pad the title with spaces so that the cloud looks
3717                         # less crammed.
3718                         my $title = esc_html($ctags_lc{$ctag}->{topname});
3719                         $title =~ s/ /&#160;/g;
3720                         $title =~ s/^/&#160;/g;
3721                         $title =~ s/$/&#160;/g;
3722                         if (defined $matched && $matched eq $ctag) {
3723                                 $title = qq(<span class="match">$title</span>);
3724                         }
3725                         $cloud->add($title, href(-replay=>1, action=>$action, ctag_filter=>$ctag),
3726                                     $ctags_lc{$ctag}->{count});
3727                 }
3728         } else {
3729                 $cloud = {};
3730                 foreach my $ctag (keys %ctags_lc) {
3731                         my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3732                         if (defined $matched && $matched eq $ctag) {
3733                                 $title = qq(<span class="match">$title</span>);
3734                         }
3735                         $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3736                         $cloud->{$ctag}{ctag} =
3737                                 $cgi->a({-href=>href(-replay=>1, action=>$action, ctag_filter=>$ctag)}, $title);
3738                 }
3739         }
3740         return $cloud;
3741 }
3742
3743 sub git_show_project_tagcloud {
3744         my ($cloud, $count) = @_;
3745         if (ref $cloud eq 'HTML::TagCloud') {
3746                 return $cloud->html_and_css($count);
3747         } else {
3748                 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3749                 return
3750                         '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3751                         join (', ', map {
3752                                 $cloud->{$_}->{'ctag'}
3753                         } splice(@tags, 0, $count)) .
3754                         '</div>';
3755         }
3756 }
3757
3758 sub git_get_project_url_list {
3759         my $path = shift;
3760
3761         $git_dir = "$projectroot/$path";
3762         open my $fd, '<', "$git_dir/cloneurl"
3763                 or return wantarray ?
3764                 @{ config_to_multi(git_get_project_config('url')) } :
3765                    config_to_multi(git_get_project_config('url'));
3766         my @git_project_url_list = map { chomp; to_utf8($_) } <$fd>;
3767         close $fd;
3768
3769         return wantarray ? @git_project_url_list : \@git_project_url_list;
3770 }
3771
3772 sub git_get_projects_list {
3773         my $filter = shift || '';
3774         my $paranoid = shift;
3775         my @list;
3776
3777         if (-d $projects_list) {
3778                 # search in directory
3779                 my $dir = $projects_list;
3780                 # remove the trailing "/"
3781                 $dir =~ s!/+$!!;
3782                 my $pfxlen = length("$dir");
3783                 my $pfxdepth = ($dir =~ tr!/!!);
3784                 # when filtering, search only given subdirectory
3785                 if ($filter && !$paranoid) {
3786                         $dir .= "/$filter";
3787                         $dir =~ s!/+$!!;
3788                 }
3789
3790                 File::Find::find({
3791                         follow_fast => 1, # follow symbolic links
3792                         follow_skip => 2, # ignore duplicates
3793                         dangling_symlinks => 0, # ignore dangling symlinks, silently
3794                         wanted => sub {
3795                                 # global variables
3796                                 our $project_maxdepth;
3797                                 our $projectroot;
3798                                 # skip project-list toplevel, if we get it.
3799                                 return if (m!^[/.]$!);
3800                                 # only directories can be git repositories
3801                                 return unless (-d $_);
3802                                 # don't traverse too deep (Find is super slow on os x)
3803                                 # $project_maxdepth excludes depth of $projectroot
3804                                 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3805                                         $File::Find::prune = 1;
3806                                         return;
3807                                 }
3808
3809                                 my $path = substr($File::Find::name, $pfxlen + 1);
3810                                 # paranoidly only filter here
3811                                 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3812                                         next;
3813                                 }
3814                                 # we check related file in $projectroot
3815                                 if (check_export_ok("$projectroot/$path")) {
3816                                         push @list, { path => $path };
3817                                         $File::Find::prune = 1;
3818                                 }
3819                         },
3820                 }, "$dir");
3821
3822         } elsif (-f $projects_list) {
3823                 # read from file(url-encoded):
3824                 # 'git%2Fgit.git Linus+Torvalds'
3825                 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3826                 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3827                 open my $fd, '<', $projects_list or return;
3828         PROJECT:
3829                 while (my $line = <$fd>) {
3830                         chomp $line;
3831                         my ($path, $owner) = split ' ', $line;
3832                         $path = unescape($path);
3833                         $owner = unescape($owner);
3834                         if (!defined $path) {
3835                                 next;
3836                         }
3837                         # if $filter is rpovided, check if $path begins with $filter
3838                         if ($filter && $path !~ m!^\Q$filter\E/!) {
3839                                 next;
3840                         }
3841                         if (check_export_ok("$projectroot/$path")) {
3842                                 my $pr = {
3843                                         path => $path
3844                                 };
3845                                 if ($owner) {
3846                                         $pr->{'owner'} = to_utf8($owner);
3847                                 }
3848                                 push @list, $pr;
3849                         }
3850                 }
3851                 close $fd;
3852         }
3853         return @list;
3854 }
3855
3856 # written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
3857 # as side effects it sets 'forks' field to list of forks for forked projects
3858 sub filter_forks_from_projects_list {
3859         my $projects = shift;
3860
3861         my %trie; # prefix tree of directories (path components)
3862         # generate trie out of those directories that might contain forks
3863         foreach my $pr (@$projects) {
3864                 my $path = $pr->{'path'};
3865                 $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
3866                 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3867                 next unless ($path);      # skip '.git' repository: tests, git-instaweb
3868                 next unless (-d "$projectroot/$path"); # containing directory exists
3869                 $pr->{'forks'} = [];      # there can be 0 or more forks of project
3870
3871                 # add to trie
3872                 my @dirs = split('/', $path);
3873                 # walk the trie, until either runs out of components or out of trie
3874                 my $ref = \%trie;
3875                 while (scalar @dirs &&
3876                        exists($ref->{$dirs[0]})) {
3877                         $ref = $ref->{shift @dirs};
3878                 }
3879                 # create rest of trie structure from rest of components
3880                 foreach my $dir (@dirs) {
3881                         $ref = $ref->{$dir} = {};
3882                 }
3883                 # create end marker, store $pr as a data
3884                 $ref->{''} = $pr if (!exists $ref->{''});
3885         }
3886
3887         # filter out forks, by finding shortest prefix match for paths
3888         my @filtered;
3889  PROJECT:
3890         foreach my $pr (@$projects) {
3891                 # trie lookup
3892                 my $ref = \%trie;
3893         DIR:
3894                 foreach my $dir (split('/', $pr->{'path'})) {
3895                         if (exists $ref->{''}) {
3896                                 # found [shortest] prefix, is a fork - skip it
3897                                 push @{$ref->{''}{'forks'}}, $pr;
3898                                 next PROJECT;
3899                         }
3900                         if (!exists $ref->{$dir}) {
3901                                 # not in trie, cannot have prefix, not a fork
3902                                 push @filtered, $pr;
3903                                 next PROJECT;
3904                         }
3905                         # If the dir is there, we just walk one step down the trie.
3906                         $ref = $ref->{$dir};
3907                 }
3908                 # we ran out of trie
3909                 # (shouldn't happen: it's either no match, or end marker)
3910                 push @filtered, $pr;
3911         }
3912
3913         return @filtered;
3914 }
3915
3916 # note: fill_project_list_info must be run first,
3917 # for 'descr_long' and 'ctags' to be filled
3918 sub search_projects_list {
3919         my ($projlist, %opts) = @_;
3920         my $tagfilter  = $opts{'tagfilter'};
3921         my $search_re = $opts{'search_regexp'};
3922
3923         return @$projlist
3924                 unless ($tagfilter || $search_re);
3925
3926         # searching projects require filling to be run before it;
3927         fill_project_list_info($projlist,
3928                                $tagfilter  ? 'ctags' : (),
3929                                $search_re ? ('path', 'descr') : ());
3930         my @projects;
3931  PROJECT:
3932         foreach my $pr (@$projlist) {
3933
3934                 if ($tagfilter) {
3935                         next unless ref($pr->{'ctags'}) eq 'HASH';
3936                         next unless
3937                                 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3938                 }
3939
3940                 if ($search_re) {
3941                         my $path = $pr->{'path'};
3942                         $path =~ s/\.git$//; # should not be included in search
3943                         next unless
3944                                 $path =~ /$search_re/ ||
3945                                 $pr->{'descr_long'} =~ /$search_re/;
3946                 }
3947
3948                 push @projects, $pr;
3949         }
3950
3951         return @projects;
3952 }
3953
3954 our $gitweb_project_owner = undef;
3955 sub git_get_project_list_from_file {
3956
3957         return if (defined $gitweb_project_owner);
3958
3959         $gitweb_project_owner = {};
3960         # read from file (url-encoded):
3961         # 'git%2Fgit.git Linus+Torvalds'
3962         # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3963         # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3964         if (-f $projects_list) {
3965                 open(my $fd, '<', $projects_list);
3966                 while (my $line = <$fd>) {
3967                         chomp $line;
3968                         my ($pr, $ow) = split ' ', $line;
3969                         $pr = unescape($pr);
3970                         $ow = unescape($ow);
3971                         $gitweb_project_owner->{$pr} = to_utf8($ow);
3972                 }
3973                 close $fd;
3974         }
3975 }
3976
3977 sub git_get_project_owner {
3978         my $proj = shift;
3979         my $owner;
3980
3981         return undef unless $proj;
3982         $git_dir = "$projectroot/$proj";
3983
3984         if (defined $project && $proj eq $project) {
3985                 $owner = git_get_project_config('owner');
3986         }
3987         if (!defined $owner && !defined $gitweb_project_owner) {
3988                 git_get_project_list_from_file();
3989         }
3990         if (!defined $owner && exists $gitweb_project_owner->{$proj}) {
3991                 $owner = $gitweb_project_owner->{$proj};
3992         }
3993         if (!defined $owner && (!defined $project || $proj ne $project)) {
3994                 $owner = git_get_project_config('owner');
3995         }
3996         if (!defined $owner) {
3997                 $owner = get_file_owner("$git_dir");
3998         }
3999
4000         return $owner;
4001 }
4002
4003 sub parse_activity_date {
4004         my $dstr = shift;
4005
4006         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
4007                 # Unix timestamp
4008                 return 0 + $1;
4009         }
4010         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt _](\d{1,2}):(\d{2}):(\d{2})(?:[ _]?([Zz]|(?:[-+]\d{1,2}:?\d{2})))?\s*$/) {
4011                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
4012                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, $Y-1900);
4013                 defined($z) && $z ne '' or $z = 'Z';
4014                 $z =~ s/://;
4015                 substr($z,1,0) = '0' if length($z) == 4;
4016                 my $off = 0;
4017                 if (uc($z) ne 'Z') {
4018                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
4019                         $off = -$off if substr($z,0,1) eq '-';
4020                 }
4021                 return $seconds - $off;
4022         }
4023         return undef;
4024 }
4025
4026 # If $quick is true only look at $lastactivity_file
4027 sub git_get_last_activity {
4028         my ($path, $quick) = @_;
4029         my $fd;
4030
4031         $git_dir = "$projectroot/$path";
4032         if ($lastactivity_file && open($fd, "<", "$git_dir/$lastactivity_file")) {
4033                 my $activity = <$fd>;
4034                 close $fd;
4035                 return (undef) unless defined $activity;
4036                 chomp $activity;
4037                 return (undef) if $activity eq '';
4038                 if (my $timestamp = parse_activity_date($activity)) {
4039                         return ($timestamp);
4040                 }
4041         }
4042         return (undef) if $quick;
4043         defined($fd = git_cmd_pipe 'for-each-ref',
4044              '--format=%(committer)',
4045              '--sort=-committerdate',
4046              '--count=1',
4047              map { "refs/$_" } get_branch_refs ()) or return;
4048         my $most_recent = <$fd>;
4049         close $fd or return (undef);
4050         if (defined $most_recent &&
4051             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
4052                 my $timestamp = $1;
4053                 return ($timestamp);
4054         }
4055         return (undef);
4056 }
4057
4058 # Implementation note: when a single remote is wanted, we cannot use 'git
4059 # remote show -n' because that command always work (assuming it's a remote URL
4060 # if it's not defined), and we cannot use 'git remote show' because that would
4061 # try to make a network roundtrip. So the only way to find if that particular
4062 # remote is defined is to walk the list provided by 'git remote -v' and stop if
4063 # and when we find what we want.
4064 sub git_get_remotes_list {
4065         my $wanted = shift;
4066         my %remotes = ();
4067
4068         my $fd = git_cmd_pipe 'remote', '-v';
4069         return unless $fd;
4070         while (my $remote = to_utf8(scalar <$fd>)) {
4071                 chomp $remote;
4072                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
4073                 next if $wanted and not $remote eq $wanted;
4074                 my ($url, $key) = ($1, $2);
4075
4076                 $remotes{$remote} ||= { 'heads' => [] };
4077                 $remotes{$remote}{$key} = $url;
4078         }
4079         close $fd or return;
4080         return wantarray ? %remotes : \%remotes;
4081 }
4082
4083 # Takes a hash of remotes as first parameter and fills it by adding the
4084 # available remote heads for each of the indicated remotes.
4085 sub fill_remote_heads {
4086         my $remotes = shift;
4087         my @heads = map { "remotes/$_" } keys %$remotes;
4088         my @remoteheads = git_get_heads_list(undef, @heads);
4089         foreach my $remote (keys %$remotes) {
4090                 $remotes->{$remote}{'heads'} = [ grep {
4091                         $_->{'name'} =~ s!^$remote/!!
4092                         } @remoteheads ];
4093         }
4094 }
4095
4096 sub git_get_references {
4097         my $type = shift || "";
4098         my %refs;
4099         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
4100         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
4101         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
4102                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
4103                 or return;
4104
4105         while (my $line = to_utf8(scalar <$fd>)) {
4106                 chomp $line;
4107                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
4108                         if (defined $refs{$1}) {
4109                                 push @{$refs{$1}}, $2;
4110                         } else {
4111                                 $refs{$1} = [ $2 ];
4112                         }
4113                 }
4114         }
4115         close $fd or return;
4116         return \%refs;
4117 }
4118
4119 sub git_get_rev_name_tags {
4120         my $hash = shift || return undef;
4121
4122         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
4123                 or return;
4124         my $name_rev = to_utf8(scalar <$fd>);
4125         close $fd;
4126
4127         if ($name_rev =~ m|^$hash tags/(.*)$|) {
4128                 return $1;
4129         } else {
4130                 # catches also '$hash undefined' output
4131                 return undef;
4132         }
4133 }
4134
4135 ## ----------------------------------------------------------------------
4136 ## parse to hash functions
4137
4138 sub parse_date {
4139         my $epoch = shift;
4140         my $tz = shift || "-0000";
4141
4142         my %date;
4143         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
4144         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
4145         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
4146         $date{'hour'} = $hour;
4147         $date{'minute'} = $min;
4148         $date{'mday'} = $mday;
4149         $date{'day'} = $days[$wday];
4150         $date{'month'} = $months[$mon];
4151         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
4152                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
4153         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
4154                              $mday, $months[$mon], $hour ,$min;
4155         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
4156                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
4157
4158         my ($tz_sign, $tz_hour, $tz_min) =
4159                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
4160         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
4161         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
4162         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
4163         $date{'hour_local'} = $hour;
4164         $date{'minute_local'} = $min;
4165         $date{'mday_local'} = $mday;
4166         $date{'tz_local'} = $tz;
4167         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
4168                                   1900+$year, $mon+1, $mday,
4169                                   $hour, $min, $sec, $tz);
4170         return %date;
4171 }
4172
4173 sub parse_file_date {
4174         my $file = shift;
4175         my $mtime = (stat("$projectroot/$project/$file"))[9];
4176         return () unless defined $mtime;
4177         my $tzoffset = timegm((localtime($mtime))[0..5]) - $mtime;
4178         my $tzstring = '+';
4179         if ($tzoffset <= 0) {
4180                 $tzstring = '-';
4181                 $tzoffset *= -1;
4182         }
4183         $tzoffset = int($tzoffset/60);
4184         $tzstring .= sprintf("%02d%02d", int($tzoffset/60), $tzoffset%60);
4185         return parse_date($mtime, $tzstring);
4186 }
4187
4188 sub parse_tag {
4189         my $tag_id = shift;
4190         my %tag;
4191         my @comment;
4192
4193         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
4194         $tag{'id'} = $tag_id;
4195         while (my $line = to_utf8(scalar <$fd>)) {
4196                 chomp $line;
4197                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
4198                         $tag{'object'} = $1;
4199                 } elsif ($line =~ m/^type (.+)$/) {
4200                         $tag{'type'} = $1;
4201                 } elsif ($line =~ m/^tag (.+)$/) {
4202                         $tag{'name'} = $1;
4203                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
4204                         $tag{'author'} = $1;
4205                         $tag{'author_epoch'} = $2;
4206                         $tag{'author_tz'} = $3;
4207                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4208                                 $tag{'author_name'}  = $1;
4209                                 $tag{'author_email'} = $2;
4210                         } else {
4211                                 $tag{'author_name'} = $tag{'author'};
4212                         }
4213                 } elsif ($line =~ m/--BEGIN/) {
4214                         push @comment, $line;
4215                         last;
4216                 } elsif ($line eq "") {
4217                         last;
4218                 }
4219         }
4220         push @comment, map(to_utf8($_), <$fd>);
4221         $tag{'comment'} = \@comment;
4222         close $fd or return;
4223         if (!defined $tag{'name'}) {
4224                 return
4225         };
4226         return %tag
4227 }
4228
4229 sub parse_commit_text {
4230         my ($commit_text, $withparents) = @_;
4231         my @commit_lines = split '\n', $commit_text;
4232         my %co;
4233
4234         pop @commit_lines; # Remove '\0'
4235
4236         if (! @commit_lines) {
4237                 return;
4238         }
4239
4240         my $header = shift @commit_lines;
4241         if ($header !~ m/^[0-9a-fA-F]{40}/) {
4242                 return;
4243         }
4244         ($co{'id'}, my @parents) = split ' ', $header;
4245         while (my $line = shift @commit_lines) {
4246                 last if $line eq "\n";
4247                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
4248                         $co{'tree'} = $1;
4249                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
4250                         push @parents, $1;
4251                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
4252                         $co{'author'} = to_utf8($1);
4253                         $co{'author_epoch'} = $2;
4254                         $co{'author_tz'} = $3;
4255                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4256                                 $co{'author_name'}  = $1;
4257                                 $co{'author_email'} = $2;
4258                         } else {
4259                                 $co{'author_name'} = $co{'author'};
4260                         }
4261                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
4262                         $co{'committer'} = to_utf8($1);
4263                         $co{'committer_epoch'} = $2;
4264                         $co{'committer_tz'} = $3;
4265                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
4266                                 $co{'committer_name'}  = $1;
4267                                 $co{'committer_email'} = $2;
4268                         } else {
4269                                 $co{'committer_name'} = $co{'committer'};
4270                         }
4271                 }
4272         }
4273         if (!defined $co{'tree'}) {
4274                 return;
4275         };
4276         $co{'parents'} = \@parents;
4277         $co{'parent'} = $parents[0];
4278
4279         @commit_lines = map to_utf8($_), @commit_lines;
4280         foreach my $title (@commit_lines) {
4281                 $title =~ s/^    //;
4282                 if ($title ne "") {
4283                         $co{'title'} = chop_str($title, 80, 5);
4284                         # remove leading stuff of merges to make the interesting part visible
4285                         if (length($title) > 50) {
4286                                 $title =~ s/^Automatic //;
4287                                 $title =~ s/^merge (of|with) /Merge ... /i;
4288                                 if (length($title) > 50) {
4289                                         $title =~ s/(http|rsync):\/\///;
4290                                 }
4291                                 if (length($title) > 50) {
4292                                         $title =~ s/(master|www|rsync)\.//;
4293                                 }
4294                                 if (length($title) > 50) {
4295                                         $title =~ s/kernel.org:?//;
4296                                 }
4297                                 if (length($title) > 50) {
4298                                         $title =~ s/\/pub\/scm//;
4299                                 }
4300                         }
4301                         $co{'title_short'} = chop_str($title, 50, 5);
4302                         last;
4303                 }
4304         }
4305         if (! defined $co{'title'} || $co{'title'} eq "") {
4306                 $co{'title'} = $co{'title_short'} = '(no commit message)';
4307         }
4308         # remove added spaces
4309         foreach my $line (@commit_lines) {
4310                 $line =~ s/^    //;
4311         }
4312         $co{'comment'} = \@commit_lines;
4313
4314         my $age_epoch = $co{'committer_epoch'};
4315         $co{'age_epoch'} = $age_epoch;
4316         my $time_now = time;
4317         $co{'age_string'} = age_string($age_epoch, $time_now);
4318         $co{'age_string_date'} = age_string_date($age_epoch, $time_now);
4319         $co{'age_string_age'} = age_string_age($age_epoch, $time_now);
4320         return %co;
4321 }
4322
4323 sub parse_commit {
4324         my ($commit_id) = @_;
4325         my %co;
4326
4327         local $/ = "\0";
4328
4329         defined(my $fd = git_cmd_pipe "rev-list",
4330                 "--parents",
4331                 "--header",
4332                 "--max-count=1",
4333                 $commit_id,
4334                 "--")
4335                 or die_error(500, "Open git-rev-list failed");
4336         %co = parse_commit_text(<$fd>, 1);
4337         close $fd;
4338
4339         return %co;
4340 }
4341
4342 sub parse_commits {
4343         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
4344         my @cos;
4345
4346         $maxcount ||= 1;
4347         $skip ||= 0;
4348
4349         local $/ = "\0";
4350
4351         defined(my $fd = git_cmd_pipe "rev-list",
4352                 "--header",
4353                 @args,
4354                 ("--max-count=" . $maxcount),
4355                 ("--skip=" . $skip),
4356                 @extra_options,
4357                 $commit_id,
4358                 "--",
4359                 ($filename ? ($filename) : ()))
4360                 or die_error(500, "Open git-rev-list failed");
4361         while (my $line = <$fd>) {
4362                 my %co = parse_commit_text($line);
4363                 push @cos, \%co;
4364         }
4365         close $fd;
4366
4367         return wantarray ? @cos : \@cos;
4368 }
4369
4370 # parse line of git-diff-tree "raw" output
4371 sub parse_difftree_raw_line {
4372         my $line = shift;
4373         my %res;
4374
4375         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
4376         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
4377         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
4378                 $res{'from_mode'} = $1;
4379                 $res{'to_mode'} = $2;
4380                 $res{'from_id'} = $3;
4381                 $res{'to_id'} = $4;
4382                 $res{'status'} = $5;
4383                 $res{'similarity'} = $6;
4384                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
4385                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
4386                 } else {
4387                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
4388                 }
4389         }
4390         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
4391         # combined diff (for merge commit)
4392         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
4393                 $res{'nparents'}  = length($1);
4394                 $res{'from_mode'} = [ split(' ', $2) ];
4395                 $res{'to_mode'} = pop @{$res{'from_mode'}};
4396                 $res{'from_id'} = [ split(' ', $3) ];
4397                 $res{'to_id'} = pop @{$res{'from_id'}};
4398                 $res{'status'} = [ split('', $4) ];
4399                 $res{'to_file'} = unquote($5);
4400         }
4401         # 'c512b523472485aef4fff9e57b229d9d243c967f'
4402         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
4403                 $res{'commit'} = $1;
4404         }
4405
4406         return wantarray ? %res : \%res;
4407 }
4408
4409 # wrapper: return parsed line of git-diff-tree "raw" output
4410 # (the argument might be raw line, or parsed info)
4411 sub parsed_difftree_line {
4412         my $line_or_ref = shift;
4413
4414         if (ref($line_or_ref) eq "HASH") {
4415                 # pre-parsed (or generated by hand)
4416                 return $line_or_ref;
4417         } else {
4418                 return parse_difftree_raw_line($line_or_ref);
4419         }
4420 }
4421
4422 # parse line of git-ls-tree output
4423 sub parse_ls_tree_line {
4424         my $line = shift;
4425         my %opts = @_;
4426         my %res;
4427
4428         if ($opts{'-l'}) {
4429                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
4430                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
4431
4432                 $res{'mode'} = $1;
4433                 $res{'type'} = $2;
4434                 $res{'hash'} = $3;
4435                 $res{'size'} = $4;
4436                 if ($opts{'-z'}) {
4437                         $res{'name'} = $5;
4438                 } else {
4439                         $res{'name'} = unquote($5);
4440                 }
4441         } else {
4442                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
4443                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
4444
4445                 $res{'mode'} = $1;
4446                 $res{'type'} = $2;
4447                 $res{'hash'} = $3;
4448                 if ($opts{'-z'}) {
4449                         $res{'name'} = $4;
4450                 } else {
4451                         $res{'name'} = unquote($4);
4452                 }
4453         }
4454
4455         return wantarray ? %res : \%res;
4456 }
4457
4458 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4459 sub parse_from_to_diffinfo {
4460         my ($diffinfo, $from, $to, @parents) = @_;
4461
4462         if ($diffinfo->{'nparents'}) {
4463                 # combined diff
4464                 $from->{'file'} = [];
4465                 $from->{'href'} = [];
4466                 fill_from_file_info($diffinfo, @parents)
4467                         unless exists $diffinfo->{'from_file'};
4468                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4469                         $from->{'file'}[$i] =
4470                                 defined $diffinfo->{'from_file'}[$i] ?
4471                                         $diffinfo->{'from_file'}[$i] :
4472                                         $diffinfo->{'to_file'};
4473                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4474                                 $from->{'href'}[$i] = href(action=>"blob",
4475                                                            hash_base=>$parents[$i],
4476                                                            hash=>$diffinfo->{'from_id'}[$i],
4477                                                            file_name=>$from->{'file'}[$i]);
4478                         } else {
4479                                 $from->{'href'}[$i] = undef;
4480                         }
4481                 }
4482         } else {
4483                 # ordinary (not combined) diff
4484                 $from->{'file'} = $diffinfo->{'from_file'};
4485                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4486                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4487                                                hash=>$diffinfo->{'from_id'},
4488                                                file_name=>$from->{'file'});
4489                 } else {
4490                         delete $from->{'href'};
4491                 }
4492         }
4493
4494         $to->{'file'} = $diffinfo->{'to_file'};
4495         if (!is_deleted($diffinfo)) { # file exists in result
4496                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4497                                      hash=>$diffinfo->{'to_id'},
4498                                      file_name=>$to->{'file'});
4499         } else {
4500                 delete $to->{'href'};
4501         }
4502 }
4503
4504 ## ......................................................................
4505 ## parse to array of hashes functions
4506
4507 sub git_get_heads_list {
4508         my ($limit, @classes) = @_;
4509         @classes = get_branch_refs() unless @classes;
4510         my @patterns = map { "refs/$_" } @classes;
4511         my @headslist;
4512
4513         defined(my $fd = git_cmd_pipe 'for-each-ref',
4514                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4515                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4516                 @patterns)
4517                 or return;
4518         while (my $line = to_utf8(scalar <$fd>)) {
4519                 my %ref_item;
4520
4521                 chomp $line;
4522                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4523                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4524                 my ($committer, $epoch, $tz) =
4525                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4526                 $ref_item{'fullname'}  = $name;
4527                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4528                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4529                 $ref_item{'name'} = $name;
4530                 # for refs neither in 'heads' nor 'remotes' we want to
4531                 # show their ref dir
4532                 my $ref_dir = (defined $1) ? $1 : '';
4533                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4534                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4535                 }
4536
4537                 $ref_item{'id'}    = $hash;
4538                 $ref_item{'title'} = $title || '(no commit message)';
4539                 $ref_item{'epoch'} = $epoch;
4540                 if ($epoch) {
4541                         $ref_item{'age'} = age_string($ref_item{'epoch'});
4542                 } else {
4543                         $ref_item{'age'} = "unknown";
4544                 }
4545
4546                 push @headslist, \%ref_item;
4547         }
4548         close $fd;
4549
4550         return wantarray ? @headslist : \@headslist;
4551 }
4552
4553 sub git_get_tags_list {
4554         my $limit = shift;
4555         my @tagslist;
4556         my $all = shift || 0;
4557         my $order = shift || $default_refs_order;
4558         my $sortkey = $all && $order eq 'name' ? 'refname' : '-creatordate';
4559
4560         defined(my $fd = git_cmd_pipe 'for-each-ref',
4561                 ($limit ? '--count='.($limit+1) : ()), "--sort=$sortkey",
4562                 '--format=%(objectname) %(objecttype) %(refname) '.
4563                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4564                 ($all ? 'refs' : 'refs/tags'))
4565                 or return;
4566         while (my $line = to_utf8(scalar <$fd>)) {
4567                 my %ref_item;
4568
4569                 chomp $line;
4570                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4571                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4572                 my ($creator, $epoch, $tz) =
4573                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4574                 $ref_item{'fullname'} = $name;
4575                 $name =~ s!^refs/!! if $all;
4576                 $name =~ s!^refs/tags/!! unless $all;
4577
4578                 $ref_item{'type'} = $type;
4579                 $ref_item{'id'} = $id;
4580                 $ref_item{'name'} = $name;
4581                 if ($type eq "tag") {
4582                         $ref_item{'subject'} = $title;
4583                         $ref_item{'reftype'} = $reftype;
4584                         $ref_item{'refid'}   = $refid;
4585                 } else {
4586                         $ref_item{'reftype'} = $type;
4587                         $ref_item{'refid'}   = $id;
4588                 }
4589
4590                 if ($type eq "tag" || $type eq "commit") {
4591                         $ref_item{'epoch'} = $epoch;
4592                         if ($epoch) {
4593                                 $ref_item{'age'} = age_string($ref_item{'epoch'});
4594                         } else {
4595                                 $ref_item{'age'} = "unknown";
4596                         }
4597                 }
4598
4599                 push @tagslist, \%ref_item;
4600         }
4601         close $fd;
4602
4603         return wantarray ? @tagslist : \@tagslist;
4604 }
4605
4606 ## ----------------------------------------------------------------------
4607 ## filesystem-related functions
4608
4609 sub get_file_owner {
4610         my $path = shift;
4611
4612         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4613         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4614         if (!defined $gcos) {
4615                 return undef;
4616         }
4617         my $owner = $gcos;
4618         $owner =~ s/[,;].*$//;
4619         return to_utf8($owner);
4620 }
4621
4622 # assume that file exists
4623 sub insert_file {
4624         my $filename = shift;
4625
4626         open my $fd, '<', $filename;
4627         while (<$fd>) {
4628                 print to_utf8($_);
4629         }
4630         close $fd;
4631 }
4632
4633 # return undef on failure
4634 sub collect_output {
4635         defined(my $fd = cmd_pipe @_) or return undef;
4636         if (eof $fd) {
4637                 close $fd;
4638                 return undef;
4639         }
4640         my $result = join('', map({ to_utf8($_) } <$fd>));
4641         close $fd or return undef;
4642         return $result;
4643 }
4644
4645 # return undef on failure
4646 # return '' if only comments
4647 sub collect_html_file {
4648         my $filename = shift;
4649
4650         open my $fd, '<', $filename or return undef;
4651         my $result = join('', map({ to_utf8($_) } <$fd>));
4652         close $fd or return undef;
4653         return undef unless defined($result);
4654         my $test = $result;
4655         $test =~ s/<!--(?:[^-]|(?:-(?!-)))*-->//gs;
4656         $test =~ s/\s+//s;
4657         return $test eq '' ? '' : $result;
4658 }
4659
4660 ## ......................................................................
4661 ## mimetype related functions
4662
4663 sub mimetype_guess_file {
4664         my $filename = shift;
4665         my $mimemap = shift;
4666         my $rawmode = shift;
4667         -r $mimemap or return undef;
4668
4669         my %mimemap;
4670         open(my $mh, '<', $mimemap) or return undef;
4671         while (<$mh>) {
4672                 next if m/^#/; # skip comments
4673                 my ($mimetype, @exts) = split(/\s+/);
4674                 foreach my $ext (@exts) {
4675                         $mimemap{$ext} = $mimetype;
4676                 }
4677         }
4678         close($mh);
4679
4680         my ($ext, $ans);
4681         $ext = $1 if $filename =~ /\.([^.]*)$/;
4682         $ans = $mimemap{$ext} if $ext;
4683         if (defined $ans) {
4684                 my $l = lc($ans);
4685                 $ans = 'text/html' if $l eq 'application/xhtml+xml';
4686                 if (!$rawmode) {
4687                         $ans = 'text/xml' if $l =~ m!^application/[^\s:;,=]+\+xml$! ||
4688                                              $l eq 'image/svg+xml' ||
4689                                              $l eq 'application/xml-dtd' ||
4690                                              $l eq 'application/xml-external-parsed-entity';
4691                 }
4692         }
4693         return $ans;
4694 }
4695
4696 sub mimetype_guess {
4697         my $filename = shift;
4698         my $rawmode = shift;
4699         my $mime;
4700         $filename =~ /\./ or return undef;
4701
4702         if ($mimetypes_file) {
4703                 my $file = $mimetypes_file;
4704                 if ($file !~ m!^/!) { # if it is relative path
4705                         # it is relative to project
4706                         $file = "$projectroot/$project/$file";
4707                 }
4708                 $mime = mimetype_guess_file($filename, $file, $rawmode);
4709         }
4710         $mime ||= mimetype_guess_file($filename, '/etc/mime.types', $rawmode);
4711         return $mime;
4712 }
4713
4714 sub blob_mimetype {
4715         my $fd = shift;
4716         my $filename = shift;
4717         my $rawmode = shift;
4718         my $mime;
4719
4720         # The -T/-B file operators produce the wrong result unless a perlio
4721         # layer is present when the file handle is a pipe that delivers less
4722         # than 512 bytes of data before reaching EOF.
4723         #
4724         # If we are running in a Perl that uses the stdio layer rather than the
4725         # unix+perlio layers we will end up adding a perlio layer on top of the
4726         # stdio layer and get a second level of buffering.  This is harmless
4727         # and it makes the -T/-B file operators work properly in all cases.
4728
4729         binmode $fd, ":perlio" or die_error(500, "Adding perlio layer failed")
4730                 unless grep /^perlio$/, PerlIO::get_layers($fd);
4731
4732         $mime = mimetype_guess($filename, $rawmode) if defined $filename;
4733
4734         if (!$mime && $filename) {
4735                 if ($filename =~ m/\.html?$/i) {
4736                         $mime = 'text/html';
4737                 } elsif ($filename =~ m/\.xht(?:ml)?$/i) {
4738                         $mime = 'text/html';
4739                 } elsif ($filename =~ m/\.te?xt?$/i) {
4740                         $mime = 'text/plain';
4741                 } elsif ($filename =~ m/\.(?:markdown|md)$/i) {
4742                         $mime = 'text/plain';
4743                 } elsif ($filename =~ m/\.png$/i) {
4744                         $mime = 'image/png';
4745                 } elsif ($filename =~ m/\.gif$/i) {
4746                         $mime = 'image/gif';
4747                 } elsif ($filename =~ m/\.jpe?g$/i) {
4748                         $mime = 'image/jpeg';
4749                 } elsif ($filename =~ m/\.svgz?$/i) {
4750                         $mime = 'image/svg+xml';
4751                 }
4752         }
4753
4754         # just in case
4755         return $default_blob_plain_mimetype || 'application/octet-stream' unless $fd || $mime;
4756
4757         $mime = -T $fd ? 'text/plain' : 'application/octet-stream' unless $mime;
4758
4759         return $mime;
4760 }
4761
4762 sub is_ascii {
4763         use bytes;
4764         my $data = shift;
4765         return scalar($data =~ /^[\x00-\x7f]*$/);
4766 }
4767
4768 sub is_valid_utf8 {
4769         my $data = shift;
4770         return utf8::decode($data);
4771 }
4772
4773 sub extract_html_charset {
4774         return undef unless $_[0] && "$_[0]</head>" =~ m#<head(?:\s+[^>]*)?(?<!/)>(.*?)</head\s*>#is;
4775         my $head = $1;
4776         return $2 if $head =~ m#<meta\s+charset\s*=\s*(['"])\s*([a-z0-9(:)_.+-]+)\s*\1\s*/?>#is;
4777         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) {
4778                 my %kv = (lc($1) => $3, lc($4) => $6);
4779                 my ($he, $c) = (lc($kv{'http-equiv'}), $kv{'content'});
4780                 return $1 if $he && $c && $he eq 'content-type' &&
4781                         $c =~ m!\s*text/html\s*;\s*charset\s*=\s*([a-z0-9(:)_.+-]+)\s*$!is;
4782         }
4783         return undef;
4784 }
4785
4786 sub blob_contenttype {
4787         my ($fd, $file_name, $type) = @_;
4788
4789         $type ||= blob_mimetype($fd, $file_name, 1);
4790         return $type unless $type =~ m!^text/.+!i;
4791         my ($leader, $charset, $htmlcharset);
4792         if ($fd && read($fd, $leader, 32768)) {{
4793                 $charset='US-ASCII' if is_ascii($leader);
4794                 return ("$type; charset=UTF-8", $leader) if !$charset && is_valid_utf8($leader);
4795                 $charset='ISO-8859-1' unless $charset;
4796                 $htmlcharset = extract_html_charset($leader) if $type eq 'text/html';
4797                 if ($htmlcharset && $charset ne 'US-ASCII') {
4798                         $htmlcharset = undef if $htmlcharset =~ /^(?:utf-8|us-ascii)$/i
4799                 }
4800         }}
4801         return ("$type; charset=$htmlcharset", $leader) if $htmlcharset;
4802         my $defcharset = $default_text_plain_charset || '';
4803         $defcharset =~ s/^\s+//;
4804         $defcharset =~ s/\s+$//;
4805         $defcharset = '' if $charset && $charset ne 'US-ASCII' && $defcharset =~ /^(?:utf-8|us-ascii)$/i;
4806         return ("$type; charset=" . ($defcharset || 'ISO-8859-1'), $leader);
4807 }
4808
4809 # peek the first upto 128 bytes off a file handle
4810 sub peek128bytes {
4811         my $fd = shift;
4812
4813         use IO::Handle;
4814         use bytes;
4815
4816         my $prefix128;
4817         return '' unless $fd && read($fd, $prefix128, 128);
4818
4819         # In the general case, we're guaranteed only to be able to ungetc one
4820         # character (provided, of course, we actually got a character first).
4821         #
4822         # However, we know:
4823         #
4824         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4825         #    already been called at least once on the file handle before us
4826         #
4827         # 2) we have an $fd positioned at the start of the input stream and
4828         #    therefore know we were positioned at a buffer boundary before
4829         #    reading the initial upto 128 bytes
4830         #
4831         # 3) the buffer size is at least 512 bytes
4832         #
4833         # 4) we are careful to only unget raw bytes
4834         #
4835         # 5) we are attempting to unget exactly the same number of bytes we got
4836         #
4837         # Given the above conditions we will ALWAYS be able to safely unget
4838         # the $prefix128 value we just got.
4839         #
4840         # In fact, we could read up to 511 bytes and still be sure.
4841         # (Reading 512 might pop us into the next internal buffer, but probably
4842         # not since that could break the always able to unget at least the one
4843         # you just got guarantee.)
4844
4845         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4846
4847         return $prefix128;
4848 }
4849
4850 # guess file syntax for syntax highlighting; return undef if no highlighting
4851 # the name of syntax can (in the future) depend on syntax highlighter used
4852 sub guess_file_syntax {
4853         my ($fd, $mimetype, $file_name) = @_;
4854         return undef unless $fd && defined $file_name &&
4855                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4856         my $basename = basename($file_name, '.in');
4857         return $highlight_basename{$basename}
4858                 if exists $highlight_basename{$basename};
4859
4860         # Peek to see if there's a shebang or xml line.
4861         # We always operate on bytes when testing this.
4862         {
4863                 use bytes;
4864                 my $shebang = peek128bytes($fd);
4865                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4866                         foreach my $key (keys %highlight_shebang) {
4867                                 my $ar = ref($highlight_shebang{$key}) ?
4868                                         $highlight_shebang{$key} :
4869                                         [$highlight_shebang{key}];
4870                                 map {return $key if $shebang =~ /$_/} @$ar;
4871                         }
4872                 }
4873                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4874         }
4875
4876         $basename =~ /\.([^.]*)$/;
4877         my $ext = $1 or return undef;
4878         return $highlight_ext{$ext}
4879                 if exists $highlight_ext{$ext};
4880
4881         return undef;
4882 }
4883
4884 # run highlighter and return FD of its output,
4885 # or return original FD if no highlighting
4886 sub run_highlighter {
4887         my ($fd, $syntax) = @_;
4888         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4889
4890         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4891                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4892                 $to_utf8_pipe_command.
4893                 quote_command($highlight_bin).
4894                 " --replace-tabs=8 --fragment --syntax $syntax")
4895                 or die_error(500, "Couldn't open file or run syntax highlighter");
4896         if (eof $hifd) {
4897                 # just in case, should not happen as we tested !eof($fd) above
4898                 return $fd if close($hifd);
4899
4900                 # should not happen
4901                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4902
4903                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4904                 # instead of dying horribly on this, just skip the highlighting
4905                 # but do output a message about it to STDERR that will end up in the log
4906                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4907                         sprintf("child exit status 0x%x\n", $?);
4908                 return $fd
4909         }
4910         close $fd;
4911         return ($hifd, 1);
4912 }
4913
4914 ## ======================================================================
4915 ## functions printing HTML: header, footer, error page
4916
4917 sub get_page_title {
4918         my $title = to_utf8($site_name);
4919
4920         unless (defined $project) {
4921                 if (defined $project_filter) {
4922                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4923                 }
4924                 return $title;
4925         }
4926         $title .= " - " . to_utf8($project);
4927
4928         return $title unless (defined $action);
4929         my $action_print = $action eq 'blame_incremental' ? 'blame' : $action;
4930         $title .= "/$action_print"; # $action is US-ASCII (7bit ASCII)
4931
4932         return $title unless (defined $file_name);
4933         $title .= " - " . esc_path($file_name);
4934         if ($action eq "tree" && $file_name !~ m|/$|) {
4935                 $title .= "/";
4936         }
4937
4938         return $title;
4939 }
4940
4941 sub get_content_type_html {
4942         # We do not ever emit application/xhtml+xml since that gives us
4943         # no benefits and it makes many browsers (e.g. Firefox) exceedingly
4944         # strict, which is troublesome for example when showing user-supplied
4945         # README.html files.
4946         return 'text/html';
4947 }
4948
4949 sub print_feed_meta {
4950         if (defined $project) {
4951                 my %href_params = get_feed_info();
4952                 if (!exists $href_params{'-title'}) {
4953                         $href_params{'-title'} = 'log';
4954                 }
4955
4956                 foreach my $format (qw(RSS Atom)) {
4957                         my $type = lc($format);
4958                         my %link_attr = (
4959                                 '-rel' => 'alternate',
4960                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
4961                                 '-type' => "application/$type+xml"
4962                         );
4963
4964                         $href_params{'extra_options'} = undef;
4965                         $href_params{'action'} = $type;
4966                         $link_attr{'-href'} = href(%href_params);
4967                         print "<link ".
4968                               "rel=\"$link_attr{'-rel'}\" ".
4969                               "title=\"$link_attr{'-title'}\" ".
4970                               "href=\"$link_attr{'-href'}\" ".
4971                               "type=\"$link_attr{'-type'}\" ".
4972                               "/>\n";
4973
4974                         $href_params{'extra_options'} = '--no-merges';
4975                         $link_attr{'-href'} = href(%href_params);
4976                         $link_attr{'-title'} .= ' (no merges)';
4977                         print "<link ".
4978                               "rel=\"$link_attr{'-rel'}\" ".
4979                               "title=\"$link_attr{'-title'}\" ".
4980                               "href=\"$link_attr{'-href'}\" ".
4981                               "type=\"$link_attr{'-type'}\" ".
4982                               "/>\n";
4983                 }
4984
4985         } else {
4986                 printf('<link rel="alternate" title="%s projects list" '.
4987                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
4988                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
4989                 printf('<link rel="alternate" title="%s projects feeds" '.
4990                        'href="%s" type="text/x-opml" />'."\n",
4991                        esc_attr($site_name), href(project=>undef, action=>"opml"));
4992         }
4993 }
4994
4995 sub compute_stylesheet_links {
4996         return "<?gitweb compute_stylesheet_links?>" if $cache_mode_active;
4997
4998         # include each stylesheet that exists, providing backwards capability
4999         # for those people who defined $stylesheet in a config file
5000         if (defined $stylesheet) {
5001                 return '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
5002         } else {
5003                 my $sheets = '';
5004                 foreach my $stylesheet (@stylesheets) {
5005                         next unless $stylesheet;
5006                         $sheets .= '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
5007                 }
5008                 return $sheets;
5009         }
5010 }
5011
5012 sub print_header_links {
5013         my $status = shift;
5014
5015         print compute_stylesheet_links();
5016         print_feed_meta()
5017                 if ($status eq '200 OK');
5018         if (defined $favicon) {
5019                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
5020         }
5021 }
5022
5023 sub print_nav_breadcrumbs_path {
5024         my $dirprefix = undef;
5025         while (my $part = shift) {
5026                 $dirprefix .= "/" if defined $dirprefix;
5027                 $dirprefix .= $part;
5028                 print $cgi->a({-href => href(project => undef,
5029                                              project_filter => $dirprefix,
5030                                              action => "project_list")},
5031                               esc_html($part)) . " / ";
5032         }
5033 }
5034
5035 sub print_nav_breadcrumbs {
5036         my %opts = @_;
5037
5038         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
5039                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
5040         }
5041         if (defined $project) {
5042                 my @dirname = split '/', $project;
5043                 my $projectbasename = pop @dirname;
5044                 print_nav_breadcrumbs_path(@dirname);
5045                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
5046                 if (defined $action) {
5047                         my $action_print = $action ;
5048                         $action_print = 'blame' if $action_print eq 'blame_incremental';
5049                         if (defined $opts{-action_extra}) {
5050                                 $action_print = $cgi->a({-href => href(action=>$action)},
5051                                         $action);
5052                         }
5053                         print " / $action_print";
5054                 }
5055                 if (defined $opts{-action_extra}) {
5056                         print " / $opts{-action_extra}";
5057                 }
5058                 print "\n";
5059         } elsif (defined $project_filter) {
5060                 print_nav_breadcrumbs_path(split '/', $project_filter);
5061         }
5062 }
5063
5064 sub print_search_form {
5065         if (!defined $searchtext) {
5066                 $searchtext = "";
5067         }
5068         my $search_hash;
5069         if (defined $hash_base) {
5070                 $search_hash = $hash_base;
5071         } elsif (defined $hash) {
5072                 $search_hash = $hash;
5073         } else {
5074                 $search_hash = "HEAD";
5075         }
5076         # We can't use href() here because we need to encode the
5077         # URL parameters into the form, not into the action link.
5078         my $action = $my_uri;
5079         my $use_pathinfo = gitweb_check_feature('pathinfo');
5080         if ($use_pathinfo) {
5081                 # See notes about doubled / in href()
5082                 $action =~ s,/$,,;
5083                 $action .= "/".esc_path_info($project);
5084         }
5085         print $cgi->start_form(-method => "get", -action => $action) .
5086               "<div class=\"search\">\n" .
5087               (!$use_pathinfo &&
5088               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
5089               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
5090               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
5091               $cgi->popup_menu(-name => 'st', -default => 'commit',
5092                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
5093               $cgi->sup($cgi->a({-href => href(action=>"search_help"),
5094                                  -title => "search help" },
5095                                 "<span style=\"padding-bottom:1em\">?&#160;</span>")) . " search:\n",
5096               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
5097               "<span title=\"Extended regular expression\">" .
5098               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5099                              -checked => $search_use_regexp) .
5100               "</span>" .
5101               "</div>" .
5102               $cgi->end_form() . "\n";
5103 }
5104
5105 sub git_header_html {
5106         my $status = shift || "200 OK";
5107         my $expires = shift;
5108         my %opts = @_;
5109
5110         my $title = get_page_title();
5111         my $content_type = get_content_type_html();
5112         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
5113                            -status=> $status, -expires => $expires)
5114                 unless ($opts{'-no_http_header'});
5115         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
5116         print <<EOF;
5117 <?xml version="1.0" encoding="utf-8"?>
5118 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
5119 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
5120 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
5121 <!-- git core binaries version $git_version -->
5122 <head>
5123 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
5124 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
5125 <meta name="robots" content="index, nofollow"/>
5126 <title>$title</title>
5127 <script type="text/javascript">/* <![CDATA[ */
5128 function fixBlameLinks() {
5129         var allLinks = document.getElementsByTagName("a");
5130         for (var i = 0; i < allLinks.length; i++) {
5131                 var link = allLinks.item(i);
5132                 if (link.className == 'blamelink')
5133                         link.href = link.href.replace("/blame/", "/blame_incremental/");
5134         }
5135 }
5136 /* ]]> */</script>
5137 EOF
5138         # the stylesheet, favicon etc urls won't work correctly with path_info
5139         # unless we set the appropriate base URL
5140         if ($ENV{'PATH_INFO'}) {
5141                 print "<base href=\"".esc_url($base_url)."\" />\n";
5142         }
5143         print_header_links($status);
5144
5145         if (defined $site_html_head_string) {
5146                 print to_utf8($site_html_head_string);
5147         }
5148
5149         print "</head>\n" .
5150               "<body><span class=\"body\">\n";
5151
5152         if (defined $site_header && -f $site_header) {
5153                 insert_file($site_header);
5154         }
5155
5156         print "<div class=\"page_header\">\n";
5157         print "<span class=\"logo-container\"><span class=\"logo-default\">";
5158         if (defined $logo) {
5159                 print $cgi->a({-href => esc_url($logo_url),
5160                                -title => $logo_label,
5161                                -class => "logo-link"},
5162                               $cgi->img({-src => esc_url($logo),
5163                                          -width => 72, -height => 27,
5164                                          -alt => "git",
5165                                          -class => "logo"}));
5166         }
5167         print "</span></span><span class=\"banner-container\">";
5168         print_nav_breadcrumbs(%opts);
5169         print "</span></div>\n";
5170
5171         my $have_search = gitweb_check_feature('search');
5172         if (defined $project && $have_search) {
5173                 print_search_form();
5174         }
5175 }
5176
5177 sub compute_timed_interval {
5178         return "<?gitweb compute_timed_interval?>" if $cache_mode_active;
5179         return tv_interval($t0, [ gettimeofday() ]);
5180 }
5181
5182 sub compute_commands_count {
5183         return "<?gitweb compute_commands_count?>" if $cache_mode_active;
5184         my $s = $number_of_git_cmds == 1 ? '' : 's';
5185         return '<span id="generating_cmd">'.
5186                 $number_of_git_cmds.
5187                 "</span> git command$s";
5188 }
5189
5190 sub git_footer_html {
5191         my $feed_class = 'rss_logo';
5192
5193         print "<div class=\"page_footer\">\n";
5194         if (defined $project) {
5195                 my $descr = git_get_project_description($project);
5196                 if (defined $descr) {
5197                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
5198                 }
5199
5200                 my %href_params = get_feed_info();
5201                 if (!%href_params) {
5202                         $feed_class .= ' generic';
5203                 }
5204                 $href_params{'-title'} ||= 'log';
5205
5206                 foreach my $format (qw(RSS Atom)) {
5207                         $href_params{'action'} = lc($format);
5208                         print $cgi->a({-href => href(%href_params),
5209                                       -title => "$href_params{'-title'} $format feed",
5210                                       -class => $feed_class}, $format)."\n";
5211                 }
5212
5213         } else {
5214                 print $cgi->a({-href => href(project=>undef, action=>"opml",
5215                                              project_filter => $project_filter),
5216                               -class => $feed_class}, "OPML") . " ";
5217                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
5218                                              project_filter => $project_filter),
5219                               -class => $feed_class}, "TXT") . "\n";
5220         }
5221         print "</div>\n"; # class="page_footer"
5222
5223         if (defined $t0 && gitweb_check_feature('timed')) {
5224                 print "<div id=\"generating_info\">\n";
5225                 print 'This page took '.
5226                       '<span id="generating_time" class="time_span">'.
5227                       compute_timed_interval().
5228                       ' seconds </span>'.
5229                       ' and '.
5230                       compute_commands_count().
5231                       " to generate.\n";
5232                 print "</div>\n"; # class="page_footer"
5233         }
5234
5235         if (defined $site_footer && -f $site_footer) {
5236                 insert_file($site_footer);
5237         }
5238
5239         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
5240         if (defined $action &&
5241             $action eq 'blame_incremental') {
5242                 print qq!<script type="text/javascript">\n!.
5243                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
5244                       qq!           "!. href() .qq!");\n!.
5245                       qq!</script>\n!;
5246         } else {
5247                 my ($jstimezone, $tz_cookie, $datetime_class) =
5248                         gitweb_get_feature('javascript-timezone');
5249
5250                 print qq!<script type="text/javascript">\n!.
5251                       qq!window.onload = function () {\n!;
5252                 if (gitweb_check_feature('blame_incremental')) {
5253                         print qq!       fixBlameLinks();\n!;
5254                 }
5255                 if (gitweb_check_feature('javascript-actions')) {
5256                         print qq!       fixLinks();\n!;
5257                 }
5258                 if ($jstimezone && $tz_cookie && $datetime_class) {
5259                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
5260                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
5261                 }
5262                 print qq!};\n!.
5263                       qq!</script>\n!;
5264         }
5265
5266         print "</span></body>\n" .
5267               "</html>";
5268 }
5269
5270 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
5271 # Example: die_error(404, 'Hash not found')
5272 # By convention, use the following status codes (as defined in RFC 2616):
5273 # 400: Invalid or missing CGI parameters, or
5274 #      requested object exists but has wrong type.
5275 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
5276 #      this server or project.
5277 # 404: Requested object/revision/project doesn't exist.
5278 # 500: The server isn't configured properly, or
5279 #      an internal error occurred (e.g. failed assertions caused by bugs), or
5280 #      an unknown error occurred (e.g. the git binary died unexpectedly).
5281 # 503: The server is currently unavailable (because it is overloaded,
5282 #      or down for maintenance).  Generally, this is a temporary state.
5283 sub die_error {
5284         my $status = shift || 500;
5285         my $error = esc_html(shift) || "Internal Server Error";
5286         my $extra = shift;
5287         my %opts = @_;
5288
5289         my %http_responses = (
5290                 400 => '400 Bad Request',
5291                 403 => '403 Forbidden',
5292                 404 => '404 Not Found',
5293                 500 => '500 Internal Server Error',
5294                 503 => '503 Service Unavailable',
5295         );
5296         git_header_html($http_responses{$status}, undef, %opts);
5297         print <<EOF;
5298 <div class="page_body">
5299 <br /><br />
5300 $status - $error
5301 <br />
5302 EOF
5303         if (defined $extra) {
5304                 print "<hr />\n" .
5305                       "$extra\n";
5306         }
5307         print "</div>\n";
5308
5309         git_footer_html();
5310         CORE::die
5311                 unless ($opts{'-error_handler'});
5312 }
5313
5314 ## ----------------------------------------------------------------------
5315 ## functions printing or outputting HTML: navigation
5316
5317 # $content is wrapped in a span with class 'tab'
5318 # If $selected is true it also has class 'selected'
5319 # If $disabled is true it also has class 'disabled'
5320 # Whether or not a tab can be disabled and selected at the same time
5321 # is up to the caller
5322 # If $extra_classes is non-empty, it is a whitespace-separated list of
5323 # additional class names to include
5324 # Note that $content MUST already be html-escaped as needed because
5325 # it is included verbatim.  And so are any extra class names.
5326 sub tabspan {
5327         my ($content, $selected, $disabled, $extra_classes) = @_;
5328         my @classes = ("tab");
5329         push(@classes, "selected") if $selected;
5330         push(@classes, "disabled") if $disabled;
5331         push(@classes, split(' ', $extra_classes)) if $extra_classes;
5332         return "<span class=\"" . join(" ", @classes) . "\">". $content . "</span>";
5333 }
5334
5335 sub git_print_page_nav {
5336         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
5337         $extra = '' if !defined $extra; # pager or formats
5338         $extra = "<span class=\"page_nav_sub\">".$extra."</span>" if $extra ne '';
5339
5340         my @navs = qw(summary log commit commitdiff tree refs);
5341         if ($suppress) {
5342                 my %omit;
5343                 if (ref($suppress) eq 'ARRAY') {
5344                         %omit = map { ($_ => 1) } @$suppress;
5345                 } else {
5346                         %omit = ($suppress => 1);
5347                 }
5348                 @navs = grep { !$omit{$_} } @navs;
5349         }
5350
5351         my %arg = map { $_ => {action=>$_} } @navs;
5352         if (defined $head) {
5353                 for (qw(commit commitdiff)) {
5354                         $arg{$_}{'hash'} = $head;
5355                 }
5356                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
5357                         $arg{'log'}{'hash'} = $head;
5358                 }
5359         }
5360
5361         $arg{'log'}{'action'} = 'shortlog';
5362         if ($current eq 'log') {
5363                 $current = 'shortlog';
5364         } elsif ($current eq 'shortlog') {
5365                 $current = 'log';
5366         }
5367         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
5368         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
5369
5370         my @actions = gitweb_get_feature('actions');
5371         my $escname = $project;
5372         $escname =~ s/[+]/%2B/g;
5373         my %repl = (
5374                 '%' => '%',
5375                 'n' => $project,         # project name
5376                 'f' => $git_dir,         # project path within filesystem
5377                 'h' => $treehead || '',  # current hash ('h' parameter)
5378                 'b' => $treebase || '',  # hash base ('hb' parameter)
5379                 'e' => $escname,         # project name with '+' escaped
5380         );
5381         while (@actions) {
5382                 my ($label, $link, $pos) = splice(@actions,0,3);
5383                 # insert
5384                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
5385                 # munch munch
5386                 $link =~ s/%([%nfhbe])/$repl{$1}/g;
5387                 $arg{$label}{'_href'} = $link;
5388         }
5389
5390         print "<div class=\"page_nav\">\n" .
5391                 (join $barsep,
5392                  map { $_ eq $current ?
5393                        tabspan($_, 1) :
5394                        tabspan($cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_"))
5395                  } @navs);
5396         print "<br/>\n$extra<br/>\n" .
5397               "</div>\n";
5398 }
5399
5400 # returns a submenu for the nagivation of the refs views (tags, heads,
5401 # remotes) with the current view disabled and the remotes view only
5402 # available if the feature is enabled
5403 sub format_ref_views {
5404         my ($current) = @_;
5405         my @ref_views = qw{tags heads};
5406         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
5407         return join $barsep, map {
5408                 $_ eq $current ? tabspan($_, 1) :
5409                 tabspan($cgi->a({-href => href(action=>$_)}, $_))
5410         } @ref_views
5411 }
5412
5413 sub format_paging_nav {
5414         my ($action, $page, $has_next_link) = @_;
5415         my $paging_nav = "<span class=\"paging_nav\">";
5416
5417         if ($page > 0) {
5418                 $paging_nav .= tabspan(
5419                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first")) .
5420                         $mdotsep . tabspan(
5421                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
5422                                  -accesskey => "p", -title => "Alt-p"}, "prev"));
5423         } else {
5424                 $paging_nav .= tabspan("first", 1).${mdotsep}.tabspan("prev", 0, 1);
5425         }
5426
5427         if ($has_next_link) {
5428                 $paging_nav .= $mdotsep . tabspan(
5429                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
5430                                  -accesskey => "n", -title => "Alt-n"}, "next"));
5431         } else {
5432                 $paging_nav .= ${mdotsep}.tabspan("next", 0, 1);
5433         }
5434
5435         return $paging_nav."</span>";
5436 }
5437
5438 sub format_log_nav {
5439         my ($action, $page, $has_next_link, $extra) = @_;
5440         my $paging_nav;
5441         defined $extra or $extra = '';
5442         $extra eq '' or $extra .= $barsep;
5443
5444         if ($action eq 'shortlog') {
5445                 $paging_nav .= tabspan('shortlog', 1);
5446         } else {
5447                 $paging_nav .= tabspan($cgi->a({-href => href(action=>'shortlog', -replay=>1)}, 'shortlog'));
5448         }
5449         $paging_nav .= $barsep;
5450         if ($action eq 'log') {
5451                 $paging_nav .= tabspan('fulllog', 1);
5452         } else {
5453                 $paging_nav .= tabspan($cgi->a({-href => href(action=>'log', -replay=>1)}, 'fulllog'));
5454         }
5455
5456         $paging_nav .= $barsep . $extra . format_paging_nav($action, $page, $has_next_link);
5457         return $paging_nav;
5458 }
5459
5460 ## ......................................................................
5461 ## functions printing or outputting HTML: div
5462
5463 sub git_print_header_div {
5464         my ($action, $title, $hash, $hash_base, $extra) = @_;
5465         my %args = ();
5466         defined $extra or $extra = '';
5467
5468         $args{'action'} = $action;
5469         $args{'hash'} = $hash if $hash;
5470         $args{'hash_base'} = $hash_base if $hash_base;
5471
5472         my $link1 = $cgi->a({-href => href(%args), -class => "title"},
5473                             $title ? $title : $action);
5474         my $link2 = $cgi->a({-href => href(%args), -class => "cover"}, "");
5475         print "<div class=\"header\">\n" . '<span class="title">' .
5476               $link1 . $extra . $link2 . '</span>' . "\n</div>\n";
5477 }
5478
5479 sub format_repo_url {
5480         my ($name, $url) = @_;
5481         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
5482 }
5483
5484 # Group output by placing it in a DIV element and adding a header.
5485 # Options for start_div() can be provided by passing a hash reference as the
5486 # first parameter to the function.
5487 # Options to git_print_header_div() can be provided by passing an array
5488 # reference. This must follow the options to start_div if they are present.
5489 # The content can be a scalar, which is output as-is, a scalar reference, which
5490 # is output after html escaping, an IO handle passed either as *handle or
5491 # *handle{IO}, or a function reference. In the latter case all following
5492 # parameters will be taken as argument to the content function call.
5493 sub git_print_section {
5494         my ($div_args, $header_args, $content);
5495         my $arg = shift;
5496         if (ref($arg) eq 'HASH') {
5497                 $div_args = $arg;
5498                 $arg = shift;
5499         }
5500         if (ref($arg) eq 'ARRAY') {
5501                 $header_args = $arg;
5502                 $arg = shift;
5503         }
5504         $content = $arg;
5505
5506         print $cgi->start_div($div_args);
5507         git_print_header_div(@$header_args);
5508
5509         if (ref($content) eq 'CODE') {
5510                 $content->(@_);
5511         } elsif (ref($content) eq 'SCALAR') {
5512                 print esc_html($$content);
5513         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
5514                 while (<$content>) {
5515                         print to_utf8($_);
5516                 }
5517         } elsif (!ref($content) && defined($content)) {
5518                 print $content;
5519         }
5520
5521         print $cgi->end_div;
5522 }
5523
5524 sub format_timestamp_html {
5525         my $date = shift;
5526         my $useatnight = shift;
5527         defined($useatnight) or $useatnight = 1;
5528         my $strtime = $date->{'rfc2822'};
5529
5530         my (undef, undef, $datetime_class) =
5531                 gitweb_get_feature('javascript-timezone');
5532         if ($datetime_class) {
5533                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
5534         }
5535
5536         my $localtime_format = '(%d %02d:%02d %s)';
5537         if ($useatnight && $date->{'hour_local'} < 6) {
5538                 $localtime_format = '(%d <span class="atnight">%02d:%02d</span> %s)';
5539         }
5540         $strtime .= ' ' .
5541                     sprintf($localtime_format, $date->{'mday_local'},
5542                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
5543
5544         return $strtime;
5545 }
5546
5547 sub format_lastrefresh_row {
5548         return "<?gitweb format_lastrefresh_row?>" if $cache_mode_active;
5549         my %rd = parse_file_date('.last_refresh');
5550         if (defined $rd{'rfc2822'}) {
5551                 return "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td>" .
5552                        "<td>".format_timestamp_html(\%rd,0)."</td></tr>";
5553         }
5554         return "";
5555 }
5556
5557 # Outputs the author name and date in long form
5558 sub git_print_authorship {
5559         my $co = shift;
5560         my %opts = @_;
5561         my $tag = $opts{-tag} || 'div';
5562         my $author = $co->{'author_name'};
5563
5564         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
5565         print "<$tag class=\"author_date\">" .
5566               format_search_author($author, "author", esc_html($author)) .
5567               " [".format_timestamp_html(\%ad)."]".
5568               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
5569               "</$tag>\n";
5570 }
5571
5572 # Outputs table rows containing the full author or committer information,
5573 # in the format expected for 'commit' view (& similar).
5574 # Parameters are a commit hash reference, followed by the list of people
5575 # to output information for. If the list is empty it defaults to both
5576 # author and committer.
5577 sub git_print_authorship_rows {
5578         my $co = shift;
5579         # too bad we can't use @people = @_ || ('author', 'committer')
5580         my @people = @_;
5581         @people = ('author', 'committer') unless @people;
5582         foreach my $who (@people) {
5583                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
5584                 print "<tr><td>$who</td><td>" .
5585                       format_search_author($co->{"${who}_name"}, $who,
5586                                            esc_html($co->{"${who}_name"})) . " " .
5587                       format_search_author($co->{"${who}_email"}, $who,
5588                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
5589                       "</td><td rowspan=\"2\">" .
5590                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
5591                       "</td></tr>\n" .
5592                       "<tr>" .
5593                       "<td></td><td>" .
5594                       format_timestamp_html(\%wd) .
5595                       "</td>" .
5596                       "</tr>\n";
5597         }
5598 }
5599
5600 sub git_print_page_path {
5601         my $name = shift;
5602         my $type = shift;
5603         my $hb = shift;
5604
5605
5606         print "<div class=\"page_path\">";
5607         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
5608                       -title => 'tree root'}, to_utf8("[$project]"));
5609         print " / ";
5610         if (defined $name) {
5611                 my @dirname = split '/', $name;
5612                 my $basename = pop @dirname;
5613                 my $fullname = '';
5614
5615                 foreach my $dir (@dirname) {
5616                         $fullname .= ($fullname ? '/' : '') . $dir;
5617                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
5618                                                      hash_base=>$hb),
5619                                       -title => $fullname}, esc_path($dir));
5620                         print " / ";
5621                 }
5622                 if (defined $type && $type eq 'blob') {
5623                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
5624                                                      hash_base=>$hb),
5625                                       -title => $name}, esc_path($basename));
5626                 } elsif (defined $type && $type eq 'tree') {
5627                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
5628                                                      hash_base=>$hb),
5629                                       -title => $name}, esc_path($basename));
5630                         print " / ";
5631                 } else {
5632                         print esc_path($basename);
5633                 }
5634         }
5635         print "<br/></div>\n";
5636 }
5637
5638 sub git_print_log {
5639         my $log = shift;
5640         my %opts = @_;
5641
5642         if ($opts{'-remove_title'}) {
5643                 # remove title, i.e. first line of log
5644                 shift @$log;
5645         }
5646         # remove leading empty lines
5647         while (defined $log->[0] && $log->[0] eq "") {
5648                 shift @$log;
5649         }
5650
5651         # print log
5652         my $skip_blank_line = 0;
5653         foreach my $line (@$log) {
5654                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5655                         if (! $opts{'-remove_signoff'}) {
5656                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5657                                 $skip_blank_line = 1;
5658                         }
5659                         next;
5660                 }
5661
5662                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5663                         if (! $opts{'-remove_signoff'}) {
5664                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5665                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5666                                         "</span><br/>\n";
5667                                 $skip_blank_line = 1;
5668                         }
5669                         next;
5670                 }
5671
5672                 # print only one empty line
5673                 # do not print empty line after signoff
5674                 if ($line eq "") {
5675                         next if ($skip_blank_line);
5676                         $skip_blank_line = 1;
5677                 } else {
5678                         $skip_blank_line = 0;
5679                 }
5680
5681                 print format_log_line_html($line) . "<br/>\n";
5682         }
5683
5684         if ($opts{'-final_empty_line'}) {
5685                 # end with single empty line
5686                 print "<br/>\n" unless $skip_blank_line;
5687         }
5688 }
5689
5690 # return link target (what link points to)
5691 sub git_get_link_target {
5692         my $hash = shift;
5693         my $link_target;
5694
5695         # read link
5696         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5697                 or return;
5698         {
5699                 local $/ = undef;
5700                 $link_target = to_utf8(scalar <$fd>);
5701         }
5702         close $fd
5703                 or return;
5704
5705         return $link_target;
5706 }
5707
5708 # given link target, and the directory (basedir) the link is in,
5709 # return target of link relative to top directory (top tree);
5710 # return undef if it is not possible (including absolute links).
5711 sub normalize_link_target {
5712         my ($link_target, $basedir) = @_;
5713
5714         # absolute symlinks (beginning with '/') cannot be normalized
5715         return if (substr($link_target, 0, 1) eq '/');
5716
5717         # normalize link target to path from top (root) tree (dir)
5718         my $path;
5719         if ($basedir) {
5720                 $path = $basedir . '/' . $link_target;
5721         } else {
5722                 # we are in top (root) tree (dir)
5723                 $path = $link_target;
5724         }
5725
5726         # remove //, /./, and /../
5727         my @path_parts;
5728         foreach my $part (split('/', $path)) {
5729                 # discard '.' and ''
5730                 next if (!$part || $part eq '.');
5731                 # handle '..'
5732                 if ($part eq '..') {
5733                         if (@path_parts) {
5734                                 pop @path_parts;
5735                         } else {
5736                                 # link leads outside repository (outside top dir)
5737                                 return;
5738                         }
5739                 } else {
5740                         push @path_parts, $part;
5741                 }
5742         }
5743         $path = join('/', @path_parts);
5744
5745         return $path;
5746 }
5747
5748 # print tree entry (row of git_tree), but without encompassing <tr> element
5749 sub git_print_tree_entry {
5750         my ($t, $basedir, $hash_base, $have_blame) = @_;
5751
5752         my %base_key = ();
5753         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5754
5755         # The format of a table row is: mode list link.  Where mode is
5756         # the mode of the entry, list is the name of the entry, an href,
5757         # and link is the action links of the entry.
5758
5759         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5760         if (exists $t->{'size'}) {
5761                 print "<td class=\"size\">$t->{'size'}</td>\n";
5762         }
5763         if ($t->{'type'} eq "blob") {
5764                 print "<td class=\"list\">" .
5765                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5766                                                file_name=>"$basedir$t->{'name'}", %base_key),
5767                                 -class => "list"}, esc_path($t->{'name'}));
5768                 if (S_ISLNK(oct $t->{'mode'})) {
5769                         my $link_target = git_get_link_target($t->{'hash'});
5770                         if ($link_target) {
5771                                 my $norm_target = normalize_link_target($link_target, $basedir);
5772                                 if (defined $norm_target) {
5773                                         print " -> " .
5774                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5775                                                                      file_name=>$norm_target),
5776                                                        -title => $norm_target}, esc_path($link_target));
5777                                 } else {
5778                                         print " -> " . esc_path($link_target);
5779                                 }
5780                         }
5781                 }
5782                 print "</td>\n";
5783                 print "<td class=\"link\">";
5784                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5785                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5786                               "blob");
5787                 if ($have_blame) {
5788                         print $barsep .
5789                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5790                                                      file_name=>"$basedir$t->{'name'}", %base_key),
5791                                       -class => "blamelink"},
5792                                       "blame");
5793                 }
5794                 if (defined $hash_base) {
5795                         print $barsep .
5796                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5797                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5798                                       "history");
5799                 }
5800                 print $barsep .
5801                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5802                                                file_name=>"$basedir$t->{'name'}")},
5803                                 "raw");
5804                 print "</td>\n";
5805
5806         } elsif ($t->{'type'} eq "tree") {
5807                 print "<td class=\"list\">";
5808                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5809                                              file_name=>"$basedir$t->{'name'}",
5810                                              %base_key)},
5811                               esc_path($t->{'name'}));
5812                 print "</td>\n";
5813                 print "<td class=\"link\">";
5814                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5815                                              file_name=>"$basedir$t->{'name'}",
5816                                              %base_key)},
5817                               "tree");
5818                 if (defined $hash_base) {
5819                         print $barsep .
5820                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5821                                                      file_name=>"$basedir$t->{'name'}")},
5822                                       "history");
5823                 }
5824                 print "</td>\n";
5825         } else {
5826                 # unknown object: we can only present history for it
5827                 # (this includes 'commit' object, i.e. submodule support)
5828                 print "<td class=\"list\">" .
5829                       esc_path($t->{'name'}) .
5830                       "</td>\n";
5831                 print "<td class=\"link\">";
5832                 if (defined $hash_base) {
5833                         print $cgi->a({-href => href(action=>"history",
5834                                                      hash_base=>$hash_base,
5835                                                      file_name=>"$basedir$t->{'name'}")},
5836                                       "history");
5837                 }
5838                 print "</td>\n";
5839         }
5840 }
5841
5842 ## ......................................................................
5843 ## functions printing large fragments of HTML
5844
5845 # get pre-image filenames for merge (combined) diff
5846 sub fill_from_file_info {
5847         my ($diff, @parents) = @_;
5848
5849         $diff->{'from_file'} = [ ];
5850         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5851         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5852                 if ($diff->{'status'}[$i] eq 'R' ||
5853                     $diff->{'status'}[$i] eq 'C') {
5854                         $diff->{'from_file'}[$i] =
5855                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5856                 }
5857         }
5858
5859         return $diff;
5860 }
5861
5862 # is current raw difftree line of file deletion
5863 sub is_deleted {
5864         my $diffinfo = shift;
5865
5866         return $diffinfo->{'to_id'} eq ('0' x 40);
5867 }
5868
5869 # does patch correspond to [previous] difftree raw line
5870 # $diffinfo  - hashref of parsed raw diff format
5871 # $patchinfo - hashref of parsed patch diff format
5872 #              (the same keys as in $diffinfo)
5873 sub is_patch_split {
5874         my ($diffinfo, $patchinfo) = @_;
5875
5876         return defined $diffinfo && defined $patchinfo
5877                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5878 }
5879
5880
5881 sub git_difftree_body {
5882         my ($difftree, $hash, @parents) = @_;
5883         my ($parent) = $parents[0];
5884         my $have_blame = gitweb_check_feature('blame');
5885         print "<div class=\"list_head\">\n";
5886         if ($#{$difftree} > 10) {
5887                 print(($#{$difftree} + 1) . " files changed:\n");
5888         }
5889         print "</div>\n";
5890
5891         print "<table class=\"" .
5892               (@parents > 1 ? "combined " : "") .
5893               "diff_tree\">\n";
5894
5895         # header only for combined diff in 'commitdiff' view
5896         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5897         if ($has_header) {
5898                 # table header
5899                 print "<thead><tr>\n" .
5900                        "<th></th><th></th>\n"; # filename, patchN link
5901                 for (my $i = 0; $i < @parents; $i++) {
5902                         my $par = $parents[$i];
5903                         print "<th>" .
5904                               $cgi->a({-href => href(action=>"commitdiff",
5905                                                      hash=>$hash, hash_parent=>$par),
5906                                        -title => 'commitdiff to parent number ' .
5907                                                   ($i+1) . ': ' . substr($par,0,7)},
5908                                       $i+1) .
5909                               "&#160;</th>\n";
5910                 }
5911                 print "</tr></thead>\n<tbody>\n";
5912         }
5913
5914         my $alternate = 1;
5915         my $patchno = 0;
5916         foreach my $line (@{$difftree}) {
5917                 my $diff = parsed_difftree_line($line);
5918
5919                 if ($alternate) {
5920                         print "<tr class=\"dark\">\n";
5921                 } else {
5922                         print "<tr class=\"light\">\n";
5923                 }
5924                 $alternate ^= 1;
5925
5926                 if (exists $diff->{'nparents'}) { # combined diff
5927
5928                         fill_from_file_info($diff, @parents)
5929                                 unless exists $diff->{'from_file'};
5930
5931                         if (!is_deleted($diff)) {
5932                                 # file exists in the result (child) commit
5933                                 print "<td>" .
5934                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5935                                                              file_name=>$diff->{'to_file'},
5936                                                              hash_base=>$hash),
5937                                               -class => "list"}, esc_path($diff->{'to_file'})) .
5938                                       "</td>\n";
5939                         } else {
5940                                 print "<td>" .
5941                                       esc_path($diff->{'to_file'}) .
5942                                       "</td>\n";
5943                         }
5944
5945                         if ($action eq 'commitdiff') {
5946                                 # link to patch
5947                                 $patchno++;
5948                                 print "<td class=\"link\">" .
5949                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
5950                                               "patch") .
5951                                       $barsep .
5952                                       "</td>\n";
5953                         }
5954
5955                         my $has_history = 0;
5956                         my $not_deleted = 0;
5957                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5958                                 my $hash_parent = $parents[$i];
5959                                 my $from_hash = $diff->{'from_id'}[$i];
5960                                 my $from_path = $diff->{'from_file'}[$i];
5961                                 my $status = $diff->{'status'}[$i];
5962
5963                                 $has_history ||= ($status ne 'A');
5964                                 $not_deleted ||= ($status ne 'D');
5965
5966                                 if ($status eq 'A') {
5967                                         print "<td  class=\"link\" align=\"right\">$barsep</td>\n";
5968                                 } elsif ($status eq 'D') {
5969                                         print "<td class=\"link\">" .
5970                                               $cgi->a({-href => href(action=>"blob",
5971                                                                      hash_base=>$hash,
5972                                                                      hash=>$from_hash,
5973                                                                      file_name=>$from_path)},
5974                                                       "blob" . ($i+1)) .
5975                                               "$barsep</td>\n";
5976                                 } else {
5977                                         if ($diff->{'to_id'} eq $from_hash) {
5978                                                 print "<td class=\"link nochange\">";
5979                                         } else {
5980                                                 print "<td class=\"link\">";
5981                                         }
5982                                         print $cgi->a({-href => href(action=>"blobdiff",
5983                                                                      hash=>$diff->{'to_id'},
5984                                                                      hash_parent=>$from_hash,
5985                                                                      hash_base=>$hash,
5986                                                                      hash_parent_base=>$hash_parent,
5987                                                                      file_name=>$diff->{'to_file'},
5988                                                                      file_parent=>$from_path)},
5989                                                       "diff" . ($i+1)) .
5990                                               "$barsep</td>\n";
5991                                 }
5992                         }
5993
5994                         print "<td class=\"link\">";
5995                         if ($not_deleted) {
5996                                 print $cgi->a({-href => href(action=>"blob",
5997                                                              hash=>$diff->{'to_id'},
5998                                                              file_name=>$diff->{'to_file'},
5999                                                              hash_base=>$hash)},
6000                                               "blob");
6001                                 print $barsep if ($has_history);
6002                         }
6003                         if ($has_history) {
6004                                 print $cgi->a({-href => href(action=>"history",
6005                                                              file_name=>$diff->{'to_file'},
6006                                                              hash_base=>$hash)},
6007                                               "history");
6008                         }
6009                         print "</td>\n";
6010
6011                         print "</tr>\n";
6012                         next; # instead of 'else' clause, to avoid extra indent
6013                 }
6014                 # else ordinary diff
6015
6016                 my ($to_mode_oct, $to_mode_str, $to_file_type);
6017                 my ($from_mode_oct, $from_mode_str, $from_file_type);
6018                 if ($diff->{'to_mode'} ne ('0' x 6)) {
6019                         $to_mode_oct = oct $diff->{'to_mode'};
6020                         if (S_ISREG($to_mode_oct)) { # only for regular file
6021                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
6022                         }
6023                         $to_file_type = file_type($diff->{'to_mode'});
6024                 }
6025                 if ($diff->{'from_mode'} ne ('0' x 6)) {
6026                         $from_mode_oct = oct $diff->{'from_mode'};
6027                         if (S_ISREG($from_mode_oct)) { # only for regular file
6028                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
6029                         }
6030                         $from_file_type = file_type($diff->{'from_mode'});
6031                 }
6032
6033                 if ($diff->{'status'} eq "A") { # created
6034                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
6035                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
6036                         $mode_chng   .= "]</span>";
6037                         print "<td>";
6038                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6039                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6040                                       -class => "list"}, esc_path($diff->{'file'}));
6041                         print "</td>\n";
6042                         print "<td>$mode_chng</td>\n";
6043                         print "<td class=\"link\">";
6044                         if ($action eq 'commitdiff') {
6045                                 # link to patch
6046                                 $patchno++;
6047                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6048                                               "patch") .
6049                                       $barsep;
6050                         }
6051                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6052                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6053                                       "blob");
6054                         print "</td>\n";
6055
6056                 } elsif ($diff->{'status'} eq "D") { # deleted
6057                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
6058                         print "<td>";
6059                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
6060                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
6061                                        -class => "list"}, esc_path($diff->{'file'}));
6062                         print "</td>\n";
6063                         print "<td>$mode_chng</td>\n";
6064                         print "<td class=\"link\">";
6065                         if ($action eq 'commitdiff') {
6066                                 # link to patch
6067                                 $patchno++;
6068                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6069                                               "patch") .
6070                                       $barsep;
6071                         }
6072                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
6073                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
6074                                       "blob") . $barsep;
6075                         if ($have_blame) {
6076                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
6077                                                              file_name=>$diff->{'file'}),
6078                                               -class => "blamelink"},
6079                                               "blame") . $barsep;
6080                         }
6081                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
6082                                                      file_name=>$diff->{'file'})},
6083                                       "history");
6084                         print "</td>\n";
6085
6086                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
6087                         my $mode_chnge = "";
6088                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6089                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
6090                                 if ($from_file_type ne $to_file_type) {
6091                                         $mode_chnge .= " from $from_file_type to $to_file_type";
6092                                 }
6093                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
6094                                         if ($from_mode_str && $to_mode_str) {
6095                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
6096                                         } elsif ($to_mode_str) {
6097                                                 $mode_chnge .= " mode: $to_mode_str";
6098                                         }
6099                                 }
6100                                 $mode_chnge .= "]</span>\n";
6101                         }
6102                         print "<td>";
6103                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6104                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6105                                       -class => "list"}, esc_path($diff->{'file'}));
6106                         print "</td>\n";
6107                         print "<td>$mode_chnge</td>\n";
6108                         print "<td class=\"link\">";
6109                         if ($action eq 'commitdiff') {
6110                                 # link to patch
6111                                 $patchno++;
6112                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6113                                               "patch") .
6114                                       $barsep;
6115                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6116                                 # "commit" view and modified file (not onlu mode changed)
6117                                 print $cgi->a({-href => href(action=>"blobdiff",
6118                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6119                                                              hash_base=>$hash, hash_parent_base=>$parent,
6120                                                              file_name=>$diff->{'file'})},
6121                                               "diff") .
6122                                       $barsep;
6123                         }
6124                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6125                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6126                                        "blob") . $barsep;
6127                         if ($have_blame) {
6128                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6129                                                              file_name=>$diff->{'file'}),
6130                                               -class => "blamelink"},
6131                                               "blame") . $barsep;
6132                         }
6133                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6134                                                      file_name=>$diff->{'file'})},
6135                                       "history");
6136                         print "</td>\n";
6137
6138                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
6139                         my %status_name = ('R' => 'moved', 'C' => 'copied');
6140                         my $nstatus = $status_name{$diff->{'status'}};
6141                         my $mode_chng = "";
6142                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6143                                 # mode also for directories, so we cannot use $to_mode_str
6144                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
6145                         }
6146                         print "<td>" .
6147                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
6148                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
6149                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
6150                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
6151                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
6152                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
6153                                       -class => "list"}, esc_path($diff->{'from_file'})) .
6154                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
6155                               "<td class=\"link\">";
6156                         if ($action eq 'commitdiff') {
6157                                 # link to patch
6158                                 $patchno++;
6159                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6160                                               "patch") .
6161                                       $barsep;
6162                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6163                                 # "commit" view and modified file (not only pure rename or copy)
6164                                 print $cgi->a({-href => href(action=>"blobdiff",
6165                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6166                                                              hash_base=>$hash, hash_parent_base=>$parent,
6167                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
6168                                               "diff") .
6169                                       $barsep;
6170                         }
6171                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6172                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
6173                                       "blob") . $barsep;
6174                         if ($have_blame) {
6175                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6176                                                              file_name=>$diff->{'to_file'}),
6177                                               -class => "blamelink"},
6178                                               "blame") . $barsep;
6179                         }
6180                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6181                                                     file_name=>$diff->{'to_file'})},
6182                                       "history");
6183                         print "</td>\n";
6184
6185                 } # we should not encounter Unmerged (U) or Unknown (X) status
6186                 print "</tr>\n";
6187         }
6188         print "</tbody>" if $has_header;
6189         print "</table>\n";
6190 }
6191
6192 # Print context lines and then rem/add lines in a side-by-side manner.
6193 sub print_sidebyside_diff_lines {
6194         my ($ctx, $rem, $add) = @_;
6195
6196         # print context block before add/rem block
6197         if (@$ctx) {
6198                 print join '',
6199                         '<div class="chunk_block ctx">',
6200                                 '<div class="old">',
6201                                 @$ctx,
6202                                 '</div>',
6203                                 '<div class="new">',
6204                                 @$ctx,
6205                                 '</div>',
6206                         '</div>';
6207         }
6208
6209         if (!@$add) {
6210                 # pure removal
6211                 print join '',
6212                         '<div class="chunk_block rem">',
6213                                 '<div class="old">',
6214                                 @$rem,
6215                                 '</div>',
6216                         '</div>';
6217         } elsif (!@$rem) {
6218                 # pure addition
6219                 print join '',
6220                         '<div class="chunk_block add">',
6221                                 '<div class="new">',
6222                                 @$add,
6223                                 '</div>',
6224                         '</div>';
6225         } else {
6226                 print join '',
6227                         '<div class="chunk_block chg">',
6228                                 '<div class="old">',
6229                                 @$rem,
6230                                 '</div>',
6231                                 '<div class="new">',
6232                                 @$add,
6233                                 '</div>',
6234                         '</div>';
6235         }
6236 }
6237
6238 # Print context lines and then rem/add lines in inline manner.
6239 sub print_inline_diff_lines {
6240         my ($ctx, $rem, $add) = @_;
6241
6242         print @$ctx, @$rem, @$add;
6243 }
6244
6245 # Format removed and added line, mark changed part and HTML-format them.
6246 # Implementation is based on contrib/diff-highlight
6247 sub format_rem_add_lines_pair {
6248         my ($rem, $add, $num_parents) = @_;
6249
6250         # We need to untabify lines before split()'ing them;
6251         # otherwise offsets would be invalid.
6252         chomp $rem;
6253         chomp $add;
6254         $rem = untabify($rem);
6255         $add = untabify($add);
6256
6257         my @rem = split(//, $rem);
6258         my @add = split(//, $add);
6259         my ($esc_rem, $esc_add);
6260         # Ignore leading +/- characters for each parent.
6261         my ($prefix_len, $suffix_len) = ($num_parents, 0);
6262         my ($prefix_has_nonspace, $suffix_has_nonspace);
6263
6264         my $shorter = (@rem < @add) ? @rem : @add;
6265         while ($prefix_len < $shorter) {
6266                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
6267
6268                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
6269                 $prefix_len++;
6270         }
6271
6272         while ($prefix_len + $suffix_len < $shorter) {
6273                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
6274
6275                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
6276                 $suffix_len++;
6277         }
6278
6279         # Mark lines that are different from each other, but have some common
6280         # part that isn't whitespace.  If lines are completely different, don't
6281         # mark them because that would make output unreadable, especially if
6282         # diff consists of multiple lines.
6283         if ($prefix_has_nonspace || $suffix_has_nonspace) {
6284                 $esc_rem = esc_html_hl_regions($rem, 'marked',
6285                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
6286                 $esc_add = esc_html_hl_regions($add, 'marked',
6287                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
6288         } else {
6289                 $esc_rem = esc_html($rem, -nbsp=>1);
6290                 $esc_add = esc_html($add, -nbsp=>1);
6291         }
6292
6293         return format_diff_line(\$esc_rem, 'rem'),
6294                format_diff_line(\$esc_add, 'add');
6295 }
6296
6297 # HTML-format diff context, removed and added lines.
6298 sub format_ctx_rem_add_lines {
6299         my ($ctx, $rem, $add, $num_parents) = @_;
6300         my (@new_ctx, @new_rem, @new_add);
6301         my $can_highlight = 0;
6302         my $is_combined = ($num_parents > 1);
6303
6304         # Highlight if every removed line has a corresponding added line.
6305         if (@$add > 0 && @$add == @$rem) {
6306                 $can_highlight = 1;
6307
6308                 # Highlight lines in combined diff only if the chunk contains
6309                 # diff between the same version, e.g.
6310                 #
6311                 #    - a
6312                 #   -  b
6313                 #    + c
6314                 #   +  d
6315                 #
6316                 # Otherwise the highlightling would be confusing.
6317                 if ($is_combined) {
6318                         for (my $i = 0; $i < @$add; $i++) {
6319                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
6320                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
6321
6322                                 $prefix_rem =~ s/-/+/g;
6323
6324                                 if ($prefix_rem ne $prefix_add) {
6325                                         $can_highlight = 0;
6326                                         last;
6327                                 }
6328                         }
6329                 }
6330         }
6331
6332         if ($can_highlight) {
6333                 for (my $i = 0; $i < @$add; $i++) {
6334                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
6335                                 $rem->[$i], $add->[$i], $num_parents);
6336                         push @new_rem, $line_rem;
6337                         push @new_add, $line_add;
6338                 }
6339         } else {
6340                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
6341                 @new_add = map { format_diff_line($_, 'add') } @$add;
6342         }
6343
6344         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
6345
6346         return (\@new_ctx, \@new_rem, \@new_add);
6347 }
6348
6349 # Print context lines and then rem/add lines.
6350 sub print_diff_lines {
6351         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
6352         my $is_combined = $num_parents > 1;
6353
6354         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
6355                 $num_parents);
6356
6357         if ($diff_style eq 'sidebyside' && !$is_combined) {
6358                 print_sidebyside_diff_lines($ctx, $rem, $add);
6359         } else {
6360                 # default 'inline' style and unknown styles
6361                 print_inline_diff_lines($ctx, $rem, $add);
6362         }
6363 }
6364
6365 sub print_diff_chunk {
6366         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
6367         my (@ctx, @rem, @add);
6368
6369         # The class of the previous line.
6370         my $prev_class = '';
6371
6372         return unless @chunk;
6373
6374         # incomplete last line might be among removed or added lines,
6375         # or both, or among context lines: find which
6376         for (my $i = 1; $i < @chunk; $i++) {
6377                 if ($chunk[$i][0] eq 'incomplete') {
6378                         $chunk[$i][0] = $chunk[$i-1][0];
6379                 }
6380         }
6381
6382         # guardian
6383         push @chunk, ["", ""];
6384
6385         foreach my $line_info (@chunk) {
6386                 my ($class, $line) = @$line_info;
6387
6388                 # print chunk headers
6389                 if ($class && $class eq 'chunk_header') {
6390                         print format_diff_line($line, $class, $from, $to);
6391                         next;
6392                 }
6393
6394                 ## print from accumulator when have some add/rem lines or end
6395                 # of chunk (flush context lines), or when have add and rem
6396                 # lines and new block is reached (otherwise add/rem lines could
6397                 # be reordered)
6398                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
6399                     (@rem && @add && $class ne $prev_class)) {
6400                         print_diff_lines(\@ctx, \@rem, \@add,
6401                                          $diff_style, $num_parents);
6402                         @ctx = @rem = @add = ();
6403                 }
6404
6405                 ## adding lines to accumulator
6406                 # guardian value
6407                 last unless $line;
6408                 # rem, add or change
6409                 if ($class eq 'rem') {
6410                         push @rem, $line;
6411                 } elsif ($class eq 'add') {
6412                         push @add, $line;
6413                 }
6414                 # context line
6415                 if ($class eq 'ctx') {
6416                         push @ctx, $line;
6417                 }
6418
6419                 $prev_class = $class;
6420         }
6421 }
6422
6423 sub git_patchset_body {
6424         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
6425         my ($hash_parent) = $hash_parents[0];
6426
6427         my $is_combined = (@hash_parents > 1);
6428         my $patch_idx = 0;
6429         my $patch_number = 0;
6430         my $patch_line;
6431         my $diffinfo;
6432         my $to_name;
6433         my (%from, %to);
6434         my @chunk; # for side-by-side diff
6435
6436         print "<div class=\"patchset\">\n";
6437
6438         # skip to first patch
6439         while ($patch_line = to_utf8(scalar <$fd>)) {
6440                 chomp $patch_line;
6441
6442                 last if ($patch_line =~ m/^diff /);
6443         }
6444
6445  PATCH:
6446         while ($patch_line) {
6447
6448                 # parse "git diff" header line
6449                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
6450                         # $1 is from_name, which we do not use
6451                         $to_name = unquote($2);
6452                         $to_name =~ s!^b/!!;
6453                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
6454                         # $1 is 'cc' or 'combined', which we do not use
6455                         $to_name = unquote($2);
6456                 } else {
6457                         $to_name = undef;
6458                 }
6459
6460                 # check if current patch belong to current raw line
6461                 # and parse raw git-diff line if needed
6462                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
6463                         # this is continuation of a split patch
6464                         print "<div class=\"patch cont\">\n";
6465                 } else {
6466                         # advance raw git-diff output if needed
6467                         $patch_idx++ if defined $diffinfo;
6468
6469                         # read and prepare patch information
6470                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6471
6472                         # compact combined diff output can have some patches skipped
6473                         # find which patch (using pathname of result) we are at now;
6474                         if ($is_combined) {
6475                                 while ($to_name ne $diffinfo->{'to_file'}) {
6476                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6477                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
6478                                               "</div>\n";  # class="patch"
6479
6480                                         $patch_idx++;
6481                                         $patch_number++;
6482
6483                                         last if $patch_idx > $#$difftree;
6484                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6485                                 }
6486                         }
6487
6488                         # modifies %from, %to hashes
6489                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
6490
6491                         # this is first patch for raw difftree line with $patch_idx index
6492                         # we index @$difftree array from 0, but number patches from 1
6493                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
6494                 }
6495
6496                 # git diff header
6497                 #assert($patch_line =~ m/^diff /) if DEBUG;
6498                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
6499                 $patch_number++;
6500                 # print "git diff" header
6501                 print format_git_diff_header_line($patch_line, $diffinfo,
6502                                                   \%from, \%to);
6503
6504                 # print extended diff header
6505                 print "<div class=\"diff extended_header\">\n";
6506         EXTENDED_HEADER:
6507                 while ($patch_line = to_utf8(scalar<$fd>)) {
6508                         chomp $patch_line;
6509
6510                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
6511
6512                         print format_extended_diff_header_line($patch_line, $diffinfo,
6513                                                                \%from, \%to);
6514                 }
6515                 print "</div>\n"; # class="diff extended_header"
6516
6517                 # from-file/to-file diff header
6518                 if (! $patch_line) {
6519                         print "</div>\n"; # class="patch"
6520                         last PATCH;
6521                 }
6522                 next PATCH if ($patch_line =~ m/^diff /);
6523                 #assert($patch_line =~ m/^---/) if DEBUG;
6524
6525                 my $last_patch_line = $patch_line;
6526                 $patch_line = to_utf8(scalar <$fd>);
6527                 chomp $patch_line;
6528                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
6529
6530                 print format_diff_from_to_header($last_patch_line, $patch_line,
6531                                                  $diffinfo, \%from, \%to,
6532                                                  @hash_parents);
6533
6534                 # the patch itself
6535         LINE:
6536                 while ($patch_line = to_utf8(scalar <$fd>)) {
6537                         chomp $patch_line;
6538
6539                         next PATCH if ($patch_line =~ m/^diff /);
6540
6541                         my $class = diff_line_class($patch_line, \%from, \%to);
6542
6543                         if ($class eq 'chunk_header') {
6544                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6545                                 @chunk = ();
6546                         }
6547
6548                         push @chunk, [ $class, $patch_line ];
6549                 }
6550
6551         } continue {
6552                 if (@chunk) {
6553                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6554                         @chunk = ();
6555                 }
6556                 print "</div>\n"; # class="patch"
6557         }
6558
6559         # for compact combined (--cc) format, with chunk and patch simplification
6560         # the patchset might be empty, but there might be unprocessed raw lines
6561         for (++$patch_idx if $patch_number > 0;
6562              $patch_idx < @$difftree;
6563              ++$patch_idx) {
6564                 # read and prepare patch information
6565                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6566
6567                 # generate anchor for "patch" links in difftree / whatchanged part
6568                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6569                       format_diff_cc_simplified($diffinfo, @hash_parents) .
6570                       "</div>\n";  # class="patch"
6571
6572                 $patch_number++;
6573         }
6574
6575         if ($patch_number == 0) {
6576                 if (@hash_parents > 1) {
6577                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
6578                 } else {
6579                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
6580                 }
6581         }
6582
6583         print "</div>\n"; # class="patchset"
6584 }
6585
6586 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6587
6588 sub git_project_search_form {
6589         my ($searchtext, $search_use_regexp) = @_;
6590
6591         my $limit = '';
6592         if ($project_filter) {
6593                 $limit = " in '$project_filter'";
6594         }
6595
6596         print "<div class=\"projsearch\">\n";
6597         print $cgi->start_form(-method => 'get', -action => $my_uri) .
6598               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
6599         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
6600                 if (defined $project_filter);
6601         print $cgi->textfield(-name => 's', -value => $searchtext,
6602                               -title => "Search project by name and description$limit",
6603                               -size => 60) . "\n" .
6604               "<span title=\"Extended regular expression\">" .
6605               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
6606                              -checked => $search_use_regexp) .
6607               "</span>\n" .
6608               $cgi->submit(-name => 'btnS', -value => 'Search') .
6609               $cgi->end_form() . "\n" .
6610               "<span class=\"projectlist_link\">" .
6611               $cgi->a({-href => href(project => undef, searchtext => undef,
6612                                      action => 'project_list',
6613                                      project_filter => $project_filter)},
6614                       esc_html("List all projects$limit")) . "</span><br />\n";
6615         print "<span class=\"projectlist_link\">" .
6616               $cgi->a({-href => href(project => undef, searchtext => undef,
6617                                      action => 'project_list',
6618                                      project_filter => undef)},
6619                       esc_html("List all projects")) . "</span>\n" if $project_filter;
6620         print "</div>\n";
6621 }
6622
6623 # entry for given @keys needs filling if at least one of keys in list
6624 # is not present in %$project_info
6625 sub project_info_needs_filling {
6626         my ($project_info, @keys) = @_;
6627
6628         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
6629         foreach my $key (@keys) {
6630                 if (!exists $project_info->{$key}) {
6631                         return 1;
6632                 }
6633         }
6634         return;
6635 }
6636
6637 sub git_cache_file_format {
6638         return GITWEB_CACHE_FORMAT .
6639                 (gitweb_check_feature('forks') ? " (forks)" : "");
6640 }
6641
6642 sub git_retrieve_cache_file {
6643         my $cache_file = shift;
6644
6645         use Storable qw(retrieve);
6646
6647         if ((my $dump = eval { retrieve($cache_file) })) {
6648                 return $$dump[1] if
6649                         ref($dump) eq 'ARRAY' &&
6650                         @$dump == 2 &&
6651                         ref($$dump[1]) eq 'ARRAY' &&
6652                         @{$$dump[1]} == 2 &&
6653                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
6654                         ref(${$$dump[1]}[1]) eq 'HASH' &&
6655                         $$dump[0] eq git_cache_file_format();
6656         }
6657
6658         return undef;
6659 }
6660
6661 sub git_store_cache_file {
6662         my ($cache_file, $cachedata) = @_;
6663
6664         use File::Basename qw(dirname);
6665         use File::stat;
6666         use POSIX qw(:fcntl_h);
6667         use Storable qw(store_fd);
6668
6669         my $result = undef;
6670         my $cache_d = dirname($cache_file);
6671         my $mask = umask();
6672         umask($mask & ~0070) if $cache_grpshared;
6673         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6674             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6675                 store_fd([git_cache_file_format(), $cachedata], $fd);
6676                 close $fd;
6677                 rename "$cache_file.lock", $cache_file;
6678                 $result = stat($cache_file)->mtime;
6679         }
6680         umask($mask) if $cache_grpshared;
6681         return $result;
6682 }
6683
6684 sub verify_cached_project {
6685         my ($hashref, $path) = @_;
6686         return undef unless $path;
6687         delete $$hashref{$path}, return undef unless is_valid_project($path);
6688         return $$hashref{$path} if exists $$hashref{$path};
6689
6690         # A valid project was requested but it's not yet in the cache
6691         # Manufacture a minimal project entry (path, name, description)
6692         # Also provide age, but only if it's available via $lastactivity_file
6693
6694         my %proj = ('path' => $path);
6695         my $val = git_get_project_description($path);
6696         defined $val or $val = '';
6697         $proj{'descr_long'} = $val;
6698         $proj{'descr'} = chop_str($val, $projects_list_description_width, 5);
6699         unless ($omit_owner) {
6700                 $val = git_get_project_owner($path);
6701                 defined $val or $val = '';
6702                 $proj{'owner'} = $val;
6703         }
6704         unless ($omit_age_column) {
6705                 ($val) = git_get_last_activity($path, 1);
6706                 $proj{'age_epoch'} = $val if defined $val;
6707         }
6708         $$hashref{$path} = \%proj;
6709         return \%proj;
6710 }
6711
6712 sub git_filter_cached_projects {
6713         my ($cache, $projlist, $verify) = @_;
6714         my $hashref = $$cache[1];
6715         my $sub = $verify ?
6716                 sub {verify_cached_project($hashref, $_[0])} :
6717                 sub {$$hashref{$_[0]}};
6718         return map {
6719                 my $c = &$sub($_->{'path'});
6720                 defined $c ? ($_ = $c) : ()
6721         } @$projlist;
6722 }
6723
6724 # fills project list info (age, description, owner, category, forks, etc.)
6725 # for each project in the list, removing invalid projects from
6726 # returned list, or fill only specified info.
6727 #
6728 # Invalid projects are removed from the returned list if and only if you
6729 # ask 'age_epoch' to be filled, because they are the only fields
6730 # that run unconditionally git command that requires repository, and
6731 # therefore do always check if project repository is invalid.
6732 #
6733 # USAGE:
6734 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6735 #   ensures that 'descr_long' and 'ctags' fields are filled
6736 # * @project_list = fill_project_list_info(\@project_list)
6737 #   ensures that all fields are filled (and invalid projects removed)
6738 #
6739 # NOTE: modifies $projlist, but does not remove entries from it
6740 sub fill_project_list_info {
6741         my ($projlist, @wanted_keys) = @_;
6742
6743         my $rebuild = @wanted_keys && $wanted_keys[0] eq 'rebuild-cache' && shift @wanted_keys;
6744         return fill_project_list_info_uncached($projlist, @wanted_keys)
6745                 unless $projlist_cache_lifetime && $projlist_cache_lifetime > 0;
6746
6747         use File::stat;
6748
6749         my $cache_lifetime = $rebuild ? 0 : $projlist_cache_lifetime;
6750         my $cache_file = "$cache_dir/$projlist_cache_name";
6751
6752         my @projects;
6753         my $stale = 0;
6754         my $now = time();
6755         my $cache_mtime;
6756         if ($cache_lifetime && -f $cache_file) {
6757                 $cache_mtime = stat($cache_file)->mtime;
6758                 $cache_dump = undef if $cache_mtime &&
6759                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6760         }
6761         if (defined $cache_mtime && # caching is on and $cache_file exists
6762             $cache_mtime + $cache_lifetime*60 > $now &&
6763             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6764                 # Cache hit.
6765                 $cache_dump_mtime = $cache_mtime;
6766                 $stale = $now - $cache_mtime;
6767                 my $verify = ($action eq 'summary' || $action eq 'forks') &&
6768                         gitweb_check_feature('forks');
6769                 @projects = git_filter_cached_projects($cache_dump, $projlist, $verify);
6770
6771         } else { # Cache miss.
6772                 if (defined $cache_mtime) {
6773                         # Postpone timeout by two minutes so that we get
6774                         # enough time to do our job, or to be more exact
6775                         # make cache expire after two minutes from now.
6776                         my $time = $now - $cache_lifetime*60 + 120;
6777                         utime $time, $time, $cache_file;
6778                 }
6779                 my @all_projects = git_get_projects_list();
6780                 my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6781                         fill_project_list_info_uncached(\@all_projects);
6782                 map { $all_projects_filled{$_->{'path'}} = $_ }
6783                         filter_forks_from_projects_list([values(%all_projects_filled)])
6784                         if gitweb_check_feature('forks');
6785                 $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6786                                \%all_projects_filled];
6787                 $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6788                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6789         }
6790
6791         if ($cache_lifetime && $stale > 0) {
6792                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6793                         unless $shown_stale_message;
6794                 $shown_stale_message = 1;
6795         }
6796
6797         return @projects;
6798 }
6799
6800 sub fill_project_list_info_uncached {
6801         my ($projlist, @wanted_keys) = @_;
6802         my @projects;
6803         my $filter_set = sub { return @_; };
6804         if (@wanted_keys) {
6805                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6806                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6807         }
6808
6809         my $show_ctags = gitweb_check_feature('ctags');
6810  PROJECT:
6811         foreach my $pr (@$projlist) {
6812                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6813                         my (@activity) = git_get_last_activity($pr->{'path'});
6814                         unless (@activity) {
6815                                 next PROJECT;
6816                         }
6817                         ($pr->{'age_epoch'}) = @activity;
6818                 }
6819                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6820                         my $descr = git_get_project_description($pr->{'path'}) || "";
6821                         $descr = to_utf8($descr);
6822                         $pr->{'descr_long'} = $descr;
6823                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6824                 }
6825                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6826                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6827                 }
6828                 if ($show_ctags &&
6829                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6830                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6831                 }
6832                 if ($projects_list_group_categories &&
6833                     project_info_needs_filling($pr, $filter_set->('category'))) {
6834                         my $cat = git_get_project_category($pr->{'path'}) ||
6835                                                            $project_list_default_category;
6836                         $pr->{'category'} = to_utf8($cat);
6837                 }
6838
6839                 push @projects, $pr;
6840         }
6841
6842         return @projects;
6843 }
6844
6845 sub sort_projects_list {
6846         my ($projlist, $order) = @_;
6847
6848         sub order_str {
6849                 my $key = shift;
6850                 return sub { lc($a->{$key}) cmp lc($b->{$key}) };
6851         }
6852
6853         sub order_reverse_num_then_undef {
6854                 my $key = shift;
6855                 return sub {
6856                         defined $a->{$key} ?
6857                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6858                                 (defined $b->{$key} ? 1 : 0)
6859                 };
6860         }
6861
6862         my %orderings = (
6863                 project => order_str('path'),
6864                 descr => order_str('descr_long'),
6865                 owner => order_str('owner'),
6866                 age => order_reverse_num_then_undef('age_epoch'),
6867         );
6868
6869         my $ordering = $orderings{$order};
6870         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6871 }
6872
6873 # returns a hash of categories, containing the list of project
6874 # belonging to each category
6875 sub build_projlist_by_category {
6876         my ($projlist, $from, $to) = @_;
6877         my %categories;
6878
6879         $from = 0 unless defined $from;
6880         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6881
6882         for (my $i = $from; $i <= $to; $i++) {
6883                 my $pr = $projlist->[$i];
6884                 push @{$categories{ $pr->{'category'} }}, $pr;
6885         }
6886
6887         return wantarray ? %categories : \%categories;
6888 }
6889
6890 # print 'sort by' <th> element, generating 'sort by $name' replay link
6891 # if that order is not selected
6892 sub print_sort_th {
6893         print format_sort_th(@_);
6894 }
6895
6896 sub format_sort_th {
6897         my ($name, $order, $header) = @_;
6898         my $sort_th = "";
6899         $header ||= ucfirst($name);
6900
6901         if ($order eq $name) {
6902                 $sort_th .= "<th>$header</th>\n";
6903         } else {
6904                 $sort_th .= "<th>" .
6905                             $cgi->a({-href => href(-replay=>1, order=>$name),
6906                                      -class => "header"}, $header) .
6907                             "</th>\n";
6908         }
6909
6910         return $sort_th;
6911 }
6912
6913 sub git_project_list_rows {
6914         my ($projlist, $from, $to, $check_forks) = @_;
6915
6916         $from = 0 unless defined $from;
6917         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6918
6919         my $now = time;
6920         my $alternate = 1;
6921         for (my $i = $from; $i <= $to; $i++) {
6922                 my $pr = $projlist->[$i];
6923
6924                 if ($alternate) {
6925                         print "<tr class=\"dark\">\n";
6926                 } else {
6927                         print "<tr class=\"light\">\n";
6928                 }
6929                 $alternate ^= 1;
6930
6931                 if ($check_forks) {
6932                         print "<td>";
6933                         if ($pr->{'forks'}) {
6934                                 my $nforks = scalar @{$pr->{'forks'}};
6935                                 my $s = $nforks == 1 ? '' : 's';
6936                                 if ($nforks > 0) {
6937                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
6938                                                        -title => "$nforks fork$s"}, "+");
6939                                 } else {
6940                                         print $cgi->span({-title => "$nforks fork$s"}, "+");
6941                                 }
6942                         }
6943                         print "</td>\n";
6944                 }
6945                 my $path = $pr->{'path'};
6946                 my $dotgit = $path =~ s/\.git$// ? '.git' : '';
6947                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6948                                         -class => "list"},
6949                                        esc_html_match_hl($path, $search_regexp).$dotgit) .
6950                       "</td>\n" .
6951                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6952                                         -class => "list",
6953                                         -title => $pr->{'descr_long'}},
6954                                         $search_regexp
6955                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
6956                                                                     $pr->{'descr'}, $search_regexp)
6957                                         : esc_html($pr->{'descr'})) .
6958                       "</td>\n";
6959                 unless ($omit_owner) {
6960                         print "<td><i>" . ($owner_link_hook
6961                                           ? $cgi->a({-href => $owner_link_hook->($pr->{'owner'}), -class => "list"},
6962                                                     chop_and_escape_str($pr->{'owner'}, 15))
6963                                           : chop_and_escape_str($pr->{'owner'}, 15)) . "</i></td>\n";
6964                 }
6965                 unless ($omit_age_column) {
6966                         my ($age_epoch, $age_string) = ($pr->{'age_epoch'});
6967                         $age_string = defined $age_epoch ? age_string($age_epoch, $now) : "No commits";
6968                         print "<td class=\"". age_class($age_epoch, $now) . "\">" . $age_string . "</td>\n";
6969                 }
6970                 print"<td class=\"link\">" .
6971                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . $barsep .
6972                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "log") . $barsep .
6973                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
6974                       ($pr->{'forks'} ? $barsep . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
6975                       "</td>\n" .
6976                       "</tr>\n";
6977         }
6978 }
6979
6980 sub git_project_list_body {
6981         # actually uses global variable $project
6982         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action, $keep_top) = @_;
6983         my @projects = @$projlist;
6984
6985         my $check_forks = gitweb_check_feature('forks');
6986         my $show_ctags  = gitweb_check_feature('ctags');
6987         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
6988         $check_forks = undef
6989                 if ($tagfilter || $search_regexp);
6990
6991         # filtering out forks before filling info allows us to do less work
6992         if ($check_forks) {
6993                 @projects = filter_forks_from_projects_list(\@projects);
6994                 push @projects, { 'path' => "$project_filter.git" }
6995                         if $project_filter && $keep_top && is_valid_project("$project_filter.git");
6996         }
6997         # search_projects_list pre-fills required info
6998         @projects = search_projects_list(\@projects,
6999                                          'search_regexp' => $search_regexp,
7000                                          'tagfilter'  => $tagfilter)
7001                 if ($tagfilter || $search_regexp);
7002         # fill the rest
7003         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
7004         push @all_fields, 'age_epoch' unless($omit_age_column);
7005         push @all_fields, 'owner' unless($omit_owner);
7006         @projects = fill_project_list_info(\@projects, @all_fields);
7007
7008         $order ||= $default_projects_order;
7009         $from = 0 unless defined $from;
7010         $to = $#projects if (!defined $to || $#projects < $to);
7011
7012         # short circuit
7013         if ($from > $to) {
7014                 print "<center>\n".
7015                       "<b>No such projects found</b><br />\n".
7016                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
7017                       "</center>\n<br />\n";
7018                 return;
7019         }
7020
7021         @projects = sort_projects_list(\@projects, $order);
7022
7023         if ($show_ctags) {
7024                 my $ctags = git_gather_all_ctags(\@projects);
7025                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
7026                 print git_show_project_tagcloud($cloud, 64);
7027         }
7028
7029         print "<table class=\"project_list\">\n";
7030         unless ($no_header) {
7031                 print "<tr>\n";
7032                 if ($check_forks) {
7033                         print "<th></th>\n";
7034                 }
7035                 print_sort_th('project', $order, 'Project');
7036                 print_sort_th('descr', $order, 'Description');
7037                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
7038                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
7039                 print "<th></th>\n" . # for links
7040                       "</tr>\n";
7041         }
7042
7043         if ($projects_list_group_categories) {
7044                 # only display categories with projects in the $from-$to window
7045                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
7046                 my %categories = build_projlist_by_category(\@projects, $from, $to);
7047                 foreach my $cat (sort keys %categories) {
7048                         unless ($cat eq "") {
7049                                 print "<tr>\n";
7050                                 if ($check_forks) {
7051                                         print "<td></td>\n";
7052                                 }
7053                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
7054                                 print "</tr>\n";
7055                         }
7056
7057                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
7058                 }
7059         } else {
7060                 git_project_list_rows(\@projects, $from, $to, $check_forks);
7061         }
7062
7063         if (defined $extra) {
7064                 print "<tr class=\"extra\">\n";
7065                 if ($check_forks) {
7066                         print "<td></td>\n";
7067                 }
7068                 print "<td colspan=\"5\" class=\"extra\">$extra</td>\n" .
7069                       "</tr>\n";
7070         }
7071         print "</table>\n";
7072 }
7073
7074 sub git_log_body {
7075         # uses global variable $project
7076         my ($commitlist, $from, $to, $refs, $extra) = @_;
7077
7078         $from = 0 unless defined $from;
7079         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7080
7081         for (my $i = 0; $i <= $to; $i++) {
7082                 my %co = %{$commitlist->[$i]};
7083                 next if !%co;
7084                 my $commit = $co{'id'};
7085                 my $ref = format_ref_marker($refs, $commit);
7086                 git_print_header_div('commit',
7087                                "<span class=\"age\">$co{'age_string'}</span>" .
7088                                esc_html($co{'title'}),
7089                                $commit, undef, $ref);
7090                 print "<div class=\"title_text\">\n" .
7091                       "<div class=\"log_link\">\n" .
7092                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
7093                       $barsep .
7094                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
7095                       $barsep .
7096                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
7097                       "<br/>\n" .
7098                       "</div>\n";
7099                       git_print_authorship(\%co, -tag => 'span');
7100                       print "<br/>\n</div>\n";
7101
7102                 print "<div class=\"log_body\">\n";
7103                 git_print_log($co{'comment'}, -final_empty_line=> 1);
7104                 print "</div>\n";
7105         }
7106         if ($extra) {
7107                 print "<div class=\"page_nav_trailer\">\n";
7108                 print "$extra\n";
7109                 print "</div>\n";
7110         }
7111 }
7112
7113 sub git_shortlog_body {
7114         # uses global variable $project
7115         my ($commitlist, $from, $to, $refs, $extra) = @_;
7116
7117         $from = 0 unless defined $from;
7118         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7119
7120         print "<table class=\"shortlog\">\n";
7121         my $alternate = 1;
7122         for (my $i = $from; $i <= $to; $i++) {
7123                 my %co = %{$commitlist->[$i]};
7124                 my $commit = $co{'id'};
7125                 my $ref = format_ref_marker($refs, $commit);
7126                 if ($alternate) {
7127                         print "<tr class=\"dark\">\n";
7128                 } else {
7129                         print "<tr class=\"light\">\n";
7130                 }
7131                 $alternate ^= 1;
7132                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
7133                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7134                       format_author_html('td', \%co, 10) . "<td>";
7135                 print format_subject_html($co{'title'}, $co{'title_short'},
7136                                           href(action=>"commit", hash=>$commit), $ref);
7137                 print "</td>\n" .
7138                       "<td class=\"link\">" .
7139                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . $barsep .
7140                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . $barsep .
7141                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
7142                 my $snapshot_links = format_snapshot_links($commit);
7143                 if (defined $snapshot_links) {
7144                         print $barsep . $snapshot_links;
7145                 }
7146                 print "</td>\n" .
7147                       "</tr>\n";
7148         }
7149         if (defined $extra) {
7150                 print "<tr class=\"extra\">\n" .
7151                       "<td colspan=\"4\" class=\"extra\">$extra</td>\n" .
7152                       "</tr>\n";
7153         }
7154         print "</table>\n";
7155 }
7156
7157 sub git_history_body {
7158         # Warning: assumes constant type (blob or tree) during history
7159         my ($commitlist, $from, $to, $refs, $extra,
7160             $file_name, $file_hash, $ftype) = @_;
7161
7162         $from = 0 unless defined $from;
7163         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
7164
7165         print "<table class=\"history\">\n";
7166         my $alternate = 1;
7167         for (my $i = $from; $i <= $to; $i++) {
7168                 my %co = %{$commitlist->[$i]};
7169                 if (!%co) {
7170                         next;
7171                 }
7172                 my $commit = $co{'id'};
7173
7174                 my $ref = format_ref_marker($refs, $commit);
7175
7176                 if ($alternate) {
7177                         print "<tr class=\"dark\">\n";
7178                 } else {
7179                         print "<tr class=\"light\">\n";
7180                 }
7181                 $alternate ^= 1;
7182                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7183         # shortlog:   format_author_html('td', \%co, 10)
7184                       format_author_html('td', \%co, 15, 3) . "<td>";
7185                 # originally git_history used chop_str($co{'title'}, 50)
7186                 print format_subject_html($co{'title'}, $co{'title_short'},
7187                                           href(action=>"commit", hash=>$commit), $ref);
7188                 print "</td>\n" .
7189                       "<td class=\"link\">" .
7190                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . $barsep .
7191                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
7192
7193                 if ($ftype eq 'blob') {
7194                         my $blob_current = $file_hash;
7195                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
7196                         if (defined $blob_current && defined $blob_parent &&
7197                                         $blob_current ne $blob_parent) {
7198                                 print $barsep .
7199                                         $cgi->a({-href => href(action=>"blobdiff",
7200                                                                hash=>$blob_current, hash_parent=>$blob_parent,
7201                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
7202                                                                file_name=>$file_name)},
7203                                                 "diff to current");
7204                         }
7205                 }
7206                 print "</td>\n" .
7207                       "</tr>\n";
7208         }
7209         if (defined $extra) {
7210                 print "<tr class=\"extra\">\n" .
7211                       "<td colspan=\"4\" class=\"extra\">$extra</td>\n" .
7212                       "</tr>\n";
7213         }
7214         print "</table>\n";
7215 }
7216
7217 sub git_tags_body {
7218         # uses global variable $project
7219         my ($taglist, $from, $to, $extra, $head_at, $full, $order) = @_;
7220         $from = 0 unless defined $from;
7221         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
7222         $order ||= $default_refs_order;
7223
7224         print "<table class=\"tags\">\n";
7225         if ($full) {
7226                 print "<tr class=\"tags_header\">\n";
7227                 print_sort_th('age', $order, 'Last Change');
7228                 print_sort_th('name', $order, 'Name');
7229                 print "<th></th>\n" . # for comment
7230                       "<th></th>\n" . # for tag
7231                       "<th></th>\n" . # for links
7232                       "</tr>\n";
7233         }
7234         my $alternate = 1;
7235         for (my $i = $from; $i <= $to; $i++) {
7236                 my $entry = $taglist->[$i];
7237                 my %tag = %$entry;
7238                 my $comment = $tag{'subject'};
7239                 my $comment_short;
7240                 if (defined $comment) {
7241                         $comment_short = chop_str($comment, 30, 5);
7242                 }
7243                 my $curr = defined $head_at && $tag{'id'} eq $head_at;
7244                 if ($alternate) {
7245                         print "<tr class=\"dark\">\n";
7246                 } else {
7247                         print "<tr class=\"light\">\n";
7248                 }
7249                 $alternate ^= 1;
7250                 if (defined $tag{'age'}) {
7251                         print "<td><i>$tag{'age'}</i></td>\n";
7252                 } else {
7253                         print "<td></td>\n";
7254                 }
7255                 print(($curr ? "<td class=\"current_head\">" : "<td>") .
7256                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
7257                                -class => "list name"}, esc_html($tag{'name'})) .
7258                       "</td>\n" .
7259                       "<td>");
7260                 if (defined $comment) {
7261                         print format_subject_html($comment, $comment_short,
7262                                                   href(action=>"tag", hash=>$tag{'id'}));
7263                 }
7264                 print "</td>\n" .
7265                       "<td class=\"selflink\">";
7266                 if ($tag{'type'} eq "tag") {
7267                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
7268                 } else {
7269                         print "&#160;";
7270                 }
7271                 print "</td>\n" .
7272                       "<td class=\"link\">" . $barsep .
7273                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
7274                 if ($tag{'reftype'} eq "commit") {
7275                         print $barsep . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "log");
7276                         print $barsep . $cgi->a({-href => href(action=>"tree", hash=>$tag{'fullname'})}, "tree") if $full;
7277                 } elsif ($tag{'reftype'} eq "blob") {
7278                         print $barsep . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
7279                 }
7280                 print "</td>\n" .
7281                       "</tr>";
7282         }
7283         if (defined $extra) {
7284                 print "<tr class=\"extra\">\n" .
7285                       "<td colspan=\"5\" class=\"extra\">$extra</td>\n" .
7286                       "</tr>\n";
7287         }
7288         print "</table>\n";
7289 }
7290
7291 sub git_heads_body {
7292         # uses global variable $project
7293         my ($headlist, $head_at, $from, $to, $extra) = @_;
7294         $from = 0 unless defined $from;
7295         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
7296
7297         print "<table class=\"heads\">\n";
7298         my $alternate = 1;
7299         for (my $i = $from; $i <= $to; $i++) {
7300                 my $entry = $headlist->[$i];
7301                 my %ref = %$entry;
7302                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
7303                 if ($alternate) {
7304                         print "<tr class=\"dark\">\n";
7305                 } else {
7306                         print "<tr class=\"light\">\n";
7307                 }
7308                 $alternate ^= 1;
7309                 print "<td><i>$ref{'age'}</i></td>\n" .
7310                       ($curr ? "<td class=\"current_head\">" : "<td>") .
7311                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
7312                                -class => "list name"},esc_html($ref{'name'})) .
7313                       "</td>\n" .
7314                       "<td class=\"link\">" .
7315                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "log") . $barsep .
7316                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
7317                       "</td>\n" .
7318                       "</tr>";
7319         }
7320         if (defined $extra) {
7321                 print "<tr class=\"extra\">\n" .
7322                       "<td colspan=\"3\" class=\"extra\">$extra</td>\n" .
7323                       "</tr>\n";
7324         }
7325         print "</table>\n";
7326 }
7327
7328 # Display a single remote block
7329 sub git_remote_block {
7330         my ($remote, $rdata, $limit, $head) = @_;
7331
7332         my $heads = $rdata->{'heads'};
7333         my $fetch = $rdata->{'fetch'};
7334         my $push = $rdata->{'push'};
7335
7336         my $urls_table = "<table class=\"projects_list\">\n" ;
7337
7338         if (defined $fetch) {
7339                 if ($fetch eq $push) {
7340                         $urls_table .= format_repo_url("URL", $fetch);
7341                 } else {
7342                         $urls_table .= format_repo_url("Fetch&#160;URL", $fetch);
7343                         $urls_table .= format_repo_url("Push&#160;URL", $push) if defined $push;
7344                 }
7345         } elsif (defined $push) {
7346                 $urls_table .= format_repo_url("Push&#160;URL", $push);
7347         } else {
7348                 $urls_table .= format_repo_url("", "No remote URL");
7349         }
7350
7351         $urls_table .= "</table>\n";
7352
7353         my $dots;
7354         if (defined $limit && $limit < @$heads) {
7355                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
7356         }
7357
7358         print $urls_table;
7359         git_heads_body($heads, $head, 0, $limit, $dots);
7360 }
7361
7362 # Display a list of remote names with the respective fetch and push URLs
7363 sub git_remotes_list {
7364         my ($remotedata, $limit) = @_;
7365         print "<table class=\"heads\">\n";
7366         my $alternate = 1;
7367         my @remotes = sort keys %$remotedata;
7368
7369         my $limited = $limit && $limit < @remotes;
7370
7371         $#remotes = $limit - 1 if $limited;
7372
7373         while (my $remote = shift @remotes) {
7374                 my $rdata = $remotedata->{$remote};
7375                 my $fetch = $rdata->{'fetch'};
7376                 my $push = $rdata->{'push'};
7377                 if ($alternate) {
7378                         print "<tr class=\"dark\">\n";
7379                 } else {
7380                         print "<tr class=\"light\">\n";
7381                 }
7382                 $alternate ^= 1;
7383                 print "<td>" .
7384                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
7385                                -class=> "list name"},esc_html($remote)) .
7386                       "</td>";
7387                 print "<td class=\"link\">" .
7388                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
7389                       $barsep .
7390                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
7391                       "</td>";
7392
7393                 print "</tr>\n";
7394         }
7395
7396         if ($limited) {
7397                 print "<tr>\n" .
7398                       "<td colspan=\"3\">" .
7399                       $cgi->a({-href => href(action=>"remotes")}, "...") .
7400                       "</td>\n" . "</tr>\n";
7401         }
7402
7403         print "</table>";
7404 }
7405
7406 # Display remote heads grouped by remote, unless there are too many
7407 # remotes, in which case we only display the remote names
7408 sub git_remotes_body {
7409         my ($remotedata, $limit, $head) = @_;
7410         if ($limit and $limit < keys %$remotedata) {
7411                 git_remotes_list($remotedata, $limit);
7412         } else {
7413                 fill_remote_heads($remotedata);
7414                 while (my ($remote, $rdata) = each %$remotedata) {
7415                         git_print_section({-class=>"remote", -id=>$remote},
7416                                 ["remotes", $remote, $remote], sub {
7417                                         git_remote_block($remote, $rdata, $limit, $head);
7418                                 });
7419                 }
7420         }
7421 }
7422
7423 sub git_search_message {
7424         my %co = @_;
7425
7426         my $greptype;
7427         if ($searchtype eq 'commit') {
7428                 $greptype = "--grep=";
7429         } elsif ($searchtype eq 'author') {
7430                 $greptype = "--author=";
7431         } elsif ($searchtype eq 'committer') {
7432                 $greptype = "--committer=";
7433         }
7434         $greptype .= $searchtext;
7435         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
7436                                        $greptype, '--regexp-ignore-case',
7437                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
7438
7439         my $paging_nav = "<span class=\"paging_nav\">";
7440         if ($page > 0) {
7441                 $paging_nav .= tabspan(
7442                         $cgi->a({-href => href(-replay=>1, page=>undef)},
7443                                 "first")) .
7444                         $mdotsep . tabspan(
7445                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
7446                                  -accesskey => "p", -title => "Alt-p"}, "prev"));
7447         } else {
7448                 $paging_nav .= tabspan("first", 1, 0).${mdotsep}.tabspan("prev", 0, 1);
7449         }
7450         my $next_link = '';
7451         if ($#commitlist >= 100) {
7452                 $next_link = tabspan(
7453                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7454                                  -accesskey => "n", -title => "Alt-n"}, "next"));
7455                 $paging_nav .= "${mdotsep}$next_link";
7456         } else {
7457                 $paging_nav .= ${mdotsep}.tabspan("next", 0, 1);
7458         }
7459
7460         git_header_html();
7461
7462         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav."</span>");
7463         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7464         if ($page == 0 && !@commitlist) {
7465                 print "<p>No match.</p>\n";
7466         } else {
7467                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
7468         }
7469
7470         git_footer_html();
7471 }
7472
7473 sub git_search_changes {
7474         my %co = @_;
7475
7476         local $/ = "\n";
7477         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
7478                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
7479                 ($search_use_regexp ? '--pickaxe-regex' : ()))
7480                         or die_error(500, "Open git-log failed");
7481
7482         git_header_html();
7483
7484         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7485         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7486
7487         print "<table class=\"pickaxe search\">\n";
7488         my $alternate = 1;
7489         undef %co;
7490         my @files;
7491         while (my $line = to_utf8(scalar <$fd>)) {
7492                 chomp $line;
7493                 next unless $line;
7494
7495                 my %set = parse_difftree_raw_line($line);
7496                 if (defined $set{'commit'}) {
7497                         # finish previous commit
7498                         if (%co) {
7499                                 print "</td>\n" .
7500                                       "<td class=\"link\">" .
7501                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7502                                               "commit") .
7503                                       $barsep .
7504                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7505                                                              hash_base=>$co{'id'})},
7506                                               "tree") .
7507                                       "</td>\n" .
7508                                       "</tr>\n";
7509                         }
7510
7511                         if ($alternate) {
7512                                 print "<tr class=\"dark\">\n";
7513                         } else {
7514                                 print "<tr class=\"light\">\n";
7515                         }
7516                         $alternate ^= 1;
7517                         %co = parse_commit($set{'commit'});
7518                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
7519                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7520                               "<td><i>$author</i></td>\n" .
7521                               "<td>" .
7522                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7523                                       -class => "list subject"},
7524                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
7525                 } elsif (defined $set{'to_id'}) {
7526                         next if ($set{'to_id'} =~ m/^0{40}$/);
7527
7528                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
7529                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
7530                                       -class => "list"},
7531                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
7532                               "<br/>\n";
7533                 }
7534         }
7535         close $fd;
7536
7537         # finish last commit (warning: repetition!)
7538         if (%co) {
7539                 print "</td>\n" .
7540                       "<td class=\"link\">" .
7541                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7542                               "commit") .
7543                       $barsep .
7544                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7545                                              hash_base=>$co{'id'})},
7546                               "tree") .
7547                       "</td>\n" .
7548                       "</tr>\n";
7549         }
7550
7551         print "</table>\n";
7552
7553         git_footer_html();
7554 }
7555
7556 sub git_search_files {
7557         my %co = @_;
7558
7559         local $/ = "\n";
7560         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
7561                 $search_use_regexp ? ('-E', '-i') : '-F',
7562                 $searchtext, $co{'tree'})
7563                         or die_error(500, "Open git-grep failed");
7564
7565         git_header_html();
7566
7567         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7568         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7569
7570         print "<table class=\"grep_search\">\n";
7571         my $alternate = 1;
7572         my $matches = 0;
7573         my $lastfile = '';
7574         my $file_href;
7575         while (my $line = to_utf8(scalar <$fd>)) {
7576                 chomp $line;
7577                 my ($file, $lno, $ltext, $binary);
7578                 last if ($matches++ > 1000);
7579                 if ($line =~ /^Binary file (.+) matches$/) {
7580                         $file = $1;
7581                         $binary = 1;
7582                 } else {
7583                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
7584                         $file =~ s/^$co{'tree'}://;
7585                 }
7586                 if ($file ne $lastfile) {
7587                         $lastfile and print "</td></tr>\n";
7588                         if ($alternate++) {
7589                                 print "<tr class=\"dark\">\n";
7590                         } else {
7591                                 print "<tr class=\"light\">\n";
7592                         }
7593                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
7594                                           file_name=>$file);
7595                         print "<td class=\"list\">".
7596                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
7597                         print "</td><td>\n";
7598                         $lastfile = $file;
7599                 }
7600                 if ($binary) {
7601                         print "<div class=\"binary\">Binary file</div>\n";
7602                 } else {
7603                         $ltext = untabify($ltext);
7604                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
7605                                 $ltext = esc_html($1, -nbsp=>1);
7606                                 $ltext .= '<span class="match">';
7607                                 $ltext .= esc_html($2, -nbsp=>1);
7608                                 $ltext .= '</span>';
7609                                 $ltext .= esc_html($3, -nbsp=>1);
7610                         } else {
7611                                 $ltext = esc_html($ltext, -nbsp=>1);
7612                         }
7613                         print "<div class=\"pre\">" .
7614                                 $cgi->a({-href => $file_href.'#l'.$lno,
7615                                         -class => "linenr"}, sprintf('%4i ', $lno)) .
7616                                 $ltext . "</div>\n";
7617                 }
7618         }
7619         if ($lastfile) {
7620                 print "</td></tr>\n";
7621                 if ($matches > 1000) {
7622                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
7623                 }
7624         } else {
7625                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
7626         }
7627         close $fd;
7628
7629         print "</table>\n";
7630
7631         git_footer_html();
7632 }
7633
7634 sub git_search_grep_body {
7635         my ($commitlist, $from, $to, $extra) = @_;
7636         $from = 0 unless defined $from;
7637         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7638
7639         print "<table class=\"commit_search\">\n";
7640         my $alternate = 1;
7641         for (my $i = $from; $i <= $to; $i++) {
7642                 my %co = %{$commitlist->[$i]};
7643                 if (!%co) {
7644                         next;
7645                 }
7646                 my $commit = $co{'id'};
7647                 if ($alternate) {
7648                         print "<tr class=\"dark\">\n";
7649                 } else {
7650                         print "<tr class=\"light\">\n";
7651                 }
7652                 $alternate ^= 1;
7653                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7654                       format_author_html('td', \%co, 15, 5) .
7655                       "<td>" .
7656                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7657                                -class => "list subject"},
7658                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
7659                 my $comment = $co{'comment'};
7660                 foreach my $line (@$comment) {
7661                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
7662                                 my ($lead, $match, $trail) = ($1, $2, $3);
7663                                 $match = chop_str($match, 70, 5, 'center');
7664                                 my $contextlen = int((80 - length($match))/2);
7665                                 $contextlen = 30 if ($contextlen > 30);
7666                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
7667                                 $trail = chop_str($trail, $contextlen, 10, 'right');
7668
7669                                 $lead  = esc_html($lead);
7670                                 $match = esc_html($match);
7671                                 $trail = esc_html($trail);
7672
7673                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
7674                         }
7675                 }
7676                 print "</td>\n" .
7677                       "<td class=\"link\">" .
7678                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7679                       $barsep .
7680                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7681                       $barsep .
7682                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7683                 print "</td>\n" .
7684                       "</tr>\n";
7685         }
7686         if (defined $extra) {
7687                 print "<tr class=\"extra\">\n" .
7688                       "<td colspan=\"3\" class=\"extra\">$extra</td>\n" .
7689                       "</tr>\n";
7690         }
7691         print "</table>\n";
7692 }
7693
7694 ## ======================================================================
7695 ## ======================================================================
7696 ## actions
7697
7698 sub git_project_list_load {
7699         my $empty_list_ok = shift;
7700         my $order = $input_params{'order'};
7701         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7702                 die_error(400, "Unknown order parameter");
7703         }
7704
7705         my @list = git_get_projects_list($project_filter, $strict_export);
7706         if ($project_filter && (!@list || !gitweb_check_feature('forks'))) {
7707                 push @list, { 'path' => "$project_filter.git" }
7708                         if is_valid_project("$project_filter.git");
7709         }
7710         if (!@list) {
7711                 die_error(404, "No projects found") unless $empty_list_ok;
7712         }
7713
7714         return (\@list, $order);
7715 }
7716
7717 sub git_frontpage {
7718         my ($projlist, $order);
7719
7720         if ($frontpage_no_project_list) {
7721                 $project = undef;
7722                 $project_filter = undef;
7723         } else {
7724                 ($projlist, $order) = git_project_list_load(1);
7725         }
7726         git_header_html();
7727         if (defined $home_text && -f $home_text) {
7728                 print "<div class=\"index_include\">\n";
7729                 insert_file($home_text);
7730                 print "</div>\n";
7731         }
7732         git_project_search_form($searchtext, $search_use_regexp);
7733         if ($frontpage_no_project_list) {
7734                 my $show_ctags = gitweb_check_feature('ctags');
7735                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7736                         my @projects = git_get_projects_list($project_filter, $strict_export);
7737                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7738                         @projects = fill_project_list_info(\@projects, 'ctags');
7739                         my $ctags = git_gather_all_ctags(\@projects);
7740                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7741                         print git_show_project_tagcloud($cloud, 64);
7742                 }
7743         } else {
7744                 git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7745         }
7746         git_footer_html();
7747 }
7748
7749 sub git_project_list {
7750         my ($projlist, $order) = git_project_list_load();
7751         git_header_html();
7752         if (!$frontpage_no_project_list && 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();
7758         git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7759         git_footer_html();
7760 }
7761
7762 sub git_forks {
7763         my $order = $input_params{'order'};
7764         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7765                 die_error(400, "Unknown order parameter");
7766         }
7767
7768         my $filter = $project;
7769         $filter =~ s/\.git$//;
7770         my @list = git_get_projects_list($filter);
7771         if (!@list) {
7772                 die_error(404, "No forks found");
7773         }
7774
7775         git_header_html();
7776         git_print_page_nav('','');
7777         git_print_header_div('summary', "$project forks");
7778         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7779         git_footer_html();
7780 }
7781
7782 sub git_project_index {
7783         my @projects = git_get_projects_list($project_filter, $strict_export);
7784         if (!@projects) {
7785                 die_error(404, "No projects found");
7786         }
7787
7788         print $cgi->header(
7789                 -type => 'text/plain',
7790                 -charset => 'utf-8',
7791                 -content_disposition => 'inline; filename="index.aux"');
7792
7793         foreach my $pr (@projects) {
7794                 if (!exists $pr->{'owner'}) {
7795                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7796                 }
7797
7798                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7799                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7800                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7801                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7802                 $path  =~ s/ /\+/g;
7803                 $owner =~ s/ /\+/g;
7804
7805                 print "$path $owner\n";
7806         }
7807 }
7808
7809 sub git_summary {
7810         my $descr = git_get_project_description($project) || "none";
7811         my %co = parse_commit("HEAD");
7812         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7813         my $head = $co{'id'};
7814         my $remote_heads = gitweb_check_feature('remote_heads');
7815
7816         my $owner = git_get_project_owner($project);
7817         my $homepage = git_get_project_config('homepage');
7818         my $base_url = git_get_project_config('baseurl');
7819
7820         my $refs = git_get_references();
7821         # These get_*_list functions return one more to allow us to see if
7822         # there are more ...
7823         my @taglist  = git_get_tags_list(16);
7824         my @headlist = git_get_heads_list(16);
7825         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7826         my @forklist;
7827         my $check_forks = gitweb_check_feature('forks');
7828
7829         if ($check_forks) {
7830                 # find forks of a project
7831                 my $filter = $project;
7832                 $filter =~ s/\.git$//;
7833                 @forklist = git_get_projects_list($filter);
7834                 # filter out forks of forks
7835                 @forklist = filter_forks_from_projects_list(\@forklist)
7836                         if (@forklist);
7837         }
7838
7839         git_header_html();
7840         git_print_page_nav('summary','', $head);
7841
7842         if ($check_forks and $project =~ m#/#) {
7843                 my $xproject = $project; $xproject =~ s#/[^/]+$#.git#; #
7844                 my $r = $cgi->a({-href=> href(project => $xproject, action => 'summary')}, $xproject);
7845                 print <<EOT;
7846 <div class="forkinfo">
7847 This project is a fork of the $r project. If you have that one
7848 already cloned locally, you can use
7849 <pre>git clone --reference /path/to/your/$xproject/incarnation mirror_URL</pre>
7850 to save bandwidth during cloning.
7851 </div>
7852 EOT
7853         }
7854
7855         print "<div class=\"title\">&#160;</div>\n";
7856         print "<table class=\"projects_list\">\n" .
7857               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7858         if ($homepage) {
7859                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7860         }
7861         if ($base_url) {
7862                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7863         }
7864         if ($owner and not $omit_owner) {
7865                 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . ($owner_link_hook
7866                         ? $cgi->a({-href => $owner_link_hook->($owner)}, email_obfuscate($owner))
7867                         : email_obfuscate($owner)) . "</td></tr>\n";
7868         }
7869         if (defined $cd{'rfc2822'}) {
7870                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7871                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7872         }
7873         print format_lastrefresh_row(), "\n";
7874
7875         # use per project git URL list in $projectroot/$project/cloneurl
7876         # or make project git URL from git base URL and project name
7877         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7878         my @url_list = git_get_project_url_list($project);
7879         @url_list = map { "$_/$project" } @git_base_url_list unless @url_list;
7880         foreach my $git_url (@url_list) {
7881                 next unless $git_url;
7882                 print format_repo_url($url_tag, $git_url);
7883                 $url_tag = "";
7884         }
7885         @url_list = map { "$_/$project" } @git_base_push_urls;
7886         if ((git_get_project_config("showpush", '--bool')||'false') eq "true" ||
7887             -f "$projectroot/$project/.nofetch") {
7888                 $url_tag = "push&#160;URL";
7889                 foreach my $git_push_url (@url_list) {
7890                         next unless $git_push_url;
7891                         my $hint = $https_hint_html && $git_push_url =~ /^https:/i ?
7892                                 "&#160;$https_hint_html" : '';
7893                         print "<tr class=\"metadata_pushurl\"><td>$url_tag</td><td>$git_push_url$hint</td></tr>\n";
7894                         $url_tag = "";
7895                 }
7896         }
7897
7898         if (defined($git_base_bundles_url) && -d "$projectroot/$project/bundles") {
7899                 my $projname = $project;
7900                 $projname =~ s|^.*/||;
7901                 my $url = "$git_base_bundles_url/$project/bundles";
7902                 print format_repo_url(
7903                         "bundle&#160;info",
7904                         "<a rel='nofollow' href='$url'>$projname downloadable bundles</a>");
7905         }
7906
7907         # Tag cloud
7908         my $show_ctags = gitweb_check_feature('ctags');
7909         if ($show_ctags) {
7910                 my $ctags = git_get_project_ctags($project);
7911                 if (%$ctags || $show_ctags !~ /^\d+$/) {
7912                         # without ability to add tags, don't show if there are none
7913                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7914                         print "<tr id=\"metadata_ctags\">" .
7915                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
7916                         print "</td>\n<td>" unless %$ctags;
7917                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
7918                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
7919                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
7920                               unless $show_ctags =~ /^\d+$/;
7921                         print "</td>\n<td>" if %$ctags;
7922                         print git_show_project_tagcloud($cloud, 48)."</td>" .
7923                               "</tr>\n";
7924                 }
7925         }
7926
7927         print "</table>\n";
7928
7929         # If XSS prevention is on, we don't include README.html.
7930         # TODO: Allow a readme in some safe format.
7931         if (!$prevent_xss) {
7932                 my $readme_name = "readme";
7933                 my $readme;
7934                 if (-s "$projectroot/$project/README.html") {
7935                         $readme = collect_html_file("$projectroot/$project/README.html");
7936                 } else {
7937                         $readme = collect_output($git_automatic_readme_html, "$projectroot/$project");
7938                         if ($readme && $readme =~ /^<!-- README NAME: ((?:[^-]|(?:-(?!-)))+) -->/) {
7939                                 $readme_name = $1;
7940                                 $readme =~ s/^<!--(?:[^-]|(?:-(?!-)))*-->\n?//;
7941                         }
7942                 }
7943                 if (defined($readme)) {
7944                         $readme =~ s/^\s+//s;
7945                         $readme =~ s/\s+$//s;
7946                         print "<div class=\"title\">$readme_name</div>\n",
7947                               "<div id=\"readme\" class=\"readme\">\n",
7948                               $readme,
7949                               "\n</div>\n"
7950                         if $readme ne '';
7951                 }
7952         }
7953
7954         # we need to request one more than 16 (0..15) to check if
7955         # those 16 are all
7956         my @commitlist = $head ? parse_commits($head, 17) : ();
7957         if (@commitlist) {
7958                 git_print_header_div('shortlog');
7959                 git_shortlog_body(\@commitlist, 0, 15, $refs,
7960                                   $#commitlist <=  15 ? undef :
7961                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
7962         }
7963
7964         if (@taglist) {
7965                 git_print_header_div('tags');
7966                 git_tags_body(\@taglist, 0, 15,
7967                               $#taglist <=  15 ? undef :
7968                               $cgi->a({-href => href(action=>"tags")}, "..."));
7969         }
7970
7971         if (@headlist) {
7972                 git_print_header_div('heads');
7973                 git_heads_body(\@headlist, $head, 0, 15,
7974                                $#headlist <= 15 ? undef :
7975                                $cgi->a({-href => href(action=>"heads")}, "..."));
7976         }
7977
7978         if (%remotedata) {
7979                 git_print_header_div('remotes');
7980                 git_remotes_body(\%remotedata, 15, $head);
7981         }
7982
7983         if (@forklist) {
7984                 git_print_header_div('forks');
7985                 git_project_list_body(\@forklist, 'age', 0, 15,
7986                                       $#forklist <= 15 ? undef :
7987                                       $cgi->a({-href => href(action=>"forks")}, "..."),
7988                                       'no_header', 'forks');
7989         }
7990
7991         git_footer_html();
7992 }
7993
7994 sub git_tag {
7995         my %tag = parse_tag($hash);
7996
7997         if (! %tag) {
7998                 die_error(404, "Unknown tag object");
7999         }
8000
8001         my $fullhash;
8002         $fullhash = $hash if $hash =~ m/^[0-9a-fA-F]{40}$/;
8003         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8004
8005         my $obj = $tag{'object'};
8006         git_header_html();
8007         if ($tag{'type'} eq 'commit') {
8008                 git_print_page_nav('','', $obj,undef,$obj);
8009                 git_print_header_div('commit', esc_html($tag{'name'}), $hash);
8010         } else {
8011                 if ($tag{'type'} eq 'tree') {
8012                         git_print_page_nav('',['commit','commitdiff'], undef,undef,$obj);
8013                 } else {
8014                         git_print_page_nav('',['commit','commitdiff','tree'], undef,undef,undef);
8015                 }
8016                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8017         }
8018         print "<div class=\"title_text\">\n" .
8019               "<table class=\"object_header\">\n" .
8020               "<tr><td>tag</td><td class=\"sha1\">$fullhash</td></tr>\n" .
8021               "<tr>\n" .
8022               "<td>object</td>\n" .
8023               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
8024                                $tag{'object'}) . "</td>\n" .
8025               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
8026                                               $tag{'type'}) . "</td>\n" .
8027               "</tr>\n";
8028         if (defined($tag{'author'})) {
8029                 git_print_authorship_rows(\%tag, 'author');
8030         }
8031         print "</table>\n\n" .
8032               "</div>\n";
8033         print "<div class=\"page_body\">";
8034         my $comment = $tag{'comment'};
8035         foreach my $line (@$comment) {
8036                 chomp $line;
8037                 print esc_html($line, -nbsp=>1) . "<br/>\n";
8038         }
8039         print "</div>\n";
8040         git_footer_html();
8041 }
8042
8043 sub git_blame_common {
8044         my $format = shift || 'porcelain';
8045         if ($format eq 'porcelain' && $input_params{'javascript'}) {
8046                 $format = 'incremental';
8047                 $action = 'blame_incremental'; # for page title etc
8048         }
8049
8050         # permissions
8051         gitweb_check_feature('blame')
8052                 or die_error(403, "Blame view not allowed");
8053
8054         # error checking
8055         die_error(400, "No file name given") unless $file_name;
8056         $hash_base ||= git_get_head_hash($project);
8057         die_error(404, "Couldn't find base commit") unless $hash_base;
8058         my %co = parse_commit($hash_base)
8059                 or die_error(404, "Commit not found");
8060         my $ftype = "blob";
8061         if (!defined $hash) {
8062                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
8063                         or die_error(404, "Error looking up file");
8064         } else {
8065                 $ftype = git_get_type($hash);
8066                 if ($ftype !~ "blob") {
8067                         die_error(400, "Object is not a blob");
8068                 }
8069         }
8070
8071         my $fd;
8072         if ($format eq 'incremental') {
8073                 # get file contents (as base)
8074                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
8075                         or die_error(500, "Open git-cat-file failed");
8076         } elsif ($format eq 'data') {
8077                 # run git-blame --incremental
8078                 defined($fd = git_cmd_pipe "blame", "--incremental",
8079                         $hash_base, "--", $file_name)
8080                         or die_error(500, "Open git-blame --incremental failed");
8081         } else {
8082                 # run git-blame --porcelain
8083                 defined($fd = git_cmd_pipe "blame", '-p',
8084                         $hash_base, '--', $file_name)
8085                         or die_error(500, "Open git-blame --porcelain failed");
8086         }
8087
8088         # incremental blame data returns early
8089         if ($format eq 'data') {
8090                 print $cgi->header(
8091                         -type=>"text/plain", -charset => "utf-8",
8092                         -status=> "200 OK");
8093                 local $| = 1; # output autoflush
8094                 while (<$fd>) {
8095                         print to_utf8($_);
8096                 }
8097                 close $fd
8098                         or print "ERROR $!\n";
8099
8100                 print 'END';
8101                 if (defined $t0 && gitweb_check_feature('timed')) {
8102                         print ' '.
8103                               tv_interval($t0, [ gettimeofday() ]).
8104                               ' '.$number_of_git_cmds;
8105                 }
8106                 print "\n";
8107
8108                 return;
8109         }
8110
8111         # page header
8112         git_header_html();
8113         my $formats_nav = tabspan(
8114                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
8115                         "blob"));
8116         $formats_nav .=
8117                 $barsep . tabspan(
8118                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8119                         "history")) .
8120                 $barsep . tabspan(
8121                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
8122                         "HEAD"));
8123         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8124         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8125         git_print_page_path($file_name, $ftype, $hash_base);
8126
8127         # page body
8128         if ($format eq 'incremental') {
8129                 print "<noscript>\n<div class=\"error\"><center><b>\n".
8130                       "This page requires JavaScript to run.\n Use ".
8131                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
8132                               'this page').
8133                       " instead.\n".
8134                       "</b></center></div>\n</noscript>\n";
8135
8136                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
8137         }
8138
8139         print qq!<div class="page_body">\n!;
8140         print qq!<div id="progress_info">... / ...</div>\n!
8141                 if ($format eq 'incremental');
8142         print qq!<table id="blame_table" class="blame" width="100%">\n!.
8143               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
8144               qq!<thead>\n!.
8145               qq!<tr><th nowrap="nowrap" style="white-space:nowrap">!.
8146               qq!Commit&#160;<a href="javascript:extra_blame_columns()" id="columns_expander" !.
8147               qq!title="toggles blame author information display">[+]</a></th>!.
8148               qq!<th class="extra_column">Author</th><th class="extra_column">Date</th>!.
8149               qq!<th>Line</th><th width="100%">Data</th></tr>\n!.
8150               qq!</thead>\n!.
8151               qq!<tbody>\n!;
8152
8153         my @rev_color = qw(light dark);
8154         my $num_colors = scalar(@rev_color);
8155         my $current_color = 0;
8156
8157         if ($format eq 'incremental') {
8158                 my $color_class = $rev_color[$current_color];
8159
8160                 #contents of a file
8161                 my $linenr = 0;
8162         LINE:
8163                 while (my $line = to_utf8(scalar <$fd>)) {
8164                         chomp $line;
8165                         $linenr++;
8166
8167                         print qq!<tr id="l$linenr" class="$color_class">!.
8168                               qq!<td class="sha1"><a href=""> </a></td>!.
8169                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8170                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8171                               qq!<td class="linenr">!.
8172                               qq!<a class="linenr" href="">$linenr</a></td>!;
8173                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
8174                         print qq!</tr>\n!;
8175                 }
8176
8177         } else { # porcelain, i.e. ordinary blame
8178                 my %metainfo = (); # saves information about commits
8179
8180                 # blame data
8181         LINE:
8182                 while (my $line = to_utf8(scalar <$fd>)) {
8183                         chomp $line;
8184                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
8185                         # no <lines in group> for subsequent lines in group of lines
8186                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
8187                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
8188                         if (!exists $metainfo{$full_rev}) {
8189                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
8190                         }
8191                         my $meta = $metainfo{$full_rev};
8192                         my $data;
8193                         while ($data = to_utf8(scalar <$fd>)) {
8194                                 chomp $data;
8195                                 last if ($data =~ s/^\t//); # contents of line
8196                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
8197                                         $meta->{$1} = $2 unless exists $meta->{$1};
8198                                 }
8199                                 if ($data =~ /^previous /) {
8200                                         $meta->{'nprevious'}++;
8201                                 }
8202                         }
8203                         my $short_rev = substr($full_rev, 0, 8);
8204                         my $author = $meta->{'author'};
8205                         my %date =
8206                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
8207                         my $date = $date{'iso-tz'};
8208                         if ($group_size) {
8209                                 $current_color = ($current_color + 1) % $num_colors;
8210                         }
8211                         my $tr_class = $rev_color[$current_color];
8212                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
8213                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
8214                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
8215                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
8216                         if ($group_size) {
8217                                 my $rowspan = $group_size > 1 ? " rowspan=\"$group_size\"" : "";
8218                                 print "<td class=\"sha1\"";
8219                                 print " title=\"". esc_html($author) . ", $date\"";
8220                                 print "$rowspan>";
8221                                 print $cgi->a({-href => href(action=>"commit",
8222                                                              hash=>$full_rev,
8223                                                              file_name=>$file_name)},
8224                                               esc_html($short_rev));
8225                                 if ($group_size >= 2) {
8226                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
8227                                         if (@author_initials) {
8228                                                 print "<br />" .
8229                                                       esc_html(join('', @author_initials));
8230                                                 #           or join('.', ...)
8231                                         }
8232                                 }
8233                                 print "</td>\n";
8234                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". esc_html($author) . "</td>";
8235                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". $date . "</td>";
8236                         }
8237                         # 'previous' <sha1 of parent commit> <filename at commit>
8238                         if (exists $meta->{'previous'} &&
8239                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
8240                                 $meta->{'parent'} = $1;
8241                                 $meta->{'file_parent'} = unquote($2);
8242                         }
8243                         my $linenr_commit =
8244                                 exists($meta->{'parent'}) ?
8245                                 $meta->{'parent'} : $full_rev;
8246                         my $linenr_filename =
8247                                 exists($meta->{'file_parent'}) ?
8248                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
8249                         my $blamed = href(action => 'blame',
8250                                           file_name => $linenr_filename,
8251                                           hash_base => $linenr_commit);
8252                         print "<td class=\"linenr\">";
8253                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
8254                                         -class => "linenr" },
8255                                       esc_html($lineno));
8256                         print "</td>";
8257                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
8258                         print "</tr>\n";
8259                 } # end while
8260
8261         }
8262
8263         # footer
8264         print "</tbody>\n".
8265               "</table>\n"; # class="blame"
8266         print "</div>\n";   # class="blame_body"
8267         close $fd
8268                 or print "Reading blob failed\n";
8269
8270         git_footer_html();
8271 }
8272
8273 sub git_blame {
8274         git_blame_common();
8275 }
8276
8277 sub git_blame_incremental {
8278         git_blame_common('incremental');
8279 }
8280
8281 sub git_blame_data {
8282         git_blame_common('data');
8283 }
8284
8285 sub git_tags {
8286         my $head = git_get_head_hash($project);
8287         git_header_html();
8288         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
8289         git_print_header_div('summary', $project);
8290
8291         my @tagslist = git_get_tags_list();
8292         if (@tagslist) {
8293                 git_tags_body(\@tagslist);
8294         }
8295         git_footer_html();
8296 }
8297
8298 sub git_refs {
8299         my $order = $input_params{'order'};
8300         if (defined $order && $order !~ m/age|name/) {
8301                 die_error(400, "Unknown order parameter");
8302         }
8303
8304         my $head = git_get_head_hash($project);
8305         git_header_html();
8306         git_print_page_nav('','', $head,undef,$head,format_ref_views('refs'));
8307         git_print_header_div('summary', $project);
8308
8309         my @refslist = git_get_tags_list(undef, 1, $order);
8310         if (@refslist) {
8311                 git_tags_body(\@refslist, undef, undef, undef, $head, 1, $order);
8312         }
8313         git_footer_html();
8314 }
8315
8316 sub git_heads {
8317         my $head = git_get_head_hash($project);
8318         git_header_html();
8319         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
8320         git_print_header_div('summary', $project);
8321
8322         my @headslist = git_get_heads_list();
8323         if (@headslist) {
8324                 git_heads_body(\@headslist, $head);
8325         }
8326         git_footer_html();
8327 }
8328
8329 # used both for single remote view and for list of all the remotes
8330 sub git_remotes {
8331         gitweb_check_feature('remote_heads')
8332                 or die_error(403, "Remote heads view is disabled");
8333
8334         my $head = git_get_head_hash($project);
8335         my $remote = $input_params{'hash'};
8336
8337         my $remotedata = git_get_remotes_list($remote);
8338         die_error(500, "Unable to get remote information") unless defined $remotedata;
8339
8340         unless (%$remotedata) {
8341                 die_error(404, defined $remote ?
8342                         "Remote $remote not found" :
8343                         "No remotes found");
8344         }
8345
8346         git_header_html(undef, undef, -action_extra => $remote);
8347         git_print_page_nav('', '',  $head, undef, $head,
8348                 format_ref_views($remote ? '' : 'remotes'));
8349
8350         fill_remote_heads($remotedata);
8351         if (defined $remote) {
8352                 git_print_header_div('remotes', "$remote remote for $project");
8353                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
8354         } else {
8355                 git_print_header_div('summary', "$project remotes");
8356                 git_remotes_body($remotedata, undef, $head);
8357         }
8358
8359         git_footer_html();
8360 }
8361
8362 sub git_blob_plain {
8363         my $type = shift;
8364         my $expires;
8365
8366         if (!defined $hash) {
8367                 if (defined $file_name) {
8368                         my $base = $hash_base || git_get_head_hash($project);
8369                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8370                                 or die_error(404, "Cannot find file");
8371                 } else {
8372                         die_error(400, "No file name defined");
8373                 }
8374         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8375                 # blobs defined by non-textual hash id's can be cached
8376                 $expires = "+1d";
8377         }
8378
8379         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8380                 or die_error(500, "Open git-cat-file blob '$hash' failed");
8381         binmode($fd);
8382
8383         # content-type (can include charset)
8384         my $leader;
8385         ($type, $leader) = blob_contenttype($fd, $file_name, $type);
8386
8387         # "save as" filename, even when no $file_name is given
8388         my $save_as = "$hash";
8389         if (defined $file_name) {
8390                 $save_as = $file_name;
8391         } elsif ($type =~ m/^text\//) {
8392                 $save_as .= '.txt';
8393         }
8394
8395         # With XSS prevention on, blobs of all types except a few known safe
8396         # ones are served with "Content-Disposition: attachment" to make sure
8397         # they don't run in our security domain.  For certain image types,
8398         # blob view writes an <img> tag referring to blob_plain view, and we
8399         # want to be sure not to break that by serving the image as an
8400         # attachment (though Firefox 3 doesn't seem to care).
8401         my $sandbox = $prevent_xss &&
8402                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
8403
8404         # serve text/* as text/plain
8405         if ($prevent_xss &&
8406             ($type =~ m!^text/[a-z]+\b(.*)$! ||
8407              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
8408                 my $rest = $1;
8409                 $rest = defined $rest ? $rest : '';
8410                 $type = "text/plain$rest";
8411         }
8412
8413         print $cgi->header(
8414                 -type => $type,
8415                 -expires => $expires,
8416                 -content_disposition =>
8417                         ($sandbox ? 'attachment' : 'inline')
8418                         . '; filename="' . $save_as . '"');
8419         binmode STDOUT, ':raw';
8420         $fcgi_raw_mode = 1;
8421         print $leader if defined $leader;
8422         my $buf;
8423         while (read($fd, $buf, 32768)) {
8424                 print $buf;
8425         }
8426         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8427         $fcgi_raw_mode = 0;
8428         close $fd;
8429 }
8430
8431 sub git_blob {
8432         my $expires;
8433
8434         if (!defined $hash) {
8435                 if (defined $file_name) {
8436                         my $base = $hash_base || git_get_head_hash($project);
8437                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8438                                 or die_error(404, "Cannot find file");
8439                 } else {
8440                         die_error(400, "No file name defined");
8441                 }
8442         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8443                 # blobs defined by non-textual hash id's can be cached
8444                 $expires = "+1d";
8445         }
8446         my $fullhash = git_get_full_hash($project, "$hash^{blob}");
8447         die_error(404, "No such blob") unless defined($fullhash);
8448
8449         my $have_blame = gitweb_check_feature('blame');
8450         defined(my $fd = git_cmd_pipe "cat-file", "blob", $fullhash)
8451                 or die_error(500, "Couldn't cat $file_name, $hash");
8452         binmode($fd);
8453         my $mimetype = blob_mimetype($fd, $file_name);
8454         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
8455         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
8456                 close $fd;
8457                 return git_blob_plain($mimetype);
8458         }
8459         # we can have blame only for text/* mimetype
8460         $have_blame &&= ($mimetype =~ m!^text/!);
8461
8462         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
8463         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
8464         my $highlight_mode_active;
8465         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
8466
8467         git_header_html(undef, $expires);
8468         my $formats_nav = '';
8469         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8470                 if (defined $file_name) {
8471                         if ($have_blame) {
8472                                 $formats_nav .= tabspan(
8473                                         $cgi->a({-href => href(action=>"blame", -replay=>1),
8474                                                 -class => "blamelink"},
8475                                                 "blame")) .
8476                                         $barsep;
8477                         }
8478                         $formats_nav .= tabspan(
8479                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8480                                         "history")) .
8481                                 $barsep . tabspan(
8482                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8483                                         "raw")) .
8484                                 $barsep . tabspan(
8485                                 $cgi->a({-href => href(action=>"blob",
8486                                                        hash_base=>"HEAD", file_name=>$file_name)},
8487                                         "HEAD"));
8488                 } else {
8489                         $formats_nav .= tabspan(
8490                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8491                                         "raw"));
8492                 }
8493                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8494                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8495         } else {
8496                 git_print_page_nav('',['commit','commitdiff','tree'], undef,undef,undef);
8497                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8498         }
8499         git_print_page_path($file_name, "blob", $hash_base);
8500         print "<div class=\"title_text\">\n" .
8501               "<table class=\"object_header\">\n";
8502         print "<tr><td>blob</td><td class=\"sha1\">$fullhash</td></tr>\n";
8503         print "</table>".
8504               "</div>\n";
8505         print "<div class=\"page_body\">\n";
8506         if ($mimetype =~ m!^image/!) {
8507                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
8508                 if ($file_name) {
8509                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
8510                 }
8511                 print qq! src="! .
8512                       href(action=>"blob_plain", hash=>$hash,
8513                            hash_base=>$hash_base, file_name=>$file_name) .
8514                       qq!" />\n!;
8515                 close $fd; # ignore likely EPIPE error from child
8516         } else {
8517                 my $nr;
8518                 while (my $line = to_utf8(scalar <$fd>)) {
8519                         chomp $line;
8520                         $nr++;
8521                         $line = untabify($line);
8522                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i </a>%s</div>\n!,
8523                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
8524                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
8525                 }
8526                 close $fd
8527                         or print "Reading blob failed.\n";
8528         }
8529         print "</div>";
8530         git_footer_html();
8531 }
8532
8533 sub git_tree {
8534         if (!defined $hash_base) {
8535                 $hash_base = "HEAD";
8536         }
8537         if (!defined $hash) {
8538                 if (defined $file_name) {
8539                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
8540                 } else {
8541                         $hash = $hash_base;
8542                 }
8543         }
8544         die_error(404, "No such tree") unless defined($hash);
8545         my $fullhash = git_get_full_hash($project, "$hash^{tree}");
8546         die_error(404, "No such tree") unless defined($fullhash);
8547
8548         my $show_sizes = gitweb_check_feature('show-sizes');
8549         my $have_blame = gitweb_check_feature('blame');
8550
8551         my @entries = ();
8552         {
8553                 local $/ = "\0";
8554                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
8555                         ($show_sizes ? '-l' : ()), @extra_options, $fullhash)
8556                         or die_error(500, "Open git-ls-tree failed");
8557                 @entries = map { chomp; to_utf8($_) } <$fd>;
8558                 close $fd
8559                         or die_error(404, "Reading tree failed");
8560         }
8561
8562         git_header_html();
8563         my $basedir = '';
8564         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8565                 my $refs = git_get_references();
8566                 my $ref = format_ref_marker($refs, $co{'id'});
8567                 my @views_nav = ();
8568                 if (defined $file_name) {
8569                         push @views_nav,
8570                                 tabspan($cgi->a({-href => href(action=>"history", -replay=>1)},
8571                                                 "history")),
8572                                 tabspan($cgi->a({-href => href(action=>"tree",
8573                                                                hash_base=>"HEAD", file_name=>$file_name)},
8574                                                  "HEAD")),
8575                 }
8576                 my $snapshot_links = format_snapshot_links($hash);
8577                 if (defined $snapshot_links) {
8578                         # FIXME: Should be available when we have no hash base as well.
8579                         push @views_nav, $snapshot_links;
8580                 }
8581                 git_print_page_nav('tree','', $hash_base, undef, undef,
8582                                    join($barsep, @views_nav));
8583                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base, undef, $ref);
8584         } else {
8585                 git_print_page_nav('tree',['commit','commitdiff'], undef,undef,$hash_base);
8586                 undef $hash_base;
8587                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8588         }
8589         if (defined $file_name) {
8590                 $basedir = $file_name;
8591                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
8592                         $basedir .= '/';
8593                 }
8594                 git_print_page_path($file_name, 'tree', $hash_base);
8595         }
8596         print "<div class=\"title_text\">\n" .
8597               "<table class=\"object_header\">\n";
8598         print "<tr><td>tree</td><td class=\"sha1\">$fullhash</td></tr>\n";
8599         print "</table>".
8600               "</div>\n";
8601         print "<div class=\"page_body\">\n";
8602         print "<table class=\"tree\">\n";
8603         my $alternate = 1;
8604         # '..' (top directory) link if possible
8605         if (defined $hash_base &&
8606             defined $file_name && $file_name =~ m![^/]+$!) {
8607                 if ($alternate) {
8608                         print "<tr class=\"dark\">\n";
8609                 } else {
8610                         print "<tr class=\"light\">\n";
8611                 }
8612                 $alternate ^= 1;
8613
8614                 my $up = $file_name;
8615                 $up =~ s!/?[^/]+$!!;
8616                 undef $up unless $up;
8617                 # based on git_print_tree_entry
8618                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
8619                 print '<td class="size">&#160;</td>'."\n" if $show_sizes;
8620                 print '<td class="list">';
8621                 print $cgi->a({-href => href(action=>"tree",
8622                                              hash_base=>$hash_base,
8623                                              file_name=>$up)},
8624                               "..");
8625                 print "</td>\n";
8626                 print "<td class=\"link\"></td>\n";
8627
8628                 print "</tr>\n";
8629         }
8630         foreach my $line (@entries) {
8631                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
8632
8633                 if ($alternate) {
8634                         print "<tr class=\"dark\">\n";
8635                 } else {
8636                         print "<tr class=\"light\">\n";
8637                 }
8638                 $alternate ^= 1;
8639
8640                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
8641
8642                 print "</tr>\n";
8643         }
8644         print "</table>\n" .
8645               "</div>";
8646         git_footer_html();
8647 }
8648
8649 sub sanitize_for_filename {
8650     my $name = shift;
8651
8652     $name =~ s!/!-!g;
8653     $name =~ s/[^[:alnum:]_.-]//g;
8654
8655     return $name;
8656 }
8657
8658 sub snapshot_name {
8659         my ($project, $hash) = @_;
8660
8661         # path/to/project.git  -> project
8662         # path/to/project/.git -> project
8663         my $name = to_utf8($project);
8664         $name =~ s,([^/])/*\.git$,$1,;
8665         $name = sanitize_for_filename(basename($name));
8666
8667         my $ver = $hash;
8668         if ($hash =~ /^[0-9a-fA-F]+$/) {
8669                 # shorten SHA-1 hash
8670                 my $full_hash = git_get_full_hash($project, $hash);
8671                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
8672                         $ver = git_get_short_hash($project, $hash);
8673                 }
8674         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
8675                 # tags don't need shortened SHA-1 hash
8676                 $ver = $1;
8677         } else {
8678                 # branches and other need shortened SHA-1 hash
8679                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
8680                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
8681                         my $ref_dir = (defined $1) ? $1 : '';
8682                         $ver = $2;
8683
8684                         $ref_dir = sanitize_for_filename($ref_dir);
8685                         # for refs neither in heads nor remotes we want to
8686                         # add a ref dir to archive name
8687                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
8688                                 $ver = $ref_dir . '-' . $ver;
8689                         }
8690                 }
8691                 $ver .= '-' . git_get_short_hash($project, $hash);
8692         }
8693         # special case of sanitization for filename - we change
8694         # slashes to dots instead of dashes
8695         # in case of hierarchical branch names
8696         $ver =~ s!/!.!g;
8697         $ver =~ s/[^[:alnum:]_.-]//g;
8698
8699         # name = project-version_string
8700         $name = "$name-$ver";
8701
8702         return wantarray ? ($name, $name) : $name;
8703 }
8704
8705 sub exit_if_unmodified_since {
8706         my ($latest_epoch) = @_;
8707         our $cgi;
8708
8709         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
8710         if (defined $if_modified) {
8711                 my $since;
8712                 if (eval { require HTTP::Date; 1; }) {
8713                         $since = HTTP::Date::str2time($if_modified);
8714                 } elsif (eval { require Time::ParseDate; 1; }) {
8715                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
8716                 }
8717                 if (defined $since && $latest_epoch <= $since) {
8718                         my %latest_date = parse_date($latest_epoch);
8719                         print $cgi->header(
8720                                 -last_modified => $latest_date{'rfc2822'},
8721                                 -status => '304 Not Modified');
8722                         CORE::die;
8723                 }
8724         }
8725 }
8726
8727 sub git_snapshot {
8728         my $format = $input_params{'snapshot_format'};
8729         if (!@snapshot_fmts) {
8730                 die_error(403, "Snapshots not allowed");
8731         }
8732         # default to first supported snapshot format
8733         $format ||= $snapshot_fmts[0];
8734         if ($format !~ m/^[a-z0-9]+$/) {
8735                 die_error(400, "Invalid snapshot format parameter");
8736         } elsif (!exists($known_snapshot_formats{$format})) {
8737                 die_error(400, "Unknown snapshot format");
8738         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
8739                 die_error(403, "Snapshot format not allowed");
8740         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
8741                 die_error(403, "Unsupported snapshot format");
8742         }
8743
8744         my $type = git_get_type("$hash^{}");
8745         if (!$type) {
8746                 die_error(404, 'Object does not exist');
8747         }  elsif ($type eq 'blob') {
8748                 die_error(400, 'Object is not a tree-ish');
8749         }
8750
8751         my ($name, $prefix) = snapshot_name($project, $hash);
8752         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
8753
8754         my %co = parse_commit($hash);
8755         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
8756
8757         my @cmd = (
8758                 git_cmd(), 'archive',
8759                 "--format=$known_snapshot_formats{$format}{'format'}",
8760                 "--prefix=$prefix/", $hash);
8761         if (exists $known_snapshot_formats{$format}{'compressor'}) {
8762                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
8763                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
8764         }
8765
8766         $filename =~ s/(["\\])/\\$1/g;
8767         my %latest_date;
8768         if (%co) {
8769                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
8770         }
8771
8772         print $cgi->header(
8773                 -type => $known_snapshot_formats{$format}{'type'},
8774                 -content_disposition => 'inline; filename="' . $filename . '"',
8775                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8776                 -status => '200 OK');
8777
8778         defined(my $fd = cmd_pipe @cmd)
8779                 or die_error(500, "Execute git-archive failed");
8780         binmode($fd);
8781         binmode STDOUT, ':raw';
8782         $fcgi_raw_mode = 1;
8783         my $buf;
8784         while (read($fd, $buf, 32768)) {
8785                 print $buf;
8786         }
8787         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8788         $fcgi_raw_mode = 0;
8789         close $fd;
8790 }
8791
8792 sub git_log_generic {
8793         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8794
8795         my $head = git_get_head_hash($project);
8796         if (!defined $base) {
8797                 $base = $head;
8798         }
8799         if (!defined $page) {
8800                 $page = 0;
8801         }
8802         my $refs = git_get_references();
8803
8804         my $commit_hash = $base;
8805         if (defined $parent) {
8806                 $commit_hash = "$parent..$base";
8807         }
8808         my @commitlist =
8809                 parse_commits($commit_hash, 101, (100 * $page),
8810                               defined $file_name ? ($file_name, "--full-history") : ());
8811
8812         my $ftype;
8813         if (!defined $file_hash && defined $file_name) {
8814                 # some commits could have deleted file in question,
8815                 # and not have it in tree, but one of them has to have it
8816                 for (my $i = 0; $i < @commitlist; $i++) {
8817                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8818                         last if defined $file_hash;
8819                 }
8820         }
8821         if (defined $file_hash) {
8822                 $ftype = git_get_type($file_hash);
8823         }
8824         if (defined $file_name && !defined $ftype) {
8825                 die_error(500, "Unknown type of object");
8826         }
8827         my %co;
8828         if (defined $file_name) {
8829                 %co = parse_commit($base)
8830                         or die_error(404, "Unknown commit object");
8831         }
8832
8833
8834         my $next_link = '';
8835         if ($#commitlist >= 100) {
8836                 $next_link =
8837                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8838                                  -accesskey => "n", -title => "Alt-n"}, "next");
8839         }
8840         my $extra = '';
8841         my ($patch_max) = gitweb_get_feature('patches');
8842         if ($patch_max && !defined $file_name) {
8843                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8844                         $extra = $cgi->a({-href => href(action=>"patches", -replay=>1)},
8845                                         "patches");
8846                 }
8847         }
8848         my $paging_nav = format_log_nav($fmt_name, $page, $#commitlist >= 100, $extra);
8849
8850         {
8851                 local $action = 'log';
8852                 git_header_html();
8853         }
8854         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8855         if (defined $file_name) {
8856                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8857         } else {
8858                 git_print_header_div('summary', $project)
8859         }
8860         git_print_page_path($file_name, $ftype, $hash_base)
8861                 if (defined $file_name);
8862
8863         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8864                      $file_name, $file_hash, $ftype);
8865
8866         git_footer_html();
8867 }
8868
8869 sub git_log {
8870         git_log_generic('log', \&git_log_body,
8871                         $hash, $hash_parent);
8872 }
8873
8874 sub git_commit {
8875         $hash ||= $hash_base || "HEAD";
8876         my %co = parse_commit($hash)
8877             or die_error(404, "Unknown commit object");
8878
8879         my $parent  = $co{'parent'};
8880         my $parents = $co{'parents'}; # listref
8881
8882         # we need to prepare $formats_nav before any parameter munging
8883         my $formats_nav;
8884         if (!defined $parent) {
8885                 # --root commitdiff
8886                 $formats_nav .= '<span class="parents none">(initial)</span>';
8887         } elsif (@$parents == 1) {
8888                 # single parent commit
8889                 $formats_nav .=
8890                         '<span class="parents single">(parent:&#160;' .
8891                         $cgi->a({-href => href(action=>"commit",
8892                                                hash=>$parent)},
8893                                 esc_html(substr($parent, 0, 7))) .
8894                         ')</span>';
8895         } else {
8896                 # merge commit
8897                 $formats_nav .=
8898                         '<span class="parents multiple">(merge:&#160;' .
8899                         join(' ', map {
8900                                 $cgi->a({-href => href(action=>"commit",
8901                                                        hash=>$_)},
8902                                         esc_html(substr($_, 0, 7)));
8903                         } @$parents ) .
8904                         ')</span>';
8905         }
8906         if (gitweb_check_feature('patches') && @$parents <= 1) {
8907                 $formats_nav .= $barsep . tabspan(
8908                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
8909                                 "patch"));
8910         }
8911
8912         if (!defined $parent) {
8913                 $parent = "--root";
8914         }
8915         my @difftree;
8916         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
8917                 @diff_opts,
8918                 (@$parents <= 1 ? $parent : '-c'),
8919                 $hash, "--")
8920                 or die_error(500, "Open git-diff-tree failed");
8921         @difftree = map { chomp; to_utf8($_) } <$fd>;
8922         close $fd or die_error(404, "Reading git-diff-tree failed");
8923
8924         # non-textual hash id's can be cached
8925         my $expires;
8926         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8927                 $expires = "+1d";
8928         }
8929         my $refs = git_get_references();
8930         my $ref = format_ref_marker($refs, $co{'id'});
8931
8932         git_header_html(undef, $expires);
8933         git_print_page_nav('commit', '',
8934                            $hash, $co{'tree'}, $hash,
8935                            $formats_nav);
8936
8937         if (defined $co{'parent'}) {
8938                 git_print_header_div('commitdiff', esc_html($co{'title'}), $hash, undef, $ref);
8939         } else {
8940                 git_print_header_div('tree', esc_html($co{'title'}), $co{'tree'}, $hash, $ref);
8941         }
8942         print "<div class=\"title_text\">\n" .
8943               "<table class=\"object_header\">\n";
8944         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
8945         git_print_authorship_rows(\%co);
8946         print "<tr>" .
8947               "<td>tree</td>" .
8948               "<td class=\"sha1\">" .
8949               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
8950                        class => "list"}, $co{'tree'}) .
8951               "</td>" .
8952               "<td class=\"link\">" .
8953               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
8954                       "tree");
8955         my $snapshot_links = format_snapshot_links($hash);
8956         if (defined $snapshot_links) {
8957                 print $barsep . $snapshot_links;
8958         }
8959         print "</td>" .
8960               "</tr>\n";
8961
8962         foreach my $par (@$parents) {
8963                 print "<tr>" .
8964                       "<td>parent</td>" .
8965                       "<td class=\"sha1\">" .
8966                       $cgi->a({-href => href(action=>"commit", hash=>$par),
8967                                class => "list"}, $par) .
8968                       "</td>" .
8969                       "<td class=\"link\">" .
8970                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
8971                       $barsep .
8972                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
8973                       "</td>" .
8974                       "</tr>\n";
8975         }
8976         print "</table>".
8977               "</div>\n";
8978
8979         print "<div class=\"page_body\">\n";
8980         git_print_log($co{'comment'});
8981         print "</div>\n";
8982
8983         git_difftree_body(\@difftree, $hash, @$parents);
8984
8985         git_footer_html();
8986 }
8987
8988 sub git_object {
8989         # object is defined by:
8990         # - hash or hash_base alone
8991         # - hash_base and file_name
8992         my $type;
8993
8994         # - hash or hash_base alone
8995         if ($hash || ($hash_base && !defined $file_name)) {
8996                 my $object_id = $hash || $hash_base;
8997
8998                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
8999                         or die_error(404, "Object does not exist");
9000                 $type = <$fd>;
9001                 defined $type && chomp $type;
9002                 close $fd
9003                         or die_error(404, "Object does not exist");
9004
9005         # - hash_base and file_name
9006         } elsif ($hash_base && defined $file_name) {
9007                 $file_name =~ s,/+$,,;
9008
9009                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
9010                         or die_error(404, "Base object does not exist");
9011
9012                 # here errors should not happen
9013                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
9014                         or die_error(500, "Open git-ls-tree failed");
9015                 my $line = to_utf8(scalar <$fd>);
9016                 close $fd;
9017
9018                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
9019                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
9020                         die_error(404, "File or directory for given base does not exist");
9021                 }
9022                 $type = $2;
9023                 $hash = $3;
9024         } else {
9025                 die_error(400, "Not enough information to find object");
9026         }
9027
9028         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
9029                                           hash=>$hash, hash_base=>$hash_base,
9030                                           file_name=>$file_name),
9031                              -status => '302 Found');
9032 }
9033
9034 sub git_blobdiff {
9035         my $format = shift || 'html';
9036         my $diff_style = $input_params{'diff_style'} || 'inline';
9037
9038         my $fd;
9039         my @difftree;
9040         my %diffinfo;
9041         my $expires;
9042
9043         # preparing $fd and %diffinfo for git_patchset_body
9044         # new style URI
9045         if (defined $hash_base && defined $hash_parent_base) {
9046                 if (defined $file_name) {
9047                         # read raw output
9048                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9049                                 $hash_parent_base, $hash_base,
9050                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
9051                                 or die_error(500, "Open git-diff-tree failed");
9052                         @difftree = map { chomp; to_utf8($_) } <$fd>;
9053                         close $fd
9054                                 or die_error(404, "Reading git-diff-tree failed");
9055                         @difftree
9056                                 or die_error(404, "Blob diff not found");
9057
9058                 } elsif (defined $hash &&
9059                          $hash =~ /[0-9a-fA-F]{40}/) {
9060                         # try to find filename from $hash
9061
9062                         # read filtered raw output
9063                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9064                                 $hash_parent_base, $hash_base, "--")
9065                                 or die_error(500, "Open git-diff-tree failed");
9066                         @difftree =
9067                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
9068                                 # $hash == to_id
9069                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
9070                                 map { chomp; to_utf8($_) } <$fd>;
9071                         close $fd
9072                                 or die_error(404, "Reading git-diff-tree failed");
9073                         @difftree
9074                                 or die_error(404, "Blob diff not found");
9075
9076                 } else {
9077                         die_error(400, "Missing one of the blob diff parameters");
9078                 }
9079
9080                 if (@difftree > 1) {
9081                         die_error(400, "Ambiguous blob diff specification");
9082                 }
9083
9084                 %diffinfo = parse_difftree_raw_line($difftree[0]);
9085                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
9086                 $file_name   ||= $diffinfo{'to_file'};
9087
9088                 $hash_parent ||= $diffinfo{'from_id'};
9089                 $hash        ||= $diffinfo{'to_id'};
9090
9091                 # non-textual hash id's can be cached
9092                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
9093                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
9094                         $expires = '+1d';
9095                 }
9096
9097                 # open patch output
9098                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9099                         '-p', ($format eq 'html' ? "--full-index" : ()),
9100                         $hash_parent_base, $hash_base,
9101                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
9102                         or die_error(500, "Open git-diff-tree failed");
9103         }
9104
9105         # old/legacy style URI -- not generated anymore since 1.4.3.
9106         if (!%diffinfo) {
9107                 die_error('404 Not Found', "Missing one of the blob diff parameters")
9108         }
9109
9110         # header
9111         if ($format eq 'html') {
9112                 my $formats_nav =
9113                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
9114                                 "raw");
9115                 $formats_nav .= diff_style_nav($diff_style);
9116                 git_header_html(undef, $expires);
9117                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
9118                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
9119                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
9120                 } else {
9121                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
9122                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
9123                 }
9124                 if (defined $file_name) {
9125                         git_print_page_path($file_name, "blob", $hash_base);
9126                 } else {
9127                         print "<div class=\"page_path\"></div>\n";
9128                 }
9129
9130         } elsif ($format eq 'plain') {
9131                 print $cgi->header(
9132                         -type => 'text/plain',
9133                         -charset => 'utf-8',
9134                         -expires => $expires,
9135                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
9136
9137                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9138
9139         } else {
9140                 die_error(400, "Unknown blobdiff format");
9141         }
9142
9143         # patch
9144         if ($format eq 'html') {
9145                 print "<div class=\"page_body\">\n";
9146
9147                 git_patchset_body($fd, $diff_style,
9148                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
9149                 close $fd;
9150
9151                 print "</div>\n"; # class="page_body"
9152                 git_footer_html();
9153
9154         } else {
9155                 while (my $line = to_utf8(scalar <$fd>)) {
9156                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
9157                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
9158
9159                         print $line;
9160
9161                         last if $line =~ m!^\+\+\+!;
9162                 }
9163                 while (<$fd>) {
9164                         print to_utf8($_);
9165                 }
9166                 close $fd;
9167         }
9168 }
9169
9170 sub git_blobdiff_plain {
9171         git_blobdiff('plain');
9172 }
9173
9174 # assumes that it is added as later part of already existing navigation,
9175 # so it returns "| foo | bar" rather than just "foo | bar"
9176 sub diff_style_nav {
9177         my ($diff_style, $is_combined) = @_;
9178         $diff_style ||= 'inline';
9179
9180         return "" if ($is_combined);
9181
9182         my @styles = (inline => 'inline', 'sidebyside' => 'side&#160;by&#160;side');
9183         my %styles = @styles;
9184         @styles =
9185                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
9186
9187         return $barsep . '<span class="diffstyles">' . join($barsep,
9188                 map {
9189                         $_ eq $diff_style ?
9190                         '<span class="diffstyle selected">' . $styles{$_} . '</span>' :
9191                         '<span class="diffstyle">' .
9192                                 $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_}) .
9193                                 '</span>'
9194                 } @styles) . '</span>';
9195 }
9196
9197 sub git_commitdiff {
9198         my %params = @_;
9199         my $format = $params{-format} || 'html';
9200         my $diff_style = $input_params{'diff_style'} || 'inline';
9201
9202         my ($patch_max) = gitweb_get_feature('patches');
9203         if ($format eq 'patch') {
9204                 die_error(403, "Patch view not allowed") unless $patch_max;
9205         }
9206
9207         $hash ||= $hash_base || "HEAD";
9208         my %co = parse_commit($hash)
9209             or die_error(404, "Unknown commit object");
9210
9211         # choose format for commitdiff for merge
9212         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
9213                 $hash_parent = '--cc';
9214         }
9215         # we need to prepare $formats_nav before almost any parameter munging
9216         my $formats_nav;
9217         if ($format eq 'html') {
9218                 $formats_nav = tabspan(
9219                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
9220                                 "raw"));
9221                 if ($patch_max && @{$co{'parents'}} <= 1) {
9222                         $formats_nav .= $barsep . tabspan(
9223                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
9224                                         "patch"));
9225                 }
9226                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
9227
9228                 if (defined $hash_parent &&
9229                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
9230                         # commitdiff with two commits given
9231                         my $hash_parent_short = $hash_parent;
9232                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
9233                                 $hash_parent_short = substr($hash_parent, 0, 7);
9234                         }
9235                         $formats_nav .= $spcsep . '<span class="parents multiple">' .
9236                                 '(from';
9237                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
9238                                 if ($co{'parents'}[$i] eq $hash_parent) {
9239                                         $formats_nav .= '&#160;parent&#160;' . ($i+1);
9240                                         last;
9241                                 }
9242                         }
9243                         $formats_nav .= ':&#160;' .
9244                                 $cgi->a({-href => href(-replay=>1,
9245                                                        hash=>$hash_parent, hash_base=>undef)},
9246                                         esc_html($hash_parent_short)) .
9247                                 ')</span>';
9248                 } elsif (!$co{'parent'}) {
9249                         # --root commitdiff
9250                         $formats_nav .= $spcsep . '<span class="parents none">(initial)</span>';
9251                 } elsif (scalar @{$co{'parents'}} == 1) {
9252                         # single parent commit
9253                         $formats_nav .= $spcsep .
9254                                 '<span class="parents single">(parent:&#160;' .
9255                                 $cgi->a({-href => href(-replay=>1,
9256                                                        hash=>$co{'parent'}, hash_base=>undef)},
9257                                         esc_html(substr($co{'parent'}, 0, 7))) .
9258                                 ')</span>';
9259                 } else {
9260                         # merge commit
9261                         if ($hash_parent eq '--cc') {
9262                                 $formats_nav .= $barsep . tabspan(
9263                                         $cgi->a({-href => href(-replay=>1,
9264                                                                hash=>$hash, hash_parent=>'-c')},
9265                                                 'combined'));
9266                         } else { # $hash_parent eq '-c'
9267                                 $formats_nav .= $barsep . tabspan(
9268                                         $cgi->a({-href => href(-replay=>1,
9269                                                                hash=>$hash, hash_parent=>'--cc')},
9270                                                 'compact'));
9271                         }
9272                         $formats_nav .= $spcsep .
9273                                 '<span class="parents multiple">(merge:&#160;' .
9274                                 join(' ', map {
9275                                         $cgi->a({-href => href(-replay=>1,
9276                                                                hash=>$_, hash_base=>undef)},
9277                                                 esc_html(substr($_, 0, 7)));
9278                                 } @{$co{'parents'}} ) .
9279                                 ')</span>';
9280                 }
9281         }
9282
9283         my $hash_parent_param = $hash_parent;
9284         if (!defined $hash_parent_param) {
9285                 # --cc for multiple parents, --root for parentless
9286                 $hash_parent_param =
9287                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
9288         }
9289
9290         # read commitdiff
9291         my $fd;
9292         my @difftree;
9293         if ($format eq 'html') {
9294                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9295                         "--no-commit-id", "--patch-with-raw", "--full-index",
9296                         $hash_parent_param, $hash, "--")
9297                         or die_error(500, "Open git-diff-tree failed");
9298
9299                 while (my $line = to_utf8(scalar <$fd>)) {
9300                         chomp $line;
9301                         # empty line ends raw part of diff-tree output
9302                         last unless $line;
9303                         push @difftree, scalar parse_difftree_raw_line($line);
9304                 }
9305
9306         } elsif ($format eq 'plain') {
9307                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9308                         '-p', $hash_parent_param, $hash, "--")
9309                         or die_error(500, "Open git-diff-tree failed");
9310         } elsif ($format eq 'patch') {
9311                 # For commit ranges, we limit the output to the number of
9312                 # patches specified in the 'patches' feature.
9313                 # For single commits, we limit the output to a single patch,
9314                 # diverging from the git-format-patch default.
9315                 my @commit_spec = ();
9316                 if ($hash_parent) {
9317                         if ($patch_max > 0) {
9318                                 push @commit_spec, "-$patch_max";
9319                         }
9320                         push @commit_spec, '-n', "$hash_parent..$hash";
9321                 } else {
9322                         if ($params{-single}) {
9323                                 push @commit_spec, '-1';
9324                         } else {
9325                                 if ($patch_max > 0) {
9326                                         push @commit_spec, "-$patch_max";
9327                                 }
9328                                 push @commit_spec, "-n";
9329                         }
9330                         push @commit_spec, '--root', $hash;
9331                 }
9332                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
9333                         '--encoding=utf8', '--stdout', @commit_spec)
9334                         or die_error(500, "Open git-format-patch failed");
9335         } else {
9336                 die_error(400, "Unknown commitdiff format");
9337         }
9338
9339         # non-textual hash id's can be cached
9340         my $expires;
9341         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9342                 $expires = "+1d";
9343         }
9344
9345         # write commit message
9346         if ($format eq 'html') {
9347                 my $refs = git_get_references();
9348                 my $ref = format_ref_marker($refs, $co{'id'});
9349
9350                 git_header_html(undef, $expires);
9351                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
9352                 git_print_header_div('commit', esc_html($co{'title'}), $hash, undef, $ref);
9353                 print "<div class=\"title_text\">\n" .
9354                       "<table class=\"object_header\">\n";
9355                 git_print_authorship_rows(\%co);
9356                 print "</table>".
9357                       "</div>\n";
9358                 print "<div class=\"page_body\">\n";
9359                 if (@{$co{'comment'}} > 1) {
9360                         print "<div class=\"log\">\n";
9361                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
9362                         print "</div>\n"; # class="log"
9363                 }
9364
9365         } elsif ($format eq 'plain') {
9366                 my $refs = git_get_references("tags");
9367                 my $tagname = git_get_rev_name_tags($hash);
9368                 my $filename = basename($project) . "-$hash.patch";
9369
9370                 print $cgi->header(
9371                         -type => 'text/plain',
9372                         -charset => 'utf-8',
9373                         -expires => $expires,
9374                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9375                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
9376                 print "From: " . to_utf8($co{'author'}) . "\n";
9377                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
9378                 print "Subject: " . to_utf8($co{'title'}) . "\n";
9379
9380                 print "X-Git-Tag: $tagname\n" if $tagname;
9381                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9382
9383                 foreach my $line (@{$co{'comment'}}) {
9384                         print to_utf8($line) . "\n";
9385                 }
9386                 print "---\n\n";
9387         } elsif ($format eq 'patch') {
9388                 my $filename = basename($project) . "-$hash.patch";
9389
9390                 print $cgi->header(
9391                         -type => 'text/plain',
9392                         -charset => 'utf-8',
9393                         -expires => $expires,
9394                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9395         }
9396
9397         # write patch
9398         if ($format eq 'html') {
9399                 my $use_parents = !defined $hash_parent ||
9400                         $hash_parent eq '-c' || $hash_parent eq '--cc';
9401                 git_difftree_body(\@difftree, $hash,
9402                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9403                 print "<br/>\n";
9404
9405                 git_patchset_body($fd, $diff_style,
9406                                   \@difftree, $hash,
9407                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9408                 close $fd;
9409                 print "</div>\n"; # class="page_body"
9410                 git_footer_html();
9411
9412         } elsif ($format eq 'plain') {
9413                 while (<$fd>) {
9414                         print to_utf8($_);
9415                 }
9416                 close $fd
9417                         or print "Reading git-diff-tree failed\n";
9418         } elsif ($format eq 'patch') {
9419                 while (<$fd>) {
9420                         print to_utf8($_);
9421                 }
9422                 close $fd
9423                         or print "Reading git-format-patch failed\n";
9424         }
9425 }
9426
9427 sub git_commitdiff_plain {
9428         git_commitdiff(-format => 'plain');
9429 }
9430
9431 # format-patch-style patches
9432 sub git_patch {
9433         git_commitdiff(-format => 'patch', -single => 1);
9434 }
9435
9436 sub git_patches {
9437         git_commitdiff(-format => 'patch');
9438 }
9439
9440 sub git_history {
9441         git_log_generic('history', \&git_history_body,
9442                         $hash_base, $hash_parent_base,
9443                         $file_name, $hash);
9444 }
9445
9446 sub git_search {
9447         $searchtype ||= 'commit';
9448
9449         # check if appropriate features are enabled
9450         gitweb_check_feature('search')
9451                 or die_error(403, "Search is disabled");
9452         if ($searchtype eq 'pickaxe') {
9453                 # pickaxe may take all resources of your box and run for several minutes
9454                 # with every query - so decide by yourself how public you make this feature
9455                 gitweb_check_feature('pickaxe')
9456                         or die_error(403, "Pickaxe search is disabled");
9457         }
9458         if ($searchtype eq 'grep') {
9459                 # grep search might be potentially CPU-intensive, too
9460                 gitweb_check_feature('grep')
9461                         or die_error(403, "Grep search is disabled");
9462         }
9463
9464         if (!defined $searchtext) {
9465                 die_error(400, "Text field is empty");
9466         }
9467         if (!defined $hash) {
9468                 $hash = git_get_head_hash($project);
9469         }
9470         my %co = parse_commit($hash);
9471         if (!%co) {
9472                 die_error(404, "Unknown commit object");
9473         }
9474         if (!defined $page) {
9475                 $page = 0;
9476         }
9477
9478         if ($searchtype eq 'commit' ||
9479             $searchtype eq 'author' ||
9480             $searchtype eq 'committer') {
9481                 git_search_message(%co);
9482         } elsif ($searchtype eq 'pickaxe') {
9483                 git_search_changes(%co);
9484         } elsif ($searchtype eq 'grep') {
9485                 git_search_files(%co);
9486         } else {
9487                 die_error(400, "Unknown search type");
9488         }
9489 }
9490
9491 sub git_search_help {
9492         git_header_html();
9493         git_print_page_nav('','', $hash,$hash,$hash);
9494         print <<EOT;
9495 <div class="search_help">
9496 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
9497 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
9498 the pattern entered is recognized as the POSIX extended
9499 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
9500 insensitive).</p>
9501 <dl>
9502 <dt><b>commit</b></dt>
9503 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
9504 EOT
9505         my $have_grep = gitweb_check_feature('grep');
9506         if ($have_grep) {
9507                 print <<EOT;
9508 <dt><b>grep</b></dt>
9509 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
9510     a different one) are searched for the given pattern. On large trees, this search can take
9511 a while and put some strain on the server, so please use it with some consideration. Note that
9512 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
9513 case-sensitive.</dd>
9514 EOT
9515         }
9516         print <<EOT;
9517 <dt><b>author</b></dt>
9518 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
9519 <dt><b>committer</b></dt>
9520 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
9521 EOT
9522         my $have_pickaxe = gitweb_check_feature('pickaxe');
9523         if ($have_pickaxe) {
9524                 print <<EOT;
9525 <dt><b>pickaxe</b></dt>
9526 <dd>All commits that caused the string to appear or disappear from any file (changes that
9527 added, removed or "modified" the string) will be listed. This search can take a while and
9528 takes a lot of strain on the server, so please use it wisely. Note that since you may be
9529 interested even in changes just changing the case as well, this search is case sensitive.</dd>
9530 EOT
9531         }
9532         print "</dl>\n</div>\n";
9533         git_footer_html();
9534 }
9535
9536 sub git_shortlog {
9537         git_log_generic('shortlog', \&git_shortlog_body,
9538                         $hash, $hash_parent);
9539 }
9540
9541 ## ......................................................................
9542 ## feeds (RSS, Atom; OPML)
9543
9544 sub git_feed {
9545         my $format = shift || 'atom';
9546         my $have_blame = gitweb_check_feature('blame');
9547
9548         # Atom: http://www.atomenabled.org/developers/syndication/
9549         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
9550         if ($format ne 'rss' && $format ne 'atom') {
9551                 die_error(400, "Unknown web feed format");
9552         }
9553
9554         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
9555         my $head = $hash || 'HEAD';
9556         my @commitlist = parse_commits($head, 150, 0, $file_name);
9557
9558         my %latest_commit;
9559         my %latest_date;
9560         my $content_type = "application/$format+xml";
9561         if (defined $cgi->http('HTTP_ACCEPT') &&
9562                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
9563                 # browser (feed reader) prefers text/xml
9564                 $content_type = 'text/xml';
9565         }
9566         if (defined($commitlist[0])) {
9567                 %latest_commit = %{$commitlist[0]};
9568                 my $latest_epoch = $latest_commit{'committer_epoch'};
9569                 exit_if_unmodified_since($latest_epoch);
9570                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
9571         }
9572         print $cgi->header(
9573                 -type => $content_type,
9574                 -charset => 'utf-8',
9575                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
9576                 -status => '200 OK');
9577
9578         # Optimization: skip generating the body if client asks only
9579         # for Last-Modified date.
9580         return if ($cgi->request_method() eq 'HEAD');
9581
9582         # header variables
9583         my $title = "$site_name - $project/$action";
9584         my $feed_type = 'log';
9585         if (defined $hash) {
9586                 $title .= " - '$hash'";
9587                 $feed_type = 'branch log';
9588                 if (defined $file_name) {
9589                         $title .= " :: $file_name";
9590                         $feed_type = 'history';
9591                 }
9592         } elsif (defined $file_name) {
9593                 $title .= " - $file_name";
9594                 $feed_type = 'history';
9595         }
9596         $title .= " $feed_type";
9597         $title = esc_html($title);
9598         my $descr = git_get_project_description($project);
9599         if (defined $descr) {
9600                 $descr = esc_html($descr);
9601         } else {
9602                 $descr = "$project " .
9603                          ($format eq 'rss' ? 'RSS' : 'Atom') .
9604                          " feed";
9605         }
9606         my $owner = git_get_project_owner($project);
9607         $owner = esc_html($owner);
9608
9609         #header
9610         my $alt_url;
9611         if (defined $file_name) {
9612                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
9613         } elsif (defined $hash) {
9614                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
9615         } else {
9616                 $alt_url = href(-full=>1, action=>"summary");
9617         }
9618         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
9619         if ($format eq 'rss') {
9620                 print <<XML;
9621 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
9622 <channel>
9623 XML
9624                 print "<title>$title</title>\n" .
9625                       "<link>$alt_url</link>\n" .
9626                       "<description>$descr</description>\n" .
9627                       "<language>en</language>\n" .
9628                       # project owner is responsible for 'editorial' content
9629                       "<managingEditor>$owner</managingEditor>\n";
9630                 if (defined $logo || defined $favicon) {
9631                         # prefer the logo to the favicon, since RSS
9632                         # doesn't allow both
9633                         my $img = esc_url($logo || $favicon);
9634                         print "<image>\n" .
9635                               "<url>$img</url>\n" .
9636                               "<title>$title</title>\n" .
9637                               "<link>$alt_url</link>\n" .
9638                               "</image>\n";
9639                 }
9640                 if (%latest_date) {
9641                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
9642                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
9643                 }
9644                 print "<generator>gitweb v.$version/$git_version</generator>\n";
9645         } elsif ($format eq 'atom') {
9646                 print <<XML;
9647 <feed xmlns="http://www.w3.org/2005/Atom">
9648 XML
9649                 print "<title>$title</title>\n" .
9650                       "<subtitle>$descr</subtitle>\n" .
9651                       '<link rel="alternate" type="text/html" href="' .
9652                       $alt_url . '" />' . "\n" .
9653                       '<link rel="self" type="' . $content_type . '" href="' .
9654                       $cgi->self_url() . '" />' . "\n" .
9655                       "<id>" . href(-full=>1) . "</id>\n" .
9656                       # use project owner for feed author
9657                       '<author><name>'. email_obfuscate($owner) . '</name></author>\n';
9658                 if (defined $favicon) {
9659                         print "<icon>" . esc_url($favicon) . "</icon>\n";
9660                 }
9661                 if (defined $logo) {
9662                         # not twice as wide as tall: 72 x 27 pixels
9663                         print "<logo>" . esc_url($logo) . "</logo>\n";
9664                 }
9665                 if (! %latest_date) {
9666                         # dummy date to keep the feed valid until commits trickle in:
9667                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
9668                 } else {
9669                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
9670                 }
9671                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
9672         }
9673
9674         # contents
9675         for (my $i = 0; $i <= $#commitlist; $i++) {
9676                 my %co = %{$commitlist[$i]};
9677                 my $commit = $co{'id'};
9678                 # we read 150, we always show 30 and the ones more recent than 48 hours
9679                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
9680                         last;
9681                 }
9682                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
9683
9684                 # get list of changed files
9685                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9686                         $co{'parent'} || "--root",
9687                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
9688                         or next;
9689                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
9690                 close $fd
9691                         or next;
9692
9693                 # print element (entry, item)
9694                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
9695                 if ($format eq 'rss') {
9696                         print "<item>\n" .
9697                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
9698                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
9699                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
9700                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
9701                               "<link>$co_url</link>\n" .
9702                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
9703                               "<content:encoded>" .
9704                               "<![CDATA[\n";
9705                 } elsif ($format eq 'atom') {
9706                         print "<entry>\n" .
9707                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
9708                               "<updated>$cd{'iso-8601'}</updated>\n" .
9709                               "<author>\n" .
9710                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
9711                         if ($co{'author_email'}) {
9712                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
9713                         }
9714                         print "</author>\n" .
9715                               # use committer for contributor
9716                               "<contributor>\n" .
9717                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
9718                         if ($co{'committer_email'}) {
9719                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
9720                         }
9721                         print "</contributor>\n" .
9722                               "<published>$cd{'iso-8601'}</published>\n" .
9723                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
9724                               "<id>$co_url</id>\n" .
9725                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
9726                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
9727                 }
9728                 my $comment = $co{'comment'};
9729                 print "<pre>\n";
9730                 foreach my $line (@$comment) {
9731                         $line = esc_html($line);
9732                         print "$line\n";
9733                 }
9734                 print "</pre><ul>\n";
9735                 foreach my $difftree_line (@difftree) {
9736                         my %difftree = parse_difftree_raw_line($difftree_line);
9737                         next if !$difftree{'from_id'};
9738
9739                         my $file = $difftree{'file'} || $difftree{'to_file'};
9740
9741                         print "<li>" .
9742                               "[" .
9743                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
9744                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
9745                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
9746                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
9747                                       -title => "diff"}, 'D');
9748                         if ($have_blame) {
9749                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
9750                                                              file_name=>$file, hash_base=>$commit),
9751                                               -class => "blamelink",
9752                                               -title => "blame"}, 'B');
9753                         }
9754                         # if this is not a feed of a file history
9755                         if (!defined $file_name || $file_name ne $file) {
9756                                 print $cgi->a({-href => href(-full=>1, action=>"history",
9757                                                              file_name=>$file, hash=>$commit),
9758                                               -title => "history"}, 'H');
9759                         }
9760                         $file = esc_path($file);
9761                         print "] ".
9762                               "$file</li>\n";
9763                 }
9764                 if ($format eq 'rss') {
9765                         print "</ul>]]>\n" .
9766                               "</content:encoded>\n" .
9767                               "</item>\n";
9768                 } elsif ($format eq 'atom') {
9769                         print "</ul>\n</div>\n" .
9770                               "</content>\n" .
9771                               "</entry>\n";
9772                 }
9773         }
9774
9775         # end of feed
9776         if ($format eq 'rss') {
9777                 print "</channel>\n</rss>\n";
9778         } elsif ($format eq 'atom') {
9779                 print "</feed>\n";
9780         }
9781 }
9782
9783 sub git_rss {
9784         git_feed('rss');
9785 }
9786
9787 sub git_atom {
9788         git_feed('atom');
9789 }
9790
9791 sub git_opml {
9792         my @list = git_get_projects_list($project_filter, $strict_export);
9793         if (!@list) {
9794                 die_error(404, "No projects found");
9795         }
9796
9797         print $cgi->header(
9798                 -type => 'text/xml',
9799                 -charset => 'utf-8',
9800                 -content_disposition => 'inline; filename="opml.xml"');
9801
9802         my $title = esc_html($site_name);
9803         my $filter = " within subdirectory ";
9804         if (defined $project_filter) {
9805                 $filter .= esc_html($project_filter);
9806         } else {
9807                 $filter = "";
9808         }
9809         print <<XML;
9810 <?xml version="1.0" encoding="utf-8"?>
9811 <opml version="1.0">
9812 <head>
9813   <title>$title OPML Export$filter</title>
9814 </head>
9815 <body>
9816 <outline text="git RSS feeds">
9817 XML
9818
9819         foreach my $pr (@list) {
9820                 my %proj = %$pr;
9821                 my $head = git_get_head_hash($proj{'path'});
9822                 if (!defined $head) {
9823                         next;
9824                 }
9825                 $git_dir = "$projectroot/$proj{'path'}";
9826                 my %co = parse_commit($head);
9827                 if (!%co) {
9828                         next;
9829                 }
9830
9831                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9832                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9833                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9834                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9835         }
9836         print <<XML;
9837 </outline>
9838 </body>
9839 </opml>
9840 XML
9841 }