gitweb/gitweb.perl

   1 #!/usr/bin/perl
   2
   3 # gitweb - simple web interface to track changes in git repositories
   4 #
   5 # (C) 2005-2006, Kay Sievers <kay.sievers@vrfy.org>
   6 # (C) 2005, Christian Gierke
   7 #
   8 # This program is licensed under the GPLv2
   9
  10 use 5.008;
  11 use strict;
  12 use warnings;
  13 use CGI qw(:standard :escapeHTML -nosticky);
  14 use CGI::Util qw(unescape);
  15 use CGI::Carp qw(fatalsToBrowser set_message);
  16 use Encode;
  17 use Fcntl ':mode';
  18 use File::Find qw();
  19 use File::Basename qw(basename);
  20 use File::Spec;
  21 use Time::HiRes qw(gettimeofday tv_interval);
  22 use Time::Local;
  23 use constant GITWEB_CACHE_FORMAT => "Gitweb Cache Format 3";
  24 binmode STDOUT, ':utf8';
  25
  26 if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
  27         eval 'sub CGI::multi_param { CGI::param(@_) }'
  28 }
  29
  30 our $t0 = [ gettimeofday() ];
  31 our $number_of_git_cmds = 0;
  32
  33 BEGIN {
  34         CGI->compile() if $ENV{'MOD_PERL'};
  35 }
  36
  37 our $version = "++GIT_VERSION++";
  38
  39 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
  40 sub evaluate_uri {
  41         our $cgi;
  42
  43         our $my_url = $cgi->url();
  44         our $my_uri = $cgi->url(-absolute => 1);
  45
  46         # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
  47         # needed and used only for URLs with nonempty PATH_INFO
  48         # This must be an absolute URL (i.e. no scheme, host or port), NOT a full one
  49         our $base_url = $my_uri || '/';
  50
  51         # When the script is used as DirectoryIndex, the URL does not contain the name
  52         # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
  53         # have to do it ourselves. We make $path_info global because it's also used
  54         # later on.
  55         #
  56         # Another issue with the script being the DirectoryIndex is that the resulting
  57         # $my_url data is not the full script URL: this is good, because we want
  58         # generated links to keep implying the script name if it wasn't explicitly
  59         # indicated in the URL we're handling, but it means that $my_url cannot be used
  60         # as base URL.
  61         # Therefore, if we needed to strip PATH_INFO, then we know that we have
  62         # to build the base URL ourselves:
  63         our $path_info = decode_utf8($ENV{"PATH_INFO"});
  64         if ($path_info) {
  65                 # $path_info has already been URL-decoded by the web server, but
  66                 # $my_url and $my_uri have not. URL-decode them so we can properly
  67                 # strip $path_info.
  68                 $my_url = unescape($my_url);
  69                 $my_uri = unescape($my_uri);
  70                 if ($my_url =~ s,\Q$path_info\E$,, &&
  71                     $my_uri =~ s,\Q$path_info\E$,, &&
  72                     defined $ENV{'SCRIPT_NAME'}) {
  73                         $base_url = $ENV{'SCRIPT_NAME'} || '/';
  74                 }
  75         }
  76
  77         # target of the home link on top of all pages
  78         our $home_link = $my_uri || "/";
  79 }
  80
  81 # core git executable to use
  82 # this can just be "git" if your webserver has a sensible PATH
  83 our $GIT = "++GIT_BINDIR++/git";
  84
  85 # absolute fs-path which will be prepended to the project path
  86 #our $projectroot = "/pub/scm";
  87 our $projectroot = "++GITWEB_PROJECTROOT++";
  88
  89 # fs traversing limit for getting project list
  90 # the number is relative to the projectroot
  91 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
  92
  93 # string of the home link on top of all pages
  94 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
  95
  96 # extra breadcrumbs preceding the home link
  97 our @extra_breadcrumbs = ();
  98
  99 # name of your site or organization to appear in page titles
 100 # replace this with something more descriptive for clearer bookmarks
 101 our $site_name = "++GITWEB_SITENAME++"
 102                  || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
 103
 104 # html snippet to include in the <head> section of each page
 105 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
 106 # filename of html text to include at top of each page
 107 our $site_header = "++GITWEB_SITE_HEADER++";
 108 # html text to include at home page
 109 our $home_text = "++GITWEB_HOMETEXT++";
 110 # filename of html text to include at bottom of each page
 111 our $site_footer = "++GITWEB_SITE_FOOTER++";
 112
 113 # URI of stylesheets
 114 our @stylesheets = ("++GITWEB_CSS++");
 115 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
 116 our $stylesheet = undef;
 117 # URI of GIT logo (72x27 size)
 118 our $logo = "++GITWEB_LOGO++";
 119 # URI of GIT favicon, assumed to be image/png type
 120 our $favicon = "++GITWEB_FAVICON++";
 121 # URI of gitweb.js (JavaScript code for gitweb)
 122 our $javascript = "++GITWEB_JS++";
 123
 124 # URI and label (title) of GIT logo link
 125 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
 126 #our $logo_label = "git documentation";
 127 our $logo_url = "http://git-scm.com/";
 128 our $logo_label = "git homepage";
 129
 130 # source of projects list
 131 our $projects_list = "++GITWEB_LIST++";
 132
 133 # the width (in characters) of the projects list "Description" column
 134 our $projects_list_description_width = 25;
 135
 136 # group projects by category on the projects list
 137 # (enabled if this variable evaluates to true)
 138 our $projects_list_group_categories = 0;
 139
 140 # default category if none specified
 141 # (leave the empty string for no category)
 142 our $project_list_default_category = "";
 143
 144 # default order of projects list
 145 # valid values are none, project, descr, owner, and age
 146 our $default_projects_order = "project";
 147
 148 # default order of refs list
 149 # valid values are age and name
 150 our $default_refs_order = "age";
 151
 152 # show repository only if this file exists
 153 # (only effective if this variable evaluates to true)
 154 our $export_ok = "++GITWEB_EXPORT_OK++";
 155
 156 # don't generate age column on the projects list page
 157 our $omit_age_column = 0;
 158
 159 # use contents of this file (in iso, iso-strict or raw format) as
 160 # the last activity data if it exists and is a valid date
 161 our $lastactivity_file = undef;
 162
 163 # don't generate information about owners of repositories
 164 our $omit_owner=0;
 165
 166 # owner link hook given owner name (full and NOT obfuscated)
 167 # should return full URL-escaped link to attach to owner, for example:
 168 #    sub { return "/showowner.cgi?owner=".CGI::Util::escape($_[0]); }
 169 our $owner_link_hook = undef;
 170
 171 # show repository only if this subroutine returns true
 172 # when given the path to the project, for example:
 173 #    sub { return -e "$_[0]/git-daemon-export-ok"; }
 174 our $export_auth_hook = undef;
 175
 176 # only allow viewing of repositories also shown on the overview page
 177 our $strict_export = "++GITWEB_STRICT_EXPORT++";
 178
 179 # base URL for bundle info link shown on summary page, but only if
 180 # this config item is defined AND a 'bundles' subdirectory exists
 181 # in the project's repository.
 182 # i.e. full URL is "git_base_bundles_url/$project/bundles"
 183 our $git_base_bundles_url = undef;
 184
 185 ## URL Hints
 186 ##
 187 ## Any of the urls in @git_base_url_list, @git_base_mirror_urls or
 188 ## @git_base_push_urls may be an array ref instead of a scalar in which
 189 ## case ${}[0] is the url and ${}[1] is an html fragment "hint" to display
 190 ## right after the URL.
 191
 192 # list of git base URLs used for URL to where fetch project from,
 193 # i.e. full URL is "$git_base_url/$project"
 194 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
 195
 196 ## For push projects (a .nofetch file exists OR gitweb.showpush is true)
 197 ## @git_base_url_list entries are shown as "URL" and @git_base_push_urls
 198 ## are shown as "push URL" and @git_base_mirror_urls are ignored.
 199 ## For non-push projects, @git_base_url_list and @git_base_mirror_urls are shown
 200 ## as "URL" and @git_base_push_urls are ignored.
 201
 202 # URLs shown for mirrors but not for push projects in addition to base_url_list,
 203 # extended by the project name (i.e. full URL is "$git_mirror_url/$project")
 204 our @git_base_mirror_urls = ();
 205
 206 # URLs designated for pushing new changes, extended by the
 207 # project name (i.e. "$git_base_push_url[0]/$project")
 208 our @git_base_push_urls = ();
 209
 210 # https hint html inserted right after any https push URL (undef for none)
 211 # ignored if the url already has its own hint
 212 # this is supported for backwards compatibility but is now deprecated in favor
 213 # of using an array ref in the @git_base_push_urls list instead
 214 our $https_hint_html = undef;
 215
 216 # default blob_plain mimetype and default charset for text/plain blob
 217 our $default_blob_plain_mimetype = 'application/octet-stream';
 218 our $default_text_plain_charset  = undef;
 219
 220 # file to use for guessing MIME types before trying /etc/mime.types
 221 # (relative to the current git repository)
 222 our $mimetypes_file = undef;
 223
 224 # assume this charset if line contains non-UTF-8 characters;
 225 # it should be valid encoding (see Encoding::Supported(3pm) for list),
 226 # for which encoding all byte sequences are valid, for example
 227 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
 228 # could be even 'utf-8' for the old behavior)
 229 our $fallback_encoding = 'latin1';
 230
 231 # rename detection options for git-diff and git-diff-tree
 232 # - default is '-M', with the cost proportional to
 233 #   (number of removed files) * (number of new files).
 234 # - more costly is '-C' (which implies '-M'), with the cost proportional to
 235 #   (number of changed files + number of removed files) * (number of new files)
 236 # - even more costly is '-C', '--find-copies-harder' with cost
 237 #   (number of files in the original tree) * (number of new files)
 238 # - one might want to include '-B' option, e.g. '-B', '-M'
 239 our @diff_opts = ('-M'); # taken from git_commit
 240
 241 # cache directory (relative to $GIT_DIR) for project-specific html page caches.
 242 # the directory must exist and be writable by the process running gitweb.
 243 # additionally some actions must be selected for caching in %html_cache_actions
 244 # - default is 'htmlcache'
 245 our $html_cache_dir = 'htmlcache';
 246
 247 # which actions to cache in $html_cache_dir
 248 # if $html_cache_dir exists (relative to $GIT_DIR) and is writable by the
 249 # process running gitweb, then any actions selected here will have their output
 250 # cached and the cache file will be returned instead of regenerating the page
 251 # if it exists.  For this to be useful, an external process must create the
 252 # 'changed' file (if it does not already exist) in the $html_cache_dir whenever
 253 # the project information has been changed.  Alternatively it may create a
 254 # "$action.changed" file (if it does not exist) instead to limit the changes
 255 # to just "$action" instead of any action.  If 'changed' or "$action.changed"
 256 # exist, then the cached version will never be used for "$action" and a new
 257 # cache page will be regenerated (and the "changed" files removed as appropriate).
 258 #
 259 # Additionally if $projlist_cache_lifetime is > 0 AND the forks feature has been
 260 # enabled ('$feature{'forks'}{'default'} = [1];') then additionally an external
 261 # process must create the 'forkchange' file or update its timestamp if it already
 262 # exists whenever a fork is added to or removed from the project (as well as
 263 # create the 'changed' or "$action.changed" file).  Otherwise the "forks"
 264 # section on the summary page may remain out-of-date indefinately.
 265 #
 266 # - default is none
 267 #   currently only caching of the summary page is supported
 268 # - to enable caching of the summary page use:
 269 #   $html_cache_actions{'summary'} = 1;
 270 our %html_cache_actions = ();
 271
 272 # utility to automatically produce a default README.html if README.html is
 273 # enabled and it does not exist or is 0 bytes in length.  If this is set to an
 274 # executable utility that takes an absolute path to a .git directory as its
 275 # first argument and outputs an HTML fragment to use for README.html, then
 276 # it will be called when README.html is enabled but empty or missing.
 277 our $git_automatic_readme_html = undef;
 278
 279 # Disables features that would allow repository owners to inject script into
 280 # the gitweb domain.
 281 our $prevent_xss = 0;
 282
 283 # Path to a POSIX shell.  Needed to run $highlight_bin and a snapshot compressor.
 284 # Only used when highlight is enabled or snapshots with compressors are enabled.
 285 our $posix_shell_bin = "++POSIX_SHELL_BIN++";
 286
 287 # Path to the highlight executable to use (must be the one from
 288 # http://www.andre-simon.de due to assumptions about parameters and output).
 289 # Useful if highlight is not installed on your webserver's PATH.
 290 # [Default: highlight]
 291 our $highlight_bin = "++HIGHLIGHT_BIN++";
 292
 293 # Whether to include project list on the gitweb front page; 0 means yes,
 294 # 1 means no list but show tag cloud if enabled (all projects still need
 295 # to be scanned, unless the info is cached), 2 means no list and no tag cloud
 296 # (very fast)
 297 our $frontpage_no_project_list = 0;
 298
 299 # projects list cache for busy sites with many projects;
 300 # if you set this to non-zero, it will be used as the cached
 301 # index lifetime in minutes
 302 #
 303 # the cached list version is stored in $cache_dir/$cache_name and can
 304 # be tweaked by other scripts running with the same uid as gitweb -
 305 # use this ONLY at secure installations; only single gitweb project
 306 # root per system is supported, unless you tweak configuration!
 307 our $projlist_cache_lifetime = 0; # in minutes
 308 # FHS compliant $cache_dir would be "/var/cache/gitweb"
 309 our $cache_dir =
 310         (defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp').'/gitweb';
 311 our $projlist_cache_name = 'gitweb.index.cache';
 312 our $cache_grpshared = 0;
 313
 314 # information about snapshot formats that gitweb is capable of serving
 315 our %known_snapshot_formats = (
 316         # name => {
 317         #       'display' => display name,
 318         #       'type' => mime type,
 319         #       'suffix' => filename suffix,
 320         #       'format' => --format for git-archive,
 321         #       'compressor' => [compressor command and arguments]
 322         #                       (array reference, optional)
 323         #       'disabled' => boolean (optional)}
 324         #
 325         'tgz' => {
 326                 'display' => 'tar.gz',
 327                 'type' => 'application/x-gzip',
 328                 'suffix' => '.tar.gz',
 329                 'format' => 'tar',
 330                 'compressor' => ['gzip', '-n']},
 331
 332         'tbz2' => {
 333                 'display' => 'tar.bz2',
 334                 'type' => 'application/x-bzip2',
 335                 'suffix' => '.tar.bz2',
 336                 'format' => 'tar',
 337                 'compressor' => ['bzip2']},
 338
 339         'txz' => {
 340                 'display' => 'tar.xz',
 341                 'type' => 'application/x-xz',
 342                 'suffix' => '.tar.xz',
 343                 'format' => 'tar',
 344                 'compressor' => ['xz'],
 345                 'disabled' => 1},
 346
 347         'zip' => {
 348                 'display' => 'zip',
 349                 'type' => 'application/x-zip',
 350                 'suffix' => '.zip',
 351                 'format' => 'zip'},
 352 );
 353
 354 # Aliases so we understand old gitweb.snapshot values in repository
 355 # configuration.
 356 our %known_snapshot_format_aliases = (
 357         'gzip'  => 'tgz',
 358         'bzip2' => 'tbz2',
 359         'xz'    => 'txz',
 360
 361         # backward compatibility: legacy gitweb config support
 362         'x-gzip' => undef, 'gz' => undef,
 363         'x-bzip2' => undef, 'bz2' => undef,
 364         'x-zip' => undef, '' => undef,
 365 );
 366
 367 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
 368 # are changed, it may be appropriate to change these values too via
 369 # $GITWEB_CONFIG.
 370 our %avatar_size = (
 371         'default' => 16,
 372         'double'  => 32
 373 );
 374
 375 # Used to set the maximum load that we will still respond to gitweb queries.
 376 # If server load exceed this value then return "503 server busy" error.
 377 # If gitweb cannot determined server load, it is taken to be 0.
 378 # Leave it undefined (or set to 'undef') to turn off load checking.
 379 our $maxload = 300;
 380
 381 # configuration for 'highlight' (http://www.andre-simon.de/)
 382 # match by basename
 383 our %highlight_basename = (
 384         #'Program' => 'py',
 385         #'Library' => 'py',
 386         'SConstruct' => 'py', # SCons equivalent of Makefile
 387         'Makefile' => 'make',
 388         'makefile' => 'make',
 389         'GNUmakefile' => 'make',
 390         'BSDmakefile' => 'make',
 391 );
 392 # match by shebang regex
 393 our %highlight_shebang = (
 394         # Each entry has a key which is the syntax to use and
 395         # a value which is either a qr regex or an array of qr regexs to match
 396         # against the first 128 (less if the blob is shorter) BYTES of the blob.
 397         # We match /usr/bin/env items separately to require "/usr/bin/env" and
 398         # allow a limited subset of NAME=value items to appear.
 399         'awk'    => [ qr,^#!\s*/(?:\w+/)*(?:[gnm]?awk)(?:\s|$),mo,
 400                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[gnm]?awk)(?:\s|$),mo ],
 401         'make'   => [ qr,^#!\s*/(?:\w+/)*(?:g?make)(?:\s|$),mo,
 402                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:g?make)(?:\s|$),mo ],
 403         'php'    => [ qr,^#!\s*/(?:\w+/)*(?:php)(?:\s|$),mo,
 404                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:php)(?:\s|$),mo ],
 405         'pl'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 406                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 407         'py'     => [ qr,^#!\s*/(?:\w+/)*(?:python)(?:\s|$),mo,
 408                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:python)(?:\s|$),mo ],
 409         'sh'     => [ qr,^#!\s*/(?:\w+/)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo,
 410                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo ],
 411         'rb'     => [ qr,^#!\s*/(?:\w+/)*(?:ruby)(?:\s|$),mo,
 412                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:ruby)(?:\s|$),mo ],
 413 );
 414 # match by extension
 415 our %highlight_ext = (
 416         # main extensions, defining name of syntax;
 417         # see files in /usr/share/highlight/langDefs/ directory
 418         (map { $_ => $_ } qw(
 419                 4gl a4c abnf abp ada agda ahk ampl amtrix applescript arc
 420                 arm as asm asp aspect ats au3 avenue awk bat bb bbcode bib
 421                 bms bnf boo c cb cfc chl clipper clojure clp cob cs css d
 422                 diff dot dylan e ebnf erl euphoria exp f90 flx for frink fs
 423                 go haskell hcl html httpd hx icl icn idl idlang ili
 424                 inc_luatex ini inp io iss j java js jsp lbn ldif lgt lhs
 425                 lisp lotos ls lsl lua ly make mel mercury mib miranda ml mo
 426                 mod2 mod3 mpl ms mssql n nas nbc nice nrx nsi nut nxc oberon
 427                 objc octave oorexx os oz pas php pike pl pl1 pov pro
 428                 progress ps ps1 psl pure py pyx q qmake qu r rb rebol rexx
 429                 rnc s sas sc scala scilab sh sma smalltalk sml sno spec spn
 430                 sql sybase tcl tcsh tex ttcn3 vala vb verilog vhd xml xpp y
 431                 yaiff znn)),
 432         # alternate extensions, see /etc/highlight/filetypes.conf
 433         (map { $_ => '4gl' } qw(informix)),
 434         (map { $_ => 'a4c' } qw(ascend)),
 435         (map { $_ => 'abp' } qw(abp4)),
 436         (map { $_ => 'ada' } qw(a adb ads gnad)),
 437         (map { $_ => 'ahk' } qw(autohotkey)),
 438         (map { $_ => 'ampl' } qw(dat run)),
 439         (map { $_ => 'amtrix' } qw(hnd s4 s4h s4t t4)),
 440         (map { $_ => 'as' } qw(actionscript)),
 441         (map { $_ => 'asm' } qw(29k 68s 68x a51 assembler x68 x86)),
 442         (map { $_ => 'asp' } qw(asa)),
 443         (map { $_ => 'aspect' } qw(was wud)),
 444         (map { $_ => 'ats' } qw(dats)),
 445         (map { $_ => 'au3' } qw(autoit)),
 446         (map { $_ => 'bat' } qw(cmd)),
 447         (map { $_ => 'bb' } qw(blitzbasic)),
 448         (map { $_ => 'bib' } qw(bibtex)),
 449         (map { $_ => 'c' } qw(c++ cc cpp cu cxx h hh hpp hxx)),
 450         (map { $_ => 'cb' } qw(clearbasic)),
 451         (map { $_ => 'cfc' } qw(cfm coldfusion)),
 452         (map { $_ => 'chl' } qw(chill)),
 453         (map { $_ => 'cob' } qw(cbl cobol)),
 454         (map { $_ => 'cs' } qw(csharp)),
 455         (map { $_ => 'diff' } qw(patch)),
 456         (map { $_ => 'dot' } qw(graphviz)),
 457         (map { $_ => 'e' } qw(eiffel se)),
 458         (map { $_ => 'erl' } qw(erlang hrl)),
 459         (map { $_ => 'euphoria' } qw(eu ew ex exu exw wxu)),
 460         (map { $_ => 'exp' } qw(express)),
 461         (map { $_ => 'f90' } qw(f95)),
 462         (map { $_ => 'flx' } qw(felix)),
 463         (map { $_ => 'for' } qw(f f77 ftn)),
 464         (map { $_ => 'fs' } qw(fsharp fsx)),
 465         (map { $_ => 'haskell' } qw(hs)),
 466         (map { $_ => 'html' } qw(htm xhtml)),
 467         (map { $_ => 'hx' } qw(haxe)),
 468         (map { $_ => 'icl' } qw(clean)),
 469         (map { $_ => 'icn' } qw(icon)),
 470         (map { $_ => 'ili' } qw(interlis)),
 471         (map { $_ => 'inp' } qw(fame)),
 472         (map { $_ => 'iss' } qw(innosetup)),
 473         (map { $_ => 'j' } qw(jasmin)),
 474         (map { $_ => 'java' } qw(groovy grv)),
 475         (map { $_ => 'lbn' } qw(luban)),
 476         (map { $_ => 'lgt' } qw(logtalk)),
 477         (map { $_ => 'lisp' } qw(cl clisp el lsp sbcl scom)),
 478         (map { $_ => 'ls' } qw(lotus)),
 479         (map { $_ => 'lsl' } qw(lindenscript)),
 480         (map { $_ => 'ly' } qw(lilypond)),
 481         (map { $_ => 'make' } qw(mak mk kmk)),
 482         (map { $_ => 'mel' } qw(maya)),
 483         (map { $_ => 'mib' } qw(smi snmp)),
 484         (map { $_ => 'ml' } qw(mli ocaml)),
 485         (map { $_ => 'mo' } qw(modelica)),
 486         (map { $_ => 'mod2' } qw(def mod)),
 487         (map { $_ => 'mod3' } qw(i3 m3)),
 488         (map { $_ => 'mpl' } qw(maple)),
 489         (map { $_ => 'n' } qw(nemerle)),
 490         (map { $_ => 'nas' } qw(nasal)),
 491         (map { $_ => 'nrx' } qw(netrexx)),
 492         (map { $_ => 'nsi' } qw(nsis)),
 493         (map { $_ => 'nut' } qw(squirrel)),
 494         (map { $_ => 'oberon' } qw(ooc)),
 495         (map { $_ => 'objc' } qw(M m mm)),
 496         (map { $_ => 'php' } qw(php3 php4 php5 php6)),
 497         (map { $_ => 'pike' } qw(pmod)),
 498         (map { $_ => 'pl' } qw(perl plex plx pm)),
 499         (map { $_ => 'pl1' } qw(bdy ff fp fpp rpp sf sp spb spe spp sps wf wp wpb wpp wps)),
 500         (map { $_ => 'progress' } qw(i p w)),
 501         (map { $_ => 'py' } qw(python)),
 502         (map { $_ => 'pyx' } qw(pyrex)),
 503         (map { $_ => 'rb' } qw(pp rjs ruby)),
 504         (map { $_ => 'rexx' } qw(rex rx the)),
 505         (map { $_ => 'sc' } qw(paradox)),
 506         (map { $_ => 'scilab' } qw(sce sci)),
 507         (map { $_ => 'sh' } qw(bash ebuild eclass ksh zsh)),
 508         (map { $_ => 'sma' } qw(small)),
 509         (map { $_ => 'smalltalk' } qw(gst sq st)),
 510         (map { $_ => 'sno' } qw(snobal)),
 511         (map { $_ => 'sybase' } qw(sp)),
 512         (map { $_ => 'tcl' } qw(itcl wish)),
 513         (map { $_ => 'tex' } qw(cls sty)),
 514         (map { $_ => 'vb' } qw(bas basic bi vbs)),
 515         (map { $_ => 'verilog' } qw(v)),
 516         (map { $_ => 'xml' } qw(dtd ecf ent hdr hub jnlp nrm plist resx sgm sgml svg tld vxml wml xsd xsl)),
 517         (map { $_ => 'y' } qw(bison)),
 518 );
 519
 520 # You define site-wide feature defaults here; override them with
 521 # $GITWEB_CONFIG as necessary.
 522 our %feature = (
 523         # feature => {
 524         #       'sub' => feature-sub (subroutine),
 525         #       'override' => allow-override (boolean),
 526         #       'default' => [ default options...] (array reference)}
 527         #
 528         # if feature is overridable (it means that allow-override has true value),
 529         # then feature-sub will be called with default options as parameters;
 530         # return value of feature-sub indicates if to enable specified feature
 531         #
 532         # if there is no 'sub' key (no feature-sub), then feature cannot be
 533         # overridden
 534         #
 535         # use gitweb_get_feature(<feature>) to retrieve the <feature> value
 536         # (an array) or gitweb_check_feature(<feature>) to check if <feature>
 537         # is enabled
 538
 539         # Enable the 'blame' blob view, showing the last commit that modified
 540         # each line in the file. This can be very CPU-intensive.
 541
 542         # To enable system wide have in $GITWEB_CONFIG
 543         # $feature{'blame'}{'default'} = [1];
 544         # To have project specific config enable override in $GITWEB_CONFIG
 545         # $feature{'blame'}{'override'} = 1;
 546         # and in project config gitweb.blame = 0|1;
 547         'blame' => {
 548                 'sub' => sub { feature_bool('blame', @_) },
 549                 'override' => 0,
 550                 'default' => [0]},
 551
 552         # Enable the 'incremental blame' blob view, which uses javascript to
 553         # incrementally show the revisions of lines as they are discovered
 554         # in the history. It is better for large histories, files and slow
 555         # servers, but requires javascript in the client and can slow down the
 556         # browser on large files.
 557
 558         # To enable system wide have in $GITWEB_CONFIG
 559         # $feature{'blame_incremental'}{'default'} = [1];
 560         # To have project specific config enable override in $GITWEB_CONFIG
 561         # $feature{'blame_incremental'}{'override'} = 1;
 562         # and in project config gitweb.blame_incremental = 0|1;
 563         'blame_incremental' => {
 564                 'sub' => sub { feature_bool('blame_incremental', @_) },
 565                 'override' => 0,
 566                 'default' => [0]},
 567
 568         # Enable the 'snapshot' link, providing a compressed archive of any
 569         # tree. This can potentially generate high traffic if you have large
 570         # project.
 571
 572         # Value is a list of formats defined in %known_snapshot_formats that
 573         # you wish to offer.
 574         # To disable system wide have in $GITWEB_CONFIG
 575         # $feature{'snapshot'}{'default'} = [];
 576         # To have project specific config enable override in $GITWEB_CONFIG
 577         # $feature{'snapshot'}{'override'} = 1;
 578         # and in project config, a comma-separated list of formats or "none"
 579         # to disable.  Example: gitweb.snapshot = tbz2,zip;
 580         'snapshot' => {
 581                 'sub' => \&feature_snapshot,
 582                 'override' => 0,
 583                 'default' => ['tgz']},
 584
 585         # Enable text search, which will list the commits which match author,
 586         # committer or commit text to a given string.  Enabled by default.
 587         # Project specific override is not supported.
 588         #
 589         # Note that this controls all search features, which means that if
 590         # it is disabled, then 'grep' and 'pickaxe' search would also be
 591         # disabled.
 592         'search' => {
 593                 'override' => 0,
 594                 'default' => [1]},
 595
 596         # Enable regular expression search.  Enabled by default.
 597         # Note that you need to have 'search' feature enabled too.
 598         #
 599         # Note that this affects all git search features, which means that if
 600         # it is disabled, none of the git search options will allow a regular
 601         # expression (the "RE" checkbox) to be used.  However, the project
 602         # list search is unaffected by this setting (it uses Perl to do the
 603         # matching not Git) and will always allow a regular expression to
 604         # be used (by checking the box) regardless of this setting.
 605         'regexp' => {
 606                 'sub' => sub { feature_bool('regexp', @_) },
 607                 'override' => 0,
 608                 'default' => [1]},
 609
 610         # Enable grep search, which will list the files in currently selected
 611         # tree containing the given string. Enabled by default. This can be
 612         # potentially CPU-intensive, of course.
 613         # Note that you need to have 'search' feature enabled too.
 614
 615         # To enable system wide have in $GITWEB_CONFIG
 616         # $feature{'grep'}{'default'} = [1];
 617         # To have project specific config enable override in $GITWEB_CONFIG
 618         # $feature{'grep'}{'override'} = 1;
 619         # and in project config gitweb.grep = 0|1;
 620         'grep' => {
 621                 'sub' => sub { feature_bool('grep', @_) },
 622                 'override' => 0,
 623                 'default' => [1]},
 624
 625         # Enable the pickaxe search, which will list the commits that modified
 626         # a given string in a file. This can be practical and quite faster
 627         # alternative to 'blame', but still potentially CPU-intensive.
 628         # Note that you need to have 'search' feature enabled too.
 629
 630         # To enable system wide have in $GITWEB_CONFIG
 631         # $feature{'pickaxe'}{'default'} = [1];
 632         # To have project specific config enable override in $GITWEB_CONFIG
 633         # $feature{'pickaxe'}{'override'} = 1;
 634         # and in project config gitweb.pickaxe = 0|1;
 635         'pickaxe' => {
 636                 'sub' => sub { feature_bool('pickaxe', @_) },
 637                 'override' => 0,
 638                 'default' => [1]},
 639
 640         # Enable showing size of blobs in a 'tree' view, in a separate
 641         # column, similar to what 'ls -l' does.  This cost a bit of IO.
 642
 643         # To disable system wide have in $GITWEB_CONFIG
 644         # $feature{'show-sizes'}{'default'} = [0];
 645         # To have project specific config enable override in $GITWEB_CONFIG
 646         # $feature{'show-sizes'}{'override'} = 1;
 647         # and in project config gitweb.showsizes = 0|1;
 648         'show-sizes' => {
 649                 'sub' => sub { feature_bool('showsizes', @_) },
 650                 'override' => 0,
 651                 'default' => [1]},
 652
 653         # Make gitweb use an alternative format of the URLs which can be
 654         # more readable and natural-looking: project name is embedded
 655         # directly in the path and the query string contains other
 656         # auxiliary information. All gitweb installations recognize
 657         # URL in either format; this configures in which formats gitweb
 658         # generates links.
 659
 660         # To enable system wide have in $GITWEB_CONFIG
 661         # $feature{'pathinfo'}{'default'} = [1];
 662         # Project specific override is not supported.
 663
 664         # Note that you will need to change the default location of CSS,
 665         # favicon, logo and possibly other files to an absolute URL. Also,
 666         # if gitweb.cgi serves as your indexfile, you will need to force
 667         # $my_uri to contain the script name in your $GITWEB_CONFIG (and you
 668         # will also likely want to set $home_link if you're setting $my_uri).
 669         'pathinfo' => {
 670                 'override' => 0,
 671                 'default' => [0]},
 672
 673         # Make gitweb consider projects in project root subdirectories
 674         # to be forks of existing projects. Given project $projname.git,
 675         # projects matching $projname/*.git will not be shown in the main
 676         # projects list, instead a '+' mark will be added to $projname
 677         # there and a 'forks' view will be enabled for the project, listing
 678         # all the forks. If project list is taken from a file, forks have
 679         # to be listed after the main project.
 680
 681         # To enable system wide have in $GITWEB_CONFIG
 682         # $feature{'forks'}{'default'} = [1];
 683         # Project specific override is not supported.
 684         'forks' => {
 685                 'override' => 0,
 686                 'default' => [0]},
 687
 688         # Insert custom links to the action bar of all project pages.
 689         # This enables you mainly to link to third-party scripts integrating
 690         # into gitweb; e.g. git-browser for graphical history representation
 691         # or custom web-based repository administration interface.
 692
 693         # The 'default' value consists of a list of triplets in the form
 694         # (label, link, position) where position is the label after which
 695         # to insert the link and link is a format string where %n expands
 696         # to the project name, %f to the project path within the filesystem,
 697         # %h to the current hash (h gitweb parameter) and %b to the current
 698         # hash base (hb gitweb parameter); %% expands to %.  %e expands to the
 699         # project name where all '+' characters have been replaced with '%2B'.
 700
 701         # To enable system wide have in $GITWEB_CONFIG e.g.
 702         # $feature{'actions'}{'default'} = [('graphiclog',
 703         #       '/git-browser/by-commit.html?r=%n', 'summary')];
 704         # Project specific override is not supported.
 705         'actions' => {
 706                 'override' => 0,
 707                 'default' => []},
 708
 709         # Allow gitweb scan project content tags of project repository,
 710         # and display the popular Web 2.0-ish "tag cloud" near the projects
 711         # list.  Note that this is something COMPLETELY different from the
 712         # normal Git tags.
 713
 714         # gitweb by itself can show existing tags, but it does not handle
 715         # tagging itself; you need to do it externally, outside gitweb.
 716         # The format is described in git_get_project_ctags() subroutine.
 717         # You may want to install the HTML::TagCloud Perl module to get
 718         # a pretty tag cloud instead of just a list of tags.
 719
 720         # To enable system wide have in $GITWEB_CONFIG
 721         # $feature{'ctags'}{'default'} = [1];
 722         # Project specific override is not supported.
 723
 724         # A value of 0 means no ctags display or editing.  A value of
 725         # 1 enables ctags display but never editing.  A non-empty value
 726         # that is not a string of digits enables ctags display AND the
 727         # ability to add tags using a form that uses method POST and
 728         # an action value set to the configured 'ctags' value.
 729         'ctags' => {
 730                 'override' => 0,
 731                 'default' => [0]},
 732
 733         # The maximum number of patches in a patchset generated in patch
 734         # view. Set this to 0 or undef to disable patch view, or to a
 735         # negative number to remove any limit.
 736
 737         # To disable system wide have in $GITWEB_CONFIG
 738         # $feature{'patches'}{'default'} = [0];
 739         # To have project specific config enable override in $GITWEB_CONFIG
 740         # $feature{'patches'}{'override'} = 1;
 741         # and in project config gitweb.patches = 0|n;
 742         # where n is the maximum number of patches allowed in a patchset.
 743         'patches' => {
 744                 'sub' => \&feature_patches,
 745                 'override' => 0,
 746                 'default' => [16]},
 747
 748         # Avatar support. When this feature is enabled, views such as
 749         # shortlog or commit will display an avatar associated with
 750         # the email of the committer(s) and/or author(s).
 751
 752         # Currently available providers are gravatar and picon.
 753         # If an unknown provider is specified, the feature is disabled.
 754
 755         # Gravatar depends on Digest::MD5.
 756         # Picon currently relies on the indiana.edu database.
 757
 758         # To enable system wide have in $GITWEB_CONFIG
 759         # $feature{'avatar'}{'default'} = ['<provider>'];
 760         # where <provider> is either gravatar or picon.
 761         # To have project specific config enable override in $GITWEB_CONFIG
 762         # $feature{'avatar'}{'override'} = 1;
 763         # and in project config gitweb.avatar = <provider>;
 764         'avatar' => {
 765                 'sub' => \&feature_avatar,
 766                 'override' => 0,
 767                 'default' => ['']},
 768
 769         # Enable displaying how much time and how many git commands
 770         # it took to generate and display page.  Disabled by default.
 771         # Project specific override is not supported.
 772         'timed' => {
 773                 'override' => 0,
 774                 'default' => [0]},
 775
 776         # Enable turning some links into links to actions which require
 777         # JavaScript to run (like 'blame_incremental').  Not enabled by
 778         # default.  Project specific override is currently not supported.
 779         'javascript-actions' => {
 780                 'override' => 0,
 781                 'default' => [0]},
 782
 783         # Enable and configure ability to change common timezone for dates
 784         # in gitweb output via JavaScript.  Enabled by default.
 785         # Project specific override is not supported.
 786         'javascript-timezone' => {
 787                 'override' => 0,
 788                 'default' => [
 789                         'local',     # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
 790                                      # or undef to turn off this feature
 791                         'gitweb_tz', # name of cookie where to store selected timezone
 792                         'datetime',  # CSS class used to mark up dates for manipulation
 793                 ]},
 794
 795         # Syntax highlighting support. This is based on Daniel Svensson's
 796         # and Sham Chukoury's work in gitweb-xmms2.git.
 797         # It requires the 'highlight' program present in $PATH,
 798         # and therefore is disabled by default.
 799
 800         # To enable system wide have in $GITWEB_CONFIG
 801         # $feature{'highlight'}{'default'} = [1];
 802
 803         'highlight' => {
 804                 'sub' => sub { feature_bool('highlight', @_) },
 805                 'override' => 0,
 806                 'default' => [0]},
 807
 808         # Enable displaying of remote heads in the heads list
 809
 810         # To enable system wide have in $GITWEB_CONFIG
 811         # $feature{'remote_heads'}{'default'} = [1];
 812         # To have project specific config enable override in $GITWEB_CONFIG
 813         # $feature{'remote_heads'}{'override'} = 1;
 814         # and in project config gitweb.remoteheads = 0|1;
 815         'remote_heads' => {
 816                 'sub' => sub { feature_bool('remote_heads', @_) },
 817                 'override' => 0,
 818                 'default' => [0]},
 819
 820         # Enable showing branches under other refs in addition to heads
 821
 822         # To set system wide extra branch refs have in $GITWEB_CONFIG
 823         # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
 824         # To have project specific config enable override in $GITWEB_CONFIG
 825         # $feature{'extra-branch-refs'}{'override'} = 1;
 826         # and in project config gitweb.extrabranchrefs = dirs of choice
 827         # Every directory is separated with whitespace.
 828
 829         'extra-branch-refs' => {
 830                 'sub' => \&feature_extra_branch_refs,
 831                 'override' => 0,
 832                 'default' => []},
 833 );
 834
 835 sub gitweb_get_feature {
 836         my ($name) = @_;
 837         return unless exists $feature{$name};
 838         my ($sub, $override, @defaults) = (
 839                 $feature{$name}{'sub'},
 840                 $feature{$name}{'override'},
 841                 @{$feature{$name}{'default'}});
 842         # project specific override is possible only if we have project
 843         our $git_dir; # global variable, declared later
 844         if (!$override || !defined $git_dir) {
 845                 return @defaults;
 846         }
 847         if (!defined $sub) {
 848                 warn "feature $name is not overridable";
 849                 return @defaults;
 850         }
 851         return $sub->(@defaults);
 852 }
 853
 854 # A wrapper to check if a given feature is enabled.
 855 # With this, you can say
 856 #
 857 #   my $bool_feat = gitweb_check_feature('bool_feat');
 858 #   gitweb_check_feature('bool_feat') or somecode;
 859 #
 860 # instead of
 861 #
 862 #   my ($bool_feat) = gitweb_get_feature('bool_feat');
 863 #   (gitweb_get_feature('bool_feat'))[0] or somecode;
 864 #
 865 sub gitweb_check_feature {
 866         return (gitweb_get_feature(@_))[0];
 867 }
 868
 869
 870 sub feature_bool {
 871         my $key = shift;
 872         my ($val) = git_get_project_config($key, '--bool');
 873
 874         if (!defined $val) {
 875                 return ($_[0]);
 876         } elsif ($val eq 'true') {
 877                 return (1);
 878         } elsif ($val eq 'false') {
 879                 return (0);
 880         }
 881 }
 882
 883 sub feature_snapshot {
 884         my (@fmts) = @_;
 885
 886         my ($val) = git_get_project_config('snapshot');
 887
 888         if ($val) {
 889                 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
 890         }
 891
 892         return @fmts;
 893 }
 894
 895 sub feature_patches {
 896         my @val = (git_get_project_config('patches', '--int'));
 897
 898         if (@val) {
 899                 return @val;
 900         }
 901
 902         return ($_[0]);
 903 }
 904
 905 sub feature_avatar {
 906         my @val = (git_get_project_config('avatar'));
 907
 908         return @val ? @val : @_;
 909 }
 910
 911 sub feature_extra_branch_refs {
 912         my (@branch_refs) = @_;
 913         my $values = git_get_project_config('extrabranchrefs');
 914
 915         if ($values) {
 916                 $values = config_to_multi ($values);
 917                 @branch_refs = ();
 918                 foreach my $value (@{$values}) {
 919                         push @branch_refs, split /\s+/, $value;
 920                 }
 921         }
 922
 923         return @branch_refs;
 924 }
 925
 926 # checking HEAD file with -e is fragile if the repository was
 927 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
 928 # and then pruned.
 929 sub check_head_link {
 930         my ($dir) = @_;
 931         return 0 unless -d "$dir/objects" && -x _;
 932         return 0 unless -d "$dir/refs" && -x _;
 933         my $headfile = "$dir/HEAD";
 934         return -l $headfile ?
 935                 readlink($headfile) =~ /^refs\/heads\// : -f $headfile;
 936 }
 937
 938 sub check_export_ok {
 939         my ($dir) = @_;
 940         return (check_head_link($dir) &&
 941                 (!$export_ok || -e "$dir/$export_ok") &&
 942                 (!$export_auth_hook || $export_auth_hook->($dir)));
 943 }
 944
 945 # process alternate names for backward compatibility
 946 # filter out unsupported (unknown) snapshot formats
 947 sub filter_snapshot_fmts {
 948         my @fmts = @_;
 949
 950         @fmts = map {
 951                 exists $known_snapshot_format_aliases{$_} ?
 952                        $known_snapshot_format_aliases{$_} : $_} @fmts;
 953         @fmts = grep {
 954                 exists $known_snapshot_formats{$_} &&
 955                 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
 956 }
 957
 958 sub filter_and_validate_refs {
 959         my @refs = @_;
 960         my %unique_refs = ();
 961
 962         foreach my $ref (@refs) {
 963                 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
 964                 # 'heads' are added implicitly in get_branch_refs().
 965                 $unique_refs{$ref} = 1 if ($ref ne 'heads');
 966         }
 967         return sort keys %unique_refs;
 968 }
 969
 970 # If it is set to code reference, it is code that it is to be run once per
 971 # request, allowing updating configurations that change with each request,
 972 # while running other code in config file only once.
 973 #
 974 # Otherwise, if it is false then gitweb would process config file only once;
 975 # if it is true then gitweb config would be run for each request.
 976 our $per_request_config = 1;
 977
 978 # If true and fileno STDIN is 0 and getsockname succeeds and getpeername fails
 979 # with ENOTCONN, then FCGI mode will be activated automatically in just the
 980 # same way as though the --fcgi option had been given instead.
 981 our $auto_fcgi = 0;
 982
 983 # read and parse gitweb config file given by its parameter.
 984 # returns true on success, false on recoverable error, allowing
 985 # to chain this subroutine, using first file that exists.
 986 # dies on errors during parsing config file, as it is unrecoverable.
 987 sub read_config_file {
 988         my $filename = shift;
 989         return unless defined $filename;
 990         # die if there are errors parsing config file
 991         if (-e $filename) {
 992                 do $filename;
 993                 die $@ if $@;
 994                 return 1;
 995         }
 996         return;
 997 }
 998
 999 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
1000 sub evaluate_gitweb_config {
1001         our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
1002         our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
1003         our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
1004
1005         # Protect against duplications of file names, to not read config twice.
1006         # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
1007         # there possibility of duplication of filename there doesn't matter.
1008         $GITWEB_CONFIG = ""        if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
1009         $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
1010
1011         # Common system-wide settings for convenience.
1012         # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
1013         read_config_file($GITWEB_CONFIG_COMMON);
1014
1015         # Use first config file that exists.  This means use the per-instance
1016         # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
1017         read_config_file($GITWEB_CONFIG) and return;
1018         read_config_file($GITWEB_CONFIG_SYSTEM);
1019 }
1020
1021 our $encode_object;
1022 our $to_utf8_pipe_command = '';
1023
1024 sub evaluate_encoding {
1025         my $requested = $fallback_encoding || 'ISO-8859-1';
1026         my $obj = Encode::find_encoding($requested) or
1027                 die_error(400, "Requested fallback encoding not found");
1028         if ($obj->name eq 'iso-8859-1') {
1029                 # Use Windows-1252 instead as required by the HTML 5 standard
1030                 my $altobj = Encode::find_encoding('Windows-1252');
1031                 $obj = $altobj if $altobj;
1032         }
1033         $encode_object = $obj;
1034         my $nm = lc($encode_object->name);
1035         unless ($nm eq 'cp1252' || $nm eq 'ascii' || $nm eq 'utf8' ||
1036                 $nm =~ /^utf-8/ || $nm =~ /^iso-8859-/) {
1037                 $to_utf8_pipe_command =
1038                   quote_command($^X, '-CO', '-MEncode=decode,FB_DEFAULT', '-pse',
1039                     '$_ = decode($fe, $_, FB_DEFAULT) if !utf8::decode($_);',
1040                     '--', "-fe=$fallback_encoding")." | ";
1041         }
1042 }
1043
1044 sub evaluate_email_obfuscate {
1045         # email obfuscation
1046         our $email;
1047         if (!$email && eval { require HTML::Email::Obfuscate; 1 }) {
1048                 $email = HTML::Email::Obfuscate->new(lite => 1);
1049         }
1050 }
1051
1052 # Get loadavg of system, to compare against $maxload.
1053 # Currently it requires '/proc/loadavg' present to get loadavg;
1054 # if it is not present it returns 0, which means no load checking.
1055 sub get_loadavg {
1056         if( -e '/proc/loadavg' ){
1057                 open my $fd, '<', '/proc/loadavg'
1058                         or return 0;
1059                 my @load = split(/\s+/, scalar <$fd>);
1060                 close $fd;
1061
1062                 # The first three columns measure CPU and IO utilization of the last one,
1063                 # five, and 10 minute periods.  The fourth column shows the number of
1064                 # currently running processes and the total number of processes in the m/n
1065                 # format.  The last column displays the last process ID used.
1066                 return $load[0] || 0;
1067         }
1068         # additional checks for load average should go here for things that don't export
1069         # /proc/loadavg
1070
1071         return 0;
1072 }
1073
1074 # version of the core git binary
1075 our $git_version;
1076 sub evaluate_git_version {
1077         our $git_version = $version;
1078 }
1079
1080 sub check_loadavg {
1081         if (defined $maxload && get_loadavg() > $maxload) {
1082                 die_error(503, "The load average on the server is too high");
1083         }
1084 }
1085
1086 # ======================================================================
1087 # input validation and dispatch
1088
1089 # input parameters can be collected from a variety of sources (presently, CGI
1090 # and PATH_INFO), so we define an %input_params hash that collects them all
1091 # together during validation: this allows subsequent uses (e.g. href()) to be
1092 # agnostic of the parameter origin
1093
1094 our %input_params = ();
1095
1096 # input parameters are stored with the long parameter name as key. This will
1097 # also be used in the href subroutine to convert parameters to their CGI
1098 # equivalent, and since the href() usage is the most frequent one, we store
1099 # the name -> CGI key mapping here, instead of the reverse.
1100 #
1101 # XXX: Warning: If you touch this, check the search form for updating,
1102 # too.
1103
1104 our @cgi_param_mapping = (
1105         project => "p",
1106         action => "a",
1107         file_name => "f",
1108         file_parent => "fp",
1109         hash => "h",
1110         hash_parent => "hp",
1111         hash_base => "hb",
1112         hash_parent_base => "hpb",
1113         page => "pg",
1114         order => "o",
1115         searchtext => "s",
1116         searchtype => "st",
1117         snapshot_format => "sf",
1118         ctag_filter => 't',
1119         extra_options => "opt",
1120         search_use_regexp => "sr",
1121         ctag => "by_tag",
1122         diff_style => "ds",
1123         project_filter => "pf",
1124         # this must be last entry (for manipulation from JavaScript)
1125         javascript => "js"
1126 );
1127 our %cgi_param_mapping = @cgi_param_mapping;
1128
1129 # we will also need to know the possible actions, for validation
1130 our %actions = (
1131         "blame" => \&git_blame,
1132         "blame_incremental" => \&git_blame_incremental,
1133         "blame_data" => \&git_blame_data,
1134         "blobdiff" => \&git_blobdiff,
1135         "blobdiff_plain" => \&git_blobdiff_plain,
1136         "blob" => \&git_blob,
1137         "blob_plain" => \&git_blob_plain,
1138         "commitdiff" => \&git_commitdiff,
1139         "commitdiff_plain" => \&git_commitdiff_plain,
1140         "commit" => \&git_commit,
1141         "forks" => \&git_forks,
1142         "heads" => \&git_heads,
1143         "history" => \&git_history,
1144         "log" => \&git_log,
1145         "patch" => \&git_patch,
1146         "patches" => \&git_patches,
1147         "refs" => \&git_refs,
1148         "remotes" => \&git_remotes,
1149         "rss" => \&git_rss,
1150         "atom" => \&git_atom,
1151         "search" => \&git_search,
1152         "search_help" => \&git_search_help,
1153         "shortlog" => \&git_shortlog,
1154         "summary" => \&git_summary,
1155         "tag" => \&git_tag,
1156         "tags" => \&git_tags,
1157         "tree" => \&git_tree,
1158         "snapshot" => \&git_snapshot,
1159         "object" => \&git_object,
1160         # those below don't need $project
1161         "opml" => \&git_opml,
1162         "frontpage" => \&git_frontpage,
1163         "project_list" => \&git_project_list,
1164         "project_index" => \&git_project_index,
1165 );
1166
1167 # the only actions we will allow to be cached
1168 my %supported_cache_actions;
1169 BEGIN {%supported_cache_actions = map {( $_ => 1 )} qw(summary)}
1170
1171 # finally, we have the hash of allowed extra_options for the commands that
1172 # allow them
1173 our %allowed_options = (
1174         "--no-merges" => [ qw(rss atom log shortlog history) ],
1175 );
1176
1177 # fill %input_params with the CGI parameters. All values except for 'opt'
1178 # should be single values, but opt can be an array. We should probably
1179 # build an array of parameters that can be multi-valued, but since for the time
1180 # being it's only this one, we just single it out
1181 sub evaluate_query_params {
1182         our $cgi;
1183
1184         while (my ($name, $symbol) = each %cgi_param_mapping) {
1185                 if ($symbol eq 'opt') {
1186                         $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
1187                 } else {
1188                         $input_params{$name} = decode_utf8($cgi->param($symbol));
1189                 }
1190         }
1191
1192         # Backwards compatibility - by_tag= <=> t=
1193         if ($input_params{'ctag'}) {
1194                 $input_params{'ctag_filter'} = $input_params{'ctag'};
1195         }
1196 }
1197
1198 # now read PATH_INFO and update the parameter list for missing parameters
1199 sub evaluate_path_info {
1200         return if defined $input_params{'project'};
1201         return if !$path_info;
1202         $path_info =~ s,^/+,,;
1203         return if !$path_info;
1204
1205         # find which part of PATH_INFO is project
1206         my $project = $path_info;
1207         $project =~ s,/+$,,;
1208         while ($project && !check_head_link("$projectroot/$project")) {
1209                 $project =~ s,/*[^/]*$,,;
1210         }
1211         return unless $project;
1212         $input_params{'project'} = $project;
1213
1214         # do not change any parameters if an action is given using the query string
1215         return if $input_params{'action'};
1216         $path_info =~ s,^\Q$project\E/*,,;
1217
1218         # next, check if we have an action
1219         my $action = $path_info;
1220         $action =~ s,/.*$,,;
1221         if (exists $actions{$action}) {
1222                 $path_info =~ s,^$action/*,,;
1223                 $input_params{'action'} = $action;
1224         }
1225
1226         # list of actions that want hash_base instead of hash, but can have no
1227         # pathname (f) parameter
1228         my @wants_base = (
1229                 'tree',
1230                 'history',
1231         );
1232
1233         # we want to catch, among others
1234         # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
1235         my ($parentrefname, $parentpathname, $refname, $pathname) =
1236                 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
1237
1238         # first, analyze the 'current' part
1239         if (defined $pathname) {
1240                 # we got "branch:filename" or "branch:dir/"
1241                 # we could use git_get_type(branch:pathname), but:
1242                 # - it needs $git_dir
1243                 # - it does a git() call
1244                 # - the convention of terminating directories with a slash
1245                 #   makes it superfluous
1246                 # - embedding the action in the PATH_INFO would make it even
1247                 #   more superfluous
1248                 $pathname =~ s,^/+,,;
1249                 if (!$pathname || substr($pathname, -1) eq "/") {
1250                         $input_params{'action'} ||= "tree";
1251                         $pathname =~ s,/$,,;
1252                 } else {
1253                         # the default action depends on whether we had parent info
1254                         # or not
1255                         if ($parentrefname) {
1256                                 $input_params{'action'} ||= "blobdiff_plain";
1257                         } else {
1258                                 $input_params{'action'} ||= "blob_plain";
1259                         }
1260                 }
1261                 $input_params{'hash_base'} ||= $refname;
1262                 $input_params{'file_name'} ||= $pathname;
1263         } elsif (defined $refname) {
1264                 # we got "branch". In this case we have to choose if we have to
1265                 # set hash or hash_base.
1266                 #
1267                 # Most of the actions without a pathname only want hash to be
1268                 # set, except for the ones specified in @wants_base that want
1269                 # hash_base instead. It should also be noted that hand-crafted
1270                 # links having 'history' as an action and no pathname or hash
1271                 # set will fail, but that happens regardless of PATH_INFO.
1272                 if (defined $parentrefname) {
1273                         # if there is parent let the default be 'shortlog' action
1274                         # (for http://git.example.com/repo.git/A..B links); if there
1275                         # is no parent, dispatch will detect type of object and set
1276                         # action appropriately if required (if action is not set)
1277                         $input_params{'action'} ||= "shortlog";
1278                 }
1279                 if ($input_params{'action'} &&
1280                     grep { $_ eq $input_params{'action'} } @wants_base) {
1281                         $input_params{'hash_base'} ||= $refname;
1282                 } else {
1283                         $input_params{'hash'} ||= $refname;
1284                 }
1285         }
1286
1287         # next, handle the 'parent' part, if present
1288         if (defined $parentrefname) {
1289                 # a missing pathspec defaults to the 'current' filename, allowing e.g.
1290                 # someproject/blobdiff/oldrev..newrev:/filename
1291                 if ($parentpathname) {
1292                         $parentpathname =~ s,^/+,,;
1293                         $parentpathname =~ s,/$,,;
1294                         $input_params{'file_parent'} ||= $parentpathname;
1295                 } else {
1296                         $input_params{'file_parent'} ||= $input_params{'file_name'};
1297                 }
1298                 # we assume that hash_parent_base is wanted if a path was specified,
1299                 # or if the action wants hash_base instead of hash
1300                 if (defined $input_params{'file_parent'} ||
1301                         grep { $_ eq $input_params{'action'} } @wants_base) {
1302                         $input_params{'hash_parent_base'} ||= $parentrefname;
1303                 } else {
1304                         $input_params{'hash_parent'} ||= $parentrefname;
1305                 }
1306         }
1307
1308         # for the snapshot action, we allow URLs in the form
1309         # $project/snapshot/$hash.ext
1310         # where .ext determines the snapshot and gets removed from the
1311         # passed $refname to provide the $hash.
1312         #
1313         # To be able to tell that $refname includes the format extension, we
1314         # require the following two conditions to be satisfied:
1315         # - the hash input parameter MUST have been set from the $refname part
1316         #   of the URL (i.e. they must be equal)
1317         # - the snapshot format MUST NOT have been defined already (e.g. from
1318         #   CGI parameter sf)
1319         # It's also useless to try any matching unless $refname has a dot,
1320         # so we check for that too
1321         if (defined $input_params{'action'} &&
1322                 $input_params{'action'} eq 'snapshot' &&
1323                 defined $refname && index($refname, '.') != -1 &&
1324                 $refname eq $input_params{'hash'} &&
1325                 !defined $input_params{'snapshot_format'}) {
1326                 # We loop over the known snapshot formats, checking for
1327                 # extensions. Allowed extensions are both the defined suffix
1328                 # (which includes the initial dot already) and the snapshot
1329                 # format key itself, with a prepended dot
1330                 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1331                         my $hash = $refname;
1332                         unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1333                                 next;
1334                         }
1335                         my $sfx = $1;
1336                         # a valid suffix was found, so set the snapshot format
1337                         # and reset the hash parameter
1338                         $input_params{'snapshot_format'} = $fmt;
1339                         $input_params{'hash'} = $hash;
1340                         # we also set the format suffix to the one requested
1341                         # in the URL: this way a request for e.g. .tgz returns
1342                         # a .tgz instead of a .tar.gz
1343                         $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1344                         last;
1345                 }
1346         }
1347 }
1348
1349 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1350      $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1351      $searchtext, $search_regexp, $project_filter);
1352 sub evaluate_and_validate_params {
1353         our $action = $input_params{'action'};
1354         if (defined $action) {
1355                 if (!is_valid_action($action)) {
1356                         die_error(400, "Invalid action parameter");
1357                 }
1358         }
1359
1360         # parameters which are pathnames
1361         our $project = $input_params{'project'};
1362         if (defined $project) {
1363                 if (!is_valid_project($project)) {
1364                         undef $project;
1365                         die_error(404, "No such project");
1366                 }
1367         }
1368
1369         our $project_filter = $input_params{'project_filter'};
1370         if (defined $project_filter) {
1371                 if (!is_valid_pathname($project_filter)) {
1372                         die_error(404, "Invalid project_filter parameter");
1373                 }
1374         }
1375
1376         our $file_name = $input_params{'file_name'};
1377         if (defined $file_name) {
1378                 if (!is_valid_pathname($file_name)) {
1379                         die_error(400, "Invalid file parameter");
1380                 }
1381         }
1382
1383         our $file_parent = $input_params{'file_parent'};
1384         if (defined $file_parent) {
1385                 if (!is_valid_pathname($file_parent)) {
1386                         die_error(400, "Invalid file parent parameter");
1387                 }
1388         }
1389
1390         # parameters which are refnames
1391         our $hash = $input_params{'hash'};
1392         if (defined $hash) {
1393                 if (!is_valid_refname($hash)) {
1394                         die_error(400, "Invalid hash parameter");
1395                 }
1396         }
1397
1398         our $hash_parent = $input_params{'hash_parent'};
1399         if (defined $hash_parent) {
1400                 if (!is_valid_refname($hash_parent)) {
1401                         die_error(400, "Invalid hash parent parameter");
1402                 }
1403         }
1404
1405         our $hash_base = $input_params{'hash_base'};
1406         if (defined $hash_base) {
1407                 if (!is_valid_refname($hash_base)) {
1408                         die_error(400, "Invalid hash base parameter");
1409                 }
1410         }
1411
1412         our @extra_options = @{$input_params{'extra_options'}};
1413         # @extra_options is always defined, since it can only be (currently) set from
1414         # CGI, and $cgi->param() returns the empty array in array context if the param
1415         # is not set
1416         foreach my $opt (@extra_options) {
1417                 if (not exists $allowed_options{$opt}) {
1418                         die_error(400, "Invalid option parameter");
1419                 }
1420                 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1421                         die_error(400, "Invalid option parameter for this action");
1422                 }
1423         }
1424
1425         our $hash_parent_base = $input_params{'hash_parent_base'};
1426         if (defined $hash_parent_base) {
1427                 if (!is_valid_refname($hash_parent_base)) {
1428                         die_error(400, "Invalid hash parent base parameter");
1429                 }
1430         }
1431
1432         # other parameters
1433         our $page = $input_params{'page'};
1434         if (defined $page) {
1435                 if ($page =~ m/[^0-9]/) {
1436                         die_error(400, "Invalid page parameter");
1437                 }
1438         }
1439
1440         our $searchtype = $input_params{'searchtype'};
1441         if (defined $searchtype) {
1442                 if ($searchtype =~ m/[^a-z]/) {
1443                         die_error(400, "Invalid searchtype parameter");
1444                 }
1445         }
1446
1447         our $search_use_regexp = $input_params{'search_use_regexp'};
1448
1449         our $searchtext = $input_params{'searchtext'};
1450         our $search_regexp = undef;
1451         if (defined $searchtext) {
1452                 if (length($searchtext) < 2) {
1453                         die_error(403, "At least two characters are required for search parameter");
1454                 }
1455                 if ($search_use_regexp) {
1456                         $search_regexp = $searchtext;
1457                         if (!eval { qr/$search_regexp/; 1; }) {
1458                                 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1459                                 die_error(400, "Invalid search regexp '$search_regexp'",
1460                                           esc_html($error));
1461                         }
1462                 } else {
1463                         $search_regexp = quotemeta $searchtext;
1464                 }
1465         }
1466 }
1467
1468 # path to the current git repository
1469 our $git_dir;
1470 sub evaluate_git_dir {
1471         our $git_dir = $project ? "$projectroot/$project" : undef;
1472 }
1473
1474 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1475 sub configure_gitweb_features {
1476         # list of supported snapshot formats
1477         our @snapshot_fmts = gitweb_get_feature('snapshot');
1478         @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1479
1480         # check that the avatar feature is set to a known provider name,
1481         # and for each provider check if the dependencies are satisfied.
1482         # if the provider name is invalid or the dependencies are not met,
1483         # reset $git_avatar to the empty string.
1484         our ($git_avatar) = gitweb_get_feature('avatar');
1485         if ($git_avatar eq 'gravatar') {
1486                 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1487         } elsif ($git_avatar eq 'picon') {
1488                 # no dependencies
1489         } else {
1490                 $git_avatar = '';
1491         }
1492
1493         our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1494         @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1495 }
1496
1497 sub get_branch_refs {
1498         return ('heads', @extra_branch_refs);
1499 }
1500
1501 # custom error handler: 'die <message>' is Internal Server Error
1502 sub handle_errors_html {
1503         my $msg = shift; # it is already HTML escaped
1504
1505         # to avoid infinite loop where error occurs in die_error,
1506         # change handler to default handler, disabling handle_errors_html
1507         set_message("Error occurred when inside die_error:\n$msg");
1508
1509         # you cannot jump out of die_error when called as error handler;
1510         # the subroutine set via CGI::Carp::set_message is called _after_
1511         # HTTP headers are already written, so it cannot write them itself
1512         die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1513 }
1514 set_message(\&handle_errors_html);
1515
1516 our $shown_stale_message = 0;
1517 our $cache_dump = undef;
1518 our $cache_dump_mtime = undef;
1519
1520 # dispatch
1521 my $cache_mode_active;
1522 sub dispatch {
1523         if (!defined $action) {
1524                 if (defined $hash) {
1525                         $action = git_get_type($hash);
1526                         $action or die_error(404, "Object does not exist");
1527                 } elsif (defined $hash_base && defined $file_name) {
1528                         $action = git_get_type("$hash_base:$file_name");
1529                         $action or die_error(404, "File or directory does not exist");
1530                 } elsif (defined $project) {
1531                         $action = 'summary';
1532                 } else {
1533                         $action = 'frontpage';
1534                 }
1535         }
1536         if (!defined($actions{$action})) {
1537                 die_error(400, "Unknown action");
1538         }
1539         if ($action !~ m/^(?:opml|frontpage|project_list|project_index)$/ &&
1540             !$project) {
1541                 die_error(400, "Project needed");
1542         }
1543
1544         my $cached_page = $supported_cache_actions{$action}
1545                 ? cached_action_page($action)
1546                 : undef;
1547         goto DUMPCACHE if $cached_page;
1548         local *SAVEOUT = *STDOUT;
1549         $cache_mode_active = $supported_cache_actions{$action}
1550                 ? cached_action_start($action)
1551                 : undef;
1552
1553         configure_gitweb_features();
1554         $actions{$action}->();
1555
1556         return unless $cache_mode_active;
1557
1558         $cached_page = cached_action_finish($action);
1559         *STDOUT = *SAVEOUT;
1560
1561         DUMPCACHE:
1562
1563         $cache_mode_active = 0;
1564         # Avoid any extra unwanted encoding steps as $cached_page is raw bytes
1565         binmode STDOUT, ':raw';
1566         our $fcgi_raw_mode = 1;
1567         print expand_gitweb_pi($cached_page, time);
1568         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
1569         $fcgi_raw_mode = 0;
1570 }
1571
1572 sub reset_timer {
1573         our $t0 = [ gettimeofday() ]
1574                 if defined $t0;
1575         our $number_of_git_cmds = 0;
1576 }
1577
1578 our $first_request = 1;
1579 our $evaluate_uri_force = undef;
1580 sub run_request {
1581         reset_timer();
1582
1583         # Only allow GET and HEAD methods
1584         if (!$ENV{'REQUEST_METHOD'} || ($ENV{'REQUEST_METHOD'} ne 'GET' && $ENV{'REQUEST_METHOD'} ne 'HEAD')) {
1585                 print <<EOT;
1586 Status: 405 Method Not Allowed
1587 Content-Type: text/plain
1588 Allow: GET,HEAD
1589
1590 405 Method Not Allowed
1591 EOT
1592                 return;
1593         }
1594
1595         evaluate_uri();
1596         &$evaluate_uri_force() if $evaluate_uri_force;
1597         if ($per_request_config) {
1598                 if (ref($per_request_config) eq 'CODE') {
1599                         $per_request_config->();
1600                 } elsif (!$first_request) {
1601                         evaluate_gitweb_config();
1602                         evaluate_email_obfuscate();
1603                 }
1604         }
1605         check_loadavg();
1606
1607         # $projectroot and $projects_list might be set in gitweb config file
1608         $projects_list ||= $projectroot;
1609
1610         evaluate_query_params();
1611         evaluate_path_info();
1612         evaluate_and_validate_params();
1613         evaluate_git_dir();
1614
1615         dispatch();
1616 }
1617
1618 our $is_last_request = sub { 1 };
1619 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1620 our $CGI = 'CGI';
1621 our $cgi;
1622 our $fcgi_mode = 0;
1623 our $fcgi_nproc_active = 0;
1624 our $fcgi_raw_mode = 0;
1625 sub is_fcgi {
1626         use Errno;
1627         my $stdinfno = fileno STDIN;
1628         return 0 unless defined $stdinfno && $stdinfno == 0;
1629         return 0 unless getsockname STDIN;
1630         return 0 if getpeername STDIN;
1631         return $!{ENOTCONN}?1:0;
1632 }
1633 sub configure_as_fcgi {
1634         return if $fcgi_mode;
1635
1636         require FCGI;
1637         require CGI::Fast;
1638
1639         # We have gone to great effort to make sure that all incoming data has
1640         # been converted from whatever format it was in into UTF-8.  We have
1641         # even taken care to make sure the output handle is in ':utf8' mode.
1642         # Now along comes FCGI and blows it with:
1643         #
1644         #     Use of wide characters in FCGI::Stream::PRINT is deprecated
1645         #      and will stop wprking[sic] in a future version of FCGI
1646         #
1647         # To fix this we replace FCGI::Stream::PRINT with our own routine that
1648         # first encodes everything and then calls the original routine, but
1649         # not if $fcgi_raw_mode is true (then we just call the original routine).
1650         #
1651         # Note that we could do this by using utf8::is_utf8 to check instead
1652         # of having a $fcgi_raw_mode global, but that would be slower to run
1653         # the test on each element and much slower than skipping the conversion
1654         # entirely when we know we're outputting raw bytes.
1655         my $orig = \&FCGI::Stream::PRINT;
1656         undef *FCGI::Stream::PRINT;
1657         *FCGI::Stream::PRINT = sub {
1658                 @_ = (shift, map {my $x=$_; utf8::encode($x); $x} @_)
1659                         unless $fcgi_raw_mode;
1660                 goto $orig;
1661         };
1662
1663         our $CGI = 'CGI::Fast';
1664
1665         $fcgi_mode = 1;
1666         $first_request = 0;
1667         my $request_number = 0;
1668         # let each child service 100 requests
1669         our $is_last_request = sub { ++$request_number >= 100 };
1670 }
1671 sub evaluate_argv {
1672         my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1673         configure_as_fcgi()
1674                 if $script_name =~ /\.fcgi$/ || ($auto_fcgi && is_fcgi());
1675
1676         my $nproc_sub = sub {
1677                 my ($arg, $val) = @_;
1678                 return unless eval { require FCGI::ProcManager; 1; };
1679                 $fcgi_nproc_active = 1;
1680                 my $proc_manager = FCGI::ProcManager->new({
1681                         n_processes => $val,
1682                 });
1683                 our $pre_listen_hook    = sub { $proc_manager->pm_manage()        };
1684                 our $pre_dispatch_hook  = sub { $proc_manager->pm_pre_dispatch()  };
1685                 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1686         };
1687         if (@ARGV) {
1688                 require Getopt::Long;
1689                 Getopt::Long::GetOptions(
1690                         'fastcgi|fcgi|f' => \&configure_as_fcgi,
1691                         'nproc|n=i' => $nproc_sub,
1692                 );
1693         };
1694         if (!$fcgi_nproc_active && defined $ENV{'GITWEB_FCGI_NPROC'} && $ENV{'GITWEB_FCGI_NPROC'} =~ /^\d+$/) {
1695                 &$nproc_sub('nproc', $ENV{'GITWEB_FCGI_NPROC'});
1696         }
1697 }
1698
1699 # Any "our" variable that could possibly influence correct handling of
1700 # a CGI request MUST be reset in this subroutine
1701 sub _reset_globals {
1702         # Note that $t0 and $number_of_git_commands are handled by reset_timer
1703         our %input_params = ();
1704         our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1705              $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1706              $searchtext, $search_regexp, $project_filter) = ();
1707         our $git_dir = undef;
1708         our (@snapshot_fmts, $git_avatar, @extra_branch_refs) = ();
1709         our %avatar_cache = ();
1710         our $config_file = '';
1711         our %config = ();
1712         our $gitweb_project_owner = undef;
1713         our $shown_stale_message = 0;
1714         our $fcgi_raw_mode = 0;
1715         keys %known_snapshot_formats; # reset 'each' iterator
1716 }
1717
1718 sub run {
1719         evaluate_gitweb_config();
1720         evaluate_encoding();
1721         evaluate_email_obfuscate();
1722         evaluate_git_version();
1723         my ($ml, $mi, $bu, $hl, $subroutine) = ($my_url, $my_uri, $base_url, $home_link, '');
1724         $subroutine .= '$my_url = $ml;' if defined $my_url && $my_url ne '';
1725         $subroutine .= '$my_uri = $mi;' if defined $my_uri; # this one can be ""
1726         $subroutine .= '$base_url = $bu;' if defined $base_url && $base_url ne '';
1727         $subroutine .= '$home_link = $hl;' if defined $home_link && $home_link ne '';
1728         $evaluate_uri_force = eval "sub {$subroutine}" if $subroutine;
1729         $first_request = 1;
1730         evaluate_argv();
1731
1732         $pre_listen_hook->()
1733                 if $pre_listen_hook;
1734
1735  REQUEST:
1736         while ($cgi = $CGI->new()) {
1737                 $pre_dispatch_hook->()
1738                         if $pre_dispatch_hook;
1739                 {
1740                         # most globals can simply be reset
1741                         _reset_globals;
1742
1743                         # evaluate_path_info corrupts %known_snapshot_formats
1744                         # so we need a deepish copy of it -- note that
1745                         # _reset_globals already took care of resetting its
1746                         # hash iterator that evaluate_path_info also leaves
1747                         # in an indeterminate state
1748                         my %formats = ();
1749                         while (my ($k,$v) = each(%known_snapshot_formats)) {
1750                                 $formats{$k} = {%{$known_snapshot_formats{$k}}};
1751                         }
1752                         local *known_snapshot_formats = \%formats;
1753
1754                         eval {run_request()};
1755                 }
1756                 $post_dispatch_hook->()
1757                         if $post_dispatch_hook;
1758                 $first_request = 0;
1759
1760                 last REQUEST if ($is_last_request->());
1761         }
1762
1763         1;
1764 }
1765
1766 run();
1767
1768 if (defined caller) {
1769         # wrapped in a subroutine processing requests,
1770         # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1771         return;
1772 } else {
1773         # pure CGI script, serving single request
1774         exit;
1775 }
1776
1777 ## ======================================================================
1778 ## action links
1779
1780 # possible values of extra options
1781 # -full => 0|1      - use absolute/full URL ($my_uri/$my_url as base)
1782 # -replay => 1      - start from a current view (replay with modifications)
1783 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1784 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1785 sub href {
1786         my %params = @_;
1787         # default is to use -absolute url() i.e. $my_uri
1788         my $href = $params{-full} ? $my_url : $my_uri;
1789
1790         # implicit -replay, must be first of implicit params
1791         $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1792
1793         $params{'project'} = $project unless exists $params{'project'};
1794
1795         if ($params{-replay}) {
1796                 while (my ($name, $symbol) = each %cgi_param_mapping) {
1797                         if (!exists $params{$name}) {
1798                                 $params{$name} = $input_params{$name};
1799                         }
1800                 }
1801         }
1802
1803         my $use_pathinfo = gitweb_check_feature('pathinfo');
1804         if (defined $params{'project'} &&
1805             (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1806                 # try to put as many parameters as possible in PATH_INFO:
1807                 #   - project name
1808                 #   - action
1809                 #   - hash_parent or hash_parent_base:/file_parent
1810                 #   - hash or hash_base:/filename
1811                 #   - the snapshot_format as an appropriate suffix
1812
1813                 # When the script is the root DirectoryIndex for the domain,
1814                 # $href here would be something like http://gitweb.example.com/
1815                 # Thus, we strip any trailing / from $href, to spare us double
1816                 # slashes in the final URL
1817                 $href =~ s,/$,,;
1818
1819                 # Then add the project name, if present
1820                 $href .= "/".esc_path_info($params{'project'});
1821                 delete $params{'project'};
1822
1823                 # since we destructively absorb parameters, we keep this
1824                 # boolean that remembers if we're handling a snapshot
1825                 my $is_snapshot = $params{'action'} eq 'snapshot';
1826
1827                 # Summary just uses the project path URL, any other action is
1828                 # added to the URL
1829                 if (defined $params{'action'}) {
1830                         $href .= "/".esc_path_info($params{'action'})
1831                                 unless $params{'action'} eq 'summary';
1832                         delete $params{'action'};
1833                 }
1834
1835                 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1836                 # stripping nonexistent or useless pieces
1837                 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1838                         || $params{'hash_parent'} || $params{'hash'});
1839                 if (defined $params{'hash_base'}) {
1840                         if (defined $params{'hash_parent_base'}) {
1841                                 $href .= esc_path_info($params{'hash_parent_base'});
1842                                 # skip the file_parent if it's the same as the file_name
1843                                 if (defined $params{'file_parent'}) {
1844                                         if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1845                                                 delete $params{'file_parent'};
1846                                         } elsif ($params{'file_parent'} !~ /\.\./) {
1847                                                 $href .= ":/".esc_path_info($params{'file_parent'});
1848                                                 delete $params{'file_parent'};
1849                                         }
1850                                 }
1851                                 $href .= "..";
1852                                 delete $params{'hash_parent'};
1853                                 delete $params{'hash_parent_base'};
1854                         } elsif (defined $params{'hash_parent'}) {
1855                                 $href .= esc_path_info($params{'hash_parent'}). "..";
1856                                 delete $params{'hash_parent'};
1857                         }
1858
1859                         $href .= esc_path_info($params{'hash_base'});
1860                         if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1861                                 $href .= ":/".esc_path_info($params{'file_name'});
1862                                 delete $params{'file_name'};
1863                         }
1864                         delete $params{'hash'};
1865                         delete $params{'hash_base'};
1866                 } elsif (defined $params{'hash'}) {
1867                         $href .= esc_path_info($params{'hash'});
1868                         delete $params{'hash'};
1869                 }
1870
1871                 # If the action was a snapshot, we can absorb the
1872                 # snapshot_format parameter too
1873                 if ($is_snapshot) {
1874                         my $fmt = $params{'snapshot_format'};
1875                         # snapshot_format should always be defined when href()
1876                         # is called, but just in case some code forgets, we
1877                         # fall back to the default
1878                         $fmt ||= $snapshot_fmts[0];
1879                         $href .= $known_snapshot_formats{$fmt}{'suffix'};
1880                         delete $params{'snapshot_format'};
1881                 }
1882         }
1883
1884         # now encode the parameters explicitly
1885         my @result = ();
1886         for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1887                 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1888                 if (defined $params{$name}) {
1889                         if (ref($params{$name}) eq "ARRAY") {
1890                                 foreach my $par (@{$params{$name}}) {
1891                                         push @result, $symbol . "=" . esc_param($par);
1892                                 }
1893                         } else {
1894                                 push @result, $symbol . "=" . esc_param($params{$name});
1895                         }
1896                 }
1897         }
1898         $href .= "?" . join(';', @result) if scalar @result;
1899
1900         # final transformation: trailing spaces must be escaped (URI-encoded)
1901         $href =~ s/(\s+)$/CGI::escape($1)/e;
1902
1903         if ($params{-anchor}) {
1904                 $href .= "#".esc_param($params{-anchor});
1905         }
1906
1907         return $href;
1908 }
1909
1910
1911 ## ======================================================================
1912 ## validation, quoting/unquoting and escaping
1913
1914 sub is_valid_action {
1915         my $input = shift;
1916         return undef unless exists $actions{$input};
1917         return 1;
1918 }
1919
1920 sub is_valid_project {
1921         my $input = shift;
1922
1923         return unless defined $input;
1924         if (!is_valid_pathname($input) ||
1925                 !(-d "$projectroot/$input") ||
1926                 !check_export_ok("$projectroot/$input") ||
1927                 ($strict_export && !project_in_list($input))) {
1928                 return undef;
1929         } else {
1930                 return 1;
1931         }
1932 }
1933
1934 sub is_valid_pathname {
1935         my $input = shift;
1936
1937         return undef unless defined $input;
1938         # no '.' or '..' as elements of path, i.e. no '.' or '..'
1939         # at the beginning, at the end, and between slashes.
1940         # also this catches doubled slashes
1941         if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1942                 return undef;
1943         }
1944         # no null characters
1945         if ($input =~ m!\0!) {
1946                 return undef;
1947         }
1948         return 1;
1949 }
1950
1951 sub is_valid_ref_format {
1952         my $input = shift;
1953
1954         return undef unless defined $input;
1955         # restrictions on ref name according to git-check-ref-format
1956         if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1957                 return undef;
1958         }
1959         return 1;
1960 }
1961
1962 sub is_valid_refname {
1963         my $input = shift;
1964
1965         return undef unless defined $input;
1966         # textual hashes are O.K.
1967         if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1968                 return 1;
1969         }
1970         # allow repeated trailing '[~^]n*' suffix(es)
1971         $input =~ s/^([^~^]+)(?:[~^]\d*)+$/$1/;
1972         # it must be correct pathname
1973         is_valid_pathname($input) or return undef;
1974         # check git-check-ref-format restrictions
1975         is_valid_ref_format($input) or return undef;
1976         return 1;
1977 }
1978
1979 # decode sequences of octets in utf8 into Perl's internal form,
1980 # which is utf-8 with utf8 flag set if needed.  gitweb writes out
1981 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
1982 sub to_utf8 {
1983         my $str = shift;
1984         return undef unless defined $str;
1985
1986         if (utf8::is_utf8($str) || utf8::decode($str)) {
1987                 return $str;
1988         } else {
1989                 return $encode_object->decode($str, Encode::FB_DEFAULT);
1990         }
1991 }
1992
1993 # quote unsafe chars, but keep the slash, even when it's not
1994 # correct, but quoted slashes look too horrible in bookmarks
1995 sub esc_param {
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 # the quoting rules for path_info fragment are slightly different
2004 sub esc_path_info {
2005         my $str = shift;
2006         return undef unless defined $str;
2007
2008         # path_info doesn't treat '+' as space (specially), but '?' must be escaped
2009         $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
2010
2011         return $str;
2012 }
2013
2014 # quote unsafe chars in whole URL, so some characters cannot be quoted
2015 sub esc_url {
2016         my $str = shift;
2017         return undef unless defined $str;
2018         $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
2019         $str =~ s/ /\+/g;
2020         return $str;
2021 }
2022
2023 # quote unsafe characters in HTML attributes
2024 sub esc_attr {
2025
2026         # for XHTML conformance escaping '"' to '&quot;' is not enough
2027         return esc_html(@_);
2028 }
2029
2030 # replace invalid utf8 character with SUBSTITUTION sequence
2031 sub esc_html {
2032         my $str = shift;
2033         my %opts = @_;
2034
2035         return undef unless defined $str;
2036
2037         $str = to_utf8($str);
2038         $str = $cgi->escapeHTML($str);
2039         if ($opts{'-nbsp'}) {
2040                 $str =~ s/ /&#160;/g;
2041         }
2042         use bytes;
2043         $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
2044         return $str;
2045 }
2046
2047 # quote control characters and escape filename to HTML
2048 sub esc_path {
2049         my $str = shift;
2050         my %opts = @_;
2051
2052         return undef unless defined $str;
2053
2054         $str = to_utf8($str);
2055         $str = $cgi->escapeHTML($str);
2056         if ($opts{'-nbsp'}) {
2057                 $str =~ s/ /&#160;/g;
2058         }
2059         use bytes;
2060         $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
2061         return $str;
2062 }
2063
2064 # Sanitize for use in XHTML + application/xml+xhtm (valid XML 1.0)
2065 sub sanitize {
2066         my $str = shift;
2067
2068         return undef unless defined $str;
2069
2070         $str = to_utf8($str);
2071         use bytes;
2072         $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
2073         return $str;
2074 }
2075
2076 # Make control characters "printable", using character escape codes (CEC)
2077 sub quot_cec {
2078         my $cntrl = shift;
2079         my %opts = @_;
2080         my %es = ( # character escape codes, aka escape sequences
2081                 "\t" => '\t',   # tab            (HT)
2082                 "\n" => '\n',   # line feed      (LF)
2083                 "\r" => '\r',   # carrige return (CR)
2084                 "\f" => '\f',   # form feed      (FF)
2085                 "\b" => '\b',   # backspace      (BS)
2086                 "\a" => '\a',   # alarm (bell)   (BEL)
2087                 "\e" => '\e',   # escape         (ESC)
2088                 "\013" => '\v', # vertical tab   (VT)
2089                 "\000" => '\0', # nul character  (NUL)
2090         );
2091         my $chr = ( (exists $es{$cntrl})
2092                     ? $es{$cntrl}
2093                     : sprintf('\x%02x', ord($cntrl)) );
2094         if ($opts{-nohtml}) {
2095                 return $chr;
2096         } else {
2097                 return "<span class=\"cntrl\">$chr</span>";
2098         }
2099 }
2100
2101 # Alternatively use unicode control pictures codepoints,
2102 # Unicode "printable representation" (PR)
2103 sub quot_upr {
2104         my $cntrl = shift;
2105         my %opts = @_;
2106
2107         my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
2108         if ($opts{-nohtml}) {
2109                 return $chr;
2110         } else {
2111                 return "<span class=\"cntrl\">$chr</span>";
2112         }
2113 }
2114
2115 # git may return quoted and escaped filenames
2116 sub unquote {
2117         my $str = shift;
2118
2119         sub unq {
2120                 my $seq = shift;
2121                 my %es = ( # character escape codes, aka escape sequences
2122                         't' => "\t",   # tab            (HT, TAB)
2123                         'n' => "\n",   # newline        (NL)
2124                         'r' => "\r",   # return         (CR)
2125                         'f' => "\f",   # form feed      (FF)
2126                         'b' => "\b",   # backspace      (BS)
2127                         'a' => "\a",   # alarm (bell)   (BEL)
2128                         'e' => "\e",   # escape         (ESC)
2129                         'v' => "\013", # vertical tab   (VT)
2130                 );
2131
2132                 if ($seq =~ m/^[0-7]{1,3}$/) {
2133                         # octal char sequence
2134                         return chr(oct($seq));
2135                 } elsif (exists $es{$seq}) {
2136                         # C escape sequence, aka character escape code
2137                         return $es{$seq};
2138                 }
2139                 # quoted ordinary character
2140                 return $seq;
2141         }
2142
2143         if ($str =~ m/^"(.*)"$/) {
2144                 # needs unquoting
2145                 $str = $1;
2146                 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
2147         }
2148         return $str;
2149 }
2150
2151 # escape tabs (convert tabs to spaces)
2152 sub untabify {
2153         my $line = shift;
2154
2155         while ((my $pos = index($line, "\t")) != -1) {
2156                 if (my $count = (8 - ($pos % 8))) {
2157                         my $spaces = ' ' x $count;
2158                         $line =~ s/\t/$spaces/;
2159                 }
2160         }
2161
2162         return $line;
2163 }
2164
2165 sub project_in_list {
2166         my $project = shift;
2167         my @list = git_get_projects_list();
2168         return @list && scalar(grep { $_->{'path'} eq $project } @list);
2169 }
2170
2171 sub cached_page_precondition_check {
2172         my $action = shift;
2173         return 1 unless
2174                 $action eq 'summary' &&
2175                 $projlist_cache_lifetime > 0 &&
2176                 gitweb_check_feature('forks');
2177
2178         # Note that ALL the 'forkchange' logic is in this function.
2179         # It does NOT belong in cached_action_page NOR in cached_action_start
2180         # NOR in cached_action_finish.  None of those functions should know anything
2181         # about nor do anything to any of the 'forkchange'/"$action.forkchange" files.
2182
2183         # besides the basic 'changed' "$action.changed" check, we may only use
2184         # a summary cache if:
2185         #
2186         #   1) we are not using a project list cache file
2187         #   -OR-
2188         #   2) we are not using the 'forks' feature
2189         #   -OR-
2190         #   3) there is no 'forkchange' nor "$action.forkchange" file in $html_cache_dir
2191         #   -OR-
2192         #   4) there is no cache file ("$cache_dir/$projlist_cache_name")
2193         #   -OR-
2194         #   5) the OLDER of 'forkchange'/"$action.forkchange" is NEWER than the cache file
2195         #
2196         # Otherwise we must re-generate the cache because we've had a fork change
2197         # (either a fork was added or a fork was removed) AND the change has been
2198         # picked up in the cache file AND we've not got that in our cached copy
2199         #
2200         # For (5) regenerating the cached page wouldn't get us anything if the project
2201         # cache file is older than the 'forkchange'/"$action.forkchange" because the
2202         # forks information comes from the project cache file and it's clearly not
2203         # picked up the changes yet so we may continue to use a cached page until it does.
2204
2205         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2206         my $fc_mt = (stat("$htmlcd/forkchange"))[9];
2207         my $afc_mt = (stat("$htmlcd/$action.forkchange"))[9];
2208         return 1 unless defined($fc_mt) || defined($afc_mt);
2209         my $prj_mt = (stat("$cache_dir/$projlist_cache_name"))[9];
2210         return 1 unless $prj_mt;
2211         my $old_mt = $fc_mt;
2212         $old_mt = $afc_mt if !defined($old_mt) || (defined($afc_mt) && $afc_mt < $old_mt);
2213         return 1 if $old_mt > $prj_mt;
2214
2215         # We're going to regenerate the cached page because we know the project cache
2216         # has new fork information that we cannot possibly have in our cached copy.
2217         #
2218         # However, if both 'forkchange' and "$action.forkchange" exist and one of
2219         # them is older than the project cache and one of them is newer, we still
2220         # need to regenerate the page cache, but we will also need to do it again
2221         # in the future because there's yet another fork update not yet in the cache.
2222         #
2223         # So we make sure to touch "$action.changed" to force a cache regeneration
2224         # and then we remove either or both of 'forkchange'/"$action.forkchange" if
2225         # they're older than the project cache (they've served their purpose, we're
2226         # forcing a page regeneration by touching "$action.changed" but the project
2227         # cache was rebuilt since then so there are no more pending fork updates to
2228         # pick up in the future and they need to go).
2229
2230         # For best results, the external code that touches 'forkchange' should always
2231         # touch 'forkchange' and additionally touch 'summary.forkchange' but only
2232         # if it does not already exist.  That way the cached page will be regenerated
2233         # each time it's requested and ANY fork updates are available in the proj
2234         # cache rather than waiting until they all are before updating.
2235
2236         # Note that we take a shortcut here and will zap 'forkchange' since we know
2237         # that it only affects the 'summary' cache.  If, in the future, it affects
2238         # other cache types, it will first need to be propogated down to
2239         # "$action.forkchange" for those types before we zap it.
2240
2241         my $fd;
2242         open $fd, '>', "$htmlcd/$action.changed" and close $fd;
2243         $fc_mt=undef, unlink "$htmlcd/forkchange" if defined $fc_mt && $fc_mt < $prj_mt;
2244         $afc_mt=undef, unlink "$htmlcd/$action.forkchange" if defined $afc_mt && $afc_mt < $prj_mt;
2245
2246         # Now we propagate 'forkchange' to "$action.forkchange" if we have the
2247         # one and not the other.
2248
2249         if (defined $fc_mt && ! defined $afc_mt) {
2250                 open $fd, '>', "$htmlcd/$action.forkchange" and close $fd;
2251                 -e "$htmlcd/$action.forkchange" and
2252                 utime($fc_mt, $fc_mt, "$htmlcd/$action.forkchange") and
2253                 unlink "$htmlcd/forkchange";
2254         }
2255
2256         return 0;
2257 }
2258
2259 sub cached_action_page {
2260         my $action = shift;
2261
2262         return undef unless $action && $html_cache_actions{$action} && $html_cache_dir;
2263         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2264         return undef if -e "$htmlcd/changed" || -e "$htmlcd/$action.changed";
2265         return undef unless cached_page_precondition_check($action);
2266         open my $fd, '<', "$htmlcd/$action" or return undef;
2267         binmode $fd;
2268         local $/;
2269         my $cached_page = <$fd>;
2270         close $fd or return undef;
2271         return $cached_page;
2272 }
2273
2274 package Git::Gitweb::CacheFile;
2275
2276 sub TIEHANDLE {
2277         use POSIX qw(:fcntl_h);
2278         my $class = shift;
2279         my $cachefile = shift;
2280
2281         sysopen(my $self, $cachefile, O_WRONLY|O_CREAT|O_EXCL, 0664)
2282                 or return undef;
2283         $$self->{'cachefile'} = $cachefile;
2284         $$self->{'opened'} = 1;
2285         $$self->{'contents'} = '';
2286         return bless $self, $class;
2287 }
2288
2289 sub CLOSE {
2290         my $self = shift;
2291         if ($$self->{'opened'}) {
2292                 $$self->{'opened'} = 0;
2293                 my $result = close $self;
2294                 unlink $$self->{'cachefile'} unless $result;
2295                 return $result;
2296         }
2297         return 0;
2298 }
2299
2300 sub DESTROY {
2301         my $self = shift;
2302         if ($$self->{'opened'}) {
2303                 $self->CLOSE() and unlink $$self->{'cachefile'};
2304         }
2305 }
2306
2307 sub PRINT {
2308         my $self = shift;
2309         @_ = (map {my $x=$_; utf8::encode($x); $x} @_) unless $fcgi_raw_mode;
2310         print $self @_ if $$self->{'opened'};
2311         $$self->{'contents'} .= join('', @_);
2312         return 1;
2313 }
2314
2315 sub PRINTF {
2316         my $self = shift;
2317         my $template = shift;
2318         return $self->PRINT(sprintf $template, @_);
2319 }
2320
2321 sub contents {
2322         my $self = shift;
2323         return $$self->{'contents'};
2324 }
2325
2326 package main;
2327
2328 # Caller is responsible for preserving STDOUT beforehand if needed
2329 sub cached_action_start {
2330         my $action = shift;
2331
2332         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2333         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2334         return undef unless -d $htmlcd;
2335         if (-e "$htmlcd/changed") {
2336                 foreach my $cacheable (keys(%html_cache_actions)) {
2337                         next unless $supported_cache_actions{$cacheable} &&
2338                                     $html_cache_actions{$cacheable};
2339                         my $fd;
2340                         open $fd, '>', "$htmlcd/$cacheable.changed"
2341                         and close $fd;
2342                 }
2343                 unlink "$htmlcd/changed";
2344         }
2345         local *CACHEFILE;
2346         tie *CACHEFILE, 'Git::Gitweb::CacheFile', "$htmlcd/$action.lock"  or return undef;
2347         *STDOUT = *CACHEFILE;
2348         unlink "$htmlcd/$action", "$htmlcd/$action.changed";
2349         return 1;
2350 }
2351
2352 # Caller is responsible for restoring STDOUT afterward if needed
2353 sub cached_action_finish {
2354         my $action = shift;
2355
2356         use File::Spec;
2357
2358         my $obj = tied *STDOUT;
2359         return undef unless ref($obj) eq 'Git::Gitweb::CacheFile';
2360         my $cached_page = $obj->contents;
2361         (my $result = close(STDOUT)) or warn "couldn't close cache file on STDOUT: $!";
2362         # Do not leave STDOUT file descriptor invalid!
2363         local *NULL;
2364         open(NULL, '>', File::Spec->devnull) or die "couldn't open NULL to devnull: $!";
2365         *STDOUT = *NULL;
2366         return $cached_page unless $result;
2367         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2368         return $cached_page unless -d $htmlcd;
2369         unlink "$htmlcd/$action.lock" unless rename "$htmlcd/$action.lock", "$htmlcd/$action";
2370         return $cached_page;
2371 }
2372
2373 my %expand_pi_subs;
2374 BEGIN {%expand_pi_subs = (
2375         'age_string'              => \&age_string,
2376         'age_string_date'         => \&age_string_date,
2377         'age_string_age'          => \&age_string_age,
2378         'compute_timed_interval'  => \&compute_timed_interval,
2379         'compute_commands_count'  => \&compute_commands_count,
2380         'format_lastrefresh_row'  => \&format_lastrefresh_row,
2381 )}
2382
2383 # Expands any <?gitweb...> processing instructions and returns the result
2384 sub expand_gitweb_pi {
2385         my $page = shift;
2386         $page .= '';
2387         my @time_now = gettimeofday();
2388         $page =~ s{<\?gitweb(?:\s+([^\s>]+)([^>]*))?\s*\?>}
2389                   {defined($1) ?
2390                           (ref($expand_pi_subs{$1}) eq 'CODE' ?
2391                                   $expand_pi_subs{$1}->(split(' ',$2), @time_now) :
2392                                   '') :
2393                           '' }goes;
2394         return $page;
2395 }
2396
2397 ## ----------------------------------------------------------------------
2398 ## HTML aware string manipulation
2399
2400 # Try to chop given string on a word boundary between position
2401 # $len and $len+$add_len. If there is no word boundary there,
2402 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
2403 # (marking chopped part) would be longer than given string.
2404 sub chop_str {
2405         my $str = shift;
2406         my $len = shift;
2407         my $add_len = shift || 10;
2408         my $where = shift || 'right'; # 'left' | 'center' | 'right'
2409
2410         # Make sure perl knows it is utf8 encoded so we don't
2411         # cut in the middle of a utf8 multibyte char.
2412         $str = to_utf8($str);
2413
2414         # allow only $len chars, but don't cut a word if it would fit in $add_len
2415         # if it doesn't fit, cut it if it's still longer than the dots we would add
2416         # remove chopped character entities entirely
2417
2418         # when chopping in the middle, distribute $len into left and right part
2419         # return early if chopping wouldn't make string shorter
2420         if ($where eq 'center') {
2421                 return $str if ($len + 5 >= length($str)); # filler is length 5
2422                 $len = int($len/2);
2423         } else {
2424                 return $str if ($len + 4 >= length($str)); # filler is length 4
2425         }
2426
2427         # regexps: ending and beginning with word part up to $add_len
2428         my $endre = qr/.{$len}\w{0,$add_len}/;
2429         my $begre = qr/\w{0,$add_len}.{$len}/;
2430
2431         if ($where eq 'left') {
2432                 $str =~ m/^(.*?)($begre)$/;
2433                 my ($lead, $body) = ($1, $2);
2434                 if (length($lead) > 4) {
2435                         $lead = " ...";
2436                 }
2437                 return "$lead$body";
2438
2439         } elsif ($where eq 'center') {
2440                 $str =~ m/^($endre)(.*)$/;
2441                 my ($left, $str)  = ($1, $2);
2442                 $str =~ m/^(.*?)($begre)$/;
2443                 my ($mid, $right) = ($1, $2);
2444                 if (length($mid) > 5) {
2445                         $mid = " ... ";
2446                 }
2447                 return "$left$mid$right";
2448
2449         } else {
2450                 $str =~ m/^($endre)(.*)$/;
2451                 my $body = $1;
2452                 my $tail = $2;
2453                 if (length($tail) > 4) {
2454                         $tail = "... ";
2455                 }
2456                 return "$body$tail";
2457         }
2458 }
2459
2460 # pass-through email filter, obfuscating it when possible
2461 sub email_obfuscate {
2462         our $email;
2463         my ($str) = @_;
2464         if ($email) {
2465                 $str = $email->escape_html($str);
2466                 # Stock HTML::Email::Obfuscate version likes to produce
2467                 # invalid XHTML...
2468                 $str =~ s#<(/?)B>#<$1b>#g;
2469                 return $str;
2470         } else {
2471                 $str = esc_html($str);
2472                 $str =~ s/@/&#x40;/;
2473                 return $str;
2474         }
2475 }
2476
2477 # takes the same arguments as chop_str, but also wraps a <span> around the
2478 # result with a title attribute if it does get chopped. Additionally, the
2479 # string is HTML-escaped.
2480 sub chop_and_escape_str {
2481         my ($str) = @_;
2482
2483         my $chopped = chop_str(@_);
2484         $str = to_utf8($str);
2485         if ($chopped eq $str) {
2486                 return email_obfuscate($chopped);
2487         } else {
2488                 use bytes;
2489                 $str =~ s/[[:cntrl:]]/?/g;
2490                 return $cgi->span({-title=>$str}, email_obfuscate($chopped));
2491         }
2492 }
2493
2494 # Highlight selected fragments of string, using given CSS class,
2495 # and escape HTML.  It is assumed that fragments do not overlap.
2496 # Regions are passed as list of pairs (array references).
2497 #
2498 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
2499 # '<span class="mark">foo</span>bar'
2500 sub esc_html_hl_regions {
2501         my ($str, $css_class, @sel) = @_;
2502         my %opts = grep { ref($_) ne 'ARRAY' } @sel;
2503         @sel     = grep { ref($_) eq 'ARRAY' } @sel;
2504         return esc_html($str, %opts) unless @sel;
2505
2506         my $out = '';
2507         my $pos = 0;
2508
2509         for my $s (@sel) {
2510                 my ($begin, $end) = @$s;
2511
2512                 # Don't create empty <span> elements.
2513                 next if $end <= $begin;
2514
2515                 my $escaped = esc_html(substr($str, $begin, $end - $begin),
2516                                        %opts);
2517
2518                 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
2519                         if ($begin - $pos > 0);
2520                 $out .= $cgi->span({-class => $css_class}, $escaped);
2521
2522                 $pos = $end;
2523         }
2524         $out .= esc_html(substr($str, $pos), %opts)
2525                 if ($pos < length($str));
2526
2527         return $out;
2528 }
2529
2530 # return positions of beginning and end of each match
2531 sub matchpos_list {
2532         my ($str, $regexp) = @_;
2533         return unless (defined $str && defined $regexp);
2534
2535         my @matches;
2536         while ($str =~ /$regexp/g) {
2537                 push @matches, [$-[0], $+[0]];
2538         }
2539         return @matches;
2540 }
2541
2542 # highlight match (if any), and escape HTML
2543 sub esc_html_match_hl {
2544         my ($str, $regexp) = @_;
2545         return esc_html($str) unless defined $regexp;
2546
2547         my @matches = matchpos_list($str, $regexp);
2548         return esc_html($str) unless @matches;
2549
2550         return esc_html_hl_regions($str, 'match', @matches);
2551 }
2552
2553
2554 # highlight match (if any) of shortened string, and escape HTML
2555 sub esc_html_match_hl_chopped {
2556         my ($str, $chopped, $regexp) = @_;
2557         return esc_html_match_hl($str, $regexp) unless defined $chopped;
2558
2559         my @matches = matchpos_list($str, $regexp);
2560         return esc_html($chopped) unless @matches;
2561
2562         # filter matches so that we mark chopped string
2563         my $tail = "... "; # see chop_str
2564         unless ($chopped =~ s/\Q$tail\E$//) {
2565                 $tail = '';
2566         }
2567         my $chop_len = length($chopped);
2568         my $tail_len = length($tail);
2569         my @filtered;
2570
2571         for my $m (@matches) {
2572                 if ($m->[0] > $chop_len) {
2573                         push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
2574                         last;
2575                 } elsif ($m->[1] > $chop_len) {
2576                         push @filtered, [ $m->[0], $chop_len + $tail_len ];
2577                         last;
2578                 }
2579                 push @filtered, $m;
2580         }
2581
2582         return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
2583 }
2584
2585 ## ----------------------------------------------------------------------
2586 ## functions returning short strings
2587
2588 # CSS class for given age epoch value (in seconds)
2589 # and reference time (optional, defaults to now) as second value
2590 sub age_class {
2591         my ($age_epoch, $time_now) = @_;
2592         return "noage" unless defined $age_epoch;
2593         defined $time_now or $time_now = time;
2594         my $age = $time_now - $age_epoch;
2595
2596         if ($age < 60*60*2) {
2597                 return "age0";
2598         } elsif ($age < 60*60*24*2) {
2599                 return "age1";
2600         } else {
2601                 return "age2";
2602         }
2603 }
2604
2605 # convert age epoch in seconds to "nn units ago" string
2606 # reference time used is now unless second argument passed in
2607 # to get the old behavior, pass 0 as the first argument and
2608 # the time in seconds as the second
2609 sub age_string {
2610         my ($age_epoch, $time_now) = @_;
2611         return "unknown" unless defined $age_epoch;
2612         return "<?gitweb age_string $age_epoch?>" if $cache_mode_active;
2613         defined $time_now or $time_now = time;
2614         my $age = $time_now - $age_epoch;
2615         my $age_str;
2616
2617         if ($age > 60*60*24*365*2) {
2618                 $age_str = (int $age/60/60/24/365);
2619                 $age_str .= " years ago";
2620         } elsif ($age > 60*60*24*(365/12)*2) {
2621                 $age_str = int $age/60/60/24/(365/12);
2622                 $age_str .= " months ago";
2623         } elsif ($age > 60*60*24*7*2) {
2624                 $age_str = int $age/60/60/24/7;
2625                 $age_str .= " weeks ago";
2626         } elsif ($age > 60*60*24*2) {
2627                 $age_str = int $age/60/60/24;
2628                 $age_str .= " days ago";
2629         } elsif ($age > 60*60*2) {
2630                 $age_str = int $age/60/60;
2631                 $age_str .= " hours ago";
2632         } elsif ($age > 60*2) {
2633                 $age_str = int $age/60;
2634                 $age_str .= " min ago";
2635         } elsif ($age > 2) {
2636                 $age_str = int $age;
2637                 $age_str .= " sec ago";
2638         } else {
2639                 $age_str .= " right now";
2640         }
2641         return $age_str;
2642 }
2643
2644 # returns age_string if the age is <= 2 weeks otherwise an absolute date
2645 # this is typically shown to the user directly with the age_string_age as a title
2646 sub age_string_date {
2647         my ($age_epoch, $time_now) = @_;
2648         return "unknown" unless defined $age_epoch;
2649         return "<?gitweb age_string_date $age_epoch?>" if $cache_mode_active;
2650         defined $time_now or $time_now = time;
2651         my $age = $time_now - $age_epoch;
2652
2653         if ($age > 60*60*24*7*2) {
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         } else {
2657                 return age_string($age_epoch, $time_now);
2658         }
2659 }
2660
2661 # returns an absolute date if the age is <= 2 weeks otherwise age_string
2662 # this is typically used for the 'title' attribute so it will show as a tooltip
2663 sub age_string_age {
2664         my ($age_epoch, $time_now) = @_;
2665         return "unknown" unless defined $age_epoch;
2666         return "<?gitweb age_string_age $age_epoch?>" if $cache_mode_active;
2667         defined $time_now or $time_now = time;
2668         my $age = $time_now - $age_epoch;
2669
2670         if ($age > 60*60*24*7*2) {
2671                 return age_string($age_epoch, $time_now);
2672         } else {
2673                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2674                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2675         }
2676 }
2677
2678 use constant {
2679         S_IFINVALID => 0030000,
2680         S_IFGITLINK => 0160000,
2681 };
2682
2683 # submodule/subproject, a commit object reference
2684 sub S_ISGITLINK {
2685         my $mode = shift;
2686
2687         return (($mode & S_IFMT) == S_IFGITLINK)
2688 }
2689
2690 # convert file mode in octal to symbolic file mode string
2691 sub mode_str {
2692         my $mode = oct shift;
2693
2694         if (S_ISGITLINK($mode)) {
2695                 return 'm---------';
2696         } elsif (S_ISDIR($mode & S_IFMT)) {
2697                 return 'drwxr-xr-x';
2698         } elsif (S_ISLNK($mode)) {
2699                 return 'lrwxrwxrwx';
2700         } elsif (S_ISREG($mode)) {
2701                 # git cares only about the executable bit
2702                 if ($mode & S_IXUSR) {
2703                         return '-rwxr-xr-x';
2704                 } else {
2705                         return '-rw-r--r--';
2706                 };
2707         } else {
2708                 return '----------';
2709         }
2710 }
2711
2712 # convert file mode in octal to file type string
2713 sub file_type {
2714         my $mode = shift;
2715
2716         if ($mode !~ m/^[0-7]+$/) {
2717                 return $mode;
2718         } else {
2719                 $mode = oct $mode;
2720         }
2721
2722         if (S_ISGITLINK($mode)) {
2723                 return "submodule";
2724         } elsif (S_ISDIR($mode & S_IFMT)) {
2725                 return "directory";
2726         } elsif (S_ISLNK($mode)) {
2727                 return "symlink";
2728         } elsif (S_ISREG($mode)) {
2729                 return "file";
2730         } else {
2731                 return "unknown";
2732         }
2733 }
2734
2735 # convert file mode in octal to file type description string
2736 sub file_type_long {
2737         my $mode = shift;
2738
2739         if ($mode !~ m/^[0-7]+$/) {
2740                 return $mode;
2741         } else {
2742                 $mode = oct $mode;
2743         }
2744
2745         if (S_ISGITLINK($mode)) {
2746                 return "submodule";
2747         } elsif (S_ISDIR($mode & S_IFMT)) {
2748                 return "directory";
2749         } elsif (S_ISLNK($mode)) {
2750                 return "symlink";
2751         } elsif (S_ISREG($mode)) {
2752                 if ($mode & S_IXUSR) {
2753                         return "executable";
2754                 } else {
2755                         return "file";
2756                 };
2757         } else {
2758                 return "unknown";
2759         }
2760 }
2761
2762
2763 ## ----------------------------------------------------------------------
2764 ## functions returning short HTML fragments, or transforming HTML fragments
2765 ## which don't belong to other sections
2766
2767 # format line of commit message.
2768 sub format_log_line_html {
2769         my $line = shift;
2770
2771         $line = esc_html($line, -nbsp=>1);
2772         $line =~ s{\b([0-9a-fA-F]{8,40})\b}{
2773                 $cgi->a({-href => href(action=>"object", hash=>$1),
2774                                         -class => "text"}, $1);
2775         }eg unless $line =~ /^\s*git-svn-id:/;
2776
2777         return $line;
2778 }
2779
2780 # format marker of refs pointing to given object
2781
2782 # the destination action is chosen based on object type and current context:
2783 # - for annotated tags, we choose the tag view unless it's the current view
2784 #   already, in which case we go to shortlog view
2785 # - for other refs, we keep the current view if we're in history, shortlog or
2786 #   log view, and select shortlog otherwise
2787 sub format_ref_marker {
2788         my ($refs, $id) = @_;
2789         my $markers = '';
2790
2791         if (defined $refs->{$id}) {
2792                 foreach my $ref (@{$refs->{$id}}) {
2793                         # this code exploits the fact that non-lightweight tags are the
2794                         # only indirect objects, and that they are the only objects for which
2795                         # we want to use tag instead of shortlog as action
2796                         my ($type, $name) = qw();
2797                         my $indirect = ($ref =~ s/\^\{\}$//);
2798                         # e.g. tags/v2.6.11 or heads/next
2799                         if ($ref =~ m!^(.*?)s?/(.*)$!) {
2800                                 $type = $1;
2801                                 $name = $2;
2802                         } else {
2803                                 $type = "ref";
2804                                 $name = $ref;
2805                         }
2806
2807                         my $class = $type;
2808                         $class .= " indirect" if $indirect;
2809
2810                         my $dest_action = "shortlog";
2811
2812                         if ($indirect) {
2813                                 $dest_action = "tag" unless $action eq "tag";
2814                         } elsif ($action =~ /^(history|(short)?log)$/) {
2815                                 $dest_action = $action;
2816                         }
2817
2818                         my $dest = "";
2819                         $dest .= "refs/" unless $ref =~ m!^refs/!;
2820                         $dest .= $ref;
2821
2822                         my $link = $cgi->a({
2823                                 -href => href(
2824                                         action=>$dest_action,
2825                                         hash=>$dest
2826                                 )}, esc_html($name));
2827
2828                         $markers .= "<span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2829                                 $link . "</span>";
2830                 }
2831         }
2832
2833         if ($markers) {
2834                 return '<span class="refs">'. $markers . '</span>';
2835         } else {
2836                 return "";
2837         }
2838 }
2839
2840 # format, perhaps shortened and with markers, title line
2841 sub format_subject_html {
2842         my ($long, $short, $href, $extra) = @_;
2843         $extra = '' unless defined($extra);
2844
2845         if (length($short) < length($long)) {
2846                 use bytes;
2847                 $long =~ s/[[:cntrl:]]/?/g;
2848                 return $cgi->a({-href => $href, -class => "list subject",
2849                                 -title => to_utf8($long)},
2850                        esc_html($short)) . $extra;
2851         } else {
2852                 return $cgi->a({-href => $href, -class => "list subject"},
2853                        esc_html($long)) . $extra;
2854         }
2855 }
2856
2857 # Rather than recomputing the url for an email multiple times, we cache it
2858 # after the first hit. This gives a visible benefit in views where the avatar
2859 # for the same email is used repeatedly (e.g. shortlog).
2860 # The cache is shared by all avatar engines (currently gravatar only), which
2861 # are free to use it as preferred. Since only one avatar engine is used for any
2862 # given page, there's no risk for cache conflicts.
2863 our %avatar_cache = ();
2864
2865 # Compute the picon url for a given email, by using the picon search service over at
2866 # http://www.cs.indiana.edu/picons/search.html
2867 sub picon_url {
2868         my $email = lc shift;
2869         if (!$avatar_cache{$email}) {
2870                 my ($user, $domain) = split('@', $email);
2871                 $avatar_cache{$email} =
2872                         "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2873                         "$domain/$user/" .
2874                         "users+domains+unknown/up/single";
2875         }
2876         return $avatar_cache{$email};
2877 }
2878
2879 # Compute the gravatar url for a given email, if it's not in the cache already.
2880 # Gravatar stores only the part of the URL before the size, since that's the
2881 # one computationally more expensive. This also allows reuse of the cache for
2882 # different sizes (for this particular engine).
2883 sub gravatar_url {
2884         my $email = lc shift;
2885         my $size = shift;
2886         $avatar_cache{$email} ||=
2887                 "//www.gravatar.com/avatar/" .
2888                         Digest::MD5::md5_hex($email) . "?s=";
2889         return $avatar_cache{$email} . $size;
2890 }
2891
2892 # Insert an avatar for the given $email at the given $size if the feature
2893 # is enabled.
2894 sub git_get_avatar {
2895         my ($email, %opts) = @_;
2896         my $pre_white  = ($opts{-pad_before} ? "&#160;" : "");
2897         my $post_white = ($opts{-pad_after}  ? "&#160;" : "");
2898         $opts{-size} ||= 'default';
2899         my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2900         my $url = "";
2901         if ($git_avatar eq 'gravatar') {
2902                 $url = gravatar_url($email, $size);
2903         } elsif ($git_avatar eq 'picon') {
2904                 $url = picon_url($email);
2905         }
2906         # Other providers can be added by extending the if chain, defining $url
2907         # as needed. If no variant puts something in $url, we assume avatars
2908         # are completely disabled/unavailable.
2909         if ($url) {
2910                 return $pre_white .
2911                        "<img width=\"$size\" " .
2912                             "class=\"avatar\" " .
2913                             "src=\"".esc_url($url)."\" " .
2914                             "alt=\"\" " .
2915                        "/>" . $post_white;
2916         } else {
2917                 return "";
2918         }
2919 }
2920
2921 sub format_search_author {
2922         my ($author, $searchtype, $displaytext) = @_;
2923         my $have_search = gitweb_check_feature('search');
2924
2925         if ($have_search) {
2926                 my $performed = "";
2927                 if ($searchtype eq 'author') {
2928                         $performed = "authored";
2929                 } elsif ($searchtype eq 'committer') {
2930                         $performed = "committed";
2931                 }
2932
2933                 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2934                                 searchtext=>$author,
2935                                 searchtype=>$searchtype), class=>"list",
2936                                 title=>"Search for commits $performed by $author"},
2937                                 $displaytext);
2938
2939         } else {
2940                 return $displaytext;
2941         }
2942 }
2943
2944 # format the author name of the given commit with the given tag
2945 # the author name is chopped and escaped according to the other
2946 # optional parameters (see chop_str).
2947 sub format_author_html {
2948         my $tag = shift;
2949         my $co = shift;
2950         my $author = chop_and_escape_str($co->{'author_name'}, @_);
2951         return "<$tag class=\"author\">" .
2952                format_search_author($co->{'author_name'}, "author",
2953                        git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2954                        $author) .
2955                "</$tag>";
2956 }
2957
2958 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
2959 sub format_git_diff_header_line {
2960         my $line = shift;
2961         my $diffinfo = shift;
2962         my ($from, $to) = @_;
2963
2964         if ($diffinfo->{'nparents'}) {
2965                 # combined diff
2966                 $line =~ s!^(diff (.*?) )"?.*$!$1!;
2967                 if ($to->{'href'}) {
2968                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2969                                          esc_path($to->{'file'}));
2970                 } else { # file was deleted (no href)
2971                         $line .= esc_path($to->{'file'});
2972                 }
2973         } else {
2974                 # "ordinary" diff
2975                 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
2976                 if ($from->{'href'}) {
2977                         $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
2978                                          'a/' . esc_path($from->{'file'}));
2979                 } else { # file was added (no href)
2980                         $line .= 'a/' . esc_path($from->{'file'});
2981                 }
2982                 $line .= ' ';
2983                 if ($to->{'href'}) {
2984                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2985                                          'b/' . esc_path($to->{'file'}));
2986                 } else { # file was deleted
2987                         $line .= 'b/' . esc_path($to->{'file'});
2988                 }
2989         }
2990
2991         return "<div class=\"diff header\">$line</div>\n";
2992 }
2993
2994 # format extended diff header line, before patch itself
2995 sub format_extended_diff_header_line {
2996         my $line = shift;
2997         my $diffinfo = shift;
2998         my ($from, $to) = @_;
2999
3000         # match <path>
3001         if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
3002                 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
3003                                        esc_path($from->{'file'}));
3004         }
3005         if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
3006                 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3007                                  esc_path($to->{'file'}));
3008         }
3009         # match single <mode>
3010         if ($line =~ m/\s(\d{6})$/) {
3011                 $line .= '<span class="info"> (' .
3012                          file_type_long($1) .
3013                          ')</span>';
3014         }
3015         # match <hash>
3016         if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
3017                 # can match only for combined diff
3018                 $line = 'index ';
3019                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3020                         if ($from->{'href'}[$i]) {
3021                                 $line .= $cgi->a({-href=>$from->{'href'}[$i],
3022                                                   -class=>"hash"},
3023                                                  substr($diffinfo->{'from_id'}[$i],0,7));
3024                         } else {
3025                                 $line .= '0' x 7;
3026                         }
3027                         # separator
3028                         $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
3029                 }
3030                 $line .= '..';
3031                 if ($to->{'href'}) {
3032                         $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
3033                                          substr($diffinfo->{'to_id'},0,7));
3034                 } else {
3035                         $line .= '0' x 7;
3036                 }
3037
3038         } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
3039                 # can match only for ordinary diff
3040                 my ($from_link, $to_link);
3041                 if ($from->{'href'}) {
3042                         $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
3043                                              substr($diffinfo->{'from_id'},0,7));
3044                 } else {
3045                         $from_link = '0' x 7;
3046                 }
3047                 if ($to->{'href'}) {
3048                         $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
3049                                            substr($diffinfo->{'to_id'},0,7));
3050                 } else {
3051                         $to_link = '0' x 7;
3052                 }
3053                 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
3054                 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
3055         }
3056
3057         return $line . "<br/>\n";
3058 }
3059
3060 # format from-file/to-file diff header
3061 sub format_diff_from_to_header {
3062         my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
3063         my $line;
3064         my $result = '';
3065
3066         $line = $from_line;
3067         #assert($line =~ m/^---/) if DEBUG;
3068         # no extra formatting for "^--- /dev/null"
3069         if (! $diffinfo->{'nparents'}) {
3070                 # ordinary (single parent) diff
3071                 if ($line =~ m!^--- "?a/!) {
3072                         if ($from->{'href'}) {
3073                                 $line = '--- a/' .
3074                                         $cgi->a({-href=>$from->{'href'}, -class=>"path"},
3075                                                 esc_path($from->{'file'}));
3076                         } else {
3077                                 $line = '--- a/' .
3078                                         esc_path($from->{'file'});
3079                         }
3080                 }
3081                 $result .= qq!<div class="diff from_file">$line</div>\n!;
3082
3083         } else {
3084                 # combined diff (merge commit)
3085                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3086                         if ($from->{'href'}[$i]) {
3087                                 $line = '--- ' .
3088                                         $cgi->a({-href=>href(action=>"blobdiff",
3089                                                              hash_parent=>$diffinfo->{'from_id'}[$i],
3090                                                              hash_parent_base=>$parents[$i],
3091                                                              file_parent=>$from->{'file'}[$i],
3092                                                              hash=>$diffinfo->{'to_id'},
3093                                                              hash_base=>$hash,
3094                                                              file_name=>$to->{'file'}),
3095                                                  -class=>"path",
3096                                                  -title=>"diff" . ($i+1)},
3097                                                 $i+1) .
3098                                         '/' .
3099                                         $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
3100                                                 esc_path($from->{'file'}[$i]));
3101                         } else {
3102                                 $line = '--- /dev/null';
3103                         }
3104                         $result .= qq!<div class="diff from_file">$line</div>\n!;
3105                 }
3106         }
3107
3108         $line = $to_line;
3109         #assert($line =~ m/^\+\+\+/) if DEBUG;
3110         # no extra formatting for "^+++ /dev/null"
3111         if ($line =~ m!^\+\+\+ "?b/!) {
3112                 if ($to->{'href'}) {
3113                         $line = '+++ b/' .
3114                                 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3115                                         esc_path($to->{'file'}));
3116                 } else {
3117                         $line = '+++ b/' .
3118                                 esc_path($to->{'file'});
3119                 }
3120         }
3121         $result .= qq!<div class="diff to_file">$line</div>\n!;
3122
3123         return $result;
3124 }
3125
3126 # create note for patch simplified by combined diff
3127 sub format_diff_cc_simplified {
3128         my ($diffinfo, @parents) = @_;
3129         my $result = '';
3130
3131         $result .= "<div class=\"diff header\">" .
3132                    "diff --cc ";
3133         if (!is_deleted($diffinfo)) {
3134                 $result .= $cgi->a({-href => href(action=>"blob",
3135                                                   hash_base=>$hash,
3136                                                   hash=>$diffinfo->{'to_id'},
3137                                                   file_name=>$diffinfo->{'to_file'}),
3138                                     -class => "path"},
3139                                    esc_path($diffinfo->{'to_file'}));
3140         } else {
3141                 $result .= esc_path($diffinfo->{'to_file'});
3142         }
3143         $result .= "</div>\n" . # class="diff header"
3144                    "<div class=\"diff nodifferences\">" .
3145                    "Simple merge" .
3146                    "</div>\n"; # class="diff nodifferences"
3147
3148         return $result;
3149 }
3150
3151 sub diff_line_class {
3152         my ($line, $from, $to) = @_;
3153
3154         # ordinary diff
3155         my $num_sign = 1;
3156         # combined diff
3157         if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
3158                 $num_sign = scalar @{$from->{'href'}};
3159         }
3160
3161         my @diff_line_classifier = (
3162                 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
3163                 { regexp => qr/^\\/,               class => "incomplete"  },
3164                 { regexp => qr/^ {$num_sign}/,     class => "ctx" },
3165                 # classifier for context must come before classifier add/rem,
3166                 # or we would have to use more complicated regexp, for example
3167                 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
3168                 { regexp => qr/^[+ ]{$num_sign}/,   class => "add" },
3169                 { regexp => qr/^[- ]{$num_sign}/,   class => "rem" },
3170         );
3171         for my $clsfy (@diff_line_classifier) {
3172                 return $clsfy->{'class'}
3173                         if ($line =~ $clsfy->{'regexp'});
3174         }
3175
3176         # fallback
3177         return "";
3178 }
3179
3180 # assumes that $from and $to are defined and correctly filled,
3181 # and that $line holds a line of chunk header for unified diff
3182 sub format_unidiff_chunk_header {
3183         my ($line, $from, $to) = @_;
3184
3185         my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
3186                 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
3187
3188         $from_lines = 0 unless defined $from_lines;
3189         $to_lines   = 0 unless defined $to_lines;
3190
3191         if ($from->{'href'}) {
3192                 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
3193                                      -class=>"list"}, $from_text);
3194         }
3195         if ($to->{'href'}) {
3196                 $to_text   = $cgi->a({-href=>"$to->{'href'}#l$to_start",
3197                                      -class=>"list"}, $to_text);
3198         }
3199         $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
3200                 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3201         return $line;
3202 }
3203
3204 # assumes that $from and $to are defined and correctly filled,
3205 # and that $line holds a line of chunk header for combined diff
3206 sub format_cc_diff_chunk_header {
3207         my ($line, $from, $to) = @_;
3208
3209         my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
3210         my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
3211
3212         @from_text = split(' ', $ranges);
3213         for (my $i = 0; $i < @from_text; ++$i) {
3214                 ($from_start[$i], $from_nlines[$i]) =
3215                         (split(',', substr($from_text[$i], 1)), 0);
3216         }
3217
3218         $to_text   = pop @from_text;
3219         $to_start  = pop @from_start;
3220         $to_nlines = pop @from_nlines;
3221
3222         $line = "<span class=\"chunk_info\">$prefix ";
3223         for (my $i = 0; $i < @from_text; ++$i) {
3224                 if ($from->{'href'}[$i]) {
3225                         $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
3226                                           -class=>"list"}, $from_text[$i]);
3227                 } else {
3228                         $line .= $from_text[$i];
3229                 }
3230                 $line .= " ";
3231         }
3232         if ($to->{'href'}) {
3233                 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
3234                                   -class=>"list"}, $to_text);
3235         } else {
3236                 $line .= $to_text;
3237         }
3238         $line .= " $prefix</span>" .
3239                  "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3240         return $line;
3241 }
3242
3243 # process patch (diff) line (not to be used for diff headers),
3244 # returning HTML-formatted (but not wrapped) line.
3245 # If the line is passed as a reference, it is treated as HTML and not
3246 # esc_html()'ed.
3247 sub format_diff_line {
3248         my ($line, $diff_class, $from, $to) = @_;
3249
3250         if (ref($line)) {
3251                 $line = $$line;
3252         } else {
3253                 chomp $line;
3254                 $line = untabify($line);
3255
3256                 if ($from && $to && $line =~ m/^\@{2} /) {
3257                         $line = format_unidiff_chunk_header($line, $from, $to);
3258                 } elsif ($from && $to && $line =~ m/^\@{3}/) {
3259                         $line = format_cc_diff_chunk_header($line, $from, $to);
3260                 } else {
3261                         $line = esc_html($line, -nbsp=>1);
3262                 }
3263         }
3264
3265         my $diff_classes = "diff diff_body";
3266         $diff_classes .= " $diff_class" if ($diff_class);
3267         $line = "<div class=\"$diff_classes\">$line</div>\n";
3268
3269         return $line;
3270 }
3271
3272 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
3273 # linked.  Pass the hash of the tree/commit to snapshot.
3274 sub format_snapshot_links {
3275         my ($hash) = @_;
3276         my $num_fmts = @snapshot_fmts;
3277         if ($num_fmts > 1) {
3278                 # A parenthesized list of links bearing format names.
3279                 # e.g. "snapshot (_tar.gz_ _zip_)"
3280                 return "snapshot (" . join(' ', map
3281                         $cgi->a({
3282                                 -href => href(
3283                                         action=>"snapshot",
3284                                         hash=>$hash,
3285                                         snapshot_format=>$_
3286                                 )
3287                         }, $known_snapshot_formats{$_}{'display'})
3288                 , @snapshot_fmts) . ")";
3289         } elsif ($num_fmts == 1) {
3290                 # A single "snapshot" link whose tooltip bears the format name.
3291                 # i.e. "_snapshot_"
3292                 my ($fmt) = @snapshot_fmts;
3293                 return
3294                         $cgi->a({
3295                                 -href => href(
3296                                         action=>"snapshot",
3297                                         hash=>$hash,
3298                                         snapshot_format=>$fmt
3299                                 ),
3300                                 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
3301                         }, "snapshot");
3302         } else { # $num_fmts == 0
3303                 return undef;
3304         }
3305 }
3306
3307 ## ......................................................................
3308 ## functions returning values to be passed, perhaps after some
3309 ## transformation, to other functions; e.g. returning arguments to href()
3310
3311 # returns hash to be passed to href to generate gitweb URL
3312 # in -title key it returns description of link
3313 sub get_feed_info {
3314         my $format = shift || 'Atom';
3315         my %res = (action => lc($format));
3316         my $matched_ref = 0;
3317
3318         # feed links are possible only for project views
3319         return unless (defined $project);
3320         # some views should link to OPML, or to generic project feed,
3321         # or don't have specific feed yet (so they should use generic)
3322         return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
3323
3324         my $branch = undef;
3325         # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
3326         # (fullname) to differentiate from tag links; this also makes
3327         # possible to detect branch links
3328         for my $ref (get_branch_refs()) {
3329                 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
3330                     (defined $hash      && $hash      =~ m!^refs/\Q$ref\E/(.*)$!)) {
3331                         $branch = $1;
3332                         $matched_ref = $ref;
3333                         last;
3334                 }
3335         }
3336         # find log type for feed description (title)
3337         my $type = 'log';
3338         if (defined $file_name) {
3339                 $type  = "history of $file_name";
3340                 $type .= "/" if ($action eq 'tree');
3341                 $type .= " on '$branch'" if (defined $branch);
3342         } else {
3343                 $type = "log of $branch" if (defined $branch);
3344         }
3345
3346         $res{-title} = $type;
3347         $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
3348         $res{'file_name'} = $file_name;
3349
3350         return %res;
3351 }
3352
3353 ## ----------------------------------------------------------------------
3354 ## git utility subroutines, invoking git commands
3355
3356 # returns path to the core git executable and the --git-dir parameter as list
3357 sub git_cmd {
3358         $number_of_git_cmds++;
3359         return $GIT, '--git-dir='.$git_dir;
3360 }
3361
3362 # opens a "-|" cmd pipe handle with 2>/dev/null and returns it
3363 sub cmd_pipe {
3364
3365         # In order to be compatible with FCGI mode we must use POSIX
3366         # and access the STDERR_FILENO file descriptor directly
3367
3368         use POSIX qw(STDERR_FILENO dup dup2);
3369
3370         open(my $null, '>', File::Spec->devnull) or die "couldn't open devnull: $!";
3371         (my $saveerr = dup(STDERR_FILENO)) or die "couldn't dup STDERR: $!";
3372         my $dup2ok = dup2(fileno($null), STDERR_FILENO);
3373         close($null) or !$dup2ok or die "couldn't close NULL: $!";
3374         $dup2ok or POSIX::close($saveerr), die "couldn't dup NULL to STDERR: $!";
3375         my $result = open(my $fd, "-|", @_);
3376         $dup2ok = dup2($saveerr, STDERR_FILENO);
3377         POSIX::close($saveerr) or !$dup2ok or die "couldn't close SAVEERR: $!";
3378         $dup2ok or die "couldn't dup SAVERR to STDERR: $!";
3379
3380         return $result ? $fd : undef;
3381 }
3382
3383 # opens a "-|" git_cmd pipe handle with 2>/dev/null and returns it
3384 sub git_cmd_pipe {
3385         return cmd_pipe git_cmd(), @_;
3386 }
3387
3388 # quote the given arguments for passing them to the shell
3389 # quote_command("command", "arg 1", "arg with ' and ! characters")
3390 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
3391 # Try to avoid using this function wherever possible.
3392 sub quote_command {
3393         return join(' ',
3394                 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
3395 }
3396
3397 # get HEAD ref of given project as hash
3398 sub git_get_head_hash {
3399         return git_get_full_hash(shift, 'HEAD');
3400 }
3401
3402 sub git_get_full_hash {
3403         return git_get_hash(@_);
3404 }
3405
3406 sub git_get_short_hash {
3407         return git_get_hash(@_, '--short=7');
3408 }
3409
3410 sub git_get_hash {
3411         my ($project, $hash, @options) = @_;
3412         my $o_git_dir = $git_dir;
3413         my $retval = undef;
3414         $git_dir = "$projectroot/$project";
3415         if (defined(my $fd = git_cmd_pipe 'rev-parse',
3416             '--verify', '-q', @options, $hash)) {
3417                 $retval = <$fd>;
3418                 chomp $retval if defined $retval;
3419                 close $fd;
3420         }
3421         if (defined $o_git_dir) {
3422                 $git_dir = $o_git_dir;
3423         }
3424         return $retval;
3425 }
3426
3427 # get type of given object
3428 sub git_get_type {
3429         my $hash = shift;
3430
3431         defined(my $fd = git_cmd_pipe "cat-file", '-t', $hash) or return;
3432         my $type = <$fd>;
3433         close $fd or return;
3434         chomp $type;
3435         return $type;
3436 }
3437
3438 # repository configuration
3439 our $config_file = '';
3440 our %config;
3441
3442 # store multiple values for single key as anonymous array reference
3443 # single values stored directly in the hash, not as [ <value> ]
3444 sub hash_set_multi {
3445         my ($hash, $key, $value) = @_;
3446
3447         if (!exists $hash->{$key}) {
3448                 $hash->{$key} = $value;
3449         } elsif (!ref $hash->{$key}) {
3450                 $hash->{$key} = [ $hash->{$key}, $value ];
3451         } else {
3452                 push @{$hash->{$key}}, $value;
3453         }
3454 }
3455
3456 # return hash of git project configuration
3457 # optionally limited to some section, e.g. 'gitweb'
3458 sub git_parse_project_config {
3459         my $section_regexp = shift;
3460         my %config;
3461
3462         local $/ = "\0";
3463
3464         defined(my $fh = git_cmd_pipe "config", '-z', '-l')
3465                 or return;
3466
3467         while (my $keyval = to_utf8(scalar <$fh>)) {
3468                 chomp $keyval;
3469                 my ($key, $value) = split(/\n/, $keyval, 2);
3470
3471                 hash_set_multi(\%config, $key, $value)
3472                         if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
3473         }
3474         close $fh;
3475
3476         return %config;
3477 }
3478
3479 # convert config value to boolean: 'true' or 'false'
3480 # no value, number > 0, 'true' and 'yes' values are true
3481 # rest of values are treated as false (never as error)
3482 sub config_to_bool {
3483         my $val = shift;
3484
3485         return 1 if !defined $val;             # section.key
3486
3487         # strip leading and trailing whitespace
3488         $val =~ s/^\s+//;
3489         $val =~ s/\s+$//;
3490
3491         return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
3492                 ($val =~ /^(?:true|yes)$/i));  # section.key = true
3493 }
3494
3495 # convert config value to simple decimal number
3496 # an optional value suffix of 'k', 'm', or 'g' will cause the value
3497 # to be multiplied by 1024, 1048576, or 1073741824
3498 sub config_to_int {
3499         my $val = shift;
3500
3501         # strip leading and trailing whitespace
3502         $val =~ s/^\s+//;
3503         $val =~ s/\s+$//;
3504
3505         if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
3506                 $unit = lc($unit);
3507                 # unknown unit is treated as 1
3508                 return $num * ($unit eq 'g' ? 1073741824 :
3509                                $unit eq 'm' ?    1048576 :
3510                                $unit eq 'k' ?       1024 : 1);
3511         }
3512         return $val;
3513 }
3514
3515 # convert config value to array reference, if needed
3516 sub config_to_multi {
3517         my $val = shift;
3518
3519         return ref($val) ? $val : (defined($val) ? [ $val ] : []);
3520 }
3521
3522 sub git_get_project_config {
3523         my ($key, $type) = @_;
3524
3525         return unless defined $git_dir;
3526
3527         # key sanity check
3528         return unless ($key);
3529         # only subsection, if exists, is case sensitive,
3530         # and not lowercased by 'git config -z -l'
3531         if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
3532                 $lo =~ s/_//g;
3533                 $key = join(".", lc($hi), $mi, lc($lo));
3534                 return if ($lo =~ /\W/ || $hi =~ /\W/);
3535         } else {
3536                 $key = lc($key);
3537                 $key =~ s/_//g;
3538                 return if ($key =~ /\W/);
3539         }
3540         $key =~ s/^gitweb\.//;
3541
3542         # type sanity check
3543         if (defined $type) {
3544                 $type =~ s/^--//;
3545                 $type = undef
3546                         unless ($type eq 'bool' || $type eq 'int');
3547         }
3548
3549         # get config
3550         if (!defined $config_file ||
3551             $config_file ne "$git_dir/config") {
3552                 %config = git_parse_project_config('gitweb');
3553                 $config_file = "$git_dir/config";
3554         }
3555
3556         # check if config variable (key) exists
3557         return unless exists $config{"gitweb.$key"};
3558
3559         # ensure given type
3560         if (!defined $type) {
3561                 return $config{"gitweb.$key"};
3562         } elsif ($type eq 'bool') {
3563                 # backward compatibility: 'git config --bool' returns true/false
3564                 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
3565         } elsif ($type eq 'int') {
3566                 return config_to_int($config{"gitweb.$key"});
3567         }
3568         return $config{"gitweb.$key"};
3569 }
3570
3571 # get hash of given path at given ref
3572 sub git_get_hash_by_path {
3573         my $base = shift;
3574         my $path = shift || return undef;
3575         my $type = shift;
3576
3577         $path =~ s,/+$,,;
3578
3579         defined(my $fd = git_cmd_pipe "ls-tree", $base, "--", $path)
3580                 or die_error(500, "Open git-ls-tree failed");
3581         my $line = to_utf8(scalar <$fd>);
3582         close $fd or return undef;
3583
3584         if (!defined $line) {
3585                 # there is no tree or hash given by $path at $base
3586                 return undef;
3587         }
3588
3589         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3590         $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
3591         if (defined $type && $type ne $2) {
3592                 # type doesn't match
3593                 return undef;
3594         }
3595         return $3;
3596 }
3597
3598 # get path of entry with given hash at given tree-ish (ref)
3599 # used to get 'from' filename for combined diff (merge commit) for renames
3600 sub git_get_path_by_hash {
3601         my $base = shift || return;
3602         my $hash = shift || return;
3603
3604         local $/ = "\0";
3605
3606         defined(my $fd = git_cmd_pipe "ls-tree", '-r', '-t', '-z', $base)
3607                 or return undef;
3608         while (my $line = to_utf8(scalar <$fd>)) {
3609                 chomp $line;
3610
3611                 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423  gitweb'
3612                 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f  gitweb/README'
3613                 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
3614                         close $fd;
3615                         return $1;
3616                 }
3617         }
3618         close $fd;
3619         return undef;
3620 }
3621
3622 ## ......................................................................
3623 ## git utility functions, directly accessing git repository
3624
3625 # get the value of config variable either from file named as the variable
3626 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
3627 # configuration variable in the repository config file.
3628 sub git_get_file_or_project_config {
3629         my ($path, $name) = @_;
3630
3631         $git_dir = "$projectroot/$path";
3632         open my $fd, '<', "$git_dir/$name"
3633                 or return git_get_project_config($name);
3634         my $conf = to_utf8(scalar <$fd>);
3635         close $fd;
3636         if (defined $conf) {
3637                 chomp $conf;
3638         }
3639         return $conf;
3640 }
3641
3642 sub git_get_project_description {
3643         my $path = shift;
3644         return git_get_file_or_project_config($path, 'description');
3645 }
3646
3647 sub git_get_project_category {
3648         my $path = shift;
3649         return git_get_file_or_project_config($path, 'category');
3650 }
3651
3652
3653 # supported formats:
3654 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
3655 #   - if its contents is a number, use it as tag weight,
3656 #   - otherwise add a tag with weight 1
3657 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
3658 #   the same value multiple times increases tag weight
3659 # * `gitweb.ctag' multi-valued repo config variable
3660 sub git_get_project_ctags {
3661         my $project = shift;
3662         my $ctags = {};
3663
3664         $git_dir = "$projectroot/$project";
3665         if (opendir my $dh, "$git_dir/ctags") {
3666                 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
3667                 foreach my $tagfile (@files) {
3668                         open my $ct, '<', $tagfile
3669                                 or next;
3670                         my $val = <$ct>;
3671                         chomp $val if $val;
3672                         close $ct;
3673
3674                         (my $ctag = $tagfile) =~ s#.*/##;
3675                         $ctag = to_utf8($ctag);
3676                         if ($val =~ /^\d+$/) {
3677                                 $ctags->{$ctag} = $val;
3678                         } else {
3679                                 $ctags->{$ctag} = 1;
3680                         }
3681                 }
3682                 closedir $dh;
3683
3684         } elsif (open my $fh, '<', "$git_dir/ctags") {
3685                 while (my $line = to_utf8(scalar <$fh>)) {
3686                         chomp $line;
3687                         $ctags->{$line}++ if $line;
3688                 }
3689                 close $fh;
3690
3691         } else {
3692                 my $taglist = config_to_multi(git_get_project_config('ctag'));
3693                 foreach my $tag (@$taglist) {
3694                         $ctags->{$tag}++;
3695                 }
3696         }
3697
3698         return $ctags;
3699 }
3700
3701 # return hash, where keys are content tags ('ctags'),
3702 # and values are sum of weights of given tag in every project
3703 sub git_gather_all_ctags {
3704         my $projects = shift;
3705         my $ctags = {};
3706
3707         foreach my $p (@$projects) {
3708                 foreach my $ct (keys %{$p->{'ctags'}}) {
3709                         $ctags->{$ct} += $p->{'ctags'}->{$ct};
3710                 }
3711         }
3712
3713         return $ctags;
3714 }
3715
3716 sub git_populate_project_tagcloud {
3717         my ($ctags, $action) = @_;
3718
3719         # First, merge different-cased tags; tags vote on casing
3720         my %ctags_lc;
3721         foreach (keys %$ctags) {
3722                 $ctags_lc{lc $_}->{count} += $ctags->{$_};
3723                 if (not $ctags_lc{lc $_}->{topcount}
3724                     or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
3725                         $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
3726                         $ctags_lc{lc $_}->{topname} = $_;
3727                 }
3728         }
3729
3730         my $cloud;
3731         my $matched = $input_params{'ctag_filter'};
3732         if (eval { require HTML::TagCloud; 1; }) {
3733                 $cloud = HTML::TagCloud->new;
3734                 foreach my $ctag (sort keys %ctags_lc) {
3735                         # Pad the title with spaces so that the cloud looks
3736                         # less crammed.
3737                         my $title = esc_html($ctags_lc{$ctag}->{topname});
3738                         $title =~ s/ /&#160;/g;
3739                         $title =~ s/^/&#160;/g;
3740                         $title =~ s/$/&#160;/g;
3741                         if (defined $matched && $matched eq $ctag) {
3742                                 $title = qq(<span class="match">$title</span>);
3743                         }
3744                         $cloud->add($title, href(-replay=>1, action=>$action, ctag_filter=>$ctag),
3745                                     $ctags_lc{$ctag}->{count});
3746                 }
3747         } else {
3748                 $cloud = {};
3749                 foreach my $ctag (keys %ctags_lc) {
3750                         my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3751                         if (defined $matched && $matched eq $ctag) {
3752                                 $title = qq(<span class="match">$title</span>);
3753                         }
3754                         $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3755                         $cloud->{$ctag}{ctag} =
3756                                 $cgi->a({-href=>href(-replay=>1, action=>$action, ctag_filter=>$ctag)}, $title);
3757                 }
3758         }
3759         return $cloud;
3760 }
3761
3762 sub git_show_project_tagcloud {
3763         my ($cloud, $count) = @_;
3764         if (ref $cloud eq 'HTML::TagCloud') {
3765                 return $cloud->html_and_css($count);
3766         } else {
3767                 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3768                 return
3769                         '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3770                         join (', ', map {
3771                                 $cloud->{$_}->{'ctag'}
3772                         } splice(@tags, 0, $count)) .
3773                         '</div>';
3774         }
3775 }
3776
3777 sub git_get_project_url_list {
3778         my $path = shift;
3779
3780         $git_dir = "$projectroot/$path";
3781         open my $fd, '<', "$git_dir/cloneurl"
3782                 or return wantarray ?
3783                 @{ config_to_multi(git_get_project_config('url')) } :
3784                    config_to_multi(git_get_project_config('url'));
3785         my @git_project_url_list = map { chomp; to_utf8($_) } <$fd>;
3786         close $fd;
3787
3788         return wantarray ? @git_project_url_list : \@git_project_url_list;
3789 }
3790
3791 sub git_get_projects_list {
3792         my $filter = shift || '';
3793         my $paranoid = shift;
3794         my @list;
3795
3796         if (-d $projects_list) {
3797                 # search in directory
3798                 my $dir = $projects_list;
3799                 # remove the trailing "/"
3800                 $dir =~ s!/+$!!;
3801                 my $pfxlen = length("$dir");
3802                 my $pfxdepth = ($dir =~ tr!/!!);
3803                 # when filtering, search only given subdirectory
3804                 if ($filter && !$paranoid) {
3805                         $dir .= "/$filter";
3806                         $dir =~ s!/+$!!;
3807                 }
3808
3809                 File::Find::find({
3810                         follow_fast => 1, # follow symbolic links
3811                         follow_skip => 2, # ignore duplicates
3812                         dangling_symlinks => 0, # ignore dangling symlinks, silently
3813                         wanted => sub {
3814                                 # global variables
3815                                 our $project_maxdepth;
3816                                 our $projectroot;
3817                                 # skip project-list toplevel, if we get it.
3818                                 return if (m!^[/.]$!);
3819                                 # only directories can be git repositories
3820                                 return unless (-d $_);
3821                                 # don't traverse too deep (Find is super slow on os x)
3822                                 # $project_maxdepth excludes depth of $projectroot
3823                                 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3824                                         $File::Find::prune = 1;
3825                                         return;
3826                                 }
3827
3828                                 my $path = substr($File::Find::name, $pfxlen + 1);
3829                                 # paranoidly only filter here
3830                                 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3831                                         next;
3832                                 }
3833                                 # we check related file in $projectroot
3834                                 if (check_export_ok("$projectroot/$path")) {
3835                                         push @list, { path => $path };
3836                                         $File::Find::prune = 1;
3837                                 }
3838                         },
3839                 }, "$dir");
3840
3841         } elsif (-f $projects_list) {
3842                 # read from file(url-encoded):
3843                 # 'git%2Fgit.git Linus+Torvalds'
3844                 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3845                 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3846                 open my $fd, '<', $projects_list or return;
3847         PROJECT:
3848                 while (my $line = <$fd>) {
3849                         chomp $line;
3850                         my ($path, $owner) = split ' ', $line;
3851                         $path = unescape($path);
3852                         $owner = unescape($owner);
3853                         if (!defined $path) {
3854                                 next;
3855                         }
3856                         # if $filter is rpovided, check if $path begins with $filter
3857                         if ($filter && $path !~ m!^\Q$filter\E/!) {
3858                                 next;
3859                         }
3860                         if (check_export_ok("$projectroot/$path")) {
3861                                 my $pr = {
3862                                         path => $path
3863                                 };
3864                                 if ($owner) {
3865                                         $pr->{'owner'} = to_utf8($owner);
3866                                 }
3867                                 push @list, $pr;
3868                         }
3869                 }
3870                 close $fd;
3871         }
3872         return @list;
3873 }
3874
3875 # written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
3876 # as side effects it sets 'forks' field to list of forks for forked projects
3877 sub filter_forks_from_projects_list {
3878         my $projects = shift;
3879
3880         my %trie; # prefix tree of directories (path components)
3881         # generate trie out of those directories that might contain forks
3882         foreach my $pr (@$projects) {
3883                 my $path = $pr->{'path'};
3884                 $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
3885                 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3886                 next unless ($path);      # skip '.git' repository: tests, git-instaweb
3887                 next unless (-d "$projectroot/$path"); # containing directory exists
3888                 $pr->{'forks'} = [];      # there can be 0 or more forks of project
3889
3890                 # add to trie
3891                 my @dirs = split('/', $path);
3892                 # walk the trie, until either runs out of components or out of trie
3893                 my $ref = \%trie;
3894                 while (scalar @dirs &&
3895                        exists($ref->{$dirs[0]})) {
3896                         $ref = $ref->{shift @dirs};
3897                 }
3898                 # create rest of trie structure from rest of components
3899                 foreach my $dir (@dirs) {
3900                         $ref = $ref->{$dir} = {};
3901                 }
3902                 # create end marker, store $pr as a data
3903                 $ref->{''} = $pr if (!exists $ref->{''});
3904         }
3905
3906         # filter out forks, by finding shortest prefix match for paths
3907         my @filtered;
3908  PROJECT:
3909         foreach my $pr (@$projects) {
3910                 # trie lookup
3911                 my $ref = \%trie;
3912         DIR:
3913                 foreach my $dir (split('/', $pr->{'path'})) {
3914                         if (exists $ref->{''}) {
3915                                 # found [shortest] prefix, is a fork - skip it
3916                                 push @{$ref->{''}{'forks'}}, $pr;
3917                                 next PROJECT;
3918                         }
3919                         if (!exists $ref->{$dir}) {
3920                                 # not in trie, cannot have prefix, not a fork
3921                                 push @filtered, $pr;
3922                                 next PROJECT;
3923                         }
3924                         # If the dir is there, we just walk one step down the trie.
3925                         $ref = $ref->{$dir};
3926                 }
3927                 # we ran out of trie
3928                 # (shouldn't happen: it's either no match, or end marker)
3929                 push @filtered, $pr;
3930         }
3931
3932         return @filtered;
3933 }
3934
3935 # note: fill_project_list_info must be run first,
3936 # for 'descr_long' and 'ctags' to be filled
3937 sub search_projects_list {
3938         my ($projlist, %opts) = @_;
3939         my $tagfilter  = $opts{'tagfilter'};
3940         my $search_re = $opts{'search_regexp'};
3941
3942         return @$projlist
3943                 unless ($tagfilter || $search_re);
3944
3945         # searching projects require filling to be run before it;
3946         fill_project_list_info($projlist,
3947                                $tagfilter  ? 'ctags' : (),
3948                                $search_re ? ('path', 'descr') : ());
3949         my @projects;
3950  PROJECT:
3951         foreach my $pr (@$projlist) {
3952
3953                 if ($tagfilter) {
3954                         next unless ref($pr->{'ctags'}) eq 'HASH';
3955                         next unless
3956                                 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3957                 }
3958
3959                 if ($search_re) {
3960                         my $path = $pr->{'path'};
3961                         $path =~ s/\.git$//; # should not be included in search
3962                         next unless
3963                                 $path =~ /$search_re/ ||
3964                                 $pr->{'descr_long'} =~ /$search_re/;
3965                 }
3966
3967                 push @projects, $pr;
3968         }
3969
3970         return @projects;
3971 }
3972
3973 our $gitweb_project_owner = undef;
3974 sub git_get_project_list_from_file {
3975
3976         return if (defined $gitweb_project_owner);
3977
3978         $gitweb_project_owner = {};
3979         # read from file (url-encoded):
3980         # 'git%2Fgit.git Linus+Torvalds'
3981         # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3982         # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3983         if (-f $projects_list) {
3984                 open(my $fd, '<', $projects_list);
3985                 while (my $line = <$fd>) {
3986                         chomp $line;
3987                         my ($pr, $ow) = split ' ', $line;
3988                         $pr = unescape($pr);
3989                         $ow = unescape($ow);
3990                         $gitweb_project_owner->{$pr} = to_utf8($ow);
3991                 }
3992                 close $fd;
3993         }
3994 }
3995
3996 sub git_get_project_owner {
3997         my $proj = shift;
3998         my $owner;
3999
4000         return undef unless $proj;
4001         $git_dir = "$projectroot/$proj";
4002
4003         if (defined $project && $proj eq $project) {
4004                 $owner = git_get_project_config('owner');
4005         }
4006         if (!defined $owner && !defined $gitweb_project_owner) {
4007                 git_get_project_list_from_file();
4008         }
4009         if (!defined $owner && exists $gitweb_project_owner->{$proj}) {
4010                 $owner = $gitweb_project_owner->{$proj};
4011         }
4012         if (!defined $owner && (!defined $project || $proj ne $project)) {
4013                 $owner = git_get_project_config('owner');
4014         }
4015         if (!defined $owner) {
4016                 $owner = get_file_owner("$git_dir");
4017         }
4018
4019         return $owner;
4020 }
4021
4022 sub parse_activity_date {
4023         my $dstr = shift;
4024
4025         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
4026                 # Unix timestamp
4027                 return 0 + $1;
4028         }
4029         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt _](\d{1,2}):(\d{2}):(\d{2})(?:[ _]?([Zz]|(?:[-+]\d{1,2}:?\d{2})))?\s*$/) {
4030                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
4031                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, $Y-1900);
4032                 defined($z) && $z ne '' or $z = 'Z';
4033                 $z =~ s/://;
4034                 substr($z,1,0) = '0' if length($z) == 4;
4035                 my $off = 0;
4036                 if (uc($z) ne 'Z') {
4037                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
4038                         $off = -$off if substr($z,0,1) eq '-';
4039                 }
4040                 return $seconds - $off;
4041         }
4042         return undef;
4043 }
4044
4045 # If $quick is true only look at $lastactivity_file
4046 sub git_get_last_activity {
4047         my ($path, $quick) = @_;
4048         my $fd;
4049
4050         $git_dir = "$projectroot/$path";
4051         if ($lastactivity_file && open($fd, "<", "$git_dir/$lastactivity_file")) {
4052                 my $activity = <$fd>;
4053                 close $fd;
4054                 return (undef) unless defined $activity;
4055                 chomp $activity;
4056                 return (undef) if $activity eq '';
4057                 if (my $timestamp = parse_activity_date($activity)) {
4058                         return ($timestamp);
4059                 }
4060         }
4061         return (undef) if $quick;
4062         defined($fd = git_cmd_pipe 'for-each-ref',
4063              '--format=%(committer)',
4064              '--sort=-committerdate',
4065              '--count=1',
4066              map { "refs/$_" } get_branch_refs ()) or return;
4067         my $most_recent = <$fd>;
4068         close $fd or return (undef);
4069         if (defined $most_recent &&
4070             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
4071                 my $timestamp = $1;
4072                 return ($timestamp);
4073         }
4074         return (undef);
4075 }
4076
4077 # Implementation note: when a single remote is wanted, we cannot use 'git
4078 # remote show -n' because that command always work (assuming it's a remote URL
4079 # if it's not defined), and we cannot use 'git remote show' because that would
4080 # try to make a network roundtrip. So the only way to find if that particular
4081 # remote is defined is to walk the list provided by 'git remote -v' and stop if
4082 # and when we find what we want.
4083 sub git_get_remotes_list {
4084         my $wanted = shift;
4085         my %remotes = ();
4086
4087         my $fd = git_cmd_pipe 'remote', '-v';
4088         return unless $fd;
4089         while (my $remote = to_utf8(scalar <$fd>)) {
4090                 chomp $remote;
4091                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
4092                 next if $wanted and not $remote eq $wanted;
4093                 my ($url, $key) = ($1, $2);
4094
4095                 $remotes{$remote} ||= { 'heads' => [] };
4096                 $remotes{$remote}{$key} = $url;
4097         }
4098         close $fd or return;
4099         return wantarray ? %remotes : \%remotes;
4100 }
4101
4102 # Takes a hash of remotes as first parameter and fills it by adding the
4103 # available remote heads for each of the indicated remotes.
4104 sub fill_remote_heads {
4105         my $remotes = shift;
4106         my @heads = map { "remotes/$_" } keys %$remotes;
4107         my @remoteheads = git_get_heads_list(undef, @heads);
4108         foreach my $remote (keys %$remotes) {
4109                 $remotes->{$remote}{'heads'} = [ grep {
4110                         $_->{'name'} =~ s!^$remote/!!
4111                         } @remoteheads ];
4112         }
4113 }
4114
4115 sub git_get_references {
4116         my $type = shift || "";
4117         my %refs;
4118         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
4119         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
4120         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
4121                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
4122                 or return;
4123
4124         while (my $line = to_utf8(scalar <$fd>)) {
4125                 chomp $line;
4126                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
4127                         if (defined $refs{$1}) {
4128                                 push @{$refs{$1}}, $2;
4129                         } else {
4130                                 $refs{$1} = [ $2 ];
4131                         }
4132                 }
4133         }
4134         close $fd or return;
4135         return \%refs;
4136 }
4137
4138 sub git_get_rev_name_tags {
4139         my $hash = shift || return undef;
4140
4141         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
4142                 or return;
4143         my $name_rev = to_utf8(scalar <$fd>);
4144         close $fd;
4145
4146         if ($name_rev =~ m|^$hash tags/(.*)$|) {
4147                 return $1;
4148         } else {
4149                 # catches also '$hash undefined' output
4150                 return undef;
4151         }
4152 }
4153
4154 ## ----------------------------------------------------------------------
4155 ## parse to hash functions
4156
4157 sub parse_date {
4158         my $epoch = shift;
4159         my $tz = shift || "-0000";
4160
4161         my %date;
4162         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
4163         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
4164         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
4165         $date{'hour'} = $hour;
4166         $date{'minute'} = $min;
4167         $date{'mday'} = $mday;
4168         $date{'day'} = $days[$wday];
4169         $date{'month'} = $months[$mon];
4170         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
4171                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
4172         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
4173                              $mday, $months[$mon], $hour ,$min;
4174         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
4175                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
4176
4177         my ($tz_sign, $tz_hour, $tz_min) =
4178                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
4179         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
4180         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
4181         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
4182         $date{'hour_local'} = $hour;
4183         $date{'minute_local'} = $min;
4184         $date{'mday_local'} = $mday;
4185         $date{'tz_local'} = $tz;
4186         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
4187                                   1900+$year, $mon+1, $mday,
4188                                   $hour, $min, $sec, $tz);
4189         return %date;
4190 }
4191
4192 sub parse_file_date {
4193         my $file = shift;
4194         my $mtime = (stat("$projectroot/$project/$file"))[9];
4195         return () unless defined $mtime;
4196         my $tzoffset = timegm((localtime($mtime))[0..5]) - $mtime;
4197         my $tzstring = '+';
4198         if ($tzoffset <= 0) {
4199                 $tzstring = '-';
4200                 $tzoffset *= -1;
4201         }
4202         $tzoffset = int($tzoffset/60);
4203         $tzstring .= sprintf("%02d%02d", int($tzoffset/60), $tzoffset%60);
4204         return parse_date($mtime, $tzstring);
4205 }
4206
4207 sub parse_tag {
4208         my $tag_id = shift;
4209         my %tag;
4210         my @comment;
4211
4212         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
4213         $tag{'id'} = $tag_id;
4214         while (my $line = to_utf8(scalar <$fd>)) {
4215                 chomp $line;
4216                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
4217                         $tag{'object'} = $1;
4218                 } elsif ($line =~ m/^type (.+)$/) {
4219                         $tag{'type'} = $1;
4220                 } elsif ($line =~ m/^tag (.+)$/) {
4221                         $tag{'name'} = $1;
4222                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
4223                         $tag{'author'} = $1;
4224                         $tag{'author_epoch'} = $2;
4225                         $tag{'author_tz'} = $3;
4226                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4227                                 $tag{'author_name'}  = $1;
4228                                 $tag{'author_email'} = $2;
4229                         } else {
4230                                 $tag{'author_name'} = $tag{'author'};
4231                         }
4232                 } elsif ($line =~ m/--BEGIN/) {
4233                         push @comment, $line;
4234                         last;
4235                 } elsif ($line eq "") {
4236                         last;
4237                 }
4238         }
4239         push @comment, map(to_utf8($_), <$fd>);
4240         $tag{'comment'} = \@comment;
4241         close $fd or return;
4242         if (!defined $tag{'name'}) {
4243                 return
4244         };
4245         return %tag
4246 }
4247
4248 sub parse_commit_text {
4249         my ($commit_text, $withparents) = @_;
4250         my @commit_lines = split '\n', $commit_text;
4251         my %co;
4252
4253         pop @commit_lines; # Remove '\0'
4254
4255         if (! @commit_lines) {
4256                 return;
4257         }
4258
4259         my $header = shift @commit_lines;
4260         if ($header !~ m/^[0-9a-fA-F]{40}/) {
4261                 return;
4262         }
4263         ($co{'id'}, my @parents) = split ' ', $header;
4264         while (my $line = shift @commit_lines) {
4265                 last if $line eq "\n";
4266                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
4267                         $co{'tree'} = $1;
4268                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
4269                         push @parents, $1;
4270                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
4271                         $co{'author'} = to_utf8($1);
4272                         $co{'author_epoch'} = $2;
4273                         $co{'author_tz'} = $3;
4274                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4275                                 $co{'author_name'}  = $1;
4276                                 $co{'author_email'} = $2;
4277                         } else {
4278                                 $co{'author_name'} = $co{'author'};
4279                         }
4280                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
4281                         $co{'committer'} = to_utf8($1);
4282                         $co{'committer_epoch'} = $2;
4283                         $co{'committer_tz'} = $3;
4284                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
4285                                 $co{'committer_name'}  = $1;
4286                                 $co{'committer_email'} = $2;
4287                         } else {
4288                                 $co{'committer_name'} = $co{'committer'};
4289                         }
4290                 }
4291         }
4292         if (!defined $co{'tree'}) {
4293                 return;
4294         };
4295         $co{'parents'} = \@parents;
4296         $co{'parent'} = $parents[0];
4297
4298         @commit_lines = map to_utf8($_), @commit_lines;
4299         foreach my $title (@commit_lines) {
4300                 $title =~ s/^    //;
4301                 if ($title ne "") {
4302                         $co{'title'} = chop_str($title, 80, 5);
4303                         # remove leading stuff of merges to make the interesting part visible
4304                         if (length($title) > 50) {
4305                                 $title =~ s/^Automatic //;
4306                                 $title =~ s/^merge (of|with) /Merge ... /i;
4307                                 if (length($title) > 50) {
4308                                         $title =~ s/(http|rsync):\/\///;
4309                                 }
4310                                 if (length($title) > 50) {
4311                                         $title =~ s/(master|www|rsync)\.//;
4312                                 }
4313                                 if (length($title) > 50) {
4314                                         $title =~ s/kernel.org:?//;
4315                                 }
4316                                 if (length($title) > 50) {
4317                                         $title =~ s/\/pub\/scm//;
4318                                 }
4319                         }
4320                         $co{'title_short'} = chop_str($title, 50, 5);
4321                         last;
4322                 }
4323         }
4324         if (! defined $co{'title'} || $co{'title'} eq "") {
4325                 $co{'title'} = $co{'title_short'} = '(no commit message)';
4326         }
4327         # remove added spaces
4328         foreach my $line (@commit_lines) {
4329                 $line =~ s/^    //;
4330         }
4331         $co{'comment'} = \@commit_lines;
4332
4333         my $age_epoch = $co{'committer_epoch'};
4334         $co{'age_epoch'} = $age_epoch;
4335         my $time_now = time;
4336         $co{'age_string'} = age_string($age_epoch, $time_now);
4337         $co{'age_string_date'} = age_string_date($age_epoch, $time_now);
4338         $co{'age_string_age'} = age_string_age($age_epoch, $time_now);
4339         return %co;
4340 }
4341
4342 sub parse_commit {
4343         my ($commit_id) = @_;
4344         my %co;
4345
4346         local $/ = "\0";
4347
4348         defined(my $fd = git_cmd_pipe "rev-list",
4349                 "--parents",
4350                 "--header",
4351                 "--max-count=1",
4352                 $commit_id,
4353                 "--")
4354                 or die_error(500, "Open git-rev-list failed");
4355         %co = parse_commit_text(<$fd>, 1);
4356         close $fd;
4357
4358         return %co;
4359 }
4360
4361 sub parse_commits {
4362         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
4363         my @cos;
4364
4365         $maxcount ||= 1;
4366         $skip ||= 0;
4367
4368         local $/ = "\0";
4369
4370         defined(my $fd = git_cmd_pipe "rev-list",
4371                 "--header",
4372                 @args,
4373                 ("--max-count=" . $maxcount),
4374                 ("--skip=" . $skip),
4375                 @extra_options,
4376                 $commit_id,
4377                 "--",
4378                 ($filename ? ($filename) : ()))
4379                 or die_error(500, "Open git-rev-list failed");
4380         while (my $line = <$fd>) {
4381                 my %co = parse_commit_text($line);
4382                 push @cos, \%co;
4383         }
4384         close $fd;
4385
4386         return wantarray ? @cos : \@cos;
4387 }
4388
4389 # parse line of git-diff-tree "raw" output
4390 sub parse_difftree_raw_line {
4391         my $line = shift;
4392         my %res;
4393
4394         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
4395         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
4396         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
4397                 $res{'from_mode'} = $1;
4398                 $res{'to_mode'} = $2;
4399                 $res{'from_id'} = $3;
4400                 $res{'to_id'} = $4;
4401                 $res{'status'} = $5;
4402                 $res{'similarity'} = $6;
4403                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
4404                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
4405                 } else {
4406                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
4407                 }
4408         }
4409         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
4410         # combined diff (for merge commit)
4411         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
4412                 $res{'nparents'}  = length($1);
4413                 $res{'from_mode'} = [ split(' ', $2) ];
4414                 $res{'to_mode'} = pop @{$res{'from_mode'}};
4415                 $res{'from_id'} = [ split(' ', $3) ];
4416                 $res{'to_id'} = pop @{$res{'from_id'}};
4417                 $res{'status'} = [ split('', $4) ];
4418                 $res{'to_file'} = unquote($5);
4419         }
4420         # 'c512b523472485aef4fff9e57b229d9d243c967f'
4421         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
4422                 $res{'commit'} = $1;
4423         }
4424
4425         return wantarray ? %res : \%res;
4426 }
4427
4428 # wrapper: return parsed line of git-diff-tree "raw" output
4429 # (the argument might be raw line, or parsed info)
4430 sub parsed_difftree_line {
4431         my $line_or_ref = shift;
4432
4433         if (ref($line_or_ref) eq "HASH") {
4434                 # pre-parsed (or generated by hand)
4435                 return $line_or_ref;
4436         } else {
4437                 return parse_difftree_raw_line($line_or_ref);
4438         }
4439 }
4440
4441 # parse line of git-ls-tree output
4442 sub parse_ls_tree_line {
4443         my $line = shift;
4444         my %opts = @_;
4445         my %res;
4446
4447         if ($opts{'-l'}) {
4448                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
4449                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
4450
4451                 $res{'mode'} = $1;
4452                 $res{'type'} = $2;
4453                 $res{'hash'} = $3;
4454                 $res{'size'} = $4;
4455                 if ($opts{'-z'}) {
4456                         $res{'name'} = $5;
4457                 } else {
4458                         $res{'name'} = unquote($5);
4459                 }
4460         } else {
4461                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
4462                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
4463
4464                 $res{'mode'} = $1;
4465                 $res{'type'} = $2;
4466                 $res{'hash'} = $3;
4467                 if ($opts{'-z'}) {
4468                         $res{'name'} = $4;
4469                 } else {
4470                         $res{'name'} = unquote($4);
4471                 }
4472         }
4473
4474         return wantarray ? %res : \%res;
4475 }
4476
4477 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4478 sub parse_from_to_diffinfo {
4479         my ($diffinfo, $from, $to, @parents) = @_;
4480
4481         if ($diffinfo->{'nparents'}) {
4482                 # combined diff
4483                 $from->{'file'} = [];
4484                 $from->{'href'} = [];
4485                 fill_from_file_info($diffinfo, @parents)
4486                         unless exists $diffinfo->{'from_file'};
4487                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4488                         $from->{'file'}[$i] =
4489                                 defined $diffinfo->{'from_file'}[$i] ?
4490                                         $diffinfo->{'from_file'}[$i] :
4491                                         $diffinfo->{'to_file'};
4492                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4493                                 $from->{'href'}[$i] = href(action=>"blob",
4494                                                            hash_base=>$parents[$i],
4495                                                            hash=>$diffinfo->{'from_id'}[$i],
4496                                                            file_name=>$from->{'file'}[$i]);
4497                         } else {
4498                                 $from->{'href'}[$i] = undef;
4499                         }
4500                 }
4501         } else {
4502                 # ordinary (not combined) diff
4503                 $from->{'file'} = $diffinfo->{'from_file'};
4504                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4505                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4506                                                hash=>$diffinfo->{'from_id'},
4507                                                file_name=>$from->{'file'});
4508                 } else {
4509                         delete $from->{'href'};
4510                 }
4511         }
4512
4513         $to->{'file'} = $diffinfo->{'to_file'};
4514         if (!is_deleted($diffinfo)) { # file exists in result
4515                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4516                                      hash=>$diffinfo->{'to_id'},
4517                                      file_name=>$to->{'file'});
4518         } else {
4519                 delete $to->{'href'};
4520         }
4521 }
4522
4523 ## ......................................................................
4524 ## parse to array of hashes functions
4525
4526 sub git_get_heads_list {
4527         my ($limit, @classes) = @_;
4528         @classes = get_branch_refs() unless @classes;
4529         my @patterns = map { "refs/$_" } @classes;
4530         my @headslist;
4531
4532         defined(my $fd = git_cmd_pipe 'for-each-ref',
4533                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4534                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4535                 @patterns)
4536                 or return;
4537         while (my $line = to_utf8(scalar <$fd>)) {
4538                 my %ref_item;
4539
4540                 chomp $line;
4541                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4542                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4543                 my ($committer, $epoch, $tz) =
4544                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4545                 $ref_item{'fullname'}  = $name;
4546                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4547                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4548                 $ref_item{'name'} = $name;
4549                 # for refs neither in 'heads' nor 'remotes' we want to
4550                 # show their ref dir
4551                 my $ref_dir = (defined $1) ? $1 : '';
4552                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4553                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4554                 }
4555
4556                 $ref_item{'id'}    = $hash;
4557                 $ref_item{'title'} = $title || '(no commit message)';
4558                 $ref_item{'epoch'} = $epoch;
4559                 if ($epoch) {
4560                         $ref_item{'age'} = age_string($ref_item{'epoch'});
4561                 } else {
4562                         $ref_item{'age'} = "unknown";
4563                 }
4564
4565                 push @headslist, \%ref_item;
4566         }
4567         close $fd;
4568
4569         return wantarray ? @headslist : \@headslist;
4570 }
4571
4572 sub git_get_tags_list {
4573         my $limit = shift;
4574         my @tagslist;
4575         my $all = shift || 0;
4576         my $order = shift || $default_refs_order;
4577         my $sortkey = $all && $order eq 'name' ? 'refname' : '-creatordate';
4578
4579         defined(my $fd = git_cmd_pipe 'for-each-ref',
4580                 ($limit ? '--count='.($limit+1) : ()), "--sort=$sortkey",
4581                 '--format=%(objectname) %(objecttype) %(refname) '.
4582                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4583                 ($all ? 'refs' : 'refs/tags'))
4584                 or return;
4585         while (my $line = to_utf8(scalar <$fd>)) {
4586                 my %ref_item;
4587
4588                 chomp $line;
4589                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4590                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4591                 my ($creator, $epoch, $tz) =
4592                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4593                 $ref_item{'fullname'} = $name;
4594                 $name =~ s!^refs/!! if $all;
4595                 $name =~ s!^refs/tags/!! unless $all;
4596
4597                 $ref_item{'type'} = $type;
4598                 $ref_item{'id'} = $id;
4599                 $ref_item{'name'} = $name;
4600                 if ($type eq "tag") {
4601                         $ref_item{'subject'} = $title;
4602                         $ref_item{'reftype'} = $reftype;
4603                         $ref_item{'refid'}   = $refid;
4604                 } else {
4605                         $ref_item{'reftype'} = $type;
4606                         $ref_item{'refid'}   = $id;
4607                 }
4608
4609                 if ($type eq "tag" || $type eq "commit") {
4610                         $ref_item{'epoch'} = $epoch;
4611                         if ($epoch) {
4612                                 $ref_item{'age'} = age_string($ref_item{'epoch'});
4613                         } else {
4614                                 $ref_item{'age'} = "unknown";
4615                         }
4616                 }
4617
4618                 push @tagslist, \%ref_item;
4619         }
4620         close $fd;
4621
4622         return wantarray ? @tagslist : \@tagslist;
4623 }
4624
4625 ## ----------------------------------------------------------------------
4626 ## filesystem-related functions
4627
4628 sub get_file_owner {
4629         my $path = shift;
4630
4631         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4632         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4633         if (!defined $gcos) {
4634                 return undef;
4635         }
4636         my $owner = $gcos;
4637         $owner =~ s/[,;].*$//;
4638         return to_utf8($owner);
4639 }
4640
4641 # assume that file exists
4642 sub insert_file {
4643         my $filename = shift;
4644
4645         open my $fd, '<', $filename;
4646         while (<$fd>) {
4647                 print to_utf8($_);
4648         }
4649         close $fd;
4650 }
4651
4652 # return undef on failure
4653 sub collect_output {
4654         defined(my $fd = cmd_pipe @_) or return undef;
4655         if (eof $fd) {
4656                 close $fd;
4657                 return undef;
4658         }
4659         my $result = join('', map({ to_utf8($_) } <$fd>));
4660         close $fd or return undef;
4661         return $result;
4662 }
4663
4664 # return undef on failure
4665 # return '' if only comments
4666 sub collect_html_file {
4667         my $filename = shift;
4668
4669         open my $fd, '<', $filename or return undef;
4670         my $result = join('', map({ to_utf8($_) } <$fd>));
4671         close $fd or return undef;
4672         return undef unless defined($result);
4673         my $test = $result;
4674         $test =~ s/<!--(?:[^-]|(?:-(?!-)))*-->//gs;
4675         $test =~ s/\s+//s;
4676         return $test eq '' ? '' : $result;
4677 }
4678
4679 ## ......................................................................
4680 ## mimetype related functions
4681
4682 sub mimetype_guess_file {
4683         my $filename = shift;
4684         my $mimemap = shift;
4685         my $rawmode = shift;
4686         -r $mimemap or return undef;
4687
4688         my %mimemap;
4689         open(my $mh, '<', $mimemap) or return undef;
4690         while (<$mh>) {
4691                 next if m/^#/; # skip comments
4692                 my ($mimetype, @exts) = split(/\s+/);
4693                 foreach my $ext (@exts) {
4694                         $mimemap{$ext} = $mimetype;
4695                 }
4696         }
4697         close($mh);
4698
4699         my ($ext, $ans);
4700         $ext = $1 if $filename =~ /\.([^.]*)$/;
4701         $ans = $mimemap{$ext} if $ext;
4702         if (defined $ans) {
4703                 my $l = lc($ans);
4704                 $ans = 'text/html' if $l eq 'application/xhtml+xml';
4705                 if (!$rawmode) {
4706                         $ans = 'text/xml' if $l =~ m!^application/[^\s:;,=]+\+xml$! ||
4707                                              $l eq 'image/svg+xml' ||
4708                                              $l eq 'application/xml-dtd' ||
4709                                              $l eq 'application/xml-external-parsed-entity';
4710                 }
4711         }
4712         return $ans;
4713 }
4714
4715 sub mimetype_guess {
4716         my $filename = shift;
4717         my $rawmode = shift;
4718         my $mime;
4719         $filename =~ /\./ or return undef;
4720
4721         if ($mimetypes_file) {
4722                 my $file = $mimetypes_file;
4723                 if ($file !~ m!^/!) { # if it is relative path
4724                         # it is relative to project
4725                         $file = "$projectroot/$project/$file";
4726                 }
4727                 $mime = mimetype_guess_file($filename, $file, $rawmode);
4728         }
4729         $mime ||= mimetype_guess_file($filename, '/etc/mime.types', $rawmode);
4730         return $mime;
4731 }
4732
4733 sub blob_mimetype {
4734         my $fd = shift;
4735         my $filename = shift;
4736         my $rawmode = shift;
4737         my $mime;
4738
4739         # The -T/-B file operators produce the wrong result unless a perlio
4740         # layer is present when the file handle is a pipe that delivers less
4741         # than 512 bytes of data before reaching EOF.
4742         #
4743         # If we are running in a Perl that uses the stdio layer rather than the
4744         # unix+perlio layers we will end up adding a perlio layer on top of the
4745         # stdio layer and get a second level of buffering.  This is harmless
4746         # and it makes the -T/-B file operators work properly in all cases.
4747
4748         binmode $fd, ":perlio" or die_error(500, "Adding perlio layer failed")
4749                 unless grep /^perlio$/, PerlIO::get_layers($fd);
4750
4751         $mime = mimetype_guess($filename, $rawmode) if defined $filename;
4752
4753         if (!$mime && $filename) {
4754                 if ($filename =~ m/\.html?$/i) {
4755                         $mime = 'text/html';
4756                 } elsif ($filename =~ m/\.xht(?:ml)?$/i) {
4757                         $mime = 'text/html';
4758                 } elsif ($filename =~ m/\.te?xt?$/i) {
4759                         $mime = 'text/plain';
4760                 } elsif ($filename =~ m/\.(?:markdown|md)$/i) {
4761                         $mime = 'text/plain';
4762                 } elsif ($filename =~ m/\.png$/i) {
4763                         $mime = 'image/png';
4764                 } elsif ($filename =~ m/\.gif$/i) {
4765                         $mime = 'image/gif';
4766                 } elsif ($filename =~ m/\.jpe?g$/i) {
4767                         $mime = 'image/jpeg';
4768                 } elsif ($filename =~ m/\.svgz?$/i) {
4769                         $mime = 'image/svg+xml';
4770                 }
4771         }
4772
4773         # just in case
4774         return $default_blob_plain_mimetype || 'application/octet-stream' unless $fd || $mime;
4775
4776         $mime = -T $fd ? 'text/plain' : 'application/octet-stream' unless $mime;
4777
4778         return $mime;
4779 }
4780
4781 sub is_ascii {
4782         use bytes;
4783         my $data = shift;
4784         return scalar($data =~ /^[\x00-\x7f]*$/);
4785 }
4786
4787 sub is_valid_utf8 {
4788         my $data = shift;
4789         return utf8::decode($data);
4790 }
4791
4792 sub extract_html_charset {
4793         return undef unless $_[0] && "$_[0]</head>" =~ m#<head(?:\s+[^>]*)?(?<!/)>(.*?)</head\s*>#is;
4794         my $head = $1;
4795         return $2 if $head =~ m#<meta\s+charset\s*=\s*(['"])\s*([a-z0-9(:)_.+-]+)\s*\1\s*/?>#is;
4796         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) {
4797                 my %kv = (lc($1) => $3, lc($4) => $6);
4798                 my ($he, $c) = (lc($kv{'http-equiv'}), $kv{'content'});
4799                 return $1 if $he && $c && $he eq 'content-type' &&
4800                         $c =~ m!\s*text/html\s*;\s*charset\s*=\s*([a-z0-9(:)_.+-]+)\s*$!is;
4801         }
4802         return undef;
4803 }
4804
4805 sub blob_contenttype {
4806         my ($fd, $file_name, $type) = @_;
4807
4808         $type ||= blob_mimetype($fd, $file_name, 1);
4809         return $type unless $type =~ m!^text/.+!i;
4810         my ($leader, $charset, $htmlcharset);
4811         if ($fd && read($fd, $leader, 32768)) {{
4812                 $charset='US-ASCII' if is_ascii($leader);
4813                 return ("$type; charset=UTF-8", $leader) if !$charset && is_valid_utf8($leader);
4814                 $charset='ISO-8859-1' unless $charset;
4815                 $htmlcharset = extract_html_charset($leader) if $type eq 'text/html';
4816                 if ($htmlcharset && $charset ne 'US-ASCII') {
4817                         $htmlcharset = undef if $htmlcharset =~ /^(?:utf-8|us-ascii)$/i
4818                 }
4819         }}
4820         return ("$type; charset=$htmlcharset", $leader) if $htmlcharset;
4821         my $defcharset = $default_text_plain_charset || '';
4822         $defcharset =~ s/^\s+//;
4823         $defcharset =~ s/\s+$//;
4824         $defcharset = '' if $charset && $charset ne 'US-ASCII' && $defcharset =~ /^(?:utf-8|us-ascii)$/i;
4825         return ("$type; charset=" . ($defcharset || 'ISO-8859-1'), $leader);
4826 }
4827
4828 # peek the first upto 128 bytes off a file handle
4829 sub peek128bytes {
4830         my $fd = shift;
4831
4832         use IO::Handle;
4833         use bytes;
4834
4835         my $prefix128;
4836         return '' unless $fd && read($fd, $prefix128, 128);
4837
4838         # In the general case, we're guaranteed only to be able to ungetc one
4839         # character (provided, of course, we actually got a character first).
4840         #
4841         # However, we know:
4842         #
4843         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4844         #    already been called at least once on the file handle before us
4845         #
4846         # 2) we have an $fd positioned at the start of the input stream and
4847         #    therefore know we were positioned at a buffer boundary before
4848         #    reading the initial upto 128 bytes
4849         #
4850         # 3) the buffer size is at least 512 bytes
4851         #
4852         # 4) we are careful to only unget raw bytes
4853         #
4854         # 5) we are attempting to unget exactly the same number of bytes we got
4855         #
4856         # Given the above conditions we will ALWAYS be able to safely unget
4857         # the $prefix128 value we just got.
4858         #
4859         # In fact, we could read up to 511 bytes and still be sure.
4860         # (Reading 512 might pop us into the next internal buffer, but probably
4861         # not since that could break the always able to unget at least the one
4862         # you just got guarantee.)
4863
4864         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4865
4866         return $prefix128;
4867 }
4868
4869 # guess file syntax for syntax highlighting; return undef if no highlighting
4870 # the name of syntax can (in the future) depend on syntax highlighter used
4871 sub guess_file_syntax {
4872         my ($fd, $mimetype, $file_name) = @_;
4873         return undef unless $fd && defined $file_name &&
4874                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4875         my $basename = basename($file_name, '.in');
4876         return $highlight_basename{$basename}
4877                 if exists $highlight_basename{$basename};
4878
4879         # Peek to see if there's a shebang or xml line.
4880         # We always operate on bytes when testing this.
4881         {
4882                 use bytes;
4883                 my $shebang = peek128bytes($fd);
4884                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4885                         foreach my $key (keys %highlight_shebang) {
4886                                 my $ar = ref($highlight_shebang{$key}) ?
4887                                         $highlight_shebang{$key} :
4888                                         [$highlight_shebang{key}];
4889                                 map {return $key if $shebang =~ /$_/} @$ar;
4890                         }
4891                 }
4892                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4893         }
4894
4895         $basename =~ /\.([^.]*)$/;
4896         my $ext = $1 or return undef;
4897         return $highlight_ext{$ext}
4898                 if exists $highlight_ext{$ext};
4899
4900         return undef;
4901 }
4902
4903 # run highlighter and return FD of its output,
4904 # or return original FD if no highlighting
4905 sub run_highlighter {
4906         my ($fd, $syntax) = @_;
4907         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4908
4909         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4910                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4911                 $to_utf8_pipe_command.
4912                 quote_command($highlight_bin).
4913                 " --replace-tabs=8 --fragment --syntax $syntax")
4914                 or die_error(500, "Couldn't open file or run syntax highlighter");
4915         if (eof $hifd) {
4916                 # just in case, should not happen as we tested !eof($fd) above
4917                 return $fd if close($hifd);
4918
4919                 # should not happen
4920                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4921
4922                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4923                 # instead of dying horribly on this, just skip the highlighting
4924                 # but do output a message about it to STDERR that will end up in the log
4925                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4926                         sprintf("child exit status 0x%x\n", $?);
4927                 return $fd
4928         }
4929         close $fd;
4930         return ($hifd, 1);
4931 }
4932
4933 ## ======================================================================
4934 ## functions printing HTML: header, footer, error page
4935
4936 sub get_page_title {
4937         my $title = to_utf8($site_name);
4938
4939         unless (defined $project) {
4940                 if (defined $project_filter) {
4941                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4942                 }
4943                 return $title;
4944         }
4945         $title .= " - " . to_utf8($project);
4946
4947         return $title unless (defined $action);
4948         my $action_print = $action eq 'blame_incremental' ? 'blame' : $action;
4949         $title .= "/$action_print"; # $action is US-ASCII (7bit ASCII)
4950
4951         return $title unless (defined $file_name);
4952         $title .= " - " . esc_path($file_name);
4953         if ($action eq "tree" && $file_name !~ m|/$|) {
4954                 $title .= "/";
4955         }
4956
4957         return $title;
4958 }
4959
4960 sub get_content_type_html {
4961         # We do not ever emit application/xhtml+xml since that gives us
4962         # no benefits and it makes many browsers (e.g. Firefox) exceedingly
4963         # strict, which is troublesome for example when showing user-supplied
4964         # README.html files.
4965         return 'text/html';
4966 }
4967
4968 sub print_feed_meta {
4969         if (defined $project) {
4970                 my %href_params = get_feed_info();
4971                 if (!exists $href_params{'-title'}) {
4972                         $href_params{'-title'} = 'log';
4973                 }
4974
4975                 foreach my $format (qw(RSS Atom)) {
4976                         my $type = lc($format);
4977                         my %link_attr = (
4978                                 '-rel' => 'alternate',
4979                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
4980                                 '-type' => "application/$type+xml"
4981                         );
4982
4983                         $href_params{'extra_options'} = undef;
4984                         $href_params{'action'} = $type;
4985                         $link_attr{'-href'} = href(%href_params);
4986                         print "<link ".
4987                               "rel=\"$link_attr{'-rel'}\" ".
4988                               "title=\"$link_attr{'-title'}\" ".
4989                               "href=\"$link_attr{'-href'}\" ".
4990                               "type=\"$link_attr{'-type'}\" ".
4991                               "/>\n";
4992
4993                         $href_params{'extra_options'} = '--no-merges';
4994                         $link_attr{'-href'} = href(%href_params);
4995                         $link_attr{'-title'} .= ' (no merges)';
4996                         print "<link ".
4997                               "rel=\"$link_attr{'-rel'}\" ".
4998                               "title=\"$link_attr{'-title'}\" ".
4999                               "href=\"$link_attr{'-href'}\" ".
5000                               "type=\"$link_attr{'-type'}\" ".
5001                               "/>\n";
5002                 }
5003
5004         } else {
5005                 printf('<link rel="alternate" title="%s projects list" '.
5006                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
5007                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
5008                 printf('<link rel="alternate" title="%s projects feeds" '.
5009                        'href="%s" type="text/x-opml" />'."\n",
5010                        esc_attr($site_name), href(project=>undef, action=>"opml"));
5011         }
5012 }
5013
5014 sub print_header_links {
5015         my $status = shift;
5016
5017         # print out each stylesheet that exist, providing backwards capability
5018         # for those people who defined $stylesheet in a config file
5019         if (defined $stylesheet) {
5020                 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
5021         } else {
5022                 foreach my $stylesheet (@stylesheets) {
5023                         next unless $stylesheet;
5024                         print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
5025                 }
5026         }
5027         print_feed_meta()
5028                 if ($status eq '200 OK');
5029         if (defined $favicon) {
5030                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
5031         }
5032 }
5033
5034 sub print_nav_breadcrumbs_path {
5035         my $dirprefix = undef;
5036         while (my $part = shift) {
5037                 $dirprefix .= "/" if defined $dirprefix;
5038                 $dirprefix .= $part;
5039                 print $cgi->a({-href => href(project => undef,
5040                                              project_filter => $dirprefix,
5041                                              action => "project_list")},
5042                               esc_html($part)) . " / ";
5043         }
5044 }
5045
5046 sub print_nav_breadcrumbs {
5047         my %opts = @_;
5048
5049         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
5050                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
5051         }
5052         if (defined $project) {
5053                 my @dirname = split '/', $project;
5054                 my $projectbasename = pop @dirname;
5055                 print_nav_breadcrumbs_path(@dirname);
5056                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
5057                 if (defined $action) {
5058                         my $action_print = $action ;
5059                         $action_print = 'blame' if $action_print eq 'blame_incremental';
5060                         if (defined $opts{-action_extra}) {
5061                                 $action_print = $cgi->a({-href => href(action=>$action)},
5062                                         $action);
5063                         }
5064                         print " / $action_print";
5065                 }
5066                 if (defined $opts{-action_extra}) {
5067                         print " / $opts{-action_extra}";
5068                 }
5069                 print "\n";
5070         } elsif (defined $project_filter) {
5071                 print_nav_breadcrumbs_path(split '/', $project_filter);
5072         }
5073 }
5074
5075 sub print_search_form {
5076         if (!defined $searchtext) {
5077                 $searchtext = "";
5078         }
5079         my $search_hash;
5080         if (defined $hash_base) {
5081                 $search_hash = $hash_base;
5082         } elsif (defined $hash) {
5083                 $search_hash = $hash;
5084         } else {
5085                 $search_hash = "HEAD";
5086         }
5087         # We can't use href() here because we need to encode the
5088         # URL parameters into the form, not into the action link.
5089         my $action = $my_uri;
5090         my $use_pathinfo = gitweb_check_feature('pathinfo');
5091         if ($use_pathinfo) {
5092                 # See notes about doubled / in href()
5093                 $action =~ s,/$,,;
5094                 $action .= "/".esc_path_info($project);
5095         }
5096         print $cgi->start_form(-method => "get", -action => $action) .
5097               "<div class=\"search\">\n" .
5098               (!$use_pathinfo &&
5099               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
5100               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
5101               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
5102               $cgi->popup_menu(-name => 'st', -default => 'commit',
5103                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
5104               " " . $cgi->a({-href => href(action=>"search_help"),
5105                              -title => "search help" }, "?") . " search:\n",
5106               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
5107               "<span title=\"Extended regular expression\">" .
5108               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5109                              -checked => $search_use_regexp) .
5110               "</span>" .
5111               "</div>" .
5112               $cgi->end_form() . "\n";
5113 }
5114
5115 sub git_header_html {
5116         my $status = shift || "200 OK";
5117         my $expires = shift;
5118         my %opts = @_;
5119
5120         my $title = get_page_title();
5121         my $content_type = get_content_type_html();
5122         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
5123                            -status=> $status, -expires => $expires)
5124                 unless ($opts{'-no_http_header'});
5125         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
5126         print <<EOF;
5127 <?xml version="1.0" encoding="utf-8"?>
5128 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
5129 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
5130 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
5131 <!-- git core binaries version $git_version -->
5132 <head>
5133 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
5134 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
5135 <meta name="robots" content="index, nofollow"/>
5136 <title>$title</title>
5137 <script type="text/javascript">/* <![CDATA[ */
5138 function fixBlameLinks() {
5139         var allLinks = document.getElementsByTagName("a");
5140         for (var i = 0; i < allLinks.length; i++) {
5141                 var link = allLinks.item(i);
5142                 if (link.className == 'blamelink')
5143                         link.href = link.href.replace("/blame/", "/blame_incremental/");
5144         }
5145 }
5146 /* ]]> */</script>
5147 EOF
5148         # the stylesheet, favicon etc urls won't work correctly with path_info
5149         # unless we set the appropriate base URL
5150         if ($ENV{'PATH_INFO'}) {
5151                 print "<base href=\"".esc_url($base_url)."\" />\n";
5152         }
5153         print_header_links($status);
5154
5155         if (defined $site_html_head_string) {
5156                 print to_utf8($site_html_head_string);
5157         }
5158
5159         print "</head>\n" .
5160               "<body>\n";
5161
5162         if (defined $site_header && -f $site_header) {
5163                 insert_file($site_header);
5164         }
5165
5166         print "<div class=\"page_header\">\n";
5167         if (defined $logo) {
5168                 print $cgi->a({-href => esc_url($logo_url),
5169                                -title => $logo_label},
5170                               $cgi->img({-src => esc_url($logo),
5171                                          -width => 72, -height => 27,
5172                                          -alt => "git",
5173                                          -class => "logo"}));
5174         }
5175         print_nav_breadcrumbs(%opts);
5176         print "</div>\n";
5177
5178         my $have_search = gitweb_check_feature('search');
5179         if (defined $project && $have_search) {
5180                 print_search_form();
5181         }
5182 }
5183
5184 sub compute_timed_interval {
5185         return "<?gitweb compute_timed_interval?>" if $cache_mode_active;
5186         return tv_interval($t0, [ gettimeofday() ]);
5187 }
5188
5189 sub compute_commands_count {
5190         return "<?gitweb compute_commands_count?>" if $cache_mode_active;
5191         my $s = $number_of_git_cmds == 1 ? '' : 's';
5192         return '<span id="generating_cmd">'.
5193                 $number_of_git_cmds.
5194                 "</span> git command$s";
5195 }
5196
5197 sub git_footer_html {
5198         my $feed_class = 'rss_logo';
5199
5200         print "<div class=\"page_footer\">\n";
5201         if (defined $project) {
5202                 my $descr = git_get_project_description($project);
5203                 if (defined $descr) {
5204                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
5205                 }
5206
5207                 my %href_params = get_feed_info();
5208                 if (!%href_params) {
5209                         $feed_class .= ' generic';
5210                 }
5211                 $href_params{'-title'} ||= 'log';
5212
5213                 foreach my $format (qw(RSS Atom)) {
5214                         $href_params{'action'} = lc($format);
5215                         print $cgi->a({-href => href(%href_params),
5216                                       -title => "$href_params{'-title'} $format feed",
5217                                       -class => $feed_class}, $format)."\n";
5218                 }
5219
5220         } else {
5221                 print $cgi->a({-href => href(project=>undef, action=>"opml",
5222                                              project_filter => $project_filter),
5223                               -class => $feed_class}, "OPML") . " ";
5224                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
5225                                              project_filter => $project_filter),
5226                               -class => $feed_class}, "TXT") . "\n";
5227         }
5228         print "</div>\n"; # class="page_footer"
5229
5230         if (defined $t0 && gitweb_check_feature('timed')) {
5231                 print "<div id=\"generating_info\">\n";
5232                 print 'This page took '.
5233                       '<span id="generating_time" class="time_span">'.
5234                       compute_timed_interval().
5235                       ' seconds </span>'.
5236                       ' and '.
5237                       compute_commands_count().
5238                       " to generate.\n";
5239                 print "</div>\n"; # class="page_footer"
5240         }
5241
5242         if (defined $site_footer && -f $site_footer) {
5243                 insert_file($site_footer);
5244         }
5245
5246         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
5247         if (defined $action &&
5248             $action eq 'blame_incremental') {
5249                 print qq!<script type="text/javascript">\n!.
5250                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
5251                       qq!           "!. href() .qq!");\n!.
5252                       qq!</script>\n!;
5253         } else {
5254                 my ($jstimezone, $tz_cookie, $datetime_class) =
5255                         gitweb_get_feature('javascript-timezone');
5256
5257                 print qq!<script type="text/javascript">\n!.
5258                       qq!window.onload = function () {\n!;
5259                 if (gitweb_check_feature('blame_incremental')) {
5260                         print qq!       fixBlameLinks();\n!;
5261                 }
5262                 if (gitweb_check_feature('javascript-actions')) {
5263                         print qq!       fixLinks();\n!;
5264                 }
5265                 if ($jstimezone && $tz_cookie && $datetime_class) {
5266                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
5267                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
5268                 }
5269                 print qq!};\n!.
5270                       qq!</script>\n!;
5271         }
5272
5273         print "</body>\n" .
5274               "</html>";
5275 }
5276
5277 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
5278 # Example: die_error(404, 'Hash not found')
5279 # By convention, use the following status codes (as defined in RFC 2616):
5280 # 400: Invalid or missing CGI parameters, or
5281 #      requested object exists but has wrong type.
5282 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
5283 #      this server or project.
5284 # 404: Requested object/revision/project doesn't exist.
5285 # 500: The server isn't configured properly, or
5286 #      an internal error occurred (e.g. failed assertions caused by bugs), or
5287 #      an unknown error occurred (e.g. the git binary died unexpectedly).
5288 # 503: The server is currently unavailable (because it is overloaded,
5289 #      or down for maintenance).  Generally, this is a temporary state.
5290 sub die_error {
5291         my $status = shift || 500;
5292         my $error = esc_html(shift) || "Internal Server Error";
5293         my $extra = shift;
5294         my %opts = @_;
5295
5296         my %http_responses = (
5297                 400 => '400 Bad Request',
5298                 403 => '403 Forbidden',
5299                 404 => '404 Not Found',
5300                 500 => '500 Internal Server Error',
5301                 503 => '503 Service Unavailable',
5302         );
5303         git_header_html($http_responses{$status}, undef, %opts);
5304         print <<EOF;
5305 <div class="page_body">
5306 <br /><br />
5307 $status - $error
5308 <br />
5309 EOF
5310         if (defined $extra) {
5311                 print "<hr />\n" .
5312                       "$extra\n";
5313         }
5314         print "</div>\n";
5315
5316         git_footer_html();
5317         CORE::die
5318                 unless ($opts{'-error_handler'});
5319 }
5320
5321 ## ----------------------------------------------------------------------
5322 ## functions printing or outputting HTML: navigation
5323
5324 sub git_print_page_nav {
5325         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
5326         $extra = '' if !defined $extra; # pager or formats
5327
5328         my @navs = qw(summary log commit commitdiff tree refs);
5329         if ($suppress) {
5330                 my %omit;
5331                 if (ref($suppress) eq 'ARRAY') {
5332                         %omit = map { ($_ => 1) } @$suppress;
5333                 } else {
5334                         %omit = ($suppress => 1);
5335                 }
5336                 @navs = grep { !$omit{$_} } @navs;
5337         }
5338
5339         my %arg = map { $_ => {action=>$_} } @navs;
5340         if (defined $head) {
5341                 for (qw(commit commitdiff)) {
5342                         $arg{$_}{'hash'} = $head;
5343                 }
5344                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
5345                         $arg{'log'}{'hash'} = $head;
5346                 }
5347         }
5348
5349         $arg{'log'}{'action'} = 'shortlog';
5350         if ($current eq 'log') {
5351                 $current = 'shortlog';
5352         } elsif ($current eq 'shortlog') {
5353                 $current = 'log';
5354         }
5355         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
5356         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
5357
5358         my @actions = gitweb_get_feature('actions');
5359         my $escname = $project;
5360         $escname =~ s/[+]/%2B/g;
5361         my %repl = (
5362                 '%' => '%',
5363                 'n' => $project,         # project name
5364                 'f' => $git_dir,         # project path within filesystem
5365                 'h' => $treehead || '',  # current hash ('h' parameter)
5366                 'b' => $treebase || '',  # hash base ('hb' parameter)
5367                 'e' => $escname,         # project name with '+' escaped
5368         );
5369         while (@actions) {
5370                 my ($label, $link, $pos) = splice(@actions,0,3);
5371                 # insert
5372                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
5373                 # munch munch
5374                 $link =~ s/%([%nfhbe])/$repl{$1}/g;
5375                 $arg{$label}{'_href'} = $link;
5376         }
5377
5378         print "<div class=\"page_nav\">\n" .
5379                 (join " | ",
5380                  map { $_ eq $current ?
5381                        $_ : $cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_")
5382                  } @navs);
5383         print "<br/>\n$extra<br/>\n" .
5384               "</div>\n";
5385 }
5386
5387 # returns a submenu for the nagivation of the refs views (tags, heads,
5388 # remotes) with the current view disabled and the remotes view only
5389 # available if the feature is enabled
5390 sub format_ref_views {
5391         my ($current) = @_;
5392         my @ref_views = qw{tags heads};
5393         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
5394         return join " | ", map {
5395                 $_ eq $current ? $_ :
5396                 $cgi->a({-href => href(action=>$_)}, $_)
5397         } @ref_views
5398 }
5399
5400 sub format_paging_nav {
5401         my ($action, $page, $has_next_link) = @_;
5402         my $paging_nav;
5403
5404
5405         if ($page > 0) {
5406                 $paging_nav .=
5407                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first") .
5408                         " &#183; " .
5409                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
5410                                  -accesskey => "p", -title => "Alt-p"}, "prev");
5411         } else {
5412                 $paging_nav .= "first &#183; prev";
5413         }
5414
5415         if ($has_next_link) {
5416                 $paging_nav .= " &#183; " .
5417                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
5418                                  -accesskey => "n", -title => "Alt-n"}, "next");
5419         } else {
5420                 $paging_nav .= " &#183; next";
5421         }
5422
5423         return $paging_nav;
5424 }
5425
5426 sub format_log_nav {
5427         my ($action, $page, $has_next_link) = @_;
5428         my $paging_nav;
5429
5430         if ($action eq 'shortlog') {
5431                 $paging_nav .= 'shortlog';
5432         } else {
5433                 $paging_nav .= $cgi->a({-href => href(action=>'shortlog', -replay=>1)}, 'shortlog');
5434         }
5435         $paging_nav .= ' | ';
5436         if ($action eq 'log') {
5437                 $paging_nav .= 'fulllog';
5438         } else {
5439                 $paging_nav .= $cgi->a({-href => href(action=>'log', -replay=>1)}, 'fulllog');
5440         }
5441
5442         $paging_nav .= " | " . format_paging_nav($action, $page, $has_next_link);
5443         return $paging_nav;
5444 }
5445
5446 ## ......................................................................
5447 ## functions printing or outputting HTML: div
5448
5449 sub git_print_header_div {
5450         my ($action, $title, $hash, $hash_base, $extra) = @_;
5451         my %args = ();
5452         defined $extra or $extra = '';
5453
5454         $args{'action'} = $action;
5455         $args{'hash'} = $hash if $hash;
5456         $args{'hash_base'} = $hash_base if $hash_base;
5457
5458         my $link1 = $cgi->a({-href => href(%args), -class => "title"},
5459                             $title ? $title : $action);
5460         my $link2 = $cgi->a({-href => href(%args), -class => "cover"}, "");
5461         print "<div class=\"header\">\n" . '<span class="title">' .
5462               $link1 . $extra . $link2 . '</span>' . "\n</div>\n";
5463 }
5464
5465 sub format_repo_url {
5466         my ($name, $url) = @_;
5467         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
5468 }
5469
5470 # Group output by placing it in a DIV element and adding a header.
5471 # Options for start_div() can be provided by passing a hash reference as the
5472 # first parameter to the function.
5473 # Options to git_print_header_div() can be provided by passing an array
5474 # reference. This must follow the options to start_div if they are present.
5475 # The content can be a scalar, which is output as-is, a scalar reference, which
5476 # is output after html escaping, an IO handle passed either as *handle or
5477 # *handle{IO}, or a function reference. In the latter case all following
5478 # parameters will be taken as argument to the content function call.
5479 sub git_print_section {
5480         my ($div_args, $header_args, $content);
5481         my $arg = shift;
5482         if (ref($arg) eq 'HASH') {
5483                 $div_args = $arg;
5484                 $arg = shift;
5485         }
5486         if (ref($arg) eq 'ARRAY') {
5487                 $header_args = $arg;
5488                 $arg = shift;
5489         }
5490         $content = $arg;
5491
5492         print $cgi->start_div($div_args);
5493         git_print_header_div(@$header_args);
5494
5495         if (ref($content) eq 'CODE') {
5496                 $content->(@_);
5497         } elsif (ref($content) eq 'SCALAR') {
5498                 print esc_html($$content);
5499         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
5500                 while (<$content>) {
5501                         print to_utf8($_);
5502                 }
5503         } elsif (!ref($content) && defined($content)) {
5504                 print $content;
5505         }
5506
5507         print $cgi->end_div;
5508 }
5509
5510 sub format_timestamp_html {
5511         my $date = shift;
5512         my $useatnight = shift;
5513         defined($useatnight) or $useatnight = 1;
5514         my $strtime = $date->{'rfc2822'};
5515
5516         my (undef, undef, $datetime_class) =
5517                 gitweb_get_feature('javascript-timezone');
5518         if ($datetime_class) {
5519                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
5520         }
5521
5522         my $localtime_format = '(%d %02d:%02d %s)';
5523         if ($useatnight && $date->{'hour_local'} < 6) {
5524                 $localtime_format = '(%d <span class="atnight">%02d:%02d</span> %s)';
5525         }
5526         $strtime .= ' ' .
5527                     sprintf($localtime_format, $date->{'mday_local'},
5528                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
5529
5530         return $strtime;
5531 }
5532
5533 sub format_lastrefresh_row {
5534         return "<?gitweb format_lastrefresh_row?>" if $cache_mode_active;
5535         my %rd = parse_file_date('.last_refresh');
5536         if (defined $rd{'rfc2822'}) {
5537                 return "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td>" .
5538                        "<td>".format_timestamp_html(\%rd,0)."</td></tr>";
5539         }
5540         return "";
5541 }
5542
5543 # Outputs the author name and date in long form
5544 sub git_print_authorship {
5545         my $co = shift;
5546         my %opts = @_;
5547         my $tag = $opts{-tag} || 'div';
5548         my $author = $co->{'author_name'};
5549
5550         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
5551         print "<$tag class=\"author_date\">" .
5552               format_search_author($author, "author", esc_html($author)) .
5553               " [".format_timestamp_html(\%ad)."]".
5554               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
5555               "</$tag>\n";
5556 }
5557
5558 # Outputs table rows containing the full author or committer information,
5559 # in the format expected for 'commit' view (& similar).
5560 # Parameters are a commit hash reference, followed by the list of people
5561 # to output information for. If the list is empty it defaults to both
5562 # author and committer.
5563 sub git_print_authorship_rows {
5564         my $co = shift;
5565         # too bad we can't use @people = @_ || ('author', 'committer')
5566         my @people = @_;
5567         @people = ('author', 'committer') unless @people;
5568         foreach my $who (@people) {
5569                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
5570                 print "<tr><td>$who</td><td>" .
5571                       format_search_author($co->{"${who}_name"}, $who,
5572                                            esc_html($co->{"${who}_name"})) . " " .
5573                       format_search_author($co->{"${who}_email"}, $who,
5574                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
5575                       "</td><td rowspan=\"2\">" .
5576                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
5577                       "</td></tr>\n" .
5578                       "<tr>" .
5579                       "<td></td><td>" .
5580                       format_timestamp_html(\%wd) .
5581                       "</td>" .
5582                       "</tr>\n";
5583         }
5584 }
5585
5586 sub git_print_page_path {
5587         my $name = shift;
5588         my $type = shift;
5589         my $hb = shift;
5590
5591
5592         print "<div class=\"page_path\">";
5593         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
5594                       -title => 'tree root'}, to_utf8("[$project]"));
5595         print " / ";
5596         if (defined $name) {
5597                 my @dirname = split '/', $name;
5598                 my $basename = pop @dirname;
5599                 my $fullname = '';
5600
5601                 foreach my $dir (@dirname) {
5602                         $fullname .= ($fullname ? '/' : '') . $dir;
5603                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
5604                                                      hash_base=>$hb),
5605                                       -title => $fullname}, esc_path($dir));
5606                         print " / ";
5607                 }
5608                 if (defined $type && $type eq 'blob') {
5609                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
5610                                                      hash_base=>$hb),
5611                                       -title => $name}, esc_path($basename));
5612                 } elsif (defined $type && $type eq 'tree') {
5613                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
5614                                                      hash_base=>$hb),
5615                                       -title => $name}, esc_path($basename));
5616                         print " / ";
5617                 } else {
5618                         print esc_path($basename);
5619                 }
5620         }
5621         print "<br/></div>\n";
5622 }
5623
5624 sub git_print_log {
5625         my $log = shift;
5626         my %opts = @_;
5627
5628         if ($opts{'-remove_title'}) {
5629                 # remove title, i.e. first line of log
5630                 shift @$log;
5631         }
5632         # remove leading empty lines
5633         while (defined $log->[0] && $log->[0] eq "") {
5634                 shift @$log;
5635         }
5636
5637         # print log
5638         my $skip_blank_line = 0;
5639         foreach my $line (@$log) {
5640                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5641                         if (! $opts{'-remove_signoff'}) {
5642                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5643                                 $skip_blank_line = 1;
5644                         }
5645                         next;
5646                 }
5647
5648                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5649                         if (! $opts{'-remove_signoff'}) {
5650                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5651                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5652                                         "</span><br/>\n";
5653                                 $skip_blank_line = 1;
5654                         }
5655                         next;
5656                 }
5657
5658                 # print only one empty line
5659                 # do not print empty line after signoff
5660                 if ($line eq "") {
5661                         next if ($skip_blank_line);
5662                         $skip_blank_line = 1;
5663                 } else {
5664                         $skip_blank_line = 0;
5665                 }
5666
5667                 print format_log_line_html($line) . "<br/>\n";
5668         }
5669
5670         if ($opts{'-final_empty_line'}) {
5671                 # end with single empty line
5672                 print "<br/>\n" unless $skip_blank_line;
5673         }
5674 }
5675
5676 # return link target (what link points to)
5677 sub git_get_link_target {
5678         my $hash = shift;
5679         my $link_target;
5680
5681         # read link
5682         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5683                 or return;
5684         {
5685                 local $/ = undef;
5686                 $link_target = to_utf8(scalar <$fd>);
5687         }
5688         close $fd
5689                 or return;
5690
5691         return $link_target;
5692 }
5693
5694 # given link target, and the directory (basedir) the link is in,
5695 # return target of link relative to top directory (top tree);
5696 # return undef if it is not possible (including absolute links).
5697 sub normalize_link_target {
5698         my ($link_target, $basedir) = @_;
5699
5700         # absolute symlinks (beginning with '/') cannot be normalized
5701         return if (substr($link_target, 0, 1) eq '/');
5702
5703         # normalize link target to path from top (root) tree (dir)
5704         my $path;
5705         if ($basedir) {
5706                 $path = $basedir . '/' . $link_target;
5707         } else {
5708                 # we are in top (root) tree (dir)
5709                 $path = $link_target;
5710         }
5711
5712         # remove //, /./, and /../
5713         my @path_parts;
5714         foreach my $part (split('/', $path)) {
5715                 # discard '.' and ''
5716                 next if (!$part || $part eq '.');
5717                 # handle '..'
5718                 if ($part eq '..') {
5719                         if (@path_parts) {
5720                                 pop @path_parts;
5721                         } else {
5722                                 # link leads outside repository (outside top dir)
5723                                 return;
5724                         }
5725                 } else {
5726                         push @path_parts, $part;
5727                 }
5728         }
5729         $path = join('/', @path_parts);
5730
5731         return $path;
5732 }
5733
5734 # print tree entry (row of git_tree), but without encompassing <tr> element
5735 sub git_print_tree_entry {
5736         my ($t, $basedir, $hash_base, $have_blame) = @_;
5737
5738         my %base_key = ();
5739         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5740
5741         # The format of a table row is: mode list link.  Where mode is
5742         # the mode of the entry, list is the name of the entry, an href,
5743         # and link is the action links of the entry.
5744
5745         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5746         if (exists $t->{'size'}) {
5747                 print "<td class=\"size\">$t->{'size'}</td>\n";
5748         }
5749         if ($t->{'type'} eq "blob") {
5750                 print "<td class=\"list\">" .
5751                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5752                                                file_name=>"$basedir$t->{'name'}", %base_key),
5753                                 -class => "list"}, esc_path($t->{'name'}));
5754                 if (S_ISLNK(oct $t->{'mode'})) {
5755                         my $link_target = git_get_link_target($t->{'hash'});
5756                         if ($link_target) {
5757                                 my $norm_target = normalize_link_target($link_target, $basedir);
5758                                 if (defined $norm_target) {
5759                                         print " -> " .
5760                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5761                                                                      file_name=>$norm_target),
5762                                                        -title => $norm_target}, esc_path($link_target));
5763                                 } else {
5764                                         print " -> " . esc_path($link_target);
5765                                 }
5766                         }
5767                 }
5768                 print "</td>\n";
5769                 print "<td class=\"link\">";
5770                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5771                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5772                               "blob");
5773                 if ($have_blame) {
5774                         print " | " .
5775                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5776                                                      file_name=>"$basedir$t->{'name'}", %base_key),
5777                                       -class => "blamelink"},
5778                                       "blame");
5779                 }
5780                 if (defined $hash_base) {
5781                         print " | " .
5782                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5783                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5784                                       "history");
5785                 }
5786                 print " | " .
5787                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5788                                                file_name=>"$basedir$t->{'name'}")},
5789                                 "raw");
5790                 print "</td>\n";
5791
5792         } elsif ($t->{'type'} eq "tree") {
5793                 print "<td class=\"list\">";
5794                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5795                                              file_name=>"$basedir$t->{'name'}",
5796                                              %base_key)},
5797                               esc_path($t->{'name'}));
5798                 print "</td>\n";
5799                 print "<td class=\"link\">";
5800                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5801                                              file_name=>"$basedir$t->{'name'}",
5802                                              %base_key)},
5803                               "tree");
5804                 if (defined $hash_base) {
5805                         print " | " .
5806                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5807                                                      file_name=>"$basedir$t->{'name'}")},
5808                                       "history");
5809                 }
5810                 print "</td>\n";
5811         } else {
5812                 # unknown object: we can only present history for it
5813                 # (this includes 'commit' object, i.e. submodule support)
5814                 print "<td class=\"list\">" .
5815                       esc_path($t->{'name'}) .
5816                       "</td>\n";
5817                 print "<td class=\"link\">";
5818                 if (defined $hash_base) {
5819                         print $cgi->a({-href => href(action=>"history",
5820                                                      hash_base=>$hash_base,
5821                                                      file_name=>"$basedir$t->{'name'}")},
5822                                       "history");
5823                 }
5824                 print "</td>\n";
5825         }
5826 }
5827
5828 ## ......................................................................
5829 ## functions printing large fragments of HTML
5830
5831 # get pre-image filenames for merge (combined) diff
5832 sub fill_from_file_info {
5833         my ($diff, @parents) = @_;
5834
5835         $diff->{'from_file'} = [ ];
5836         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5837         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5838                 if ($diff->{'status'}[$i] eq 'R' ||
5839                     $diff->{'status'}[$i] eq 'C') {
5840                         $diff->{'from_file'}[$i] =
5841                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5842                 }
5843         }
5844
5845         return $diff;
5846 }
5847
5848 # is current raw difftree line of file deletion
5849 sub is_deleted {
5850         my $diffinfo = shift;
5851
5852         return $diffinfo->{'to_id'} eq ('0' x 40);
5853 }
5854
5855 # does patch correspond to [previous] difftree raw line
5856 # $diffinfo  - hashref of parsed raw diff format
5857 # $patchinfo - hashref of parsed patch diff format
5858 #              (the same keys as in $diffinfo)
5859 sub is_patch_split {
5860         my ($diffinfo, $patchinfo) = @_;
5861
5862         return defined $diffinfo && defined $patchinfo
5863                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5864 }
5865
5866
5867 sub git_difftree_body {
5868         my ($difftree, $hash, @parents) = @_;
5869         my ($parent) = $parents[0];
5870         my $have_blame = gitweb_check_feature('blame');
5871         print "<div class=\"list_head\">\n";
5872         if ($#{$difftree} > 10) {
5873                 print(($#{$difftree} + 1) . " files changed:\n");
5874         }
5875         print "</div>\n";
5876
5877         print "<table class=\"" .
5878               (@parents > 1 ? "combined " : "") .
5879               "diff_tree\">\n";
5880
5881         # header only for combined diff in 'commitdiff' view
5882         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5883         if ($has_header) {
5884                 # table header
5885                 print "<thead><tr>\n" .
5886                        "<th></th><th></th>\n"; # filename, patchN link
5887                 for (my $i = 0; $i < @parents; $i++) {
5888                         my $par = $parents[$i];
5889                         print "<th>" .
5890                               $cgi->a({-href => href(action=>"commitdiff",
5891                                                      hash=>$hash, hash_parent=>$par),
5892                                        -title => 'commitdiff to parent number ' .
5893                                                   ($i+1) . ': ' . substr($par,0,7)},
5894                                       $i+1) .
5895                               "&#160;</th>\n";
5896                 }
5897                 print "</tr></thead>\n<tbody>\n";
5898         }
5899
5900         my $alternate = 1;
5901         my $patchno = 0;
5902         foreach my $line (@{$difftree}) {
5903                 my $diff = parsed_difftree_line($line);
5904
5905                 if ($alternate) {
5906                         print "<tr class=\"dark\">\n";
5907                 } else {
5908                         print "<tr class=\"light\">\n";
5909                 }
5910                 $alternate ^= 1;
5911
5912                 if (exists $diff->{'nparents'}) { # combined diff
5913
5914                         fill_from_file_info($diff, @parents)
5915                                 unless exists $diff->{'from_file'};
5916
5917                         if (!is_deleted($diff)) {
5918                                 # file exists in the result (child) commit
5919                                 print "<td>" .
5920                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5921                                                              file_name=>$diff->{'to_file'},
5922                                                              hash_base=>$hash),
5923                                               -class => "list"}, esc_path($diff->{'to_file'})) .
5924                                       "</td>\n";
5925                         } else {
5926                                 print "<td>" .
5927                                       esc_path($diff->{'to_file'}) .
5928                                       "</td>\n";
5929                         }
5930
5931                         if ($action eq 'commitdiff') {
5932                                 # link to patch
5933                                 $patchno++;
5934                                 print "<td class=\"link\">" .
5935                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
5936                                               "patch") .
5937                                       " | " .
5938                                       "</td>\n";
5939                         }
5940
5941                         my $has_history = 0;
5942                         my $not_deleted = 0;
5943                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5944                                 my $hash_parent = $parents[$i];
5945                                 my $from_hash = $diff->{'from_id'}[$i];
5946                                 my $from_path = $diff->{'from_file'}[$i];
5947                                 my $status = $diff->{'status'}[$i];
5948
5949                                 $has_history ||= ($status ne 'A');
5950                                 $not_deleted ||= ($status ne 'D');
5951
5952                                 if ($status eq 'A') {
5953                                         print "<td  class=\"link\" align=\"right\"> | </td>\n";
5954                                 } elsif ($status eq 'D') {
5955                                         print "<td class=\"link\">" .
5956                                               $cgi->a({-href => href(action=>"blob",
5957                                                                      hash_base=>$hash,
5958                                                                      hash=>$from_hash,
5959                                                                      file_name=>$from_path)},
5960                                                       "blob" . ($i+1)) .
5961                                               " | </td>\n";
5962                                 } else {
5963                                         if ($diff->{'to_id'} eq $from_hash) {
5964                                                 print "<td class=\"link nochange\">";
5965                                         } else {
5966                                                 print "<td class=\"link\">";
5967                                         }
5968                                         print $cgi->a({-href => href(action=>"blobdiff",
5969                                                                      hash=>$diff->{'to_id'},
5970                                                                      hash_parent=>$from_hash,
5971                                                                      hash_base=>$hash,
5972                                                                      hash_parent_base=>$hash_parent,
5973                                                                      file_name=>$diff->{'to_file'},
5974                                                                      file_parent=>$from_path)},
5975                                                       "diff" . ($i+1)) .
5976                                               " | </td>\n";
5977                                 }
5978                         }
5979
5980                         print "<td class=\"link\">";
5981                         if ($not_deleted) {
5982                                 print $cgi->a({-href => href(action=>"blob",
5983                                                              hash=>$diff->{'to_id'},
5984                                                              file_name=>$diff->{'to_file'},
5985                                                              hash_base=>$hash)},
5986                                               "blob");
5987                                 print " | " if ($has_history);
5988                         }
5989                         if ($has_history) {
5990                                 print $cgi->a({-href => href(action=>"history",
5991                                                              file_name=>$diff->{'to_file'},
5992                                                              hash_base=>$hash)},
5993                                               "history");
5994                         }
5995                         print "</td>\n";
5996
5997                         print "</tr>\n";
5998                         next; # instead of 'else' clause, to avoid extra indent
5999                 }
6000                 # else ordinary diff
6001
6002                 my ($to_mode_oct, $to_mode_str, $to_file_type);
6003                 my ($from_mode_oct, $from_mode_str, $from_file_type);
6004                 if ($diff->{'to_mode'} ne ('0' x 6)) {
6005                         $to_mode_oct = oct $diff->{'to_mode'};
6006                         if (S_ISREG($to_mode_oct)) { # only for regular file
6007                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
6008                         }
6009                         $to_file_type = file_type($diff->{'to_mode'});
6010                 }
6011                 if ($diff->{'from_mode'} ne ('0' x 6)) {
6012                         $from_mode_oct = oct $diff->{'from_mode'};
6013                         if (S_ISREG($from_mode_oct)) { # only for regular file
6014                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
6015                         }
6016                         $from_file_type = file_type($diff->{'from_mode'});
6017                 }
6018
6019                 if ($diff->{'status'} eq "A") { # created
6020                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
6021                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
6022                         $mode_chng   .= "]</span>";
6023                         print "<td>";
6024                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6025                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6026                                       -class => "list"}, esc_path($diff->{'file'}));
6027                         print "</td>\n";
6028                         print "<td>$mode_chng</td>\n";
6029                         print "<td class=\"link\">";
6030                         if ($action eq 'commitdiff') {
6031                                 # link to patch
6032                                 $patchno++;
6033                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6034                                               "patch") .
6035                                       " | ";
6036                         }
6037                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6038                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6039                                       "blob");
6040                         print "</td>\n";
6041
6042                 } elsif ($diff->{'status'} eq "D") { # deleted
6043                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
6044                         print "<td>";
6045                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
6046                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
6047                                        -class => "list"}, esc_path($diff->{'file'}));
6048                         print "</td>\n";
6049                         print "<td>$mode_chng</td>\n";
6050                         print "<td class=\"link\">";
6051                         if ($action eq 'commitdiff') {
6052                                 # link to patch
6053                                 $patchno++;
6054                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6055                                               "patch") .
6056                                       " | ";
6057                         }
6058                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
6059                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
6060                                       "blob") . " | ";
6061                         if ($have_blame) {
6062                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
6063                                                              file_name=>$diff->{'file'}),
6064                                               -class => "blamelink"},
6065                                               "blame") . " | ";
6066                         }
6067                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
6068                                                      file_name=>$diff->{'file'})},
6069                                       "history");
6070                         print "</td>\n";
6071
6072                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
6073                         my $mode_chnge = "";
6074                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6075                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
6076                                 if ($from_file_type ne $to_file_type) {
6077                                         $mode_chnge .= " from $from_file_type to $to_file_type";
6078                                 }
6079                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
6080                                         if ($from_mode_str && $to_mode_str) {
6081                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
6082                                         } elsif ($to_mode_str) {
6083                                                 $mode_chnge .= " mode: $to_mode_str";
6084                                         }
6085                                 }
6086                                 $mode_chnge .= "]</span>\n";
6087                         }
6088                         print "<td>";
6089                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6090                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6091                                       -class => "list"}, esc_path($diff->{'file'}));
6092                         print "</td>\n";
6093                         print "<td>$mode_chnge</td>\n";
6094                         print "<td class=\"link\">";
6095                         if ($action eq 'commitdiff') {
6096                                 # link to patch
6097                                 $patchno++;
6098                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6099                                               "patch") .
6100                                       " | ";
6101                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6102                                 # "commit" view and modified file (not onlu mode changed)
6103                                 print $cgi->a({-href => href(action=>"blobdiff",
6104                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6105                                                              hash_base=>$hash, hash_parent_base=>$parent,
6106                                                              file_name=>$diff->{'file'})},
6107                                               "diff") .
6108                                       " | ";
6109                         }
6110                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6111                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6112                                        "blob") . " | ";
6113                         if ($have_blame) {
6114                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6115                                                              file_name=>$diff->{'file'}),
6116                                               -class => "blamelink"},
6117                                               "blame") . " | ";
6118                         }
6119                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6120                                                      file_name=>$diff->{'file'})},
6121                                       "history");
6122                         print "</td>\n";
6123
6124                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
6125                         my %status_name = ('R' => 'moved', 'C' => 'copied');
6126                         my $nstatus = $status_name{$diff->{'status'}};
6127                         my $mode_chng = "";
6128                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6129                                 # mode also for directories, so we cannot use $to_mode_str
6130                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
6131                         }
6132                         print "<td>" .
6133                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
6134                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
6135                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
6136                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
6137                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
6138                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
6139                                       -class => "list"}, esc_path($diff->{'from_file'})) .
6140                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
6141                               "<td class=\"link\">";
6142                         if ($action eq 'commitdiff') {
6143                                 # link to patch
6144                                 $patchno++;
6145                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6146                                               "patch") .
6147                                       " | ";
6148                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6149                                 # "commit" view and modified file (not only pure rename or copy)
6150                                 print $cgi->a({-href => href(action=>"blobdiff",
6151                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6152                                                              hash_base=>$hash, hash_parent_base=>$parent,
6153                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
6154                                               "diff") .
6155                                       " | ";
6156                         }
6157                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6158                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
6159                                       "blob") . " | ";
6160                         if ($have_blame) {
6161                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6162                                                              file_name=>$diff->{'to_file'}),
6163                                               -class => "blamelink"},
6164                                               "blame") . " | ";
6165                         }
6166                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6167                                                     file_name=>$diff->{'to_file'})},
6168                                       "history");
6169                         print "</td>\n";
6170
6171                 } # we should not encounter Unmerged (U) or Unknown (X) status
6172                 print "</tr>\n";
6173         }
6174         print "</tbody>" if $has_header;
6175         print "</table>\n";
6176 }
6177
6178 # Print context lines and then rem/add lines in a side-by-side manner.
6179 sub print_sidebyside_diff_lines {
6180         my ($ctx, $rem, $add) = @_;
6181
6182         # print context block before add/rem block
6183         if (@$ctx) {
6184                 print join '',
6185                         '<div class="chunk_block ctx">',
6186                                 '<div class="old">',
6187                                 @$ctx,
6188                                 '</div>',
6189                                 '<div class="new">',
6190                                 @$ctx,
6191                                 '</div>',
6192                         '</div>';
6193         }
6194
6195         if (!@$add) {
6196                 # pure removal
6197                 print join '',
6198                         '<div class="chunk_block rem">',
6199                                 '<div class="old">',
6200                                 @$rem,
6201                                 '</div>',
6202                         '</div>';
6203         } elsif (!@$rem) {
6204                 # pure addition
6205                 print join '',
6206                         '<div class="chunk_block add">',
6207                                 '<div class="new">',
6208                                 @$add,
6209                                 '</div>',
6210                         '</div>';
6211         } else {
6212                 print join '',
6213                         '<div class="chunk_block chg">',
6214                                 '<div class="old">',
6215                                 @$rem,
6216                                 '</div>',
6217                                 '<div class="new">',
6218                                 @$add,
6219                                 '</div>',
6220                         '</div>';
6221         }
6222 }
6223
6224 # Print context lines and then rem/add lines in inline manner.
6225 sub print_inline_diff_lines {
6226         my ($ctx, $rem, $add) = @_;
6227
6228         print @$ctx, @$rem, @$add;
6229 }
6230
6231 # Format removed and added line, mark changed part and HTML-format them.
6232 # Implementation is based on contrib/diff-highlight
6233 sub format_rem_add_lines_pair {
6234         my ($rem, $add, $num_parents) = @_;
6235
6236         # We need to untabify lines before split()'ing them;
6237         # otherwise offsets would be invalid.
6238         chomp $rem;
6239         chomp $add;
6240         $rem = untabify($rem);
6241         $add = untabify($add);
6242
6243         my @rem = split(//, $rem);
6244         my @add = split(//, $add);
6245         my ($esc_rem, $esc_add);
6246         # Ignore leading +/- characters for each parent.
6247         my ($prefix_len, $suffix_len) = ($num_parents, 0);
6248         my ($prefix_has_nonspace, $suffix_has_nonspace);
6249
6250         my $shorter = (@rem < @add) ? @rem : @add;
6251         while ($prefix_len < $shorter) {
6252                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
6253
6254                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
6255                 $prefix_len++;
6256         }
6257
6258         while ($prefix_len + $suffix_len < $shorter) {
6259                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
6260
6261                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
6262                 $suffix_len++;
6263         }
6264
6265         # Mark lines that are different from each other, but have some common
6266         # part that isn't whitespace.  If lines are completely different, don't
6267         # mark them because that would make output unreadable, especially if
6268         # diff consists of multiple lines.
6269         if ($prefix_has_nonspace || $suffix_has_nonspace) {
6270                 $esc_rem = esc_html_hl_regions($rem, 'marked',
6271                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
6272                 $esc_add = esc_html_hl_regions($add, 'marked',
6273                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
6274         } else {
6275                 $esc_rem = esc_html($rem, -nbsp=>1);
6276                 $esc_add = esc_html($add, -nbsp=>1);
6277         }
6278
6279         return format_diff_line(\$esc_rem, 'rem'),
6280                format_diff_line(\$esc_add, 'add');
6281 }
6282
6283 # HTML-format diff context, removed and added lines.
6284 sub format_ctx_rem_add_lines {
6285         my ($ctx, $rem, $add, $num_parents) = @_;
6286         my (@new_ctx, @new_rem, @new_add);
6287         my $can_highlight = 0;
6288         my $is_combined = ($num_parents > 1);
6289
6290         # Highlight if every removed line has a corresponding added line.
6291         if (@$add > 0 && @$add == @$rem) {
6292                 $can_highlight = 1;
6293
6294                 # Highlight lines in combined diff only if the chunk contains
6295                 # diff between the same version, e.g.
6296                 #
6297                 #    - a
6298                 #   -  b
6299                 #    + c
6300                 #   +  d
6301                 #
6302                 # Otherwise the highlightling would be confusing.
6303                 if ($is_combined) {
6304                         for (my $i = 0; $i < @$add; $i++) {
6305                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
6306                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
6307
6308                                 $prefix_rem =~ s/-/+/g;
6309
6310                                 if ($prefix_rem ne $prefix_add) {
6311                                         $can_highlight = 0;
6312                                         last;
6313                                 }
6314                         }
6315                 }
6316         }
6317
6318         if ($can_highlight) {
6319                 for (my $i = 0; $i < @$add; $i++) {
6320                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
6321                                 $rem->[$i], $add->[$i], $num_parents);
6322                         push @new_rem, $line_rem;
6323                         push @new_add, $line_add;
6324                 }
6325         } else {
6326                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
6327                 @new_add = map { format_diff_line($_, 'add') } @$add;
6328         }
6329
6330         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
6331
6332         return (\@new_ctx, \@new_rem, \@new_add);
6333 }
6334
6335 # Print context lines and then rem/add lines.
6336 sub print_diff_lines {
6337         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
6338         my $is_combined = $num_parents > 1;
6339
6340         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
6341                 $num_parents);
6342
6343         if ($diff_style eq 'sidebyside' && !$is_combined) {
6344                 print_sidebyside_diff_lines($ctx, $rem, $add);
6345         } else {
6346                 # default 'inline' style and unknown styles
6347                 print_inline_diff_lines($ctx, $rem, $add);
6348         }
6349 }
6350
6351 sub print_diff_chunk {
6352         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
6353         my (@ctx, @rem, @add);
6354
6355         # The class of the previous line.
6356         my $prev_class = '';
6357
6358         return unless @chunk;
6359
6360         # incomplete last line might be among removed or added lines,
6361         # or both, or among context lines: find which
6362         for (my $i = 1; $i < @chunk; $i++) {
6363                 if ($chunk[$i][0] eq 'incomplete') {
6364                         $chunk[$i][0] = $chunk[$i-1][0];
6365                 }
6366         }
6367
6368         # guardian
6369         push @chunk, ["", ""];
6370
6371         foreach my $line_info (@chunk) {
6372                 my ($class, $line) = @$line_info;
6373
6374                 # print chunk headers
6375                 if ($class && $class eq 'chunk_header') {
6376                         print format_diff_line($line, $class, $from, $to);
6377                         next;
6378                 }
6379
6380                 ## print from accumulator when have some add/rem lines or end
6381                 # of chunk (flush context lines), or when have add and rem
6382                 # lines and new block is reached (otherwise add/rem lines could
6383                 # be reordered)
6384                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
6385                     (@rem && @add && $class ne $prev_class)) {
6386                         print_diff_lines(\@ctx, \@rem, \@add,
6387                                          $diff_style, $num_parents);
6388                         @ctx = @rem = @add = ();
6389                 }
6390
6391                 ## adding lines to accumulator
6392                 # guardian value
6393                 last unless $line;
6394                 # rem, add or change
6395                 if ($class eq 'rem') {
6396                         push @rem, $line;
6397                 } elsif ($class eq 'add') {
6398                         push @add, $line;
6399                 }
6400                 # context line
6401                 if ($class eq 'ctx') {
6402                         push @ctx, $line;
6403                 }
6404
6405                 $prev_class = $class;
6406         }
6407 }
6408
6409 sub git_patchset_body {
6410         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
6411         my ($hash_parent) = $hash_parents[0];
6412
6413         my $is_combined = (@hash_parents > 1);
6414         my $patch_idx = 0;
6415         my $patch_number = 0;
6416         my $patch_line;
6417         my $diffinfo;
6418         my $to_name;
6419         my (%from, %to);
6420         my @chunk; # for side-by-side diff
6421
6422         print "<div class=\"patchset\">\n";
6423
6424         # skip to first patch
6425         while ($patch_line = to_utf8(scalar <$fd>)) {
6426                 chomp $patch_line;
6427
6428                 last if ($patch_line =~ m/^diff /);
6429         }
6430
6431  PATCH:
6432         while ($patch_line) {
6433
6434                 # parse "git diff" header line
6435                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
6436                         # $1 is from_name, which we do not use
6437                         $to_name = unquote($2);
6438                         $to_name =~ s!^b/!!;
6439                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
6440                         # $1 is 'cc' or 'combined', which we do not use
6441                         $to_name = unquote($2);
6442                 } else {
6443                         $to_name = undef;
6444                 }
6445
6446                 # check if current patch belong to current raw line
6447                 # and parse raw git-diff line if needed
6448                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
6449                         # this is continuation of a split patch
6450                         print "<div class=\"patch cont\">\n";
6451                 } else {
6452                         # advance raw git-diff output if needed
6453                         $patch_idx++ if defined $diffinfo;
6454
6455                         # read and prepare patch information
6456                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6457
6458                         # compact combined diff output can have some patches skipped
6459                         # find which patch (using pathname of result) we are at now;
6460                         if ($is_combined) {
6461                                 while ($to_name ne $diffinfo->{'to_file'}) {
6462                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6463                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
6464                                               "</div>\n";  # class="patch"
6465
6466                                         $patch_idx++;
6467                                         $patch_number++;
6468
6469                                         last if $patch_idx > $#$difftree;
6470                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6471                                 }
6472                         }
6473
6474                         # modifies %from, %to hashes
6475                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
6476
6477                         # this is first patch for raw difftree line with $patch_idx index
6478                         # we index @$difftree array from 0, but number patches from 1
6479                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
6480                 }
6481
6482                 # git diff header
6483                 #assert($patch_line =~ m/^diff /) if DEBUG;
6484                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
6485                 $patch_number++;
6486                 # print "git diff" header
6487                 print format_git_diff_header_line($patch_line, $diffinfo,
6488                                                   \%from, \%to);
6489
6490                 # print extended diff header
6491                 print "<div class=\"diff extended_header\">\n";
6492         EXTENDED_HEADER:
6493                 while ($patch_line = to_utf8(scalar<$fd>)) {
6494                         chomp $patch_line;
6495
6496                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
6497
6498                         print format_extended_diff_header_line($patch_line, $diffinfo,
6499                                                                \%from, \%to);
6500                 }
6501                 print "</div>\n"; # class="diff extended_header"
6502
6503                 # from-file/to-file diff header
6504                 if (! $patch_line) {
6505                         print "</div>\n"; # class="patch"
6506                         last PATCH;
6507                 }
6508                 next PATCH if ($patch_line =~ m/^diff /);
6509                 #assert($patch_line =~ m/^---/) if DEBUG;
6510
6511                 my $last_patch_line = $patch_line;
6512                 $patch_line = to_utf8(scalar <$fd>);
6513                 chomp $patch_line;
6514                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
6515
6516                 print format_diff_from_to_header($last_patch_line, $patch_line,
6517                                                  $diffinfo, \%from, \%to,
6518                                                  @hash_parents);
6519
6520                 # the patch itself
6521         LINE:
6522                 while ($patch_line = to_utf8(scalar <$fd>)) {
6523                         chomp $patch_line;
6524
6525                         next PATCH if ($patch_line =~ m/^diff /);
6526
6527                         my $class = diff_line_class($patch_line, \%from, \%to);
6528
6529                         if ($class eq 'chunk_header') {
6530                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6531                                 @chunk = ();
6532                         }
6533
6534                         push @chunk, [ $class, $patch_line ];
6535                 }
6536
6537         } continue {
6538                 if (@chunk) {
6539                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6540                         @chunk = ();
6541                 }
6542                 print "</div>\n"; # class="patch"
6543         }
6544
6545         # for compact combined (--cc) format, with chunk and patch simplification
6546         # the patchset might be empty, but there might be unprocessed raw lines
6547         for (++$patch_idx if $patch_number > 0;
6548              $patch_idx < @$difftree;
6549              ++$patch_idx) {
6550                 # read and prepare patch information
6551                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6552
6553                 # generate anchor for "patch" links in difftree / whatchanged part
6554                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6555                       format_diff_cc_simplified($diffinfo, @hash_parents) .
6556                       "</div>\n";  # class="patch"
6557
6558                 $patch_number++;
6559         }
6560
6561         if ($patch_number == 0) {
6562                 if (@hash_parents > 1) {
6563                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
6564                 } else {
6565                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
6566                 }
6567         }
6568
6569         print "</div>\n"; # class="patchset"
6570 }
6571
6572 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6573
6574 sub git_project_search_form {
6575         my ($searchtext, $search_use_regexp) = @_;
6576
6577         my $limit = '';
6578         if ($project_filter) {
6579                 $limit = " in '$project_filter'";
6580         }
6581
6582         print "<div class=\"projsearch\">\n";
6583         print $cgi->start_form(-method => 'get', -action => $my_uri) .
6584               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
6585         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
6586                 if (defined $project_filter);
6587         print $cgi->textfield(-name => 's', -value => $searchtext,
6588                               -title => "Search project by name and description$limit",
6589                               -size => 60) . "\n" .
6590               "<span title=\"Extended regular expression\">" .
6591               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
6592                              -checked => $search_use_regexp) .
6593               "</span>\n" .
6594               $cgi->submit(-name => 'btnS', -value => 'Search') .
6595               $cgi->end_form() . "\n" .
6596               "<span class=\"projectlist_link\">" .
6597               $cgi->a({-href => href(project => undef, searchtext => undef,
6598                                      action => 'project_list',
6599                                      project_filter => $project_filter)},
6600                       esc_html("List all projects$limit")) . "</span><br />\n";
6601         print "<span class=\"projectlist_link\">" .
6602               $cgi->a({-href => href(project => undef, searchtext => undef,
6603                                      action => 'project_list',
6604                                      project_filter => undef)},
6605                       esc_html("List all projects")) . "</span>\n" if $project_filter;
6606         print "</div>\n";
6607 }
6608
6609 # entry for given @keys needs filling if at least one of keys in list
6610 # is not present in %$project_info
6611 sub project_info_needs_filling {
6612         my ($project_info, @keys) = @_;
6613
6614         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
6615         foreach my $key (@keys) {
6616                 if (!exists $project_info->{$key}) {
6617                         return 1;
6618                 }
6619         }
6620         return;
6621 }
6622
6623 sub git_cache_file_format {
6624         return GITWEB_CACHE_FORMAT .
6625                 (gitweb_check_feature('forks') ? " (forks)" : "");
6626 }
6627
6628 sub git_retrieve_cache_file {
6629         my $cache_file = shift;
6630
6631         use Storable qw(retrieve);
6632
6633         if ((my $dump = eval { retrieve($cache_file) })) {
6634                 return $$dump[1] if
6635                         ref($dump) eq 'ARRAY' &&
6636                         @$dump == 2 &&
6637                         ref($$dump[1]) eq 'ARRAY' &&
6638                         @{$$dump[1]} == 2 &&
6639                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
6640                         ref(${$$dump[1]}[1]) eq 'HASH' &&
6641                         $$dump[0] eq git_cache_file_format();
6642         }
6643
6644         return undef;
6645 }
6646
6647 sub git_store_cache_file {
6648         my ($cache_file, $cachedata) = @_;
6649
6650         use File::Basename qw(dirname);
6651         use File::stat;
6652         use POSIX qw(:fcntl_h);
6653         use Storable qw(store_fd);
6654
6655         my $result = undef;
6656         my $cache_d = dirname($cache_file);
6657         my $mask = umask();
6658         umask($mask & ~0070) if $cache_grpshared;
6659         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6660             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6661                 store_fd([git_cache_file_format(), $cachedata], $fd);
6662                 close $fd;
6663                 rename "$cache_file.lock", $cache_file;
6664                 $result = stat($cache_file)->mtime;
6665         }
6666         umask($mask) if $cache_grpshared;
6667         return $result;
6668 }
6669
6670 sub verify_cached_project {
6671         my ($hashref, $path) = @_;
6672         return undef unless $path;
6673         delete $$hashref{$path}, return undef unless is_valid_project($path);
6674         return $$hashref{$path} if exists $$hashref{$path};
6675
6676         # A valid project was requested but it's not yet in the cache
6677         # Manufacture a minimal project entry (path, name, description)
6678         # Also provide age, but only if it's available via $lastactivity_file
6679
6680         my %proj = ('path' => $path);
6681         my $val = git_get_project_description($path);
6682         defined $val or $val = '';
6683         $proj{'descr_long'} = $val;
6684         $proj{'descr'} = chop_str($val, $projects_list_description_width, 5);
6685         unless ($omit_owner) {
6686                 $val = git_get_project_owner($path);
6687                 defined $val or $val = '';
6688                 $proj{'owner'} = $val;
6689         }
6690         unless ($omit_age_column) {
6691                 ($val) = git_get_last_activity($path, 1);
6692                 $proj{'age_epoch'} = $val if defined $val;
6693         }
6694         $$hashref{$path} = \%proj;
6695         return \%proj;
6696 }
6697
6698 sub git_filter_cached_projects {
6699         my ($cache, $projlist, $verify) = @_;
6700         my $hashref = $$cache[1];
6701         my $sub = $verify ?
6702                 sub {verify_cached_project($hashref, $_[0])} :
6703                 sub {$$hashref{$_[0]}};
6704         return map {
6705                 my $c = &$sub($_->{'path'});
6706                 defined $c ? ($_ = $c) : ()
6707         } @$projlist;
6708 }
6709
6710 # fills project list info (age, description, owner, category, forks, etc.)
6711 # for each project in the list, removing invalid projects from
6712 # returned list, or fill only specified info.
6713 #
6714 # Invalid projects are removed from the returned list if and only if you
6715 # ask 'age_epoch' to be filled, because they are the only fields
6716 # that run unconditionally git command that requires repository, and
6717 # therefore do always check if project repository is invalid.
6718 #
6719 # USAGE:
6720 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6721 #   ensures that 'descr_long' and 'ctags' fields are filled
6722 # * @project_list = fill_project_list_info(\@project_list)
6723 #   ensures that all fields are filled (and invalid projects removed)
6724 #
6725 # NOTE: modifies $projlist, but does not remove entries from it
6726 sub fill_project_list_info {
6727         my ($projlist, @wanted_keys) = @_;
6728
6729         my $rebuild = @wanted_keys && $wanted_keys[0] eq 'rebuild-cache' && shift @wanted_keys;
6730         return fill_project_list_info_uncached($projlist, @wanted_keys)
6731                 unless $projlist_cache_lifetime && $projlist_cache_lifetime > 0;
6732
6733         use File::stat;
6734
6735         my $cache_lifetime = $rebuild ? 0 : $projlist_cache_lifetime;
6736         my $cache_file = "$cache_dir/$projlist_cache_name";
6737
6738         my @projects;
6739         my $stale = 0;
6740         my $now = time();
6741         my $cache_mtime;
6742         if ($cache_lifetime && -f $cache_file) {
6743                 $cache_mtime = stat($cache_file)->mtime;
6744                 $cache_dump = undef if $cache_mtime &&
6745                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6746         }
6747         if (defined $cache_mtime && # caching is on and $cache_file exists
6748             $cache_mtime + $cache_lifetime*60 > $now &&
6749             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6750                 # Cache hit.
6751                 $cache_dump_mtime = $cache_mtime;
6752                 $stale = $now - $cache_mtime;
6753                 my $verify = ($action eq 'summary' || $action eq 'forks') &&
6754                         gitweb_check_feature('forks');
6755                 @projects = git_filter_cached_projects($cache_dump, $projlist, $verify);
6756
6757         } else { # Cache miss.
6758                 if (defined $cache_mtime) {
6759                         # Postpone timeout by two minutes so that we get
6760                         # enough time to do our job, or to be more exact
6761                         # make cache expire after two minutes from now.
6762                         my $time = $now - $cache_lifetime*60 + 120;
6763                         utime $time, $time, $cache_file;
6764                 }
6765                 my @all_projects = git_get_projects_list();
6766                 my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6767                         fill_project_list_info_uncached(\@all_projects);
6768                 map { $all_projects_filled{$_->{'path'}} = $_ }
6769                         filter_forks_from_projects_list([values(%all_projects_filled)])
6770                         if gitweb_check_feature('forks');
6771                 $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6772                                \%all_projects_filled];
6773                 $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6774                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6775         }
6776
6777         if ($cache_lifetime && $stale > 0) {
6778                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6779                         unless $shown_stale_message;
6780                 $shown_stale_message = 1;
6781         }
6782
6783         return @projects;
6784 }
6785
6786 sub fill_project_list_info_uncached {
6787         my ($projlist, @wanted_keys) = @_;
6788         my @projects;
6789         my $filter_set = sub { return @_; };
6790         if (@wanted_keys) {
6791                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6792                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6793         }
6794
6795         my $show_ctags = gitweb_check_feature('ctags');
6796  PROJECT:
6797         foreach my $pr (@$projlist) {
6798                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6799                         my (@activity) = git_get_last_activity($pr->{'path'});
6800                         unless (@activity) {
6801                                 next PROJECT;
6802                         }
6803                         ($pr->{'age_epoch'}) = @activity;
6804                 }
6805                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6806                         my $descr = git_get_project_description($pr->{'path'}) || "";
6807                         $descr = to_utf8($descr);
6808                         $pr->{'descr_long'} = $descr;
6809                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6810                 }
6811                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6812                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6813                 }
6814                 if ($show_ctags &&
6815                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6816                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6817                 }
6818                 if ($projects_list_group_categories &&
6819                     project_info_needs_filling($pr, $filter_set->('category'))) {
6820                         my $cat = git_get_project_category($pr->{'path'}) ||
6821                                                            $project_list_default_category;
6822                         $pr->{'category'} = to_utf8($cat);
6823                 }
6824
6825                 push @projects, $pr;
6826         }
6827
6828         return @projects;
6829 }
6830
6831 sub sort_projects_list {
6832         my ($projlist, $order) = @_;
6833
6834         sub order_str {
6835                 my $key = shift;
6836                 return sub { lc($a->{$key}) cmp lc($b->{$key}) };
6837         }
6838
6839         sub order_reverse_num_then_undef {
6840                 my $key = shift;
6841                 return sub {
6842                         defined $a->{$key} ?
6843                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6844                                 (defined $b->{$key} ? 1 : 0)
6845                 };
6846         }
6847
6848         my %orderings = (
6849                 project => order_str('path'),
6850                 descr => order_str('descr_long'),
6851                 owner => order_str('owner'),
6852                 age => order_reverse_num_then_undef('age_epoch'),
6853         );
6854
6855         my $ordering = $orderings{$order};
6856         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6857 }
6858
6859 # returns a hash of categories, containing the list of project
6860 # belonging to each category
6861 sub build_projlist_by_category {
6862         my ($projlist, $from, $to) = @_;
6863         my %categories;
6864
6865         $from = 0 unless defined $from;
6866         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6867
6868         for (my $i = $from; $i <= $to; $i++) {
6869                 my $pr = $projlist->[$i];
6870                 push @{$categories{ $pr->{'category'} }}, $pr;
6871         }
6872
6873         return wantarray ? %categories : \%categories;
6874 }
6875
6876 # print 'sort by' <th> element, generating 'sort by $name' replay link
6877 # if that order is not selected
6878 sub print_sort_th {
6879         print format_sort_th(@_);
6880 }
6881
6882 sub format_sort_th {
6883         my ($name, $order, $header) = @_;
6884         my $sort_th = "";
6885         $header ||= ucfirst($name);
6886
6887         if ($order eq $name) {
6888                 $sort_th .= "<th>$header</th>\n";
6889         } else {
6890                 $sort_th .= "<th>" .
6891                             $cgi->a({-href => href(-replay=>1, order=>$name),
6892                                      -class => "header"}, $header) .
6893                             "</th>\n";
6894         }
6895
6896         return $sort_th;
6897 }
6898
6899 sub git_project_list_rows {
6900         my ($projlist, $from, $to, $check_forks) = @_;
6901
6902         $from = 0 unless defined $from;
6903         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6904
6905         my $now = time;
6906         my $alternate = 1;
6907         for (my $i = $from; $i <= $to; $i++) {
6908                 my $pr = $projlist->[$i];
6909
6910                 if ($alternate) {
6911                         print "<tr class=\"dark\">\n";
6912                 } else {
6913                         print "<tr class=\"light\">\n";
6914                 }
6915                 $alternate ^= 1;
6916
6917                 if ($check_forks) {
6918                         print "<td>";
6919                         if ($pr->{'forks'}) {
6920                                 my $nforks = scalar @{$pr->{'forks'}};
6921                                 my $s = $nforks == 1 ? '' : 's';
6922                                 if ($nforks > 0) {
6923                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
6924                                                        -title => "$nforks fork$s"}, "+");
6925                                 } else {
6926                                         print $cgi->span({-title => "$nforks fork$s"}, "+");
6927                                 }
6928                         }
6929                         print "</td>\n";
6930                 }
6931                 my $path = $pr->{'path'};
6932                 my $dotgit = $path =~ s/\.git$// ? '.git' : '';
6933                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6934                                         -class => "list"},
6935                                        esc_html_match_hl($path, $search_regexp).$dotgit) .
6936                       "</td>\n" .
6937                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6938                                         -class => "list",
6939                                         -title => $pr->{'descr_long'}},
6940                                         $search_regexp
6941                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
6942                                                                     $pr->{'descr'}, $search_regexp)
6943                                         : esc_html($pr->{'descr'})) .
6944                       "</td>\n";
6945                 unless ($omit_owner) {
6946                         print "<td><i>" . ($owner_link_hook
6947                                           ? $cgi->a({-href => $owner_link_hook->($pr->{'owner'}), -class => "list"},
6948                                                     chop_and_escape_str($pr->{'owner'}, 15))
6949                                           : chop_and_escape_str($pr->{'owner'}, 15)) . "</i></td>\n";
6950                 }
6951                 unless ($omit_age_column) {
6952                         my ($age_epoch, $age_string) = ($pr->{'age_epoch'});
6953                         $age_string = defined $age_epoch ? age_string($age_epoch, $now) : "No commits";
6954                         print "<td class=\"". age_class($age_epoch, $now) . "\">" . $age_string . "</td>\n";
6955                 }
6956                 print"<td class=\"link\">" .
6957                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . " | " .
6958                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "log") . " | " .
6959                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
6960                       ($pr->{'forks'} ? " | " . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
6961                       "</td>\n" .
6962                       "</tr>\n";
6963         }
6964 }
6965
6966 sub git_project_list_body {
6967         # actually uses global variable $project
6968         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action, $keep_top) = @_;
6969         my @projects = @$projlist;
6970
6971         my $check_forks = gitweb_check_feature('forks');
6972         my $show_ctags  = gitweb_check_feature('ctags');
6973         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
6974         $check_forks = undef
6975                 if ($tagfilter || $search_regexp);
6976
6977         # filtering out forks before filling info allows us to do less work
6978         if ($check_forks) {
6979                 @projects = filter_forks_from_projects_list(\@projects);
6980                 push @projects, { 'path' => "$project_filter.git" }
6981                         if $project_filter && $keep_top && is_valid_project("$project_filter.git");
6982         }
6983         # search_projects_list pre-fills required info
6984         @projects = search_projects_list(\@projects,
6985                                          'search_regexp' => $search_regexp,
6986                                          'tagfilter'  => $tagfilter)
6987                 if ($tagfilter || $search_regexp);
6988         # fill the rest
6989         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
6990         push @all_fields, 'age_epoch' unless($omit_age_column);
6991         push @all_fields, 'owner' unless($omit_owner);
6992         @projects = fill_project_list_info(\@projects, @all_fields);
6993
6994         $order ||= $default_projects_order;
6995         $from = 0 unless defined $from;
6996         $to = $#projects if (!defined $to || $#projects < $to);
6997
6998         # short circuit
6999         if ($from > $to) {
7000                 print "<center>\n".
7001                       "<b>No such projects found</b><br />\n".
7002                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
7003                       "</center>\n<br />\n";
7004                 return;
7005         }
7006
7007         @projects = sort_projects_list(\@projects, $order);
7008
7009         if ($show_ctags) {
7010                 my $ctags = git_gather_all_ctags(\@projects);
7011                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
7012                 print git_show_project_tagcloud($cloud, 64);
7013         }
7014
7015         print "<table class=\"project_list\">\n";
7016         unless ($no_header) {
7017                 print "<tr>\n";
7018                 if ($check_forks) {
7019                         print "<th></th>\n";
7020                 }
7021                 print_sort_th('project', $order, 'Project');
7022                 print_sort_th('descr', $order, 'Description');
7023                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
7024                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
7025                 print "<th></th>\n" . # for links
7026                       "</tr>\n";
7027         }
7028
7029         if ($projects_list_group_categories) {
7030                 # only display categories with projects in the $from-$to window
7031                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
7032                 my %categories = build_projlist_by_category(\@projects, $from, $to);
7033                 foreach my $cat (sort keys %categories) {
7034                         unless ($cat eq "") {
7035                                 print "<tr>\n";
7036                                 if ($check_forks) {
7037                                         print "<td></td>\n";
7038                                 }
7039                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
7040                                 print "</tr>\n";
7041                         }
7042
7043                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
7044                 }
7045         } else {
7046                 git_project_list_rows(\@projects, $from, $to, $check_forks);
7047         }
7048
7049         if (defined $extra) {
7050                 print "<tr>\n";
7051                 if ($check_forks) {
7052                         print "<td></td>\n";
7053                 }
7054                 print "<td colspan=\"5\">$extra</td>\n" .
7055                       "</tr>\n";
7056         }
7057         print "</table>\n";
7058 }
7059
7060 sub git_log_body {
7061         # uses global variable $project
7062         my ($commitlist, $from, $to, $refs, $extra) = @_;
7063
7064         $from = 0 unless defined $from;
7065         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7066
7067         for (my $i = 0; $i <= $to; $i++) {
7068                 my %co = %{$commitlist->[$i]};
7069                 next if !%co;
7070                 my $commit = $co{'id'};
7071                 my $ref = format_ref_marker($refs, $commit);
7072                 git_print_header_div('commit',
7073                                "<span class=\"age\">$co{'age_string'}</span>" .
7074                                esc_html($co{'title'}),
7075                                $commit, undef, $ref);
7076                 print "<div class=\"title_text\">\n" .
7077                       "<div class=\"log_link\">\n" .
7078                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
7079                       " | " .
7080                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
7081                       " | " .
7082                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
7083                       "<br/>\n" .
7084                       "</div>\n";
7085                       git_print_authorship(\%co, -tag => 'span');
7086                       print "<br/>\n</div>\n";
7087
7088                 print "<div class=\"log_body\">\n";
7089                 git_print_log($co{'comment'}, -final_empty_line=> 1);
7090                 print "</div>\n";
7091         }
7092         if ($extra) {
7093                 print "<div class=\"page_nav\">\n";
7094                 print "$extra\n";
7095                 print "</div>\n";
7096         }
7097 }
7098
7099 sub git_shortlog_body {
7100         # uses global variable $project
7101         my ($commitlist, $from, $to, $refs, $extra) = @_;
7102
7103         $from = 0 unless defined $from;
7104         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7105
7106         print "<table class=\"shortlog\">\n";
7107         my $alternate = 1;
7108         for (my $i = $from; $i <= $to; $i++) {
7109                 my %co = %{$commitlist->[$i]};
7110                 my $commit = $co{'id'};
7111                 my $ref = format_ref_marker($refs, $commit);
7112                 if ($alternate) {
7113                         print "<tr class=\"dark\">\n";
7114                 } else {
7115                         print "<tr class=\"light\">\n";
7116                 }
7117                 $alternate ^= 1;
7118                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
7119                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7120                       format_author_html('td', \%co, 10) . "<td>";
7121                 print format_subject_html($co{'title'}, $co{'title_short'},
7122                                           href(action=>"commit", hash=>$commit), $ref);
7123                 print "</td>\n" .
7124                       "<td class=\"link\">" .
7125                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . " | " .
7126                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . " | " .
7127                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
7128                 my $snapshot_links = format_snapshot_links($commit);
7129                 if (defined $snapshot_links) {
7130                         print " | " . $snapshot_links;
7131                 }
7132                 print "</td>\n" .
7133                       "</tr>\n";
7134         }
7135         if (defined $extra) {
7136                 print "<tr>\n" .
7137                       "<td colspan=\"4\">$extra</td>\n" .
7138                       "</tr>\n";
7139         }
7140         print "</table>\n";
7141 }
7142
7143 sub git_history_body {
7144         # Warning: assumes constant type (blob or tree) during history
7145         my ($commitlist, $from, $to, $refs, $extra,
7146             $file_name, $file_hash, $ftype) = @_;
7147
7148         $from = 0 unless defined $from;
7149         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
7150
7151         print "<table class=\"history\">\n";
7152         my $alternate = 1;
7153         for (my $i = $from; $i <= $to; $i++) {
7154                 my %co = %{$commitlist->[$i]};
7155                 if (!%co) {
7156                         next;
7157                 }
7158                 my $commit = $co{'id'};
7159
7160                 my $ref = format_ref_marker($refs, $commit);
7161
7162                 if ($alternate) {
7163                         print "<tr class=\"dark\">\n";
7164                 } else {
7165                         print "<tr class=\"light\">\n";
7166                 }
7167                 $alternate ^= 1;
7168                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7169         # shortlog:   format_author_html('td', \%co, 10)
7170                       format_author_html('td', \%co, 15, 3) . "<td>";
7171                 # originally git_history used chop_str($co{'title'}, 50)
7172                 print format_subject_html($co{'title'}, $co{'title_short'},
7173                                           href(action=>"commit", hash=>$commit), $ref);
7174                 print "</td>\n" .
7175                       "<td class=\"link\">" .
7176                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . " | " .
7177                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
7178
7179                 if ($ftype eq 'blob') {
7180                         my $blob_current = $file_hash;
7181                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
7182                         if (defined $blob_current && defined $blob_parent &&
7183                                         $blob_current ne $blob_parent) {
7184                                 print " | " .
7185                                         $cgi->a({-href => href(action=>"blobdiff",
7186                                                                hash=>$blob_current, hash_parent=>$blob_parent,
7187                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
7188                                                                file_name=>$file_name)},
7189                                                 "diff to current");
7190                         }
7191                 }
7192                 print "</td>\n" .
7193                       "</tr>\n";
7194         }
7195         if (defined $extra) {
7196                 print "<tr>\n" .
7197                       "<td colspan=\"4\">$extra</td>\n" .
7198                       "</tr>\n";
7199         }
7200         print "</table>\n";
7201 }
7202
7203 sub git_tags_body {
7204         # uses global variable $project
7205         my ($taglist, $from, $to, $extra, $head_at, $full, $order) = @_;
7206         $from = 0 unless defined $from;
7207         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
7208         $order ||= $default_refs_order;
7209
7210         print "<table class=\"tags\">\n";
7211         if ($full) {
7212                 print "<tr class=\"tags_header\">\n";
7213                 print_sort_th('age', $order, 'Last Change');
7214                 print_sort_th('name', $order, 'Name');
7215                 print "<th></th>\n" . # for comment
7216                       "<th></th>\n" . # for tag
7217                       "<th></th>\n" . # for links
7218                       "</tr>\n";
7219         }
7220         my $alternate = 1;
7221         for (my $i = $from; $i <= $to; $i++) {
7222                 my $entry = $taglist->[$i];
7223                 my %tag = %$entry;
7224                 my $comment = $tag{'subject'};
7225                 my $comment_short;
7226                 if (defined $comment) {
7227                         $comment_short = chop_str($comment, 30, 5);
7228                 }
7229                 my $curr = defined $head_at && $tag{'id'} eq $head_at;
7230                 if ($alternate) {
7231                         print "<tr class=\"dark\">\n";
7232                 } else {
7233                         print "<tr class=\"light\">\n";
7234                 }
7235                 $alternate ^= 1;
7236                 if (defined $tag{'age'}) {
7237                         print "<td><i>$tag{'age'}</i></td>\n";
7238                 } else {
7239                         print "<td></td>\n";
7240                 }
7241                 print(($curr ? "<td class=\"current_head\">" : "<td>") .
7242                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
7243                                -class => "list name"}, esc_html($tag{'name'})) .
7244                       "</td>\n" .
7245                       "<td>");
7246                 if (defined $comment) {
7247                         print format_subject_html($comment, $comment_short,
7248                                                   href(action=>"tag", hash=>$tag{'id'}));
7249                 }
7250                 print "</td>\n" .
7251                       "<td class=\"selflink\">";
7252                 if ($tag{'type'} eq "tag") {
7253                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
7254                 } else {
7255                         print "&#160;";
7256                 }
7257                 print "</td>\n" .
7258                       "<td class=\"link\">" . " | " .
7259                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
7260                 if ($tag{'reftype'} eq "commit") {
7261                         print " | " . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "log");
7262                         print " | " . $cgi->a({-href => href(action=>"tree", hash=>$tag{'fullname'})}, "tree") if $full;
7263                 } elsif ($tag{'reftype'} eq "blob") {
7264                         print " | " . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
7265                 }
7266                 print "</td>\n" .
7267                       "</tr>";
7268         }
7269         if (defined $extra) {
7270                 print "<tr>\n" .
7271                       "<td colspan=\"5\">$extra</td>\n" .
7272                       "</tr>\n";
7273         }
7274         print "</table>\n";
7275 }
7276
7277 sub git_heads_body {
7278         # uses global variable $project
7279         my ($headlist, $head_at, $from, $to, $extra) = @_;
7280         $from = 0 unless defined $from;
7281         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
7282
7283         print "<table class=\"heads\">\n";
7284         my $alternate = 1;
7285         for (my $i = $from; $i <= $to; $i++) {
7286                 my $entry = $headlist->[$i];
7287                 my %ref = %$entry;
7288                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
7289                 if ($alternate) {
7290                         print "<tr class=\"dark\">\n";
7291                 } else {
7292                         print "<tr class=\"light\">\n";
7293                 }
7294                 $alternate ^= 1;
7295                 print "<td><i>$ref{'age'}</i></td>\n" .
7296                       ($curr ? "<td class=\"current_head\">" : "<td>") .
7297                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
7298                                -class => "list name"},esc_html($ref{'name'})) .
7299                       "</td>\n" .
7300                       "<td class=\"link\">" .
7301                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "log") . " | " .
7302                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
7303                       "</td>\n" .
7304                       "</tr>";
7305         }
7306         if (defined $extra) {
7307                 print "<tr>\n" .
7308                       "<td colspan=\"3\">$extra</td>\n" .
7309                       "</tr>\n";
7310         }
7311         print "</table>\n";
7312 }
7313
7314 # Display a single remote block
7315 sub git_remote_block {
7316         my ($remote, $rdata, $limit, $head) = @_;
7317
7318         my $heads = $rdata->{'heads'};
7319         my $fetch = $rdata->{'fetch'};
7320         my $push = $rdata->{'push'};
7321
7322         my $urls_table = "<table class=\"projects_list\">\n" ;
7323
7324         if (defined $fetch) {
7325                 if ($fetch eq $push) {
7326                         $urls_table .= format_repo_url("URL", $fetch);
7327                 } else {
7328                         $urls_table .= format_repo_url("Fetch&#160;URL", $fetch);
7329                         $urls_table .= format_repo_url("Push&#160;URL", $push) if defined $push;
7330                 }
7331         } elsif (defined $push) {
7332                 $urls_table .= format_repo_url("Push&#160;URL", $push);
7333         } else {
7334                 $urls_table .= format_repo_url("", "No remote URL");
7335         }
7336
7337         $urls_table .= "</table>\n";
7338
7339         my $dots;
7340         if (defined $limit && $limit < @$heads) {
7341                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
7342         }
7343
7344         print $urls_table;
7345         git_heads_body($heads, $head, 0, $limit, $dots);
7346 }
7347
7348 # Display a list of remote names with the respective fetch and push URLs
7349 sub git_remotes_list {
7350         my ($remotedata, $limit) = @_;
7351         print "<table class=\"heads\">\n";
7352         my $alternate = 1;
7353         my @remotes = sort keys %$remotedata;
7354
7355         my $limited = $limit && $limit < @remotes;
7356
7357         $#remotes = $limit - 1 if $limited;
7358
7359         while (my $remote = shift @remotes) {
7360                 my $rdata = $remotedata->{$remote};
7361                 my $fetch = $rdata->{'fetch'};
7362                 my $push = $rdata->{'push'};
7363                 if ($alternate) {
7364                         print "<tr class=\"dark\">\n";
7365                 } else {
7366                         print "<tr class=\"light\">\n";
7367                 }
7368                 $alternate ^= 1;
7369                 print "<td>" .
7370                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
7371                                -class=> "list name"},esc_html($remote)) .
7372                       "</td>";
7373                 print "<td class=\"link\">" .
7374                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
7375                       " | " .
7376                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
7377                       "</td>";
7378
7379                 print "</tr>\n";
7380         }
7381
7382         if ($limited) {
7383                 print "<tr>\n" .
7384                       "<td colspan=\"3\">" .
7385                       $cgi->a({-href => href(action=>"remotes")}, "...") .
7386                       "</td>\n" . "</tr>\n";
7387         }
7388
7389         print "</table>";
7390 }
7391
7392 # Display remote heads grouped by remote, unless there are too many
7393 # remotes, in which case we only display the remote names
7394 sub git_remotes_body {
7395         my ($remotedata, $limit, $head) = @_;
7396         if ($limit and $limit < keys %$remotedata) {
7397                 git_remotes_list($remotedata, $limit);
7398         } else {
7399                 fill_remote_heads($remotedata);
7400                 while (my ($remote, $rdata) = each %$remotedata) {
7401                         git_print_section({-class=>"remote", -id=>$remote},
7402                                 ["remotes", $remote, $remote], sub {
7403                                         git_remote_block($remote, $rdata, $limit, $head);
7404                                 });
7405                 }
7406         }
7407 }
7408
7409 sub git_search_message {
7410         my %co = @_;
7411
7412         my $greptype;
7413         if ($searchtype eq 'commit') {
7414                 $greptype = "--grep=";
7415         } elsif ($searchtype eq 'author') {
7416                 $greptype = "--author=";
7417         } elsif ($searchtype eq 'committer') {
7418                 $greptype = "--committer=";
7419         }
7420         $greptype .= $searchtext;
7421         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
7422                                        $greptype, '--regexp-ignore-case',
7423                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
7424
7425         my $paging_nav = '';
7426         if ($page > 0) {
7427                 $paging_nav .=
7428                         $cgi->a({-href => href(-replay=>1, page=>undef)},
7429                                 "first") .
7430                         " &#183; " .
7431                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
7432                                  -accesskey => "p", -title => "Alt-p"}, "prev");
7433         } else {
7434                 $paging_nav .= "first &#183; prev";
7435         }
7436         my $next_link = '';
7437         if ($#commitlist >= 100) {
7438                 $next_link =
7439                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7440                                  -accesskey => "n", -title => "Alt-n"}, "next");
7441                 $paging_nav .= " &#183; $next_link";
7442         } else {
7443                 $paging_nav .= " &#183; next";
7444         }
7445
7446         git_header_html();
7447
7448         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav);
7449         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7450         if ($page == 0 && !@commitlist) {
7451                 print "<p>No match.</p>\n";
7452         } else {
7453                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
7454         }
7455
7456         git_footer_html();
7457 }
7458
7459 sub git_search_changes {
7460         my %co = @_;
7461
7462         local $/ = "\n";
7463         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
7464                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
7465                 ($search_use_regexp ? '--pickaxe-regex' : ()))
7466                         or die_error(500, "Open git-log failed");
7467
7468         git_header_html();
7469
7470         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7471         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7472
7473         print "<table class=\"pickaxe search\">\n";
7474         my $alternate = 1;
7475         undef %co;
7476         my @files;
7477         while (my $line = to_utf8(scalar <$fd>)) {
7478                 chomp $line;
7479                 next unless $line;
7480
7481                 my %set = parse_difftree_raw_line($line);
7482                 if (defined $set{'commit'}) {
7483                         # finish previous commit
7484                         if (%co) {
7485                                 print "</td>\n" .
7486                                       "<td class=\"link\">" .
7487                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7488                                               "commit") .
7489                                       " | " .
7490                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7491                                                              hash_base=>$co{'id'})},
7492                                               "tree") .
7493                                       "</td>\n" .
7494                                       "</tr>\n";
7495                         }
7496
7497                         if ($alternate) {
7498                                 print "<tr class=\"dark\">\n";
7499                         } else {
7500                                 print "<tr class=\"light\">\n";
7501                         }
7502                         $alternate ^= 1;
7503                         %co = parse_commit($set{'commit'});
7504                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
7505                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7506                               "<td><i>$author</i></td>\n" .
7507                               "<td>" .
7508                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7509                                       -class => "list subject"},
7510                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
7511                 } elsif (defined $set{'to_id'}) {
7512                         next if ($set{'to_id'} =~ m/^0{40}$/);
7513
7514                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
7515                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
7516                                       -class => "list"},
7517                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
7518                               "<br/>\n";
7519                 }
7520         }
7521         close $fd;
7522
7523         # finish last commit (warning: repetition!)
7524         if (%co) {
7525                 print "</td>\n" .
7526                       "<td class=\"link\">" .
7527                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7528                               "commit") .
7529                       " | " .
7530                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7531                                              hash_base=>$co{'id'})},
7532                               "tree") .
7533                       "</td>\n" .
7534                       "</tr>\n";
7535         }
7536
7537         print "</table>\n";
7538
7539         git_footer_html();
7540 }
7541
7542 sub git_search_files {
7543         my %co = @_;
7544
7545         local $/ = "\n";
7546         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
7547                 $search_use_regexp ? ('-E', '-i') : '-F',
7548                 $searchtext, $co{'tree'})
7549                         or die_error(500, "Open git-grep failed");
7550
7551         git_header_html();
7552
7553         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7554         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7555
7556         print "<table class=\"grep_search\">\n";
7557         my $alternate = 1;
7558         my $matches = 0;
7559         my $lastfile = '';
7560         my $file_href;
7561         while (my $line = to_utf8(scalar <$fd>)) {
7562                 chomp $line;
7563                 my ($file, $lno, $ltext, $binary);
7564                 last if ($matches++ > 1000);
7565                 if ($line =~ /^Binary file (.+) matches$/) {
7566                         $file = $1;
7567                         $binary = 1;
7568                 } else {
7569                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
7570                         $file =~ s/^$co{'tree'}://;
7571                 }
7572                 if ($file ne $lastfile) {
7573                         $lastfile and print "</td></tr>\n";
7574                         if ($alternate++) {
7575                                 print "<tr class=\"dark\">\n";
7576                         } else {
7577                                 print "<tr class=\"light\">\n";
7578                         }
7579                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
7580                                           file_name=>$file);
7581                         print "<td class=\"list\">".
7582                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
7583                         print "</td><td>\n";
7584                         $lastfile = $file;
7585                 }
7586                 if ($binary) {
7587                         print "<div class=\"binary\">Binary file</div>\n";
7588                 } else {
7589                         $ltext = untabify($ltext);
7590                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
7591                                 $ltext = esc_html($1, -nbsp=>1);
7592                                 $ltext .= '<span class="match">';
7593                                 $ltext .= esc_html($2, -nbsp=>1);
7594                                 $ltext .= '</span>';
7595                                 $ltext .= esc_html($3, -nbsp=>1);
7596                         } else {
7597                                 $ltext = esc_html($ltext, -nbsp=>1);
7598                         }
7599                         print "<div class=\"pre\">" .
7600                                 $cgi->a({-href => $file_href.'#l'.$lno,
7601                                         -class => "linenr"}, sprintf('%4i ', $lno)) .
7602                                 $ltext . "</div>\n";
7603                 }
7604         }
7605         if ($lastfile) {
7606                 print "</td></tr>\n";
7607                 if ($matches > 1000) {
7608                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
7609                 }
7610         } else {
7611                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
7612         }
7613         close $fd;
7614
7615         print "</table>\n";
7616
7617         git_footer_html();
7618 }
7619
7620 sub git_search_grep_body {
7621         my ($commitlist, $from, $to, $extra) = @_;
7622         $from = 0 unless defined $from;
7623         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7624
7625         print "<table class=\"commit_search\">\n";
7626         my $alternate = 1;
7627         for (my $i = $from; $i <= $to; $i++) {
7628                 my %co = %{$commitlist->[$i]};
7629                 if (!%co) {
7630                         next;
7631                 }
7632                 my $commit = $co{'id'};
7633                 if ($alternate) {
7634                         print "<tr class=\"dark\">\n";
7635                 } else {
7636                         print "<tr class=\"light\">\n";
7637                 }
7638                 $alternate ^= 1;
7639                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7640                       format_author_html('td', \%co, 15, 5) .
7641                       "<td>" .
7642                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7643                                -class => "list subject"},
7644                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
7645                 my $comment = $co{'comment'};
7646                 foreach my $line (@$comment) {
7647                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
7648                                 my ($lead, $match, $trail) = ($1, $2, $3);
7649                                 $match = chop_str($match, 70, 5, 'center');
7650                                 my $contextlen = int((80 - length($match))/2);
7651                                 $contextlen = 30 if ($contextlen > 30);
7652                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
7653                                 $trail = chop_str($trail, $contextlen, 10, 'right');
7654
7655                                 $lead  = esc_html($lead);
7656                                 $match = esc_html($match);
7657                                 $trail = esc_html($trail);
7658
7659                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
7660                         }
7661                 }
7662                 print "</td>\n" .
7663                       "<td class=\"link\">" .
7664                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7665                       " | " .
7666                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7667                       " | " .
7668                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7669                 print "</td>\n" .
7670                       "</tr>\n";
7671         }
7672         if (defined $extra) {
7673                 print "<tr>\n" .
7674                       "<td colspan=\"3\">$extra</td>\n" .
7675                       "</tr>\n";
7676         }
7677         print "</table>\n";
7678 }
7679
7680 ## ======================================================================
7681 ## ======================================================================
7682 ## actions
7683
7684 sub git_project_list_load {
7685         my $empty_list_ok = shift;
7686         my $order = $input_params{'order'};
7687         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7688                 die_error(400, "Unknown order parameter");
7689         }
7690
7691         my @list = git_get_projects_list($project_filter, $strict_export);
7692         if ($project_filter && (!@list || !gitweb_check_feature('forks'))) {
7693                 push @list, { 'path' => "$project_filter.git" }
7694                         if is_valid_project("$project_filter.git");
7695         }
7696         if (!@list) {
7697                 die_error(404, "No projects found") unless $empty_list_ok;
7698         }
7699
7700         return (\@list, $order);
7701 }
7702
7703 sub git_frontpage {
7704         my ($projlist, $order);
7705
7706         if ($frontpage_no_project_list) {
7707                 $project = undef;
7708                 $project_filter = undef;
7709         } else {
7710                 ($projlist, $order) = git_project_list_load(1);
7711         }
7712         git_header_html();
7713         if (defined $home_text && -f $home_text) {
7714                 print "<div class=\"index_include\">\n";
7715                 insert_file($home_text);
7716                 print "</div>\n";
7717         }
7718         git_project_search_form($searchtext, $search_use_regexp);
7719         if ($frontpage_no_project_list) {
7720                 my $show_ctags = gitweb_check_feature('ctags');
7721                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7722                         my @projects = git_get_projects_list($project_filter, $strict_export);
7723                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7724                         @projects = fill_project_list_info(\@projects, 'ctags');
7725                         my $ctags = git_gather_all_ctags(\@projects);
7726                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7727                         print git_show_project_tagcloud($cloud, 64);
7728                 }
7729         } else {
7730                 git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7731         }
7732         git_footer_html();
7733 }
7734
7735 sub git_project_list {
7736         my ($projlist, $order) = git_project_list_load();
7737         git_header_html();
7738         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7739                 print "<div class=\"index_include\">\n";
7740                 insert_file($home_text);
7741                 print "</div>\n";
7742         }
7743         git_project_search_form();
7744         git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7745         git_footer_html();
7746 }
7747
7748 sub git_forks {
7749         my $order = $input_params{'order'};
7750         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7751                 die_error(400, "Unknown order parameter");
7752         }
7753
7754         my $filter = $project;
7755         $filter =~ s/\.git$//;
7756         my @list = git_get_projects_list($filter);
7757         if (!@list) {
7758                 die_error(404, "No forks found");
7759         }
7760
7761         git_header_html();
7762         git_print_page_nav('','');
7763         git_print_header_div('summary', "$project forks");
7764         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7765         git_footer_html();
7766 }
7767
7768 sub git_project_index {
7769         my @projects = git_get_projects_list($project_filter, $strict_export);
7770         if (!@projects) {
7771                 die_error(404, "No projects found");
7772         }
7773
7774         print $cgi->header(
7775                 -type => 'text/plain',
7776                 -charset => 'utf-8',
7777                 -content_disposition => 'inline; filename="index.aux"');
7778
7779         foreach my $pr (@projects) {
7780                 if (!exists $pr->{'owner'}) {
7781                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7782                 }
7783
7784                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7785                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7786                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7787                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7788                 $path  =~ s/ /\+/g;
7789                 $owner =~ s/ /\+/g;
7790
7791                 print "$path $owner\n";
7792         }
7793 }
7794
7795 sub git_summary {
7796         my $descr = git_get_project_description($project) || "none";
7797         my %co = parse_commit("HEAD");
7798         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7799         my $head = $co{'id'};
7800         my $remote_heads = gitweb_check_feature('remote_heads');
7801
7802         my $owner = git_get_project_owner($project);
7803         my $homepage = git_get_project_config('homepage');
7804         my $base_url = git_get_project_config('baseurl');
7805
7806         my $refs = git_get_references();
7807         # These get_*_list functions return one more to allow us to see if
7808         # there are more ...
7809         my @taglist  = git_get_tags_list(16);
7810         my @headlist = git_get_heads_list(16);
7811         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7812         my @forklist;
7813         my $check_forks = gitweb_check_feature('forks');
7814
7815         if ($check_forks) {
7816                 # find forks of a project
7817                 my $filter = $project;
7818                 $filter =~ s/\.git$//;
7819                 @forklist = git_get_projects_list($filter);
7820                 # filter out forks of forks
7821                 @forklist = filter_forks_from_projects_list(\@forklist)
7822                         if (@forklist);
7823         }
7824
7825         git_header_html();
7826         git_print_page_nav('summary','', $head);
7827
7828         if ($check_forks and $project =~ m#/#) {
7829                 my $xproject = $project; $xproject =~ s#/[^/]+$#.git#; #
7830                 if (is_valid_project($xproject)) {
7831                         my $r = $cgi->a({-href=> href(project => $xproject, action => 'summary')}, $xproject);
7832                         print <<EOT;
7833 <div class="forkinfo">
7834 This project is a fork of the $r project. If you have that one
7835 already cloned locally, you can use
7836 <pre>git clone --reference /path/to/your/$xproject/incarnation mirror_URL</pre>
7837 to save bandwidth during cloning.
7838 </div>
7839 EOT
7840                 }
7841         }
7842
7843         print "<div class=\"title\">&#160;</div>\n";
7844         print "<table class=\"projects_list\">\n" .
7845               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7846         if ($homepage) {
7847                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7848         }
7849         if ($base_url) {
7850                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7851         }
7852         if ($owner and not $omit_owner) {
7853                 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . ($owner_link_hook
7854                         ? $cgi->a({-href => $owner_link_hook->($owner)}, email_obfuscate($owner))
7855                         : email_obfuscate($owner)) . "</td></tr>\n";
7856         }
7857         if (defined $cd{'rfc2822'}) {
7858                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7859                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7860         }
7861         print format_lastrefresh_row(), "\n";
7862
7863         # use per project git URL list in $projectroot/$project/cloneurl
7864         # or make project git URL from git base URL and project name
7865         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7866         my $url_class = "metadata_url";
7867         my @url_list = git_get_project_url_list($project);
7868         unless (@url_list) {
7869                 @url_list = @git_base_url_list;
7870                 if ((git_get_project_config("showpush", '--bool')||'false') eq "true" ||
7871                     -f "$projectroot/$project/.nofetch") {
7872                         my $pushidx = @url_list;
7873                         foreach (@git_base_push_urls) {
7874                                 if ($https_hint_html && !ref($_) && $_ =~ /^https:/i) {
7875                                         push(@url_list, [$_, $https_hint_html]);
7876                                 } else {
7877                                         push(@url_list, $_);
7878                                 }
7879                         }
7880                         if ($#url_list >= $pushidx) {
7881                                 my $pushtag = "push&#160;URL";
7882                                 my $classtag = "metadata_pushurl";
7883                                 if (ref($url_list[$pushidx])) {
7884                                         $url_list[$pushidx] = [
7885                                                 ${$url_list[$pushidx]}[0],
7886                                                 ${$url_list[$pushidx]}[1],
7887                                                 $pushtag,
7888                                                 $classtag];
7889                                 } else {
7890                                         $url_list[$pushidx] = [
7891                                                 $url_list[$pushidx],
7892                                                 undef,
7893                                                 $pushtag,
7894                                                 $classtag];
7895                                 }
7896                         }
7897                 } else {
7898                         push(@url_list, @git_base_mirror_urls);
7899                 }
7900                 for (my $i=0; $i<=$#url_list; ++$i) {
7901                         if (ref($url_list[$i])) {
7902                                 $url_list[$i] = [
7903                                         ${$url_list[$i]}[0] . "/$project",
7904                                         ${$url_list[$i]}[1],
7905                                         ${$url_list[$i]}[2],
7906                                         ${$url_list[$i]}[3]];
7907                         } else {
7908                                 $url_list[$i] .= "/$project";
7909                         }
7910                 }
7911         }
7912         foreach (@url_list) {
7913                 next unless $_;
7914                 my $git_url;
7915                 my $html_hint = "";
7916                 my $next_tag = undef;
7917                 my $next_class = undef;
7918                 if (ref($_)) {
7919                         $git_url = $$_[0];
7920                         $html_hint = "&#160;" . $$_[1] if defined($$_[1]);
7921                         $next_tag = $$_[2];
7922                         $next_class = $$_[3];
7923                 } else {
7924                         $git_url = $_;
7925                 }
7926                 next unless $git_url;
7927                 $url_class = $next_class if $next_class;
7928                 $url_tag = $next_tag if $next_tag;
7929                 print "<tr class=\"$url_class\"><td>$url_tag</td><td>$git_url$html_hint</td></tr>\n";
7930                 $url_tag = "";
7931         }
7932
7933         if (defined($git_base_bundles_url) && -d "$projectroot/$project/bundles") {
7934                 my $projname = $project;
7935                 $projname =~ s|^.*/||;
7936                 my $url = "$git_base_bundles_url/$project/bundles";
7937                 print format_repo_url(
7938                         "bundle&#160;info",
7939                         "<a rel='nofollow' href='$url'>$projname downloadable bundles</a>");
7940         }
7941
7942         # Tag cloud
7943         my $show_ctags = gitweb_check_feature('ctags');
7944         if ($show_ctags) {
7945                 my $ctags = git_get_project_ctags($project);
7946                 if (%$ctags || $show_ctags !~ /^\d+$/) {
7947                         # without ability to add tags, don't show if there are none
7948                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7949                         print "<tr id=\"metadata_ctags\">" .
7950                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
7951                         print "</td>\n<td>" unless %$ctags;
7952                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
7953                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
7954                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
7955                               unless $show_ctags =~ /^\d+$/;
7956                         print "</td>\n<td>" if %$ctags;
7957                         print git_show_project_tagcloud($cloud, 48)."</td>" .
7958                               "</tr>\n";
7959                 }
7960         }
7961
7962         print "</table>\n";
7963
7964         # If XSS prevention is on, we don't include README.html.
7965         # TODO: Allow a readme in some safe format.
7966         if (!$prevent_xss) {
7967                 my $readme_name = "readme";
7968                 my $readme;
7969                 if (-s "$projectroot/$project/README.html") {
7970                         $readme = collect_html_file("$projectroot/$project/README.html");
7971                 } else {
7972                         $readme = collect_output($git_automatic_readme_html, "$projectroot/$project");
7973                         if ($readme && $readme =~ /^<!-- README NAME: ((?:[^-]|(?:-(?!-)))+) -->/) {
7974                                 $readme_name = $1;
7975                                 $readme =~ s/^<!--(?:[^-]|(?:-(?!-)))*-->\n?//;
7976                         }
7977                 }
7978                 if (defined($readme)) {
7979                         $readme =~ s/^\s+//s;
7980                         $readme =~ s/\s+$//s;
7981                         print "<div class=\"title\">$readme_name</div>\n",
7982                               "<div class=\"readme\">\n",
7983                               $readme,
7984                               "\n</div>\n"
7985                         if $readme ne '';
7986                 }
7987         }
7988
7989         # we need to request one more than 16 (0..15) to check if
7990         # those 16 are all
7991         my @commitlist = $head ? parse_commits($head, 17) : ();
7992         if (@commitlist) {
7993                 git_print_header_div('shortlog');
7994                 git_shortlog_body(\@commitlist, 0, 15, $refs,
7995                                   $#commitlist <=  15 ? undef :
7996                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
7997         }
7998
7999         if (@taglist) {
8000                 git_print_header_div('tags');
8001                 git_tags_body(\@taglist, 0, 15,
8002                               $#taglist <=  15 ? undef :
8003                               $cgi->a({-href => href(action=>"tags")}, "..."));
8004         }
8005
8006         if (@headlist) {
8007                 git_print_header_div('heads');
8008                 git_heads_body(\@headlist, $head, 0, 15,
8009                                $#headlist <= 15 ? undef :
8010                                $cgi->a({-href => href(action=>"heads")}, "..."));
8011         }
8012
8013         if (%remotedata) {
8014                 git_print_header_div('remotes');
8015                 git_remotes_body(\%remotedata, 15, $head);
8016         }
8017
8018         if (@forklist) {
8019                 git_print_header_div('forks');
8020                 git_project_list_body(\@forklist, 'age', 0, 15,
8021                                       $#forklist <= 15 ? undef :
8022                                       $cgi->a({-href => href(action=>"forks")}, "..."),
8023                                       'no_header', 'forks');
8024         }
8025
8026         git_footer_html();
8027 }
8028
8029 sub git_tag {
8030         my %tag = parse_tag($hash);
8031
8032         if (! %tag) {
8033                 die_error(404, "Unknown tag object");
8034         }
8035
8036         my $fullhash;
8037         $fullhash = $hash if $hash =~ m/^[0-9a-fA-F]{40}$/;
8038         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8039
8040         my $obj = $tag{'object'};
8041         git_header_html();
8042         if ($tag{'type'} eq 'commit') {
8043                 git_print_page_nav('','', $obj,undef,$obj);
8044                 git_print_header_div('commit', esc_html($tag{'name'}), $hash);
8045         } else {
8046                 if ($tag{'type'} eq 'tree') {
8047                         git_print_page_nav('',['commit','commitdiff'], undef,undef,$obj);
8048                 } else {
8049                         git_print_page_nav('',['commit','commitdiff','tree'], undef,undef,undef);
8050                 }
8051                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8052         }
8053         print "<div class=\"title_text\">\n" .
8054               "<table class=\"object_header\">\n" .
8055               "<tr><td>tag</td><td class=\"sha1\">$fullhash</td></tr>\n" .
8056               "<tr>\n" .
8057               "<td>object</td>\n" .
8058               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
8059                                $tag{'object'}) . "</td>\n" .
8060               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
8061                                               $tag{'type'}) . "</td>\n" .
8062               "</tr>\n";
8063         if (defined($tag{'author'})) {
8064                 git_print_authorship_rows(\%tag, 'author');
8065         }
8066         print "</table>\n\n" .
8067               "</div>\n";
8068         print "<div class=\"page_body\">";
8069         my $comment = $tag{'comment'};
8070         foreach my $line (@$comment) {
8071                 chomp $line;
8072                 print esc_html($line, -nbsp=>1) . "<br/>\n";
8073         }
8074         print "</div>\n";
8075         git_footer_html();
8076 }
8077
8078 sub git_blame_common {
8079         my $format = shift || 'porcelain';
8080         if ($format eq 'porcelain' && $input_params{'javascript'}) {
8081                 $format = 'incremental';
8082                 $action = 'blame_incremental'; # for page title etc
8083         }
8084
8085         # permissions
8086         gitweb_check_feature('blame')
8087                 or die_error(403, "Blame view not allowed");
8088
8089         # error checking
8090         die_error(400, "No file name given") unless $file_name;
8091         $hash_base ||= git_get_head_hash($project);
8092         die_error(404, "Couldn't find base commit") unless $hash_base;
8093         my %co = parse_commit($hash_base)
8094                 or die_error(404, "Commit not found");
8095         my $ftype = "blob";
8096         if (!defined $hash) {
8097                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
8098                         or die_error(404, "Error looking up file");
8099         } else {
8100                 $ftype = git_get_type($hash);
8101                 if ($ftype !~ "blob") {
8102                         die_error(400, "Object is not a blob");
8103                 }
8104         }
8105
8106         my $fd;
8107         if ($format eq 'incremental') {
8108                 # get file contents (as base)
8109                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
8110                         or die_error(500, "Open git-cat-file failed");
8111         } elsif ($format eq 'data') {
8112                 # run git-blame --incremental
8113                 defined($fd = git_cmd_pipe "blame", "--incremental",
8114                         $hash_base, "--", $file_name)
8115                         or die_error(500, "Open git-blame --incremental failed");
8116         } else {
8117                 # run git-blame --porcelain
8118                 defined($fd = git_cmd_pipe "blame", '-p',
8119                         $hash_base, '--', $file_name)
8120                         or die_error(500, "Open git-blame --porcelain failed");
8121         }
8122
8123         # incremental blame data returns early
8124         if ($format eq 'data') {
8125                 print $cgi->header(
8126                         -type=>"text/plain", -charset => "utf-8",
8127                         -status=> "200 OK");
8128                 local $| = 1; # output autoflush
8129                 while (<$fd>) {
8130                         print to_utf8($_);
8131                 }
8132                 close $fd
8133                         or print "ERROR $!\n";
8134
8135                 print 'END';
8136                 if (defined $t0 && gitweb_check_feature('timed')) {
8137                         print ' '.
8138                               tv_interval($t0, [ gettimeofday() ]).
8139                               ' '.$number_of_git_cmds;
8140                 }
8141                 print "\n";
8142
8143                 return;
8144         }
8145
8146         # page header
8147         git_header_html();
8148         my $formats_nav =
8149                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
8150                         "blob");
8151         $formats_nav .=
8152                 " | " .
8153                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8154                         "history") .
8155                 " | " .
8156                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
8157                         "HEAD");
8158         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8159         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8160         git_print_page_path($file_name, $ftype, $hash_base);
8161
8162         # page body
8163         if ($format eq 'incremental') {
8164                 print "<noscript>\n<div class=\"error\"><center><b>\n".
8165                       "This page requires JavaScript to run.\n Use ".
8166                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
8167                               'this page').
8168                       " instead.\n".
8169                       "</b></center></div>\n</noscript>\n";
8170
8171                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
8172         }
8173
8174         print qq!<div class="page_body">\n!;
8175         print qq!<div id="progress_info">... / ...</div>\n!
8176                 if ($format eq 'incremental');
8177         print qq!<table id="blame_table" class="blame" width="100%">\n!.
8178               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
8179               qq!<thead>\n!.
8180               qq!<tr><th nowrap="nowrap" style="white-space:nowrap">!.
8181               qq!Commit&#160;<a href="javascript:extra_blame_columns()" id="columns_expander" !.
8182               qq!title="toggles blame author information display">[+]</a></th>!.
8183               qq!<th class="extra_column">Author</th><th class="extra_column">Date</th>!.
8184               qq!<th>Line</th><th width="100%">Data</th></tr>\n!.
8185               qq!</thead>\n!.
8186               qq!<tbody>\n!;
8187
8188         my @rev_color = qw(light dark);
8189         my $num_colors = scalar(@rev_color);
8190         my $current_color = 0;
8191
8192         if ($format eq 'incremental') {
8193                 my $color_class = $rev_color[$current_color];
8194
8195                 #contents of a file
8196                 my $linenr = 0;
8197         LINE:
8198                 while (my $line = to_utf8(scalar <$fd>)) {
8199                         chomp $line;
8200                         $linenr++;
8201
8202                         print qq!<tr id="l$linenr" class="$color_class">!.
8203                               qq!<td class="sha1"><a href=""> </a></td>!.
8204                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8205                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8206                               qq!<td class="linenr">!.
8207                               qq!<a class="linenr" href="">$linenr</a></td>!;
8208                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
8209                         print qq!</tr>\n!;
8210                 }
8211
8212         } else { # porcelain, i.e. ordinary blame
8213                 my %metainfo = (); # saves information about commits
8214
8215                 # blame data
8216         LINE:
8217                 while (my $line = to_utf8(scalar <$fd>)) {
8218                         chomp $line;
8219                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
8220                         # no <lines in group> for subsequent lines in group of lines
8221                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
8222                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
8223                         if (!exists $metainfo{$full_rev}) {
8224                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
8225                         }
8226                         my $meta = $metainfo{$full_rev};
8227                         my $data;
8228                         while ($data = to_utf8(scalar <$fd>)) {
8229                                 chomp $data;
8230                                 last if ($data =~ s/^\t//); # contents of line
8231                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
8232                                         $meta->{$1} = $2 unless exists $meta->{$1};
8233                                 }
8234                                 if ($data =~ /^previous /) {
8235                                         $meta->{'nprevious'}++;
8236                                 }
8237                         }
8238                         my $short_rev = substr($full_rev, 0, 8);
8239                         my $author = $meta->{'author'};
8240                         my %date =
8241                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
8242                         my $date = $date{'iso-tz'};
8243                         if ($group_size) {
8244                                 $current_color = ($current_color + 1) % $num_colors;
8245                         }
8246                         my $tr_class = $rev_color[$current_color];
8247                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
8248                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
8249                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
8250                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
8251                         if ($group_size) {
8252                                 my $rowspan = $group_size > 1 ? " rowspan=\"$group_size\"" : "";
8253                                 print "<td class=\"sha1\"";
8254                                 print " title=\"". esc_html($author) . ", $date\"";
8255                                 print "$rowspan>";
8256                                 print $cgi->a({-href => href(action=>"commit",
8257                                                              hash=>$full_rev,
8258                                                              file_name=>$file_name)},
8259                                               esc_html($short_rev));
8260                                 if ($group_size >= 2) {
8261                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
8262                                         if (@author_initials) {
8263                                                 print "<br />" .
8264                                                       esc_html(join('', @author_initials));
8265                                                 #           or join('.', ...)
8266                                         }
8267                                 }
8268                                 print "</td>\n";
8269                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". esc_html($author) . "</td>";
8270                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". $date . "</td>";
8271                         }
8272                         # 'previous' <sha1 of parent commit> <filename at commit>
8273                         if (exists $meta->{'previous'} &&
8274                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
8275                                 $meta->{'parent'} = $1;
8276                                 $meta->{'file_parent'} = unquote($2);
8277                         }
8278                         my $linenr_commit =
8279                                 exists($meta->{'parent'}) ?
8280                                 $meta->{'parent'} : $full_rev;
8281                         my $linenr_filename =
8282                                 exists($meta->{'file_parent'}) ?
8283                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
8284                         my $blamed = href(action => 'blame',
8285                                           file_name => $linenr_filename,
8286                                           hash_base => $linenr_commit);
8287                         print "<td class=\"linenr\">";
8288                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
8289                                         -class => "linenr" },
8290                                       esc_html($lineno));
8291                         print "</td>";
8292                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
8293                         print "</tr>\n";
8294                 } # end while
8295
8296         }
8297
8298         # footer
8299         print "</tbody>\n".
8300               "</table>\n"; # class="blame"
8301         print "</div>\n";   # class="blame_body"
8302         close $fd
8303                 or print "Reading blob failed\n";
8304
8305         git_footer_html();
8306 }
8307
8308 sub git_blame {
8309         git_blame_common();
8310 }
8311
8312 sub git_blame_incremental {
8313         git_blame_common('incremental');
8314 }
8315
8316 sub git_blame_data {
8317         git_blame_common('data');
8318 }
8319
8320 sub git_tags {
8321         my $head = git_get_head_hash($project);
8322         git_header_html();
8323         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
8324         git_print_header_div('summary', $project);
8325
8326         my @tagslist = git_get_tags_list();
8327         if (@tagslist) {
8328                 git_tags_body(\@tagslist);
8329         }
8330         git_footer_html();
8331 }
8332
8333 sub git_refs {
8334         my $order = $input_params{'order'};
8335         if (defined $order && $order !~ m/age|name/) {
8336                 die_error(400, "Unknown order parameter");
8337         }
8338
8339         my $head = git_get_head_hash($project);
8340         git_header_html();
8341         git_print_page_nav('','', $head,undef,$head,format_ref_views('refs'));
8342         git_print_header_div('summary', $project);
8343
8344         my @refslist = git_get_tags_list(undef, 1, $order);
8345         if (@refslist) {
8346                 git_tags_body(\@refslist, undef, undef, undef, $head, 1, $order);
8347         }
8348         git_footer_html();
8349 }
8350
8351 sub git_heads {
8352         my $head = git_get_head_hash($project);
8353         git_header_html();
8354         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
8355         git_print_header_div('summary', $project);
8356
8357         my @headslist = git_get_heads_list();
8358         if (@headslist) {
8359                 git_heads_body(\@headslist, $head);
8360         }
8361         git_footer_html();
8362 }
8363
8364 # used both for single remote view and for list of all the remotes
8365 sub git_remotes {
8366         gitweb_check_feature('remote_heads')
8367                 or die_error(403, "Remote heads view is disabled");
8368
8369         my $head = git_get_head_hash($project);
8370         my $remote = $input_params{'hash'};
8371
8372         my $remotedata = git_get_remotes_list($remote);
8373         die_error(500, "Unable to get remote information") unless defined $remotedata;
8374
8375         unless (%$remotedata) {
8376                 die_error(404, defined $remote ?
8377                         "Remote $remote not found" :
8378                         "No remotes found");
8379         }
8380
8381         git_header_html(undef, undef, -action_extra => $remote);
8382         git_print_page_nav('', '',  $head, undef, $head,
8383                 format_ref_views($remote ? '' : 'remotes'));
8384
8385         fill_remote_heads($remotedata);
8386         if (defined $remote) {
8387                 git_print_header_div('remotes', "$remote remote for $project");
8388                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
8389         } else {
8390                 git_print_header_div('summary', "$project remotes");
8391                 git_remotes_body($remotedata, undef, $head);
8392         }
8393
8394         git_footer_html();
8395 }
8396
8397 sub git_blob_plain {
8398         my $type = shift;
8399         my $expires;
8400
8401         if (!defined $hash) {
8402                 if (defined $file_name) {
8403                         my $base = $hash_base || git_get_head_hash($project);
8404                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8405                                 or die_error(404, "Cannot find file");
8406                 } else {
8407                         die_error(400, "No file name defined");
8408                 }
8409         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8410                 # blobs defined by non-textual hash id's can be cached
8411                 $expires = "+1d";
8412         }
8413
8414         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8415                 or die_error(500, "Open git-cat-file blob '$hash' failed");
8416         binmode($fd);
8417
8418         # content-type (can include charset)
8419         my $leader;
8420         ($type, $leader) = blob_contenttype($fd, $file_name, $type);
8421
8422         # "save as" filename, even when no $file_name is given
8423         my $save_as = "$hash";
8424         if (defined $file_name) {
8425                 $save_as = $file_name;
8426         } elsif ($type =~ m/^text\//) {
8427                 $save_as .= '.txt';
8428         }
8429
8430         # With XSS prevention on, blobs of all types except a few known safe
8431         # ones are served with "Content-Disposition: attachment" to make sure
8432         # they don't run in our security domain.  For certain image types,
8433         # blob view writes an <img> tag referring to blob_plain view, and we
8434         # want to be sure not to break that by serving the image as an
8435         # attachment (though Firefox 3 doesn't seem to care).
8436         my $sandbox = $prevent_xss &&
8437                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
8438
8439         # serve text/* as text/plain
8440         if ($prevent_xss &&
8441             ($type =~ m!^text/[a-z]+\b(.*)$! ||
8442              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
8443                 my $rest = $1;
8444                 $rest = defined $rest ? $rest : '';
8445                 $type = "text/plain$rest";
8446         }
8447
8448         print $cgi->header(
8449                 -type => $type,
8450                 -expires => $expires,
8451                 -content_disposition =>
8452                         ($sandbox ? 'attachment' : 'inline')
8453                         . '; filename="' . $save_as . '"');
8454         binmode STDOUT, ':raw';
8455         $fcgi_raw_mode = 1;
8456         print $leader if defined $leader;
8457         my $buf;
8458         while (read($fd, $buf, 32768)) {
8459                 print $buf;
8460         }
8461         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8462         $fcgi_raw_mode = 0;
8463         close $fd;
8464 }
8465
8466 sub git_blob {
8467         my $expires;
8468
8469         if (!defined $hash) {
8470                 if (defined $file_name) {
8471                         my $base = $hash_base || git_get_head_hash($project);
8472                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8473                                 or die_error(404, "Cannot find file");
8474                 } else {
8475                         die_error(400, "No file name defined");
8476                 }
8477         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8478                 # blobs defined by non-textual hash id's can be cached
8479                 $expires = "+1d";
8480         }
8481         my $fullhash = git_get_full_hash($project, "$hash^{blob}");
8482         die_error(404, "No such blob") unless defined($fullhash);
8483
8484         my $have_blame = gitweb_check_feature('blame');
8485         defined(my $fd = git_cmd_pipe "cat-file", "blob", $fullhash)
8486                 or die_error(500, "Couldn't cat $file_name, $hash");
8487         binmode($fd);
8488         my $mimetype = blob_mimetype($fd, $file_name);
8489         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
8490         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
8491                 close $fd;
8492                 return git_blob_plain($mimetype);
8493         }
8494         # we can have blame only for text/* mimetype
8495         $have_blame &&= ($mimetype =~ m!^text/!);
8496
8497         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
8498         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
8499         my $highlight_mode_active;
8500         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
8501
8502         git_header_html(undef, $expires);
8503         my $formats_nav = '';
8504         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8505                 if (defined $file_name) {
8506                         if ($have_blame) {
8507                                 $formats_nav .=
8508                                         $cgi->a({-href => href(action=>"blame", -replay=>1),
8509                                                 -class => "blamelink"},
8510                                                 "blame") .
8511                                         " | ";
8512                         }
8513                         $formats_nav .=
8514                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8515                                         "history") .
8516                                 " | " .
8517                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8518                                         "raw") .
8519                                 " | " .
8520                                 $cgi->a({-href => href(action=>"blob",
8521                                                        hash_base=>"HEAD", file_name=>$file_name)},
8522                                         "HEAD");
8523                 } else {
8524                         $formats_nav .=
8525                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8526                                         "raw");
8527                 }
8528                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8529                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8530         } else {
8531                 git_print_page_nav('',['commit','commitdiff','tree'], undef,undef,undef);
8532                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8533         }
8534         git_print_page_path($file_name, "blob", $hash_base);
8535         print "<div class=\"title_text\">\n" .
8536               "<table class=\"object_header\">\n";
8537         print "<tr><td>blob</td><td class=\"sha1\">$fullhash</td></tr>\n";
8538         print "</table>".
8539               "</div>\n";
8540         print "<div class=\"page_body\">\n";
8541         if ($mimetype =~ m!^image/!) {
8542                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
8543                 if ($file_name) {
8544                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
8545                 }
8546                 print qq! src="! .
8547                       href(action=>"blob_plain", hash=>$hash,
8548                            hash_base=>$hash_base, file_name=>$file_name) .
8549                       qq!" />\n!;
8550                 close $fd; # ignore likely EPIPE error from child
8551         } else {
8552                 my $nr;
8553                 while (my $line = to_utf8(scalar <$fd>)) {
8554                         chomp $line;
8555                         $nr++;
8556                         $line = untabify($line);
8557                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i </a>%s</div>\n!,
8558                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
8559                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
8560                 }
8561                 close $fd
8562                         or print "Reading blob failed.\n";
8563         }
8564         print "</div>";
8565         git_footer_html();
8566 }
8567
8568 sub git_tree {
8569         if (!defined $hash_base) {
8570                 $hash_base = "HEAD";
8571         }
8572         if (!defined $hash) {
8573                 if (defined $file_name) {
8574                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
8575                 } else {
8576                         $hash = $hash_base;
8577                 }
8578         }
8579         die_error(404, "No such tree") unless defined($hash);
8580         my $fullhash = git_get_full_hash($project, "$hash^{tree}");
8581         die_error(404, "No such tree") unless defined($fullhash);
8582
8583         my $show_sizes = gitweb_check_feature('show-sizes');
8584         my $have_blame = gitweb_check_feature('blame');
8585
8586         my @entries = ();
8587         {
8588                 local $/ = "\0";
8589                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
8590                         ($show_sizes ? '-l' : ()), @extra_options, $fullhash)
8591                         or die_error(500, "Open git-ls-tree failed");
8592                 @entries = map { chomp; to_utf8($_) } <$fd>;
8593                 close $fd
8594                         or die_error(404, "Reading tree failed");
8595         }
8596
8597         git_header_html();
8598         my $basedir = '';
8599         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8600                 my $refs = git_get_references();
8601                 my $ref = format_ref_marker($refs, $co{'id'});
8602                 my @views_nav = ();
8603                 if (defined $file_name) {
8604                         push @views_nav,
8605                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8606                                         "history"),
8607                                 $cgi->a({-href => href(action=>"tree",
8608                                                        hash_base=>"HEAD", file_name=>$file_name)},
8609                                         "HEAD"),
8610                 }
8611                 my $snapshot_links = format_snapshot_links($hash);
8612                 if (defined $snapshot_links) {
8613                         # FIXME: Should be available when we have no hash base as well.
8614                         push @views_nav, $snapshot_links;
8615                 }
8616                 git_print_page_nav('tree','', $hash_base, undef, undef,
8617                                    join(' | ', @views_nav));
8618                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base, undef, $ref);
8619         } else {
8620                 git_print_page_nav('tree',['commit','commitdiff'], undef,undef,$hash_base);
8621                 undef $hash_base;
8622                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8623         }
8624         if (defined $file_name) {
8625                 $basedir = $file_name;
8626                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
8627                         $basedir .= '/';
8628                 }
8629                 git_print_page_path($file_name, 'tree', $hash_base);
8630         }
8631         print "<div class=\"title_text\">\n" .
8632               "<table class=\"object_header\">\n";
8633         print "<tr><td>tree</td><td class=\"sha1\">$fullhash</td></tr>\n";
8634         print "</table>".
8635               "</div>\n";
8636         print "<div class=\"page_body\">\n";
8637         print "<table class=\"tree\">\n";
8638         my $alternate = 1;
8639         # '..' (top directory) link if possible
8640         if (defined $hash_base &&
8641             defined $file_name && $file_name =~ m![^/]+$!) {
8642                 if ($alternate) {
8643                         print "<tr class=\"dark\">\n";
8644                 } else {
8645                         print "<tr class=\"light\">\n";
8646                 }
8647                 $alternate ^= 1;
8648
8649                 my $up = $file_name;
8650                 $up =~ s!/?[^/]+$!!;
8651                 undef $up unless $up;
8652                 # based on git_print_tree_entry
8653                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
8654                 print '<td class="size">&#160;</td>'."\n" if $show_sizes;
8655                 print '<td class="list">';
8656                 print $cgi->a({-href => href(action=>"tree",
8657                                              hash_base=>$hash_base,
8658                                              file_name=>$up)},
8659                               "..");
8660                 print "</td>\n";
8661                 print "<td class=\"link\"></td>\n";
8662
8663                 print "</tr>\n";
8664         }
8665         foreach my $line (@entries) {
8666                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
8667
8668                 if ($alternate) {
8669                         print "<tr class=\"dark\">\n";
8670                 } else {
8671                         print "<tr class=\"light\">\n";
8672                 }
8673                 $alternate ^= 1;
8674
8675                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
8676
8677                 print "</tr>\n";
8678         }
8679         print "</table>\n" .
8680               "</div>";
8681         git_footer_html();
8682 }
8683
8684 sub sanitize_for_filename {
8685     my $name = shift;
8686
8687     $name =~ s!/!-!g;
8688     $name =~ s/[^[:alnum:]_.-]//g;
8689
8690     return $name;
8691 }
8692
8693 sub snapshot_name {
8694         my ($project, $hash) = @_;
8695
8696         # path/to/project.git  -> project
8697         # path/to/project/.git -> project
8698         my $name = to_utf8($project);
8699         $name =~ s,([^/])/*\.git$,$1,;
8700         $name = sanitize_for_filename(basename($name));
8701
8702         my $ver = $hash;
8703         if ($hash =~ /^[0-9a-fA-F]+$/) {
8704                 # shorten SHA-1 hash
8705                 my $full_hash = git_get_full_hash($project, $hash);
8706                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
8707                         $ver = git_get_short_hash($project, $hash);
8708                 }
8709         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
8710                 # tags don't need shortened SHA-1 hash
8711                 $ver = $1;
8712         } else {
8713                 # branches and other need shortened SHA-1 hash
8714                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
8715                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
8716                         my $ref_dir = (defined $1) ? $1 : '';
8717                         $ver = $2;
8718
8719                         $ref_dir = sanitize_for_filename($ref_dir);
8720                         # for refs neither in heads nor remotes we want to
8721                         # add a ref dir to archive name
8722                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
8723                                 $ver = $ref_dir . '-' . $ver;
8724                         }
8725                 }
8726                 $ver .= '-' . git_get_short_hash($project, $hash);
8727         }
8728         # special case of sanitization for filename - we change
8729         # slashes to dots instead of dashes
8730         # in case of hierarchical branch names
8731         $ver =~ s!/!.!g;
8732         $ver =~ s/[^[:alnum:]_.-]//g;
8733
8734         # name = project-version_string
8735         $name = "$name-$ver";
8736
8737         return wantarray ? ($name, $name) : $name;
8738 }
8739
8740 sub exit_if_unmodified_since {
8741         my ($latest_epoch) = @_;
8742         our $cgi;
8743
8744         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
8745         if (defined $if_modified) {
8746                 my $since;
8747                 if (eval { require HTTP::Date; 1; }) {
8748                         $since = HTTP::Date::str2time($if_modified);
8749                 } elsif (eval { require Time::ParseDate; 1; }) {
8750                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
8751                 }
8752                 if (defined $since && $latest_epoch <= $since) {
8753                         my %latest_date = parse_date($latest_epoch);
8754                         print $cgi->header(
8755                                 -last_modified => $latest_date{'rfc2822'},
8756                                 -status => '304 Not Modified');
8757                         CORE::die;
8758                 }
8759         }
8760 }
8761
8762 sub git_snapshot {
8763         my $format = $input_params{'snapshot_format'};
8764         if (!@snapshot_fmts) {
8765                 die_error(403, "Snapshots not allowed");
8766         }
8767         # default to first supported snapshot format
8768         $format ||= $snapshot_fmts[0];
8769         if ($format !~ m/^[a-z0-9]+$/) {
8770                 die_error(400, "Invalid snapshot format parameter");
8771         } elsif (!exists($known_snapshot_formats{$format})) {
8772                 die_error(400, "Unknown snapshot format");
8773         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
8774                 die_error(403, "Snapshot format not allowed");
8775         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
8776                 die_error(403, "Unsupported snapshot format");
8777         }
8778
8779         my $type = git_get_type("$hash^{}");
8780         if (!$type) {
8781                 die_error(404, 'Object does not exist');
8782         }  elsif ($type eq 'blob') {
8783                 die_error(400, 'Object is not a tree-ish');
8784         }
8785
8786         my ($name, $prefix) = snapshot_name($project, $hash);
8787         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
8788
8789         my %co = parse_commit($hash);
8790         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
8791
8792         my @cmd = (
8793                 git_cmd(), 'archive',
8794                 "--format=$known_snapshot_formats{$format}{'format'}",
8795                 "--prefix=$prefix/", $hash);
8796         if (exists $known_snapshot_formats{$format}{'compressor'}) {
8797                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
8798                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
8799         }
8800
8801         $filename =~ s/(["\\])/\\$1/g;
8802         my %latest_date;
8803         if (%co) {
8804                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
8805         }
8806
8807         print $cgi->header(
8808                 -type => $known_snapshot_formats{$format}{'type'},
8809                 -content_disposition => 'inline; filename="' . $filename . '"',
8810                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8811                 -status => '200 OK');
8812
8813         defined(my $fd = cmd_pipe @cmd)
8814                 or die_error(500, "Execute git-archive failed");
8815         binmode($fd);
8816         binmode STDOUT, ':raw';
8817         $fcgi_raw_mode = 1;
8818         my $buf;
8819         while (read($fd, $buf, 32768)) {
8820                 print $buf;
8821         }
8822         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8823         $fcgi_raw_mode = 0;
8824         close $fd;
8825 }
8826
8827 sub git_log_generic {
8828         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8829
8830         my $head = git_get_head_hash($project);
8831         if (!defined $base) {
8832                 $base = $head;
8833         }
8834         if (!defined $page) {
8835                 $page = 0;
8836         }
8837         my $refs = git_get_references();
8838
8839         my $commit_hash = $base;
8840         if (defined $parent) {
8841                 $commit_hash = "$parent..$base";
8842         }
8843         my @commitlist =
8844                 parse_commits($commit_hash, 101, (100 * $page),
8845                               defined $file_name ? ($file_name, "--full-history") : ());
8846
8847         my $ftype;
8848         if (!defined $file_hash && defined $file_name) {
8849                 # some commits could have deleted file in question,
8850                 # and not have it in tree, but one of them has to have it
8851                 for (my $i = 0; $i < @commitlist; $i++) {
8852                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8853                         last if defined $file_hash;
8854                 }
8855         }
8856         if (defined $file_hash) {
8857                 $ftype = git_get_type($file_hash);
8858         }
8859         if (defined $file_name && !defined $ftype) {
8860                 die_error(500, "Unknown type of object");
8861         }
8862         my %co;
8863         if (defined $file_name) {
8864                 %co = parse_commit($base)
8865                         or die_error(404, "Unknown commit object");
8866         }
8867
8868
8869         my $paging_nav = format_log_nav($fmt_name, $page, $#commitlist >= 100);
8870         my $next_link = '';
8871         if ($#commitlist >= 100) {
8872                 $next_link =
8873                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8874                                  -accesskey => "n", -title => "Alt-n"}, "next");
8875         }
8876         my ($patch_max) = gitweb_get_feature('patches');
8877         if ($patch_max && !defined $file_name) {
8878                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8879                         $paging_nav .= " &#183; " .
8880                                 $cgi->a({-href => href(action=>"patches", -replay=>1)},
8881                                         "patches");
8882                 }
8883         }
8884
8885         {
8886                 local $action = 'log';
8887                 git_header_html();
8888         }
8889         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8890         if (defined $file_name) {
8891                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8892         } else {
8893                 git_print_header_div('summary', $project)
8894         }
8895         git_print_page_path($file_name, $ftype, $hash_base)
8896                 if (defined $file_name);
8897
8898         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8899                      $file_name, $file_hash, $ftype);
8900
8901         git_footer_html();
8902 }
8903
8904 sub git_log {
8905         git_log_generic('log', \&git_log_body,
8906                         $hash, $hash_parent);
8907 }
8908
8909 sub git_commit {
8910         $hash ||= $hash_base || "HEAD";
8911         my %co = parse_commit($hash)
8912             or die_error(404, "Unknown commit object");
8913
8914         my $parent  = $co{'parent'};
8915         my $parents = $co{'parents'}; # listref
8916
8917         # we need to prepare $formats_nav before any parameter munging
8918         my $formats_nav;
8919         if (!defined $parent) {
8920                 # --root commitdiff
8921                 $formats_nav .= '(initial)';
8922         } elsif (@$parents == 1) {
8923                 # single parent commit
8924                 $formats_nav .=
8925                         '(parent: ' .
8926                         $cgi->a({-href => href(action=>"commit",
8927                                                hash=>$parent)},
8928                                 esc_html(substr($parent, 0, 7))) .
8929                         ')';
8930         } else {
8931                 # merge commit
8932                 $formats_nav .=
8933                         '(merge: ' .
8934                         join(' ', map {
8935                                 $cgi->a({-href => href(action=>"commit",
8936                                                        hash=>$_)},
8937                                         esc_html(substr($_, 0, 7)));
8938                         } @$parents ) .
8939                         ')';
8940         }
8941         if (gitweb_check_feature('patches') && @$parents <= 1) {
8942                 $formats_nav .= " | " .
8943                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
8944                                 "patch");
8945         }
8946
8947         if (!defined $parent) {
8948                 $parent = "--root";
8949         }
8950         my @difftree;
8951         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
8952                 @diff_opts,
8953                 (@$parents <= 1 ? $parent : '-c'),
8954                 $hash, "--")
8955                 or die_error(500, "Open git-diff-tree failed");
8956         @difftree = map { chomp; to_utf8($_) } <$fd>;
8957         close $fd or die_error(404, "Reading git-diff-tree failed");
8958
8959         # non-textual hash id's can be cached
8960         my $expires;
8961         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8962                 $expires = "+1d";
8963         }
8964         my $refs = git_get_references();
8965         my $ref = format_ref_marker($refs, $co{'id'});
8966
8967         git_header_html(undef, $expires);
8968         git_print_page_nav('commit', '',
8969                            $hash, $co{'tree'}, $hash,
8970                            $formats_nav);
8971
8972         if (defined $co{'parent'}) {
8973                 git_print_header_div('commitdiff', esc_html($co{'title'}), $hash, undef, $ref);
8974         } else {
8975                 git_print_header_div('tree', esc_html($co{'title'}), $co{'tree'}, $hash, $ref);
8976         }
8977         print "<div class=\"title_text\">\n" .
8978               "<table class=\"object_header\">\n";
8979         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
8980         git_print_authorship_rows(\%co);
8981         print "<tr>" .
8982               "<td>tree</td>" .
8983               "<td class=\"sha1\">" .
8984               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
8985                        class => "list"}, $co{'tree'}) .
8986               "</td>" .
8987               "<td class=\"link\">" .
8988               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
8989                       "tree");
8990         my $snapshot_links = format_snapshot_links($hash);
8991         if (defined $snapshot_links) {
8992                 print " | " . $snapshot_links;
8993         }
8994         print "</td>" .
8995               "</tr>\n";
8996
8997         foreach my $par (@$parents) {
8998                 print "<tr>" .
8999                       "<td>parent</td>" .
9000                       "<td class=\"sha1\">" .
9001                       $cgi->a({-href => href(action=>"commit", hash=>$par),
9002                                class => "list"}, $par) .
9003                       "</td>" .
9004                       "<td class=\"link\">" .
9005                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
9006                       " | " .
9007                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
9008                       "</td>" .
9009                       "</tr>\n";
9010         }
9011         print "</table>".
9012               "</div>\n";
9013
9014         print "<div class=\"page_body\">\n";
9015         git_print_log($co{'comment'});
9016         print "</div>\n";
9017
9018         git_difftree_body(\@difftree, $hash, @$parents);
9019
9020         git_footer_html();
9021 }
9022
9023 sub git_object {
9024         # object is defined by:
9025         # - hash or hash_base alone
9026         # - hash_base and file_name
9027         my $type;
9028
9029         # - hash or hash_base alone
9030         if ($hash || ($hash_base && !defined $file_name)) {
9031                 my $object_id = $hash || $hash_base;
9032
9033                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
9034                         or die_error(404, "Object does not exist");
9035                 $type = <$fd>;
9036                 defined $type && chomp $type;
9037                 close $fd
9038                         or die_error(404, "Object does not exist");
9039
9040         # - hash_base and file_name
9041         } elsif ($hash_base && defined $file_name) {
9042                 $file_name =~ s,/+$,,;
9043
9044                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
9045                         or die_error(404, "Base object does not exist");
9046
9047                 # here errors should not happen
9048                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
9049                         or die_error(500, "Open git-ls-tree failed");
9050                 my $line = to_utf8(scalar <$fd>);
9051                 close $fd;
9052
9053                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
9054                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
9055                         die_error(404, "File or directory for given base does not exist");
9056                 }
9057                 $type = $2;
9058                 $hash = $3;
9059         } else {
9060                 die_error(400, "Not enough information to find object");
9061         }
9062
9063         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
9064                                           hash=>$hash, hash_base=>$hash_base,
9065                                           file_name=>$file_name),
9066                              -status => '302 Found');
9067 }
9068
9069 sub git_blobdiff {
9070         my $format = shift || 'html';
9071         my $diff_style = $input_params{'diff_style'} || 'inline';
9072
9073         my $fd;
9074         my @difftree;
9075         my %diffinfo;
9076         my $expires;
9077
9078         # preparing $fd and %diffinfo for git_patchset_body
9079         # new style URI
9080         if (defined $hash_base && defined $hash_parent_base) {
9081                 if (defined $file_name) {
9082                         # read raw output
9083                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9084                                 $hash_parent_base, $hash_base,
9085                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
9086                                 or die_error(500, "Open git-diff-tree failed");
9087                         @difftree = map { chomp; to_utf8($_) } <$fd>;
9088                         close $fd
9089                                 or die_error(404, "Reading git-diff-tree failed");
9090                         @difftree
9091                                 or die_error(404, "Blob diff not found");
9092
9093                 } elsif (defined $hash &&
9094                          $hash =~ /[0-9a-fA-F]{40}/) {
9095                         # try to find filename from $hash
9096
9097                         # read filtered raw output
9098                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9099                                 $hash_parent_base, $hash_base, "--")
9100                                 or die_error(500, "Open git-diff-tree failed");
9101                         @difftree =
9102                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
9103                                 # $hash == to_id
9104                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
9105                                 map { chomp; to_utf8($_) } <$fd>;
9106                         close $fd
9107                                 or die_error(404, "Reading git-diff-tree failed");
9108                         @difftree
9109                                 or die_error(404, "Blob diff not found");
9110
9111                 } else {
9112                         die_error(400, "Missing one of the blob diff parameters");
9113                 }
9114
9115                 if (@difftree > 1) {
9116                         die_error(400, "Ambiguous blob diff specification");
9117                 }
9118
9119                 %diffinfo = parse_difftree_raw_line($difftree[0]);
9120                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
9121                 $file_name   ||= $diffinfo{'to_file'};
9122
9123                 $hash_parent ||= $diffinfo{'from_id'};
9124                 $hash        ||= $diffinfo{'to_id'};
9125
9126                 # non-textual hash id's can be cached
9127                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
9128                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
9129                         $expires = '+1d';
9130                 }
9131
9132                 # open patch output
9133                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9134                         '-p', ($format eq 'html' ? "--full-index" : ()),
9135                         $hash_parent_base, $hash_base,
9136                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
9137                         or die_error(500, "Open git-diff-tree failed");
9138         }
9139
9140         # old/legacy style URI -- not generated anymore since 1.4.3.
9141         if (!%diffinfo) {
9142                 die_error('404 Not Found', "Missing one of the blob diff parameters")
9143         }
9144
9145         # header
9146         if ($format eq 'html') {
9147                 my $formats_nav =
9148                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
9149                                 "raw");
9150                 $formats_nav .= diff_style_nav($diff_style);
9151                 git_header_html(undef, $expires);
9152                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
9153                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
9154                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
9155                 } else {
9156                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
9157                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
9158                 }
9159                 if (defined $file_name) {
9160                         git_print_page_path($file_name, "blob", $hash_base);
9161                 } else {
9162                         print "<div class=\"page_path\"></div>\n";
9163                 }
9164
9165         } elsif ($format eq 'plain') {
9166                 print $cgi->header(
9167                         -type => 'text/plain',
9168                         -charset => 'utf-8',
9169                         -expires => $expires,
9170                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
9171
9172                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9173
9174         } else {
9175                 die_error(400, "Unknown blobdiff format");
9176         }
9177
9178         # patch
9179         if ($format eq 'html') {
9180                 print "<div class=\"page_body\">\n";
9181
9182                 git_patchset_body($fd, $diff_style,
9183                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
9184                 close $fd;
9185
9186                 print "</div>\n"; # class="page_body"
9187                 git_footer_html();
9188
9189         } else {
9190                 while (my $line = to_utf8(scalar <$fd>)) {
9191                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
9192                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
9193
9194                         print $line;
9195
9196                         last if $line =~ m!^\+\+\+!;
9197                 }
9198                 while (<$fd>) {
9199                         print to_utf8($_);
9200                 }
9201                 close $fd;
9202         }
9203 }
9204
9205 sub git_blobdiff_plain {
9206         git_blobdiff('plain');
9207 }
9208
9209 # assumes that it is added as later part of already existing navigation,
9210 # so it returns "| foo | bar" rather than just "foo | bar"
9211 sub diff_style_nav {
9212         my ($diff_style, $is_combined) = @_;
9213         $diff_style ||= 'inline';
9214
9215         return "" if ($is_combined);
9216
9217         my @styles = (inline => 'inline', 'sidebyside' => 'side by side');
9218         my %styles = @styles;
9219         @styles =
9220                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
9221
9222         return join '',
9223                 map { " | ".$_ }
9224                 map {
9225                         $_ eq $diff_style ? $styles{$_} :
9226                         $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_})
9227                 } @styles;
9228 }
9229
9230 sub git_commitdiff {
9231         my %params = @_;
9232         my $format = $params{-format} || 'html';
9233         my $diff_style = $input_params{'diff_style'} || 'inline';
9234
9235         my ($patch_max) = gitweb_get_feature('patches');
9236         if ($format eq 'patch') {
9237                 die_error(403, "Patch view not allowed") unless $patch_max;
9238         }
9239
9240         $hash ||= $hash_base || "HEAD";
9241         my %co = parse_commit($hash)
9242             or die_error(404, "Unknown commit object");
9243
9244         # choose format for commitdiff for merge
9245         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
9246                 $hash_parent = '--cc';
9247         }
9248         # we need to prepare $formats_nav before almost any parameter munging
9249         my $formats_nav;
9250         if ($format eq 'html') {
9251                 $formats_nav =
9252                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
9253                                 "raw");
9254                 if ($patch_max && @{$co{'parents'}} <= 1) {
9255                         $formats_nav .= " | " .
9256                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
9257                                         "patch");
9258                 }
9259                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
9260
9261                 if (defined $hash_parent &&
9262                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
9263                         # commitdiff with two commits given
9264                         my $hash_parent_short = $hash_parent;
9265                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
9266                                 $hash_parent_short = substr($hash_parent, 0, 7);
9267                         }
9268                         $formats_nav .=
9269                                 ' (from';
9270                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
9271                                 if ($co{'parents'}[$i] eq $hash_parent) {
9272                                         $formats_nav .= ' parent ' . ($i+1);
9273                                         last;
9274                                 }
9275                         }
9276                         $formats_nav .= ': ' .
9277                                 $cgi->a({-href => href(-replay=>1,
9278                                                        hash=>$hash_parent, hash_base=>undef)},
9279                                         esc_html($hash_parent_short)) .
9280                                 ')';
9281                 } elsif (!$co{'parent'}) {
9282                         # --root commitdiff
9283                         $formats_nav .= ' (initial)';
9284                 } elsif (scalar @{$co{'parents'}} == 1) {
9285                         # single parent commit
9286                         $formats_nav .=
9287                                 ' (parent: ' .
9288                                 $cgi->a({-href => href(-replay=>1,
9289                                                        hash=>$co{'parent'}, hash_base=>undef)},
9290                                         esc_html(substr($co{'parent'}, 0, 7))) .
9291                                 ')';
9292                 } else {
9293                         # merge commit
9294                         if ($hash_parent eq '--cc') {
9295                                 $formats_nav .= ' | ' .
9296                                         $cgi->a({-href => href(-replay=>1,
9297                                                                hash=>$hash, hash_parent=>'-c')},
9298                                                 'combined');
9299                         } else { # $hash_parent eq '-c'
9300                                 $formats_nav .= ' | ' .
9301                                         $cgi->a({-href => href(-replay=>1,
9302                                                                hash=>$hash, hash_parent=>'--cc')},
9303                                                 'compact');
9304                         }
9305                         $formats_nav .=
9306                                 ' (merge: ' .
9307                                 join(' ', map {
9308                                         $cgi->a({-href => href(-replay=>1,
9309                                                                hash=>$_, hash_base=>undef)},
9310                                                 esc_html(substr($_, 0, 7)));
9311                                 } @{$co{'parents'}} ) .
9312                                 ')';
9313                 }
9314         }
9315
9316         my $hash_parent_param = $hash_parent;
9317         if (!defined $hash_parent_param) {
9318                 # --cc for multiple parents, --root for parentless
9319                 $hash_parent_param =
9320                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
9321         }
9322
9323         # read commitdiff
9324         my $fd;
9325         my @difftree;
9326         if ($format eq 'html') {
9327                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9328                         "--no-commit-id", "--patch-with-raw", "--full-index",
9329                         $hash_parent_param, $hash, "--")
9330                         or die_error(500, "Open git-diff-tree failed");
9331
9332                 while (my $line = to_utf8(scalar <$fd>)) {
9333                         chomp $line;
9334                         # empty line ends raw part of diff-tree output
9335                         last unless $line;
9336                         push @difftree, scalar parse_difftree_raw_line($line);
9337                 }
9338
9339         } elsif ($format eq 'plain') {
9340                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9341                         '-p', $hash_parent_param, $hash, "--")
9342                         or die_error(500, "Open git-diff-tree failed");
9343         } elsif ($format eq 'patch') {
9344                 # For commit ranges, we limit the output to the number of
9345                 # patches specified in the 'patches' feature.
9346                 # For single commits, we limit the output to a single patch,
9347                 # diverging from the git-format-patch default.
9348                 my @commit_spec = ();
9349                 if ($hash_parent) {
9350                         if ($patch_max > 0) {
9351                                 push @commit_spec, "-$patch_max";
9352                         }
9353                         push @commit_spec, '-n', "$hash_parent..$hash";
9354                 } else {
9355                         if ($params{-single}) {
9356                                 push @commit_spec, '-1';
9357                         } else {
9358                                 if ($patch_max > 0) {
9359                                         push @commit_spec, "-$patch_max";
9360                                 }
9361                                 push @commit_spec, "-n";
9362                         }
9363                         push @commit_spec, '--root', $hash;
9364                 }
9365                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
9366                         '--encoding=utf8', '--stdout', @commit_spec)
9367                         or die_error(500, "Open git-format-patch failed");
9368         } else {
9369                 die_error(400, "Unknown commitdiff format");
9370         }
9371
9372         # non-textual hash id's can be cached
9373         my $expires;
9374         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9375                 $expires = "+1d";
9376         }
9377
9378         # write commit message
9379         if ($format eq 'html') {
9380                 my $refs = git_get_references();
9381                 my $ref = format_ref_marker($refs, $co{'id'});
9382
9383                 git_header_html(undef, $expires);
9384                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
9385                 git_print_header_div('commit', esc_html($co{'title'}), $hash, undef, $ref);
9386                 print "<div class=\"title_text\">\n" .
9387                       "<table class=\"object_header\">\n";
9388                 git_print_authorship_rows(\%co);
9389                 print "</table>".
9390                       "</div>\n";
9391                 print "<div class=\"page_body\">\n";
9392                 if (@{$co{'comment'}} > 1) {
9393                         print "<div class=\"log\">\n";
9394                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
9395                         print "</div>\n"; # class="log"
9396                 }
9397
9398         } elsif ($format eq 'plain') {
9399                 my $refs = git_get_references("tags");
9400                 my $tagname = git_get_rev_name_tags($hash);
9401                 my $filename = basename($project) . "-$hash.patch";
9402
9403                 print $cgi->header(
9404                         -type => 'text/plain',
9405                         -charset => 'utf-8',
9406                         -expires => $expires,
9407                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9408                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
9409                 print "From: " . to_utf8($co{'author'}) . "\n";
9410                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
9411                 print "Subject: " . to_utf8($co{'title'}) . "\n";
9412
9413                 print "X-Git-Tag: $tagname\n" if $tagname;
9414                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9415
9416                 foreach my $line (@{$co{'comment'}}) {
9417                         print to_utf8($line) . "\n";
9418                 }
9419                 print "---\n\n";
9420         } elsif ($format eq 'patch') {
9421                 my $filename = basename($project) . "-$hash.patch";
9422
9423                 print $cgi->header(
9424                         -type => 'text/plain',
9425                         -charset => 'utf-8',
9426                         -expires => $expires,
9427                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9428         }
9429
9430         # write patch
9431         if ($format eq 'html') {
9432                 my $use_parents = !defined $hash_parent ||
9433                         $hash_parent eq '-c' || $hash_parent eq '--cc';
9434                 git_difftree_body(\@difftree, $hash,
9435                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9436                 print "<br/>\n";
9437
9438                 git_patchset_body($fd, $diff_style,
9439                                   \@difftree, $hash,
9440                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9441                 close $fd;
9442                 print "</div>\n"; # class="page_body"
9443                 git_footer_html();
9444
9445         } elsif ($format eq 'plain') {
9446                 while (<$fd>) {
9447                         print to_utf8($_);
9448                 }
9449                 close $fd
9450                         or print "Reading git-diff-tree failed\n";
9451         } elsif ($format eq 'patch') {
9452                 while (<$fd>) {
9453                         print to_utf8($_);
9454                 }
9455                 close $fd
9456                         or print "Reading git-format-patch failed\n";
9457         }
9458 }
9459
9460 sub git_commitdiff_plain {
9461         git_commitdiff(-format => 'plain');
9462 }
9463
9464 # format-patch-style patches
9465 sub git_patch {
9466         git_commitdiff(-format => 'patch', -single => 1);
9467 }
9468
9469 sub git_patches {
9470         git_commitdiff(-format => 'patch');
9471 }
9472
9473 sub git_history {
9474         git_log_generic('history', \&git_history_body,
9475                         $hash_base, $hash_parent_base,
9476                         $file_name, $hash);
9477 }
9478
9479 sub git_search {
9480         $searchtype ||= 'commit';
9481
9482         # check if appropriate features are enabled
9483         gitweb_check_feature('search')
9484                 or die_error(403, "Search is disabled");
9485         if ($searchtype eq 'pickaxe') {
9486                 # pickaxe may take all resources of your box and run for several minutes
9487                 # with every query - so decide by yourself how public you make this feature
9488                 gitweb_check_feature('pickaxe')
9489                         or die_error(403, "Pickaxe search is disabled");
9490         }
9491         if ($searchtype eq 'grep') {
9492                 # grep search might be potentially CPU-intensive, too
9493                 gitweb_check_feature('grep')
9494                         or die_error(403, "Grep search is disabled");
9495         }
9496         if ($search_use_regexp) {
9497                 # regular expression search can be disabled to avoid potentially
9498                 # malicious regular expressions
9499                 gitweb_check_feature('regexp')
9500                         or die_error(403, "Regular expression search is disabled");
9501         }
9502
9503         if (!defined $searchtext) {
9504                 die_error(400, "Text field is empty");
9505         }
9506         if (!defined $hash) {
9507                 $hash = git_get_head_hash($project);
9508         }
9509         my %co = parse_commit($hash);
9510         if (!%co) {
9511                 die_error(404, "Unknown commit object");
9512         }
9513         if (!defined $page) {
9514                 $page = 0;
9515         }
9516
9517         if ($searchtype eq 'commit' ||
9518             $searchtype eq 'author' ||
9519             $searchtype eq 'committer') {
9520                 git_search_message(%co);
9521         } elsif ($searchtype eq 'pickaxe') {
9522                 git_search_changes(%co);
9523         } elsif ($searchtype eq 'grep') {
9524                 git_search_files(%co);
9525         } else {
9526                 die_error(400, "Unknown search type");
9527         }
9528 }
9529
9530 sub git_search_help {
9531         git_header_html();
9532         git_print_page_nav('','', $hash,$hash,$hash);
9533         print <<EOT;
9534 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
9535 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
9536 the pattern entered is recognized as the POSIX extended
9537 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
9538 insensitive).</p>
9539 <dl>
9540 <dt><b>commit</b></dt>
9541 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
9542 EOT
9543         my $have_grep = gitweb_check_feature('grep');
9544         if ($have_grep) {
9545                 print <<EOT;
9546 <dt><b>grep</b></dt>
9547 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
9548     a different one) are searched for the given pattern. On large trees, this search can take
9549 a while and put some strain on the server, so please use it with some consideration. Note that
9550 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
9551 case-sensitive.</dd>
9552 EOT
9553         }
9554         print <<EOT;
9555 <dt><b>author</b></dt>
9556 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
9557 <dt><b>committer</b></dt>
9558 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
9559 EOT
9560         my $have_pickaxe = gitweb_check_feature('pickaxe');
9561         if ($have_pickaxe) {
9562                 print <<EOT;
9563 <dt><b>pickaxe</b></dt>
9564 <dd>All commits that caused the string to appear or disappear from any file (changes that
9565 added, removed or "modified" the string) will be listed. This search can take a while and
9566 takes a lot of strain on the server, so please use it wisely. Note that since you may be
9567 interested even in changes just changing the case as well, this search is case sensitive.</dd>
9568 EOT
9569         }
9570         print "</dl>\n";
9571         git_footer_html();
9572 }
9573
9574 sub git_shortlog {
9575         git_log_generic('shortlog', \&git_shortlog_body,
9576                         $hash, $hash_parent);
9577 }
9578
9579 ## ......................................................................
9580 ## feeds (RSS, Atom; OPML)
9581
9582 sub git_feed {
9583         my $format = shift || 'atom';
9584         my $have_blame = gitweb_check_feature('blame');
9585
9586         # Atom: http://www.atomenabled.org/developers/syndication/
9587         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
9588         if ($format ne 'rss' && $format ne 'atom') {
9589                 die_error(400, "Unknown web feed format");
9590         }
9591
9592         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
9593         my $head = $hash || 'HEAD';
9594         my @commitlist = parse_commits($head, 150, 0, $file_name);
9595
9596         my %latest_commit;
9597         my %latest_date;
9598         my $content_type = "application/$format+xml";
9599         if (defined $cgi->http('HTTP_ACCEPT') &&
9600                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
9601                 # browser (feed reader) prefers text/xml
9602                 $content_type = 'text/xml';
9603         }
9604         if (defined($commitlist[0])) {
9605                 %latest_commit = %{$commitlist[0]};
9606                 my $latest_epoch = $latest_commit{'committer_epoch'};
9607                 exit_if_unmodified_since($latest_epoch);
9608                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
9609         }
9610         print $cgi->header(
9611                 -type => $content_type,
9612                 -charset => 'utf-8',
9613                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
9614                 -status => '200 OK');
9615
9616         # Optimization: skip generating the body if client asks only
9617         # for Last-Modified date.
9618         return if ($cgi->request_method() eq 'HEAD');
9619
9620         # header variables
9621         my $title = "$site_name - $project/$action";
9622         my $feed_type = 'log';
9623         if (defined $hash) {
9624                 $title .= " - '$hash'";
9625                 $feed_type = 'branch log';
9626                 if (defined $file_name) {
9627                         $title .= " :: $file_name";
9628                         $feed_type = 'history';
9629                 }
9630         } elsif (defined $file_name) {
9631                 $title .= " - $file_name";
9632                 $feed_type = 'history';
9633         }
9634         $title .= " $feed_type";
9635         $title = esc_html($title);
9636         my $descr = git_get_project_description($project);
9637         if (defined $descr) {
9638                 $descr = esc_html($descr);
9639         } else {
9640                 $descr = "$project " .
9641                          ($format eq 'rss' ? 'RSS' : 'Atom') .
9642                          " feed";
9643         }
9644         my $owner = git_get_project_owner($project);
9645         $owner = esc_html($owner);
9646
9647         #header
9648         my $alt_url;
9649         if (defined $file_name) {
9650                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
9651         } elsif (defined $hash) {
9652                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
9653         } else {
9654                 $alt_url = href(-full=>1, action=>"summary");
9655         }
9656         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
9657         if ($format eq 'rss') {
9658                 print <<XML;
9659 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
9660 <channel>
9661 XML
9662                 print "<title>$title</title>\n" .
9663                       "<link>$alt_url</link>\n" .
9664                       "<description>$descr</description>\n" .
9665                       "<language>en</language>\n" .
9666                       # project owner is responsible for 'editorial' content
9667                       "<managingEditor>$owner</managingEditor>\n";
9668                 if (defined $logo || defined $favicon) {
9669                         # prefer the logo to the favicon, since RSS
9670                         # doesn't allow both
9671                         my $img = esc_url($logo || $favicon);
9672                         print "<image>\n" .
9673                               "<url>$img</url>\n" .
9674                               "<title>$title</title>\n" .
9675                               "<link>$alt_url</link>\n" .
9676                               "</image>\n";
9677                 }
9678                 if (%latest_date) {
9679                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
9680                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
9681                 }
9682                 print "<generator>gitweb v.$version/$git_version</generator>\n";
9683         } elsif ($format eq 'atom') {
9684                 print <<XML;
9685 <feed xmlns="http://www.w3.org/2005/Atom">
9686 XML
9687                 print "<title>$title</title>\n" .
9688                       "<subtitle>$descr</subtitle>\n" .
9689                       '<link rel="alternate" type="text/html" href="' .
9690                       $alt_url . '" />' . "\n" .
9691                       '<link rel="self" type="' . $content_type . '" href="' .
9692                       $cgi->self_url() . '" />' . "\n" .
9693                       "<id>" . href(-full=>1) . "</id>\n" .
9694                       # use project owner for feed author
9695                       '<author><name>'. email_obfuscate($owner) . '</name></author>\n';
9696                 if (defined $favicon) {
9697                         print "<icon>" . esc_url($favicon) . "</icon>\n";
9698                 }
9699                 if (defined $logo) {
9700                         # not twice as wide as tall: 72 x 27 pixels
9701                         print "<logo>" . esc_url($logo) . "</logo>\n";
9702                 }
9703                 if (! %latest_date) {
9704                         # dummy date to keep the feed valid until commits trickle in:
9705                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
9706                 } else {
9707                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
9708                 }
9709                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
9710         }
9711
9712         # contents
9713         for (my $i = 0; $i <= $#commitlist; $i++) {
9714                 my %co = %{$commitlist[$i]};
9715                 my $commit = $co{'id'};
9716                 # we read 150, we always show 30 and the ones more recent than 48 hours
9717                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
9718                         last;
9719                 }
9720                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
9721
9722                 # get list of changed files
9723                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9724                         $co{'parent'} || "--root",
9725                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
9726                         or next;
9727                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
9728                 close $fd
9729                         or next;
9730
9731                 # print element (entry, item)
9732                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
9733                 if ($format eq 'rss') {
9734                         print "<item>\n" .
9735                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
9736                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
9737                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
9738                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
9739                               "<link>$co_url</link>\n" .
9740                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
9741                               "<content:encoded>" .
9742                               "<![CDATA[\n";
9743                 } elsif ($format eq 'atom') {
9744                         print "<entry>\n" .
9745                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
9746                               "<updated>$cd{'iso-8601'}</updated>\n" .
9747                               "<author>\n" .
9748                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
9749                         if ($co{'author_email'}) {
9750                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
9751                         }
9752                         print "</author>\n" .
9753                               # use committer for contributor
9754                               "<contributor>\n" .
9755                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
9756                         if ($co{'committer_email'}) {
9757                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
9758                         }
9759                         print "</contributor>\n" .
9760                               "<published>$cd{'iso-8601'}</published>\n" .
9761                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
9762                               "<id>$co_url</id>\n" .
9763                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
9764                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
9765                 }
9766                 my $comment = $co{'comment'};
9767                 print "<pre>\n";
9768                 foreach my $line (@$comment) {
9769                         $line = esc_html($line);
9770                         print "$line\n";
9771                 }
9772                 print "</pre><ul>\n";
9773                 foreach my $difftree_line (@difftree) {
9774                         my %difftree = parse_difftree_raw_line($difftree_line);
9775                         next if !$difftree{'from_id'};
9776
9777                         my $file = $difftree{'file'} || $difftree{'to_file'};
9778
9779                         print "<li>" .
9780                               "[" .
9781                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
9782                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
9783                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
9784                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
9785                                       -title => "diff"}, 'D');
9786                         if ($have_blame) {
9787                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
9788                                                              file_name=>$file, hash_base=>$commit),
9789                                               -class => "blamelink",
9790                                               -title => "blame"}, 'B');
9791                         }
9792                         # if this is not a feed of a file history
9793                         if (!defined $file_name || $file_name ne $file) {
9794                                 print $cgi->a({-href => href(-full=>1, action=>"history",
9795                                                              file_name=>$file, hash=>$commit),
9796                                               -title => "history"}, 'H');
9797                         }
9798                         $file = esc_path($file);
9799                         print "] ".
9800                               "$file</li>\n";
9801                 }
9802                 if ($format eq 'rss') {
9803                         print "</ul>]]>\n" .
9804                               "</content:encoded>\n" .
9805                               "</item>\n";
9806                 } elsif ($format eq 'atom') {
9807                         print "</ul>\n</div>\n" .
9808                               "</content>\n" .
9809                               "</entry>\n";
9810                 }
9811         }
9812
9813         # end of feed
9814         if ($format eq 'rss') {
9815                 print "</channel>\n</rss>\n";
9816         } elsif ($format eq 'atom') {
9817                 print "</feed>\n";
9818         }
9819 }
9820
9821 sub git_rss {
9822         git_feed('rss');
9823 }
9824
9825 sub git_atom {
9826         git_feed('atom');
9827 }
9828
9829 sub git_opml {
9830         my @list = git_get_projects_list($project_filter, $strict_export);
9831         if (!@list) {
9832                 die_error(404, "No projects found");
9833         }
9834
9835         print $cgi->header(
9836                 -type => 'text/xml',
9837                 -charset => 'utf-8',
9838                 -content_disposition => 'inline; filename="opml.xml"');
9839
9840         my $title = esc_html($site_name);
9841         my $filter = " within subdirectory ";
9842         if (defined $project_filter) {
9843                 $filter .= esc_html($project_filter);
9844         } else {
9845                 $filter = "";
9846         }
9847         print <<XML;
9848 <?xml version="1.0" encoding="utf-8"?>
9849 <opml version="1.0">
9850 <head>
9851   <title>$title OPML Export$filter</title>
9852 </head>
9853 <body>
9854 <outline text="git RSS feeds">
9855 XML
9856
9857         foreach my $pr (@list) {
9858                 my %proj = %$pr;
9859                 my $head = git_get_head_hash($proj{'path'});
9860                 if (!defined $head) {
9861                         next;
9862                 }
9863                 $git_dir = "$projectroot/$proj{'path'}";
9864                 my %co = parse_commit($head);
9865                 if (!%co) {
9866                         next;
9867                 }
9868
9869                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9870                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9871                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9872                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9873         }
9874         print <<XML;
9875 </outline>
9876 </body>
9877 </opml>
9878 XML
9879 }