gitweb/gitweb.perl

   1 #!/usr/bin/perl
   2
   3 # gitweb - simple web interface to track changes in git repositories
   4 #
   5 # (C) 2005-2006, Kay Sievers <kay.sievers@vrfy.org>
   6 # (C) 2005, Christian Gierke
   7 #
   8 # This program is licensed under the GPLv2
   9
  10 use 5.008;
  11 use strict;
  12 use warnings;
  13 use CGI qw(:standard :escapeHTML -nosticky);
  14 use CGI::Util qw(unescape);
  15 use CGI::Carp qw(fatalsToBrowser set_message);
  16 use Encode;
  17 use Fcntl ':mode';
  18 use File::Find qw();
  19 use File::Basename qw(basename);
  20 use File::Spec;
  21 use Time::HiRes qw(gettimeofday tv_interval);
  22 use Time::Local;
  23 use constant GITWEB_CACHE_FORMAT => "Gitweb Cache Format 3";
  24 binmode STDOUT, ':utf8';
  25
  26 if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
  27         eval 'sub CGI::multi_param { CGI::param(@_) }'
  28 }
  29
  30 our $t0 = [ gettimeofday() ];
  31 our $number_of_git_cmds = 0;
  32 our ($mdotsep, $barsep, $spcsep);
  33
  34 BEGIN {
  35         *mdotsep = \'<span class="mdotsep">&#160;&#183;&#160;</span>';
  36         *barsep = \'<span class="barsep">&#160;|&#160;</span>';
  37         *spcsep = \'<span class="spcsep">&#160</span>';
  38         CGI->compile() if $ENV{'MOD_PERL'};
  39 }
  40
  41 our $version = "++GIT_VERSION++";
  42
  43 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
  44 sub evaluate_uri {
  45         our $cgi;
  46
  47         our $my_url = $cgi->url();
  48         our $my_uri = $cgi->url(-absolute => 1);
  49
  50         # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
  51         # needed and used only for URLs with nonempty PATH_INFO
  52         # This must be an absolute URL (i.e. no scheme, host or port), NOT a full one
  53         our $base_url = $my_uri || '/';
  54
  55         # When the script is used as DirectoryIndex, the URL does not contain the name
  56         # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
  57         # have to do it ourselves. We make $path_info global because it's also used
  58         # later on.
  59         #
  60         # Another issue with the script being the DirectoryIndex is that the resulting
  61         # $my_url data is not the full script URL: this is good, because we want
  62         # generated links to keep implying the script name if it wasn't explicitly
  63         # indicated in the URL we're handling, but it means that $my_url cannot be used
  64         # as base URL.
  65         # Therefore, if we needed to strip PATH_INFO, then we know that we have
  66         # to build the base URL ourselves:
  67         our $path_info = decode_utf8($ENV{"PATH_INFO"});
  68         if ($path_info) {
  69                 # $path_info has already been URL-decoded by the web server, but
  70                 # $my_url and $my_uri have not. URL-decode them so we can properly
  71                 # strip $path_info.
  72                 $my_url = unescape($my_url);
  73                 $my_uri = unescape($my_uri);
  74                 if ($my_url =~ s,\Q$path_info\E$,, &&
  75                     $my_uri =~ s,\Q$path_info\E$,, &&
  76                     defined $ENV{'SCRIPT_NAME'}) {
  77                         $base_url = $ENV{'SCRIPT_NAME'} || '/';
  78                 }
  79         }
  80
  81         # target of the home link on top of all pages
  82         our $home_link = $my_uri || "/";
  83 }
  84
  85 # core git executable to use
  86 # this can just be "git" if your webserver has a sensible PATH
  87 our $GIT = "++GIT_BINDIR++/git";
  88
  89 # absolute fs-path which will be prepended to the project path
  90 #our $projectroot = "/pub/scm";
  91 our $projectroot = "++GITWEB_PROJECTROOT++";
  92
  93 # fs traversing limit for getting project list
  94 # the number is relative to the projectroot
  95 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
  96
  97 # string of the home link on top of all pages
  98 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
  99
 100 # extra breadcrumbs preceding the home link
 101 our @extra_breadcrumbs = ();
 102
 103 # name of your site or organization to appear in page titles
 104 # replace this with something more descriptive for clearer bookmarks
 105 our $site_name = "++GITWEB_SITENAME++"
 106                  || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
 107
 108 # html snippet to include in the <head> section of each page
 109 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
 110 # filename of html text to include at top of each page
 111 our $site_header = "++GITWEB_SITE_HEADER++";
 112 # html text to include at home page
 113 our $home_text = "++GITWEB_HOMETEXT++";
 114 # filename of html text to include at bottom of each page
 115 our $site_footer = "++GITWEB_SITE_FOOTER++";
 116
 117 # URI of stylesheets
 118 our @stylesheets = ("++GITWEB_CSS++");
 119 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
 120 our $stylesheet = undef;
 121 # URI of GIT logo (72x27 size)
 122 our $logo = "++GITWEB_LOGO++";
 123 # URI of GIT favicon, assumed to be image/png type
 124 our $favicon = "++GITWEB_FAVICON++";
 125 # URI of gitweb.js (JavaScript code for gitweb)
 126 our $javascript = "++GITWEB_JS++";
 127
 128 # URI and label (title) of GIT logo link
 129 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
 130 #our $logo_label = "git documentation";
 131 our $logo_url = "http://git-scm.com/";
 132 our $logo_label = "git homepage";
 133
 134 # source of projects list
 135 our $projects_list = "++GITWEB_LIST++";
 136
 137 # the width (in characters) of the projects list "Description" column
 138 our $projects_list_description_width = 25;
 139
 140 # group projects by category on the projects list
 141 # (enabled if this variable evaluates to true)
 142 our $projects_list_group_categories = 0;
 143
 144 # default category if none specified
 145 # (leave the empty string for no category)
 146 our $project_list_default_category = "";
 147
 148 # default order of projects list
 149 # valid values are none, project, descr, owner, and age
 150 our $default_projects_order = "project";
 151
 152 # default order of refs list
 153 # valid values are age and name
 154 our $default_refs_order = "age";
 155
 156 # show repository only if this file exists
 157 # (only effective if this variable evaluates to true)
 158 our $export_ok = "++GITWEB_EXPORT_OK++";
 159
 160 # don't generate age column on the projects list page
 161 our $omit_age_column = 0;
 162
 163 # use contents of this file (in iso, iso-strict or raw format) as
 164 # the last activity data if it exists and is a valid date
 165 our $lastactivity_file = undef;
 166
 167 # don't generate information about owners of repositories
 168 our $omit_owner=0;
 169
 170 # owner link hook given owner name (full and NOT obfuscated)
 171 # should return full URL-escaped link to attach to owner, for example:
 172 #    sub { return "/showowner.cgi?owner=".CGI::Util::escape($_[0]); }
 173 our $owner_link_hook = undef;
 174
 175 # show repository only if this subroutine returns true
 176 # when given the path to the project, for example:
 177 #    sub { return -e "$_[0]/git-daemon-export-ok"; }
 178 our $export_auth_hook = undef;
 179
 180 # only allow viewing of repositories also shown on the overview page
 181 our $strict_export = "++GITWEB_STRICT_EXPORT++";
 182
 183 # base URL for bundle info link shown on summary page, but only if
 184 # this config item is defined AND a 'bundles' subdirectory exists
 185 # in the project's repository.
 186 # i.e. full URL is "git_base_bundles_url/$project/bundles"
 187 our $git_base_bundles_url = undef;
 188
 189 # list of git base URLs used for URL to where fetch project from,
 190 # i.e. full URL is "$git_base_url/$project"
 191 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
 192
 193 # URLs designated for pushing new changes, extended by the
 194 # project name (i.e. "$git_base_push_url[0]/$project")
 195 our @git_base_push_urls = ();
 196
 197 # https hint html inserted right after any https push URL (undef for none)
 198 our $https_hint_html = undef;
 199
 200 # default blob_plain mimetype and default charset for text/plain blob
 201 our $default_blob_plain_mimetype = 'application/octet-stream';
 202 our $default_text_plain_charset  = undef;
 203
 204 # file to use for guessing MIME types before trying /etc/mime.types
 205 # (relative to the current git repository)
 206 our $mimetypes_file = undef;
 207
 208 # assume this charset if line contains non-UTF-8 characters;
 209 # it should be valid encoding (see Encoding::Supported(3pm) for list),
 210 # for which encoding all byte sequences are valid, for example
 211 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
 212 # could be even 'utf-8' for the old behavior)
 213 our $fallback_encoding = 'latin1';
 214
 215 # rename detection options for git-diff and git-diff-tree
 216 # - default is '-M', with the cost proportional to
 217 #   (number of removed files) * (number of new files).
 218 # - more costly is '-C' (which implies '-M'), with the cost proportional to
 219 #   (number of changed files + number of removed files) * (number of new files)
 220 # - even more costly is '-C', '--find-copies-harder' with cost
 221 #   (number of files in the original tree) * (number of new files)
 222 # - one might want to include '-B' option, e.g. '-B', '-M'
 223 our @diff_opts = ('-M'); # taken from git_commit
 224
 225 # cache directory (relative to $GIT_DIR) for project-specific html page caches.
 226 # the directory must exist and be writable by the process running gitweb.
 227 # additionally some actions must be selected for caching in %html_cache_actions
 228 # - default is 'htmlcache'
 229 our $html_cache_dir = 'htmlcache';
 230
 231 # which actions to cache in $html_cache_dir
 232 # if $html_cache_dir exists (relative to $GIT_DIR) and is writable by the
 233 # process running gitweb, then any actions selected here will have their output
 234 # cached and the cache file will be returned instead of regenerating the page
 235 # if it exists.  For this to be useful, an external process must create the
 236 # 'changed' file (if it does not already exist) in the $html_cache_dir whenever
 237 # the project information has been changed.  Alternatively it may create a
 238 # "$action.changed" file (if it does not exist) instead to limit the changes
 239 # to just "$action" instead of any action.  If 'changed' or "$action.changed"
 240 # exist, then the cached version will never be used for "$action" and a new
 241 # cache page will be regenerated (and the "changed" files removed as appropriate).
 242 #
 243 # Additionally if $projlist_cache_lifetime is > 0 AND the forks feature has been
 244 # enabled ('$feature{'forks'}{'default'} = [1];') then additionally an external
 245 # process must create the 'forkchange' file or update its timestamp if it already
 246 # exists whenever a fork is added to or removed from the project (as well as
 247 # create the 'changed' or "$action.changed" file).  Otherwise the "forks"
 248 # section on the summary page may remain out-of-date indefinately.
 249 #
 250 # - default is none
 251 #   currently only caching of the summary page is supported
 252 # - to enable caching of the summary page use:
 253 #   $html_cache_actions{'summary'} = 1;
 254 our %html_cache_actions = ();
 255
 256 # utility to automatically produce a default README.html if README.html is
 257 # enabled and it does not exist or is 0 bytes in length.  If this is set to an
 258 # executable utility that takes an absolute path to a .git directory as its
 259 # first argument and outputs an HTML fragment to use for README.html, then
 260 # it will be called when README.html is enabled but empty or missing.
 261 our $git_automatic_readme_html = undef;
 262
 263 # Disables features that would allow repository owners to inject script into
 264 # the gitweb domain.
 265 our $prevent_xss = 0;
 266
 267 # Path to a POSIX shell.  Needed to run $highlight_bin and a snapshot compressor.
 268 # Only used when highlight is enabled or snapshots with compressors are enabled.
 269 our $posix_shell_bin = "++POSIX_SHELL_BIN++";
 270
 271 # Path to the highlight executable to use (must be the one from
 272 # http://www.andre-simon.de due to assumptions about parameters and output).
 273 # Useful if highlight is not installed on your webserver's PATH.
 274 # [Default: highlight]
 275 our $highlight_bin = "++HIGHLIGHT_BIN++";
 276
 277 # Whether to include project list on the gitweb front page; 0 means yes,
 278 # 1 means no list but show tag cloud if enabled (all projects still need
 279 # to be scanned, unless the info is cached), 2 means no list and no tag cloud
 280 # (very fast)
 281 our $frontpage_no_project_list = 0;
 282
 283 # projects list cache for busy sites with many projects;
 284 # if you set this to non-zero, it will be used as the cached
 285 # index lifetime in minutes
 286 #
 287 # the cached list version is stored in $cache_dir/$cache_name and can
 288 # be tweaked by other scripts running with the same uid as gitweb -
 289 # use this ONLY at secure installations; only single gitweb project
 290 # root per system is supported, unless you tweak configuration!
 291 our $projlist_cache_lifetime = 0; # in minutes
 292 # FHS compliant $cache_dir would be "/var/cache/gitweb"
 293 our $cache_dir =
 294         (defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp').'/gitweb';
 295 our $projlist_cache_name = 'gitweb.index.cache';
 296 our $cache_grpshared = 0;
 297
 298 # information about snapshot formats that gitweb is capable of serving
 299 our %known_snapshot_formats = (
 300         # name => {
 301         #       'display' => display name,
 302         #       'type' => mime type,
 303         #       'suffix' => filename suffix,
 304         #       'format' => --format for git-archive,
 305         #       'compressor' => [compressor command and arguments]
 306         #                       (array reference, optional)
 307         #       'disabled' => boolean (optional)}
 308         #
 309         'tgz' => {
 310                 'display' => 'tar.gz',
 311                 'type' => 'application/x-gzip',
 312                 'suffix' => '.tar.gz',
 313                 'format' => 'tar',
 314                 'compressor' => ['gzip', '-n']},
 315
 316         'tbz2' => {
 317                 'display' => 'tar.bz2',
 318                 'type' => 'application/x-bzip2',
 319                 'suffix' => '.tar.bz2',
 320                 'format' => 'tar',
 321                 'compressor' => ['bzip2']},
 322
 323         'txz' => {
 324                 'display' => 'tar.xz',
 325                 'type' => 'application/x-xz',
 326                 'suffix' => '.tar.xz',
 327                 'format' => 'tar',
 328                 'compressor' => ['xz'],
 329                 'disabled' => 1},
 330
 331         'zip' => {
 332                 'display' => 'zip',
 333                 'type' => 'application/x-zip',
 334                 'suffix' => '.zip',
 335                 'format' => 'zip'},
 336 );
 337
 338 # Aliases so we understand old gitweb.snapshot values in repository
 339 # configuration.
 340 our %known_snapshot_format_aliases = (
 341         'gzip'  => 'tgz',
 342         'bzip2' => 'tbz2',
 343         'xz'    => 'txz',
 344
 345         # backward compatibility: legacy gitweb config support
 346         'x-gzip' => undef, 'gz' => undef,
 347         'x-bzip2' => undef, 'bz2' => undef,
 348         'x-zip' => undef, '' => undef,
 349 );
 350
 351 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
 352 # are changed, it may be appropriate to change these values too via
 353 # $GITWEB_CONFIG.
 354 our %avatar_size = (
 355         'default' => 16,
 356         'double'  => 32
 357 );
 358
 359 # Used to set the maximum load that we will still respond to gitweb queries.
 360 # If server load exceed this value then return "503 server busy" error.
 361 # If gitweb cannot determined server load, it is taken to be 0.
 362 # Leave it undefined (or set to 'undef') to turn off load checking.
 363 our $maxload = 300;
 364
 365 # configuration for 'highlight' (http://www.andre-simon.de/)
 366 # match by basename
 367 our %highlight_basename = (
 368         #'Program' => 'py',
 369         #'Library' => 'py',
 370         'SConstruct' => 'py', # SCons equivalent of Makefile
 371         'Makefile' => 'make',
 372         'makefile' => 'make',
 373         'GNUmakefile' => 'make',
 374         'BSDmakefile' => 'make',
 375 );
 376 # match by shebang regex
 377 our %highlight_shebang = (
 378         # Each entry has a key which is the syntax to use and
 379         # a value which is either a qr regex or an array of qr regexs to match
 380         # against the first 128 (less if the blob is shorter) BYTES of the blob.
 381         # We match /usr/bin/env items separately to require "/usr/bin/env" and
 382         # allow a limited subset of NAME=value items to appear.
 383         'awk'    => [ qr,^#!\s*/(?:\w+/)*(?:[gnm]?awk)(?:\s|$),mo,
 384                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[gnm]?awk)(?:\s|$),mo ],
 385         'make'   => [ qr,^#!\s*/(?:\w+/)*(?:g?make)(?:\s|$),mo,
 386                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:g?make)(?:\s|$),mo ],
 387         'php'    => [ qr,^#!\s*/(?:\w+/)*(?:php)(?:\s|$),mo,
 388                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:php)(?:\s|$),mo ],
 389         'pl'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 390                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 391         'py'     => [ qr,^#!\s*/(?:\w+/)*(?:python)(?:\s|$),mo,
 392                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:python)(?:\s|$),mo ],
 393         'sh'     => [ qr,^#!\s*/(?:\w+/)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo,
 394                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo ],
 395         'rb'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 396                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 397 );
 398 # match by extension
 399 our %highlight_ext = (
 400         # main extensions, defining name of syntax;
 401         # see files in /usr/share/highlight/langDefs/ directory
 402         (map { $_ => $_ } qw(
 403                 4gl a4c abnf abp ada agda ahk ampl amtrix applescript arc
 404                 arm as asm asp aspect ats au3 avenue awk bat bb bbcode bib
 405                 bms bnf boo c cb cfc chl clipper clojure clp cob cs css d
 406                 diff dot dylan e ebnf erl euphoria exp f90 flx for frink fs
 407                 go haskell hcl html httpd hx icl icn idl idlang ili
 408                 inc_luatex ini inp io iss j java js jsp lbn ldif lgt lhs
 409                 lisp lotos ls lsl lua ly make mel mercury mib miranda ml mo
 410                 mod2 mod3 mpl ms mssql n nas nbc nice nrx nsi nut nxc oberon
 411                 objc octave oorexx os oz pas php pike pl pl1 pov pro
 412                 progress ps ps1 psl pure py pyx q qmake qu r rb rebol rexx
 413                 rnc s sas sc scala scilab sh sma smalltalk sml sno spec spn
 414                 sql sybase tcl tcsh tex ttcn3 vala vb verilog vhd xml xpp y
 415                 yaiff znn)),
 416         # alternate extensions, see /etc/highlight/filetypes.conf
 417         (map { $_ => '4gl' } qw(informix)),
 418         (map { $_ => 'a4c' } qw(ascend)),
 419         (map { $_ => 'abp' } qw(abp4)),
 420         (map { $_ => 'ada' } qw(a adb ads gnad)),
 421         (map { $_ => 'ahk' } qw(autohotkey)),
 422         (map { $_ => 'ampl' } qw(dat run)),
 423         (map { $_ => 'amtrix' } qw(hnd s4 s4h s4t t4)),
 424         (map { $_ => 'as' } qw(actionscript)),
 425         (map { $_ => 'asm' } qw(29k 68s 68x a51 assembler x68 x86)),
 426         (map { $_ => 'asp' } qw(asa)),
 427         (map { $_ => 'aspect' } qw(was wud)),
 428         (map { $_ => 'ats' } qw(dats)),
 429         (map { $_ => 'au3' } qw(autoit)),
 430         (map { $_ => 'bat' } qw(cmd)),
 431         (map { $_ => 'bb' } qw(blitzbasic)),
 432         (map { $_ => 'bib' } qw(bibtex)),
 433         (map { $_ => 'c' } qw(c++ cc cpp cu cxx h hh hpp hxx)),
 434         (map { $_ => 'cb' } qw(clearbasic)),
 435         (map { $_ => 'cfc' } qw(cfm coldfusion)),
 436         (map { $_ => 'chl' } qw(chill)),
 437         (map { $_ => 'cob' } qw(cbl cobol)),
 438         (map { $_ => 'cs' } qw(csharp)),
 439         (map { $_ => 'diff' } qw(patch)),
 440         (map { $_ => 'dot' } qw(graphviz)),
 441         (map { $_ => 'e' } qw(eiffel se)),
 442         (map { $_ => 'erl' } qw(erlang hrl)),
 443         (map { $_ => 'euphoria' } qw(eu ew ex exu exw wxu)),
 444         (map { $_ => 'exp' } qw(express)),
 445         (map { $_ => 'f90' } qw(f95)),
 446         (map { $_ => 'flx' } qw(felix)),
 447         (map { $_ => 'for' } qw(f f77 ftn)),
 448         (map { $_ => 'fs' } qw(fsharp fsx)),
 449         (map { $_ => 'haskell' } qw(hs)),
 450         (map { $_ => 'html' } qw(htm xhtml)),
 451         (map { $_ => 'hx' } qw(haxe)),
 452         (map { $_ => 'icl' } qw(clean)),
 453         (map { $_ => 'icn' } qw(icon)),
 454         (map { $_ => 'ili' } qw(interlis)),
 455         (map { $_ => 'inp' } qw(fame)),
 456         (map { $_ => 'iss' } qw(innosetup)),
 457         (map { $_ => 'j' } qw(jasmin)),
 458         (map { $_ => 'java' } qw(groovy grv)),
 459         (map { $_ => 'lbn' } qw(luban)),
 460         (map { $_ => 'lgt' } qw(logtalk)),
 461         (map { $_ => 'lisp' } qw(cl clisp el lsp sbcl scom)),
 462         (map { $_ => 'ls' } qw(lotus)),
 463         (map { $_ => 'lsl' } qw(lindenscript)),
 464         (map { $_ => 'ly' } qw(lilypond)),
 465         (map { $_ => 'make' } qw(mak mk kmk)),
 466         (map { $_ => 'mel' } qw(maya)),
 467         (map { $_ => 'mib' } qw(smi snmp)),
 468         (map { $_ => 'ml' } qw(mli ocaml)),
 469         (map { $_ => 'mo' } qw(modelica)),
 470         (map { $_ => 'mod2' } qw(def mod)),
 471         (map { $_ => 'mod3' } qw(i3 m3)),
 472         (map { $_ => 'mpl' } qw(maple)),
 473         (map { $_ => 'n' } qw(nemerle)),
 474         (map { $_ => 'nas' } qw(nasal)),
 475         (map { $_ => 'nrx' } qw(netrexx)),
 476         (map { $_ => 'nsi' } qw(nsis)),
 477         (map { $_ => 'nut' } qw(squirrel)),
 478         (map { $_ => 'oberon' } qw(ooc)),
 479         (map { $_ => 'objc' } qw(M m mm)),
 480         (map { $_ => 'php' } qw(php3 php4 php5 php6)),
 481         (map { $_ => 'pike' } qw(pmod)),
 482         (map { $_ => 'pl' } qw(perl plex plx pm)),
 483         (map { $_ => 'pl1' } qw(bdy ff fp fpp rpp sf sp spb spe spp sps wf wp wpb wpp wps)),
 484         (map { $_ => 'progress' } qw(i p w)),
 485         (map { $_ => 'py' } qw(python)),
 486         (map { $_ => 'pyx' } qw(pyrex)),
 487         (map { $_ => 'rb' } qw(pp rjs ruby)),
 488         (map { $_ => 'rexx' } qw(rex rx the)),
 489         (map { $_ => 'sc' } qw(paradox)),
 490         (map { $_ => 'scilab' } qw(sce sci)),
 491         (map { $_ => 'sh' } qw(bash ebuild eclass ksh zsh)),
 492         (map { $_ => 'sma' } qw(small)),
 493         (map { $_ => 'smalltalk' } qw(gst sq st)),
 494         (map { $_ => 'sno' } qw(snobal)),
 495         (map { $_ => 'sybase' } qw(sp)),
 496         (map { $_ => 'tcl' } qw(itcl wish)),
 497         (map { $_ => 'tex' } qw(cls sty)),
 498         (map { $_ => 'vb' } qw(bas basic bi vbs)),
 499         (map { $_ => 'verilog' } qw(v)),
 500         (map { $_ => 'xml' } qw(dtd ecf ent hdr hub jnlp nrm plist resx sgm sgml svg tld vxml wml xsd xsl)),
 501         (map { $_ => 'y' } qw(bison)),
 502 );
 503
 504 # You define site-wide feature defaults here; override them with
 505 # $GITWEB_CONFIG as necessary.
 506 our %feature = (
 507         # feature => {
 508         #       'sub' => feature-sub (subroutine),
 509         #       'override' => allow-override (boolean),
 510         #       'default' => [ default options...] (array reference)}
 511         #
 512         # if feature is overridable (it means that allow-override has true value),
 513         # then feature-sub will be called with default options as parameters;
 514         # return value of feature-sub indicates if to enable specified feature
 515         #
 516         # if there is no 'sub' key (no feature-sub), then feature cannot be
 517         # overridden
 518         #
 519         # use gitweb_get_feature(<feature>) to retrieve the <feature> value
 520         # (an array) or gitweb_check_feature(<feature>) to check if <feature>
 521         # is enabled
 522
 523         # Enable the 'blame' blob view, showing the last commit that modified
 524         # each line in the file. This can be very CPU-intensive.
 525
 526         # To enable system wide have in $GITWEB_CONFIG
 527         # $feature{'blame'}{'default'} = [1];
 528         # To have project specific config enable override in $GITWEB_CONFIG
 529         # $feature{'blame'}{'override'} = 1;
 530         # and in project config gitweb.blame = 0|1;
 531         'blame' => {
 532                 'sub' => sub { feature_bool('blame', @_) },
 533                 'override' => 0,
 534                 'default' => [0]},
 535
 536         # Enable the 'incremental blame' blob view, which uses javascript to
 537         # incrementally show the revisions of lines as they are discovered
 538         # in the history. It is better for large histories, files and slow
 539         # servers, but requires javascript in the client and can slow down the
 540         # browser on large files.
 541
 542         # To enable system wide have in $GITWEB_CONFIG
 543         # $feature{'blame_incremental'}{'default'} = [1];
 544         # To have project specific config enable override in $GITWEB_CONFIG
 545         # $feature{'blame_incremental'}{'override'} = 1;
 546         # and in project config gitweb.blame_incremental = 0|1;
 547         'blame_incremental' => {
 548                 'sub' => sub { feature_bool('blame_incremental', @_) },
 549                 'override' => 0,
 550                 'default' => [0]},
 551
 552         # Enable the 'snapshot' link, providing a compressed archive of any
 553         # tree. This can potentially generate high traffic if you have large
 554         # project.
 555
 556         # Value is a list of formats defined in %known_snapshot_formats that
 557         # you wish to offer.
 558         # To disable system wide have in $GITWEB_CONFIG
 559         # $feature{'snapshot'}{'default'} = [];
 560         # To have project specific config enable override in $GITWEB_CONFIG
 561         # $feature{'snapshot'}{'override'} = 1;
 562         # and in project config, a comma-separated list of formats or "none"
 563         # to disable.  Example: gitweb.snapshot = tbz2,zip;
 564         'snapshot' => {
 565                 'sub' => \&feature_snapshot,
 566                 'override' => 0,
 567                 'default' => ['tgz']},
 568
 569         # Enable text search, which will list the commits which match author,
 570         # committer or commit text to a given string.  Enabled by default.
 571         # Project specific override is not supported.
 572         #
 573         # Note that this controls all search features, which means that if
 574         # it is disabled, then 'grep' and 'pickaxe' search would also be
 575         # disabled.
 576         'search' => {
 577                 'override' => 0,
 578                 'default' => [1]},
 579
 580         # Enable grep search, which will list the files in currently selected
 581         # tree containing the given string. Enabled by default. This can be
 582         # potentially CPU-intensive, of course.
 583         # Note that you need to have 'search' feature enabled too.
 584
 585         # To enable system wide have in $GITWEB_CONFIG
 586         # $feature{'grep'}{'default'} = [1];
 587         # To have project specific config enable override in $GITWEB_CONFIG
 588         # $feature{'grep'}{'override'} = 1;
 589         # and in project config gitweb.grep = 0|1;
 590         'grep' => {
 591                 'sub' => sub { feature_bool('grep', @_) },
 592                 'override' => 0,
 593                 'default' => [1]},
 594
 595         # Enable the pickaxe search, which will list the commits that modified
 596         # a given string in a file. This can be practical and quite faster
 597         # alternative to 'blame', but still potentially CPU-intensive.
 598         # Note that you need to have 'search' feature enabled too.
 599
 600         # To enable system wide have in $GITWEB_CONFIG
 601         # $feature{'pickaxe'}{'default'} = [1];
 602         # To have project specific config enable override in $GITWEB_CONFIG
 603         # $feature{'pickaxe'}{'override'} = 1;
 604         # and in project config gitweb.pickaxe = 0|1;
 605         'pickaxe' => {
 606                 'sub' => sub { feature_bool('pickaxe', @_) },
 607                 'override' => 0,
 608                 'default' => [1]},
 609
 610         # Enable showing size of blobs in a 'tree' view, in a separate
 611         # column, similar to what 'ls -l' does.  This cost a bit of IO.
 612
 613         # To disable system wide have in $GITWEB_CONFIG
 614         # $feature{'show-sizes'}{'default'} = [0];
 615         # To have project specific config enable override in $GITWEB_CONFIG
 616         # $feature{'show-sizes'}{'override'} = 1;
 617         # and in project config gitweb.showsizes = 0|1;
 618         'show-sizes' => {
 619                 'sub' => sub { feature_bool('showsizes', @_) },
 620                 'override' => 0,
 621                 'default' => [1]},
 622
 623         # Make gitweb use an alternative format of the URLs which can be
 624         # more readable and natural-looking: project name is embedded
 625         # directly in the path and the query string contains other
 626         # auxiliary information. All gitweb installations recognize
 627         # URL in either format; this configures in which formats gitweb
 628         # generates links.
 629
 630         # To enable system wide have in $GITWEB_CONFIG
 631         # $feature{'pathinfo'}{'default'} = [1];
 632         # Project specific override is not supported.
 633
 634         # Note that you will need to change the default location of CSS,
 635         # favicon, logo and possibly other files to an absolute URL. Also,
 636         # if gitweb.cgi serves as your indexfile, you will need to force
 637         # $my_uri to contain the script name in your $GITWEB_CONFIG (and you
 638         # will also likely want to set $home_link if you're setting $my_uri).
 639         'pathinfo' => {
 640                 'override' => 0,
 641                 'default' => [0]},
 642
 643         # Make gitweb consider projects in project root subdirectories
 644         # to be forks of existing projects. Given project $projname.git,
 645         # projects matching $projname/*.git will not be shown in the main
 646         # projects list, instead a '+' mark will be added to $projname
 647         # there and a 'forks' view will be enabled for the project, listing
 648         # all the forks. If project list is taken from a file, forks have
 649         # to be listed after the main project.
 650
 651         # To enable system wide have in $GITWEB_CONFIG
 652         # $feature{'forks'}{'default'} = [1];
 653         # Project specific override is not supported.
 654         'forks' => {
 655                 'override' => 0,
 656                 'default' => [0]},
 657
 658         # Insert custom links to the action bar of all project pages.
 659         # This enables you mainly to link to third-party scripts integrating
 660         # into gitweb; e.g. git-browser for graphical history representation
 661         # or custom web-based repository administration interface.
 662
 663         # The 'default' value consists of a list of triplets in the form
 664         # (label, link, position) where position is the label after which
 665         # to insert the link and link is a format string where %n expands
 666         # to the project name, %f to the project path within the filesystem,
 667         # %h to the current hash (h gitweb parameter) and %b to the current
 668         # hash base (hb gitweb parameter); %% expands to %.  %e expands to the
 669         # project name where all '+' characters have been replaced with '%2B'.
 670
 671         # To enable system wide have in $GITWEB_CONFIG e.g.
 672         # $feature{'actions'}{'default'} = [('graphiclog',
 673         #       '/git-browser/by-commit.html?r=%n', 'summary')];
 674         # Project specific override is not supported.
 675         'actions' => {
 676                 'override' => 0,
 677                 'default' => []},
 678
 679         # Allow gitweb scan project content tags of project repository,
 680         # and display the popular Web 2.0-ish "tag cloud" near the projects
 681         # list.  Note that this is something COMPLETELY different from the
 682         # normal Git tags.
 683
 684         # gitweb by itself can show existing tags, but it does not handle
 685         # tagging itself; you need to do it externally, outside gitweb.
 686         # The format is described in git_get_project_ctags() subroutine.
 687         # You may want to install the HTML::TagCloud Perl module to get
 688         # a pretty tag cloud instead of just a list of tags.
 689
 690         # To enable system wide have in $GITWEB_CONFIG
 691         # $feature{'ctags'}{'default'} = [1];
 692         # Project specific override is not supported.
 693
 694         # A value of 0 means no ctags display or editing.  A value of
 695         # 1 enables ctags display but never editing.  A non-empty value
 696         # that is not a string of digits enables ctags display AND the
 697         # ability to add tags using a form that uses method POST and
 698         # an action value set to the configured 'ctags' value.
 699         'ctags' => {
 700                 'override' => 0,
 701                 'default' => [0]},
 702
 703         # The maximum number of patches in a patchset generated in patch
 704         # view. Set this to 0 or undef to disable patch view, or to a
 705         # negative number to remove any limit.
 706
 707         # To disable system wide have in $GITWEB_CONFIG
 708         # $feature{'patches'}{'default'} = [0];
 709         # To have project specific config enable override in $GITWEB_CONFIG
 710         # $feature{'patches'}{'override'} = 1;
 711         # and in project config gitweb.patches = 0|n;
 712         # where n is the maximum number of patches allowed in a patchset.
 713         'patches' => {
 714                 'sub' => \&feature_patches,
 715                 'override' => 0,
 716                 'default' => [16]},
 717
 718         # Avatar support. When this feature is enabled, views such as
 719         # shortlog or commit will display an avatar associated with
 720         # the email of the committer(s) and/or author(s).
 721
 722         # Currently available providers are gravatar and picon.
 723         # If an unknown provider is specified, the feature is disabled.
 724
 725         # Gravatar depends on Digest::MD5.
 726         # Picon currently relies on the indiana.edu database.
 727
 728         # To enable system wide have in $GITWEB_CONFIG
 729         # $feature{'avatar'}{'default'} = ['<provider>'];
 730         # where <provider> is either gravatar or picon.
 731         # To have project specific config enable override in $GITWEB_CONFIG
 732         # $feature{'avatar'}{'override'} = 1;
 733         # and in project config gitweb.avatar = <provider>;
 734         'avatar' => {
 735                 'sub' => \&feature_avatar,
 736                 'override' => 0,
 737                 'default' => ['']},
 738
 739         # Enable displaying how much time and how many git commands
 740         # it took to generate and display page.  Disabled by default.
 741         # Project specific override is not supported.
 742         'timed' => {
 743                 'override' => 0,
 744                 'default' => [0]},
 745
 746         # Enable turning some links into links to actions which require
 747         # JavaScript to run (like 'blame_incremental').  Not enabled by
 748         # default.  Project specific override is currently not supported.
 749         'javascript-actions' => {
 750                 'override' => 0,
 751                 'default' => [0]},
 752
 753         # Enable and configure ability to change common timezone for dates
 754         # in gitweb output via JavaScript.  Enabled by default.
 755         # Project specific override is not supported.
 756         'javascript-timezone' => {
 757                 'override' => 0,
 758                 'default' => [
 759                         'local',     # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
 760                                      # or undef to turn off this feature
 761                         'gitweb_tz', # name of cookie where to store selected timezone
 762                         'datetime',  # CSS class used to mark up dates for manipulation
 763                 ]},
 764
 765         # Syntax highlighting support. This is based on Daniel Svensson's
 766         # and Sham Chukoury's work in gitweb-xmms2.git.
 767         # It requires the 'highlight' program present in $PATH,
 768         # and therefore is disabled by default.
 769
 770         # To enable system wide have in $GITWEB_CONFIG
 771         # $feature{'highlight'}{'default'} = [1];
 772
 773         'highlight' => {
 774                 'sub' => sub { feature_bool('highlight', @_) },
 775                 'override' => 0,
 776                 'default' => [0]},
 777
 778         # Enable displaying of remote heads in the heads list
 779
 780         # To enable system wide have in $GITWEB_CONFIG
 781         # $feature{'remote_heads'}{'default'} = [1];
 782         # To have project specific config enable override in $GITWEB_CONFIG
 783         # $feature{'remote_heads'}{'override'} = 1;
 784         # and in project config gitweb.remoteheads = 0|1;
 785         'remote_heads' => {
 786                 'sub' => sub { feature_bool('remote_heads', @_) },
 787                 'override' => 0,
 788                 'default' => [0]},
 789
 790         # Enable showing branches under other refs in addition to heads
 791
 792         # To set system wide extra branch refs have in $GITWEB_CONFIG
 793         # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
 794         # To have project specific config enable override in $GITWEB_CONFIG
 795         # $feature{'extra-branch-refs'}{'override'} = 1;
 796         # and in project config gitweb.extrabranchrefs = dirs of choice
 797         # Every directory is separated with whitespace.
 798
 799         'extra-branch-refs' => {
 800                 'sub' => \&feature_extra_branch_refs,
 801                 'override' => 0,
 802                 'default' => []},
 803 );
 804
 805 sub gitweb_get_feature {
 806         my ($name) = @_;
 807         return unless exists $feature{$name};
 808         my ($sub, $override, @defaults) = (
 809                 $feature{$name}{'sub'},
 810                 $feature{$name}{'override'},
 811                 @{$feature{$name}{'default'}});
 812         # project specific override is possible only if we have project
 813         our $git_dir; # global variable, declared later
 814         if (!$override || !defined $git_dir) {
 815                 return @defaults;
 816         }
 817         if (!defined $sub) {
 818                 warn "feature $name is not overridable";
 819                 return @defaults;
 820         }
 821         return $sub->(@defaults);
 822 }
 823
 824 # A wrapper to check if a given feature is enabled.
 825 # With this, you can say
 826 #
 827 #   my $bool_feat = gitweb_check_feature('bool_feat');
 828 #   gitweb_check_feature('bool_feat') or somecode;
 829 #
 830 # instead of
 831 #
 832 #   my ($bool_feat) = gitweb_get_feature('bool_feat');
 833 #   (gitweb_get_feature('bool_feat'))[0] or somecode;
 834 #
 835 sub gitweb_check_feature {
 836         return (gitweb_get_feature(@_))[0];
 837 }
 838
 839
 840 sub feature_bool {
 841         my $key = shift;
 842         my ($val) = git_get_project_config($key, '--bool');
 843
 844         if (!defined $val) {
 845                 return ($_[0]);
 846         } elsif ($val eq 'true') {
 847                 return (1);
 848         } elsif ($val eq 'false') {
 849                 return (0);
 850         }
 851 }
 852
 853 sub feature_snapshot {
 854         my (@fmts) = @_;
 855
 856         my ($val) = git_get_project_config('snapshot');
 857
 858         if ($val) {
 859                 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
 860         }
 861
 862         return @fmts;
 863 }
 864
 865 sub feature_patches {
 866         my @val = (git_get_project_config('patches', '--int'));
 867
 868         if (@val) {
 869                 return @val;
 870         }
 871
 872         return ($_[0]);
 873 }
 874
 875 sub feature_avatar {
 876         my @val = (git_get_project_config('avatar'));
 877
 878         return @val ? @val : @_;
 879 }
 880
 881 sub feature_extra_branch_refs {
 882         my (@branch_refs) = @_;
 883         my $values = git_get_project_config('extrabranchrefs');
 884
 885         if ($values) {
 886                 $values = config_to_multi ($values);
 887                 @branch_refs = ();
 888                 foreach my $value (@{$values}) {
 889                         push @branch_refs, split /\s+/, $value;
 890                 }
 891         }
 892
 893         return @branch_refs;
 894 }
 895
 896 # checking HEAD file with -e is fragile if the repository was
 897 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
 898 # and then pruned.
 899 sub check_head_link {
 900         my ($dir) = @_;
 901         return 0 unless -d "$dir/objects" && -x _;
 902         return 0 unless -d "$dir/refs" && -x _;
 903         my $headfile = "$dir/HEAD";
 904         return -l $headfile ?
 905                 readlink($headfile) =~ /^refs\/heads\// : -f $headfile;
 906 }
 907
 908 sub check_export_ok {
 909         my ($dir) = @_;
 910         return (check_head_link($dir) &&
 911                 (!$export_ok || -e "$dir/$export_ok") &&
 912                 (!$export_auth_hook || $export_auth_hook->($dir)));
 913 }
 914
 915 # process alternate names for backward compatibility
 916 # filter out unsupported (unknown) snapshot formats
 917 sub filter_snapshot_fmts {
 918         my @fmts = @_;
 919
 920         @fmts = map {
 921                 exists $known_snapshot_format_aliases{$_} ?
 922                        $known_snapshot_format_aliases{$_} : $_} @fmts;
 923         @fmts = grep {
 924                 exists $known_snapshot_formats{$_} &&
 925                 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
 926 }
 927
 928 sub filter_and_validate_refs {
 929         my @refs = @_;
 930         my %unique_refs = ();
 931
 932         foreach my $ref (@refs) {
 933                 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
 934                 # 'heads' are added implicitly in get_branch_refs().
 935                 $unique_refs{$ref} = 1 if ($ref ne 'heads');
 936         }
 937         return sort keys %unique_refs;
 938 }
 939
 940 # If it is set to code reference, it is code that it is to be run once per
 941 # request, allowing updating configurations that change with each request,
 942 # while running other code in config file only once.
 943 #
 944 # Otherwise, if it is false then gitweb would process config file only once;
 945 # if it is true then gitweb config would be run for each request.
 946 our $per_request_config = 1;
 947
 948 # If true and fileno STDIN is 0 and getsockname succeeds and getpeername fails
 949 # with ENOTCONN, then FCGI mode will be activated automatically in just the
 950 # same way as though the --fcgi option had been given instead.
 951 our $auto_fcgi = 0;
 952
 953 # read and parse gitweb config file given by its parameter.
 954 # returns true on success, false on recoverable error, allowing
 955 # to chain this subroutine, using first file that exists.
 956 # dies on errors during parsing config file, as it is unrecoverable.
 957 sub read_config_file {
 958         my $filename = shift;
 959         return unless defined $filename;
 960         # die if there are errors parsing config file
 961         if (-e $filename) {
 962                 do $filename;
 963                 die $@ if $@;
 964                 return 1;
 965         }
 966         return;
 967 }
 968
 969 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
 970 sub evaluate_gitweb_config {
 971         our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
 972         our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
 973         our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
 974
 975         # Protect against duplications of file names, to not read config twice.
 976         # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
 977         # there possibility of duplication of filename there doesn't matter.
 978         $GITWEB_CONFIG = ""        if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
 979         $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
 980
 981         # Common system-wide settings for convenience.
 982         # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
 983         read_config_file($GITWEB_CONFIG_COMMON);
 984
 985         # Use first config file that exists.  This means use the per-instance
 986         # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
 987         read_config_file($GITWEB_CONFIG) and return;
 988         read_config_file($GITWEB_CONFIG_SYSTEM);
 989 }
 990
 991 our $encode_object;
 992
 993 sub evaluate_encoding {
 994         my $requested = $fallback_encoding || 'ISO-8859-1';
 995         my $obj = Encode::find_encoding($requested) or
 996                 die_error(400, "Requested fallback encoding not found");
 997         if ($obj->name eq 'iso-8859-1') {
 998                 # Use Windows-1252 instead as required by the HTML 5 standard
 999                 my $altobj = Encode::find_encoding('Windows-1252');
1000                 $obj = $altobj if $altobj;
1001         }
1002         $encode_object = $obj;
1003 }
1004
1005 sub evaluate_email_obfuscate {
1006         # email obfuscation
1007         our $email;
1008         if (!$email && eval { require HTML::Email::Obfuscate; 1 }) {
1009                 $email = HTML::Email::Obfuscate->new(lite => 1);
1010         }
1011 }
1012
1013 # Get loadavg of system, to compare against $maxload.
1014 # Currently it requires '/proc/loadavg' present to get loadavg;
1015 # if it is not present it returns 0, which means no load checking.
1016 sub get_loadavg {
1017         if( -e '/proc/loadavg' ){
1018                 open my $fd, '<', '/proc/loadavg'
1019                         or return 0;
1020                 my @load = split(/\s+/, scalar <$fd>);
1021                 close $fd;
1022
1023                 # The first three columns measure CPU and IO utilization of the last one,
1024                 # five, and 10 minute periods.  The fourth column shows the number of
1025                 # currently running processes and the total number of processes in the m/n
1026                 # format.  The last column displays the last process ID used.
1027                 return $load[0] || 0;
1028         }
1029         # additional checks for load average should go here for things that don't export
1030         # /proc/loadavg
1031
1032         return 0;
1033 }
1034
1035 # version of the core git binary
1036 our $git_version;
1037 sub evaluate_git_version {
1038         our $git_version = $version;
1039 }
1040
1041 sub check_loadavg {
1042         if (defined $maxload && get_loadavg() > $maxload) {
1043                 die_error(503, "The load average on the server is too high");
1044         }
1045 }
1046
1047 # ======================================================================
1048 # input validation and dispatch
1049
1050 # input parameters can be collected from a variety of sources (presently, CGI
1051 # and PATH_INFO), so we define an %input_params hash that collects them all
1052 # together during validation: this allows subsequent uses (e.g. href()) to be
1053 # agnostic of the parameter origin
1054
1055 our %input_params = ();
1056
1057 # input parameters are stored with the long parameter name as key. This will
1058 # also be used in the href subroutine to convert parameters to their CGI
1059 # equivalent, and since the href() usage is the most frequent one, we store
1060 # the name -> CGI key mapping here, instead of the reverse.
1061 #
1062 # XXX: Warning: If you touch this, check the search form for updating,
1063 # too.
1064
1065 our @cgi_param_mapping = (
1066         project => "p",
1067         action => "a",
1068         file_name => "f",
1069         file_parent => "fp",
1070         hash => "h",
1071         hash_parent => "hp",
1072         hash_base => "hb",
1073         hash_parent_base => "hpb",
1074         page => "pg",
1075         order => "o",
1076         searchtext => "s",
1077         searchtype => "st",
1078         snapshot_format => "sf",
1079         ctag_filter => 't',
1080         extra_options => "opt",
1081         search_use_regexp => "sr",
1082         ctag => "by_tag",
1083         diff_style => "ds",
1084         project_filter => "pf",
1085         # this must be last entry (for manipulation from JavaScript)
1086         javascript => "js"
1087 );
1088 our %cgi_param_mapping = @cgi_param_mapping;
1089
1090 # we will also need to know the possible actions, for validation
1091 our %actions = (
1092         "blame" => \&git_blame,
1093         "blame_incremental" => \&git_blame_incremental,
1094         "blame_data" => \&git_blame_data,
1095         "blobdiff" => \&git_blobdiff,
1096         "blobdiff_plain" => \&git_blobdiff_plain,
1097         "blob" => \&git_blob,
1098         "blob_plain" => \&git_blob_plain,
1099         "commitdiff" => \&git_commitdiff,
1100         "commitdiff_plain" => \&git_commitdiff_plain,
1101         "commit" => \&git_commit,
1102         "forks" => \&git_forks,
1103         "heads" => \&git_heads,
1104         "history" => \&git_history,
1105         "log" => \&git_log,
1106         "patch" => \&git_patch,
1107         "patches" => \&git_patches,
1108         "refs" => \&git_refs,
1109         "remotes" => \&git_remotes,
1110         "rss" => \&git_rss,
1111         "atom" => \&git_atom,
1112         "search" => \&git_search,
1113         "search_help" => \&git_search_help,
1114         "shortlog" => \&git_shortlog,
1115         "summary" => \&git_summary,
1116         "tag" => \&git_tag,
1117         "tags" => \&git_tags,
1118         "tree" => \&git_tree,
1119         "snapshot" => \&git_snapshot,
1120         "object" => \&git_object,
1121         # those below don't need $project
1122         "opml" => \&git_opml,
1123         "frontpage" => \&git_frontpage,
1124         "project_list" => \&git_project_list,
1125         "project_index" => \&git_project_index,
1126 );
1127
1128 # the only actions we will allow to be cached
1129 my %supported_cache_actions;
1130 BEGIN {%supported_cache_actions = map {( $_ => 1 )} qw(summary)}
1131
1132 # finally, we have the hash of allowed extra_options for the commands that
1133 # allow them
1134 our %allowed_options = (
1135         "--no-merges" => [ qw(rss atom log shortlog history) ],
1136 );
1137
1138 # fill %input_params with the CGI parameters. All values except for 'opt'
1139 # should be single values, but opt can be an array. We should probably
1140 # build an array of parameters that can be multi-valued, but since for the time
1141 # being it's only this one, we just single it out
1142 sub evaluate_query_params {
1143         our $cgi;
1144
1145         while (my ($name, $symbol) = each %cgi_param_mapping) {
1146                 if ($symbol eq 'opt') {
1147                         $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
1148                 } else {
1149                         $input_params{$name} = decode_utf8($cgi->param($symbol));
1150                 }
1151         }
1152
1153         # Backwards compatibility - by_tag= <=> t=
1154         if ($input_params{'ctag'}) {
1155                 $input_params{'ctag_filter'} = $input_params{'ctag'};
1156         }
1157 }
1158
1159 # now read PATH_INFO and update the parameter list for missing parameters
1160 sub evaluate_path_info {
1161         return if defined $input_params{'project'};
1162         return if !$path_info;
1163         $path_info =~ s,^/+,,;
1164         return if !$path_info;
1165
1166         # find which part of PATH_INFO is project
1167         my $project = $path_info;
1168         $project =~ s,/+$,,;
1169         while ($project && !check_head_link("$projectroot/$project")) {
1170                 $project =~ s,/*[^/]*$,,;
1171         }
1172         return unless $project;
1173         $input_params{'project'} = $project;
1174
1175         # do not change any parameters if an action is given using the query string
1176         return if $input_params{'action'};
1177         $path_info =~ s,^\Q$project\E/*,,;
1178
1179         # next, check if we have an action
1180         my $action = $path_info;
1181         $action =~ s,/.*$,,;
1182         if (exists $actions{$action}) {
1183                 $path_info =~ s,^$action/*,,;
1184                 $input_params{'action'} = $action;
1185         }
1186
1187         # list of actions that want hash_base instead of hash, but can have no
1188         # pathname (f) parameter
1189         my @wants_base = (
1190                 'tree',
1191                 'history',
1192         );
1193
1194         # we want to catch, among others
1195         # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
1196         my ($parentrefname, $parentpathname, $refname, $pathname) =
1197                 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
1198
1199         # first, analyze the 'current' part
1200         if (defined $pathname) {
1201                 # we got "branch:filename" or "branch:dir/"
1202                 # we could use git_get_type(branch:pathname), but:
1203                 # - it needs $git_dir
1204                 # - it does a git() call
1205                 # - the convention of terminating directories with a slash
1206                 #   makes it superfluous
1207                 # - embedding the action in the PATH_INFO would make it even
1208                 #   more superfluous
1209                 $pathname =~ s,^/+,,;
1210                 if (!$pathname || substr($pathname, -1) eq "/") {
1211                         $input_params{'action'} ||= "tree";
1212                         $pathname =~ s,/$,,;
1213                 } else {
1214                         # the default action depends on whether we had parent info
1215                         # or not
1216                         if ($parentrefname) {
1217                                 $input_params{'action'} ||= "blobdiff_plain";
1218                         } else {
1219                                 $input_params{'action'} ||= "blob_plain";
1220                         }
1221                 }
1222                 $input_params{'hash_base'} ||= $refname;
1223                 $input_params{'file_name'} ||= $pathname;
1224         } elsif (defined $refname) {
1225                 # we got "branch". In this case we have to choose if we have to
1226                 # set hash or hash_base.
1227                 #
1228                 # Most of the actions without a pathname only want hash to be
1229                 # set, except for the ones specified in @wants_base that want
1230                 # hash_base instead. It should also be noted that hand-crafted
1231                 # links having 'history' as an action and no pathname or hash
1232                 # set will fail, but that happens regardless of PATH_INFO.
1233                 if (defined $parentrefname) {
1234                         # if there is parent let the default be 'shortlog' action
1235                         # (for http://git.example.com/repo.git/A..B links); if there
1236                         # is no parent, dispatch will detect type of object and set
1237                         # action appropriately if required (if action is not set)
1238                         $input_params{'action'} ||= "shortlog";
1239                 }
1240                 if ($input_params{'action'} &&
1241                     grep { $_ eq $input_params{'action'} } @wants_base) {
1242                         $input_params{'hash_base'} ||= $refname;
1243                 } else {
1244                         $input_params{'hash'} ||= $refname;
1245                 }
1246         }
1247
1248         # next, handle the 'parent' part, if present
1249         if (defined $parentrefname) {
1250                 # a missing pathspec defaults to the 'current' filename, allowing e.g.
1251                 # someproject/blobdiff/oldrev..newrev:/filename
1252                 if ($parentpathname) {
1253                         $parentpathname =~ s,^/+,,;
1254                         $parentpathname =~ s,/$,,;
1255                         $input_params{'file_parent'} ||= $parentpathname;
1256                 } else {
1257                         $input_params{'file_parent'} ||= $input_params{'file_name'};
1258                 }
1259                 # we assume that hash_parent_base is wanted if a path was specified,
1260                 # or if the action wants hash_base instead of hash
1261                 if (defined $input_params{'file_parent'} ||
1262                         grep { $_ eq $input_params{'action'} } @wants_base) {
1263                         $input_params{'hash_parent_base'} ||= $parentrefname;
1264                 } else {
1265                         $input_params{'hash_parent'} ||= $parentrefname;
1266                 }
1267         }
1268
1269         # for the snapshot action, we allow URLs in the form
1270         # $project/snapshot/$hash.ext
1271         # where .ext determines the snapshot and gets removed from the
1272         # passed $refname to provide the $hash.
1273         #
1274         # To be able to tell that $refname includes the format extension, we
1275         # require the following two conditions to be satisfied:
1276         # - the hash input parameter MUST have been set from the $refname part
1277         #   of the URL (i.e. they must be equal)
1278         # - the snapshot format MUST NOT have been defined already (e.g. from
1279         #   CGI parameter sf)
1280         # It's also useless to try any matching unless $refname has a dot,
1281         # so we check for that too
1282         if (defined $input_params{'action'} &&
1283                 $input_params{'action'} eq 'snapshot' &&
1284                 defined $refname && index($refname, '.') != -1 &&
1285                 $refname eq $input_params{'hash'} &&
1286                 !defined $input_params{'snapshot_format'}) {
1287                 # We loop over the known snapshot formats, checking for
1288                 # extensions. Allowed extensions are both the defined suffix
1289                 # (which includes the initial dot already) and the snapshot
1290                 # format key itself, with a prepended dot
1291                 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1292                         my $hash = $refname;
1293                         unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1294                                 next;
1295                         }
1296                         my $sfx = $1;
1297                         # a valid suffix was found, so set the snapshot format
1298                         # and reset the hash parameter
1299                         $input_params{'snapshot_format'} = $fmt;
1300                         $input_params{'hash'} = $hash;
1301                         # we also set the format suffix to the one requested
1302                         # in the URL: this way a request for e.g. .tgz returns
1303                         # a .tgz instead of a .tar.gz
1304                         $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1305                         last;
1306                 }
1307         }
1308 }
1309
1310 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1311      $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1312      $searchtext, $search_regexp, $project_filter);
1313 sub evaluate_and_validate_params {
1314         our $action = $input_params{'action'};
1315         if (defined $action) {
1316                 if (!is_valid_action($action)) {
1317                         die_error(400, "Invalid action parameter");
1318                 }
1319         }
1320
1321         # parameters which are pathnames
1322         our $project = $input_params{'project'};
1323         if (defined $project) {
1324                 if (!is_valid_project($project)) {
1325                         undef $project;
1326                         die_error(404, "No such project");
1327                 }
1328         }
1329
1330         our $project_filter = $input_params{'project_filter'};
1331         if (defined $project_filter) {
1332                 if (!is_valid_pathname($project_filter)) {
1333                         die_error(404, "Invalid project_filter parameter");
1334                 }
1335         }
1336
1337         our $file_name = $input_params{'file_name'};
1338         if (defined $file_name) {
1339                 if (!is_valid_pathname($file_name)) {
1340                         die_error(400, "Invalid file parameter");
1341                 }
1342         }
1343
1344         our $file_parent = $input_params{'file_parent'};
1345         if (defined $file_parent) {
1346                 if (!is_valid_pathname($file_parent)) {
1347                         die_error(400, "Invalid file parent parameter");
1348                 }
1349         }
1350
1351         # parameters which are refnames
1352         our $hash = $input_params{'hash'};
1353         if (defined $hash) {
1354                 if (!is_valid_refname($hash)) {
1355                         die_error(400, "Invalid hash parameter");
1356                 }
1357         }
1358
1359         our $hash_parent = $input_params{'hash_parent'};
1360         if (defined $hash_parent) {
1361                 if (!is_valid_refname($hash_parent)) {
1362                         die_error(400, "Invalid hash parent parameter");
1363                 }
1364         }
1365
1366         our $hash_base = $input_params{'hash_base'};
1367         if (defined $hash_base) {
1368                 if (!is_valid_refname($hash_base)) {
1369                         die_error(400, "Invalid hash base parameter");
1370                 }
1371         }
1372
1373         our @extra_options = @{$input_params{'extra_options'}};
1374         # @extra_options is always defined, since it can only be (currently) set from
1375         # CGI, and $cgi->param() returns the empty array in array context if the param
1376         # is not set
1377         foreach my $opt (@extra_options) {
1378                 if (not exists $allowed_options{$opt}) {
1379                         die_error(400, "Invalid option parameter");
1380                 }
1381                 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1382                         die_error(400, "Invalid option parameter for this action");
1383                 }
1384         }
1385
1386         our $hash_parent_base = $input_params{'hash_parent_base'};
1387         if (defined $hash_parent_base) {
1388                 if (!is_valid_refname($hash_parent_base)) {
1389                         die_error(400, "Invalid hash parent base parameter");
1390                 }
1391         }
1392
1393         # other parameters
1394         our $page = $input_params{'page'};
1395         if (defined $page) {
1396                 if ($page =~ m/[^0-9]/) {
1397                         die_error(400, "Invalid page parameter");
1398                 }
1399         }
1400
1401         our $searchtype = $input_params{'searchtype'};
1402         if (defined $searchtype) {
1403                 if ($searchtype =~ m/[^a-z]/) {
1404                         die_error(400, "Invalid searchtype parameter");
1405                 }
1406         }
1407
1408         our $search_use_regexp = $input_params{'search_use_regexp'};
1409
1410         our $searchtext = $input_params{'searchtext'};
1411         our $search_regexp = undef;
1412         if (defined $searchtext) {
1413                 if (length($searchtext) < 2) {
1414                         die_error(403, "At least two characters are required for search parameter");
1415                 }
1416                 if ($search_use_regexp) {
1417                         $search_regexp = $searchtext;
1418                         if (!eval { qr/$search_regexp/; 1; }) {
1419                                 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1420                                 die_error(400, "Invalid search regexp '$search_regexp'",
1421                                           esc_html($error));
1422                         }
1423                 } else {
1424                         $search_regexp = quotemeta $searchtext;
1425                 }
1426         }
1427 }
1428
1429 # path to the current git repository
1430 our $git_dir;
1431 sub evaluate_git_dir {
1432         our $git_dir = $project ? "$projectroot/$project" : undef;
1433 }
1434
1435 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1436 sub configure_gitweb_features {
1437         # list of supported snapshot formats
1438         our @snapshot_fmts = gitweb_get_feature('snapshot');
1439         @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1440
1441         # check that the avatar feature is set to a known provider name,
1442         # and for each provider check if the dependencies are satisfied.
1443         # if the provider name is invalid or the dependencies are not met,
1444         # reset $git_avatar to the empty string.
1445         our ($git_avatar) = gitweb_get_feature('avatar');
1446         if ($git_avatar eq 'gravatar') {
1447                 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1448         } elsif ($git_avatar eq 'picon') {
1449                 # no dependencies
1450         } else {
1451                 $git_avatar = '';
1452         }
1453
1454         our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1455         @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1456 }
1457
1458 sub get_branch_refs {
1459         return ('heads', @extra_branch_refs);
1460 }
1461
1462 # custom error handler: 'die <message>' is Internal Server Error
1463 sub handle_errors_html {
1464         my $msg = shift; # it is already HTML escaped
1465
1466         # to avoid infinite loop where error occurs in die_error,
1467         # change handler to default handler, disabling handle_errors_html
1468         set_message("Error occurred when inside die_error:\n$msg");
1469
1470         # you cannot jump out of die_error when called as error handler;
1471         # the subroutine set via CGI::Carp::set_message is called _after_
1472         # HTTP headers are already written, so it cannot write them itself
1473         die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1474 }
1475 set_message(\&handle_errors_html);
1476
1477 our $shown_stale_message = 0;
1478 our $cache_dump = undef;
1479 our $cache_dump_mtime = undef;
1480
1481 # dispatch
1482 my $cache_mode_active;
1483 sub dispatch {
1484         if (!defined $action) {
1485                 if (defined $hash) {
1486                         $action = git_get_type($hash);
1487                         $action or die_error(404, "Object does not exist");
1488                 } elsif (defined $hash_base && defined $file_name) {
1489                         $action = git_get_type("$hash_base:$file_name");
1490                         $action or die_error(404, "File or directory does not exist");
1491                 } elsif (defined $project) {
1492                         $action = 'summary';
1493                 } else {
1494                         $action = 'frontpage';
1495                 }
1496         }
1497         if (!defined($actions{$action})) {
1498                 die_error(400, "Unknown action");
1499         }
1500         if ($action !~ m/^(?:opml|frontpage|project_list|project_index)$/ &&
1501             !$project) {
1502                 die_error(400, "Project needed");
1503         }
1504
1505         my $defstyle = $stylesheet;
1506         local $stylesheet = $defstyle;
1507         if ($ENV{'HTTP_COOKIE'} && ";$ENV{'HTTP_COOKIE'};" =~ /;\s*style\s*=\s*([a-z][a-z0-9_-]*)\s*;/) {{
1508                 my $stylename = $1;
1509                 last unless $ENV{'DOCUMENT_ROOT'} && -r "$ENV{'DOCUMENT_ROOT'}/style/$stylename.css";
1510                 $stylesheet = "/style/$stylename.css";
1511         }}
1512
1513         my $cached_page = $supported_cache_actions{$action}
1514                 ? cached_action_page($action)
1515                 : undef;
1516         goto DUMPCACHE if $cached_page;
1517         local *SAVEOUT = *STDOUT;
1518         $cache_mode_active = $supported_cache_actions{$action}
1519                 ? cached_action_start($action)
1520                 : undef;
1521
1522         configure_gitweb_features();
1523         $actions{$action}->();
1524
1525         return unless $cache_mode_active;
1526
1527         $cached_page = cached_action_finish($action);
1528         *STDOUT = *SAVEOUT;
1529
1530         DUMPCACHE:
1531
1532         $cache_mode_active = 0;
1533         # Avoid any extra unwanted encoding steps as $cached_page is raw bytes
1534         binmode STDOUT, ':raw';
1535         our $fcgi_raw_mode = 1;
1536         print expand_gitweb_pi($cached_page, time);
1537         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
1538         $fcgi_raw_mode = 0;
1539 }
1540
1541 sub reset_timer {
1542         our $t0 = [ gettimeofday() ]
1543                 if defined $t0;
1544         our $number_of_git_cmds = 0;
1545 }
1546
1547 our $first_request = 1;
1548 our $evaluate_uri_force = undef;
1549 sub run_request {
1550         reset_timer();
1551
1552         # Only allow GET and HEAD methods
1553         if (!$ENV{'REQUEST_METHOD'} || ($ENV{'REQUEST_METHOD'} ne 'GET' && $ENV{'REQUEST_METHOD'} ne 'HEAD')) {
1554                 print <<EOT;
1555 Status: 405 Method Not Allowed
1556 Content-Type: text/plain
1557 Allow: GET,HEAD
1558
1559 405 Method Not Allowed
1560 EOT
1561                 return;
1562         }
1563
1564         evaluate_uri();
1565         &$evaluate_uri_force() if $evaluate_uri_force;
1566         if ($per_request_config) {
1567                 if (ref($per_request_config) eq 'CODE') {
1568                         $per_request_config->();
1569                 } elsif (!$first_request) {
1570                         evaluate_gitweb_config();
1571                         evaluate_email_obfuscate();
1572                 }
1573         }
1574         check_loadavg();
1575
1576         # $projectroot and $projects_list might be set in gitweb config file
1577         $projects_list ||= $projectroot;
1578
1579         evaluate_query_params();
1580         evaluate_path_info();
1581         evaluate_and_validate_params();
1582         evaluate_git_dir();
1583
1584         dispatch();
1585 }
1586
1587 our $is_last_request = sub { 1 };
1588 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1589 our $CGI = 'CGI';
1590 our $cgi;
1591 our $fcgi_mode = 0;
1592 our $fcgi_nproc_active = 0;
1593 our $fcgi_raw_mode = 0;
1594 sub is_fcgi {
1595         use Errno;
1596         my $stdinfno = fileno STDIN;
1597         return 0 unless defined $stdinfno && $stdinfno == 0;
1598         return 0 unless getsockname STDIN;
1599         return 0 if getpeername STDIN;
1600         return $!{ENOTCONN}?1:0;
1601 }
1602 sub configure_as_fcgi {
1603         return if $fcgi_mode;
1604
1605         require FCGI;
1606         require CGI::Fast;
1607
1608         # We have gone to great effort to make sure that all incoming data has
1609         # been converted from whatever format it was in into UTF-8.  We have
1610         # even taken care to make sure the output handle is in ':utf8' mode.
1611         # Now along comes FCGI and blows it with:
1612         #
1613         #     Use of wide characters in FCGI::Stream::PRINT is deprecated
1614         #      and will stop wprking[sic] in a future version of FCGI
1615         #
1616         # To fix this we replace FCGI::Stream::PRINT with our own routine that
1617         # first encodes everything and then calls the original routine, but
1618         # not if $fcgi_raw_mode is true (then we just call the original routine).
1619         #
1620         # Note that we could do this by using utf8::is_utf8 to check instead
1621         # of having a $fcgi_raw_mode global, but that would be slower to run
1622         # the test on each element and much slower than skipping the conversion
1623         # entirely when we know we're outputting raw bytes.
1624         my $orig = \&FCGI::Stream::PRINT;
1625         undef *FCGI::Stream::PRINT;
1626         *FCGI::Stream::PRINT = sub {
1627                 @_ = (shift, map {my $x=$_; utf8::encode($x); $x} @_)
1628                         unless $fcgi_raw_mode;
1629                 goto $orig;
1630         };
1631
1632         our $CGI = 'CGI::Fast';
1633
1634         $fcgi_mode = 1;
1635         $first_request = 0;
1636         my $request_number = 0;
1637         # let each child service 100 requests
1638         our $is_last_request = sub { ++$request_number > 100 };
1639 }
1640 sub evaluate_argv {
1641         my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1642         configure_as_fcgi()
1643                 if $script_name =~ /\.fcgi$/ || ($auto_fcgi && is_fcgi());
1644
1645         my $nproc_sub = sub {
1646                 my ($arg, $val) = @_;
1647                 return unless eval { require FCGI::ProcManager; 1; };
1648                 $fcgi_nproc_active = 1;
1649                 my $proc_manager = FCGI::ProcManager->new({
1650                         n_processes => $val,
1651                 });
1652                 our $pre_listen_hook    = sub { $proc_manager->pm_manage()        };
1653                 our $pre_dispatch_hook  = sub { $proc_manager->pm_pre_dispatch()  };
1654                 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1655         };
1656         if (@ARGV) {
1657                 require Getopt::Long;
1658                 Getopt::Long::GetOptions(
1659                         'fastcgi|fcgi|f' => \&configure_as_fcgi,
1660                         'nproc|n=i' => $nproc_sub,
1661                 );
1662         };
1663         if (!$fcgi_nproc_active && defined $ENV{'GITWEB_FCGI_NPROC'} && $ENV{'GITWEB_FCGI_NPROC'} =~ /^\d+$/) {
1664                 &$nproc_sub('nproc', $ENV{'GITWEB_FCGI_NPROC'});
1665         }
1666 }
1667
1668 # Any "our" variable that could possibly influence correct handling of
1669 # a CGI request MUST be reset in this subroutine
1670 sub _reset_globals {
1671         # Note that $t0 and $number_of_git_commands are handled by reset_timer
1672         our %input_params = ();
1673         our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1674              $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1675              $searchtext, $search_regexp, $project_filter) = ();
1676         our $git_dir = undef;
1677         our (@snapshot_fmts, $git_avatar, @extra_branch_refs) = ();
1678         our %avatar_cache = ();
1679         our $config_file = '';
1680         our %config = ();
1681         our $gitweb_project_owner = undef;
1682         our $shown_stale_message = 0;
1683         our $fcgi_raw_mode = 0;
1684         keys %known_snapshot_formats; # reset 'each' iterator
1685 }
1686
1687 sub run {
1688         evaluate_gitweb_config();
1689         evaluate_encoding();
1690         evaluate_email_obfuscate();
1691         evaluate_git_version();
1692         my ($ml, $mi, $bu, $hl, $subroutine) = ($my_url, $my_uri, $base_url, $home_link, '');
1693         $subroutine .= '$my_url = $ml;' if defined $my_url && $my_url ne '';
1694         $subroutine .= '$my_uri = $mi;' if defined $my_uri; # this one can be ""
1695         $subroutine .= '$base_url = $bu;' if defined $base_url && $base_url ne '';
1696         $subroutine .= '$home_link = $hl;' if defined $home_link && $home_link ne '';
1697         $evaluate_uri_force = eval "sub {$subroutine}" if $subroutine;
1698         $first_request = 1;
1699         evaluate_argv();
1700
1701         $pre_listen_hook->()
1702                 if $pre_listen_hook;
1703
1704  REQUEST:
1705         while ($cgi = $CGI->new()) {
1706                 $pre_dispatch_hook->()
1707                         if $pre_dispatch_hook;
1708                 {
1709                         # most globals can simply be reset
1710                         _reset_globals;
1711
1712                         # evaluate_path_info corrupts %known_snapshot_formats
1713                         # so we need a deepish copy of it -- note that
1714                         # _reset_globals already took care of resetting its
1715                         # hash iterator that evaluate_path_info also leaves
1716                         # in an indeterminate state
1717                         my %formats = ();
1718                         while (my ($k,$v) = each(%known_snapshot_formats)) {
1719                                 $formats{$k} = {%{$known_snapshot_formats{$k}}};
1720                         }
1721                         local *known_snapshot_formats = \%formats;
1722
1723                         eval {run_request()};
1724                 }
1725                 $post_dispatch_hook->()
1726                         if $post_dispatch_hook;
1727                 $first_request = 0;
1728
1729                 last REQUEST if ($is_last_request->());
1730         }
1731
1732         1;
1733 }
1734
1735 run();
1736
1737 if (defined caller) {
1738         # wrapped in a subroutine processing requests,
1739         # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1740         return;
1741 } else {
1742         # pure CGI script, serving single request
1743         exit;
1744 }
1745
1746 ## ======================================================================
1747 ## action links
1748
1749 # possible values of extra options
1750 # -full => 0|1      - use absolute/full URL ($my_uri/$my_url as base)
1751 # -replay => 1      - start from a current view (replay with modifications)
1752 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1753 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1754 sub href {
1755         my %params = @_;
1756         # default is to use -absolute url() i.e. $my_uri
1757         my $href = $params{-full} ? $my_url : $my_uri;
1758
1759         # implicit -replay, must be first of implicit params
1760         $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1761
1762         $params{'project'} = $project unless exists $params{'project'};
1763
1764         if ($params{-replay}) {
1765                 while (my ($name, $symbol) = each %cgi_param_mapping) {
1766                         if (!exists $params{$name}) {
1767                                 $params{$name} = $input_params{$name};
1768                         }
1769                 }
1770         }
1771
1772         my $use_pathinfo = gitweb_check_feature('pathinfo');
1773         if (defined $params{'project'} &&
1774             (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1775                 # try to put as many parameters as possible in PATH_INFO:
1776                 #   - project name
1777                 #   - action
1778                 #   - hash_parent or hash_parent_base:/file_parent
1779                 #   - hash or hash_base:/filename
1780                 #   - the snapshot_format as an appropriate suffix
1781
1782                 # When the script is the root DirectoryIndex for the domain,
1783                 # $href here would be something like http://gitweb.example.com/
1784                 # Thus, we strip any trailing / from $href, to spare us double
1785                 # slashes in the final URL
1786                 $href =~ s,/$,,;
1787
1788                 # Then add the project name, if present
1789                 $href .= "/".esc_path_info($params{'project'});
1790                 delete $params{'project'};
1791
1792                 # since we destructively absorb parameters, we keep this
1793                 # boolean that remembers if we're handling a snapshot
1794                 my $is_snapshot = $params{'action'} eq 'snapshot';
1795
1796                 # Summary just uses the project path URL, any other action is
1797                 # added to the URL
1798                 if (defined $params{'action'}) {
1799                         $href .= "/".esc_path_info($params{'action'})
1800                                 unless $params{'action'} eq 'summary';
1801                         delete $params{'action'};
1802                 }
1803
1804                 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1805                 # stripping nonexistent or useless pieces
1806                 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1807                         || $params{'hash_parent'} || $params{'hash'});
1808                 if (defined $params{'hash_base'}) {
1809                         if (defined $params{'hash_parent_base'}) {
1810                                 $href .= esc_path_info($params{'hash_parent_base'});
1811                                 # skip the file_parent if it's the same as the file_name
1812                                 if (defined $params{'file_parent'}) {
1813                                         if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1814                                                 delete $params{'file_parent'};
1815                                         } elsif ($params{'file_parent'} !~ /\.\./) {
1816                                                 $href .= ":/".esc_path_info($params{'file_parent'});
1817                                                 delete $params{'file_parent'};
1818                                         }
1819                                 }
1820                                 $href .= "..";
1821                                 delete $params{'hash_parent'};
1822                                 delete $params{'hash_parent_base'};
1823                         } elsif (defined $params{'hash_parent'}) {
1824                                 $href .= esc_path_info($params{'hash_parent'}). "..";
1825                                 delete $params{'hash_parent'};
1826                         }
1827
1828                         $href .= esc_path_info($params{'hash_base'});
1829                         if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1830                                 $href .= ":/".esc_path_info($params{'file_name'});
1831                                 delete $params{'file_name'};
1832                         }
1833                         delete $params{'hash'};
1834                         delete $params{'hash_base'};
1835                 } elsif (defined $params{'hash'}) {
1836                         $href .= esc_path_info($params{'hash'});
1837                         delete $params{'hash'};
1838                 }
1839
1840                 # If the action was a snapshot, we can absorb the
1841                 # snapshot_format parameter too
1842                 if ($is_snapshot) {
1843                         my $fmt = $params{'snapshot_format'};
1844                         # snapshot_format should always be defined when href()
1845                         # is called, but just in case some code forgets, we
1846                         # fall back to the default
1847                         $fmt ||= $snapshot_fmts[0];
1848                         $href .= $known_snapshot_formats{$fmt}{'suffix'};
1849                         delete $params{'snapshot_format'};
1850                 }
1851         }
1852
1853         # now encode the parameters explicitly
1854         my @result = ();
1855         for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1856                 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1857                 if (defined $params{$name}) {
1858                         if (ref($params{$name}) eq "ARRAY") {
1859                                 foreach my $par (@{$params{$name}}) {
1860                                         push @result, $symbol . "=" . esc_param($par);
1861                                 }
1862                         } else {
1863                                 push @result, $symbol . "=" . esc_param($params{$name});
1864                         }
1865                 }
1866         }
1867         $href .= "?" . join(';', @result) if scalar @result;
1868
1869         # final transformation: trailing spaces must be escaped (URI-encoded)
1870         $href =~ s/(\s+)$/CGI::escape($1)/e;
1871
1872         if ($params{-anchor}) {
1873                 $href .= "#".esc_param($params{-anchor});
1874         }
1875
1876         return $href;
1877 }
1878
1879
1880 ## ======================================================================
1881 ## validation, quoting/unquoting and escaping
1882
1883 sub is_valid_action {
1884         my $input = shift;
1885         return undef unless exists $actions{$input};
1886         return 1;
1887 }
1888
1889 sub is_valid_project {
1890         my $input = shift;
1891
1892         return unless defined $input;
1893         if (!is_valid_pathname($input) ||
1894                 !(-d "$projectroot/$input") ||
1895                 !check_export_ok("$projectroot/$input") ||
1896                 ($strict_export && !project_in_list($input))) {
1897                 return undef;
1898         } else {
1899                 return 1;
1900         }
1901 }
1902
1903 sub is_valid_pathname {
1904         my $input = shift;
1905
1906         return undef unless defined $input;
1907         # no '.' or '..' as elements of path, i.e. no '.' or '..'
1908         # at the beginning, at the end, and between slashes.
1909         # also this catches doubled slashes
1910         if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1911                 return undef;
1912         }
1913         # no null characters
1914         if ($input =~ m!\0!) {
1915                 return undef;
1916         }
1917         return 1;
1918 }
1919
1920 sub is_valid_ref_format {
1921         my $input = shift;
1922
1923         return undef unless defined $input;
1924         # restrictions on ref name according to git-check-ref-format
1925         if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1926                 return undef;
1927         }
1928         return 1;
1929 }
1930
1931 sub is_valid_refname {
1932         my $input = shift;
1933
1934         return undef unless defined $input;
1935         # textual hashes are O.K.
1936         if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1937                 return 1;
1938         }
1939         # it must be correct pathname
1940         is_valid_pathname($input) or return undef;
1941         # check git-check-ref-format restrictions
1942         is_valid_ref_format($input) or return undef;
1943         return 1;
1944 }
1945
1946 # decode sequences of octets in utf8 into Perl's internal form,
1947 # which is utf-8 with utf8 flag set if needed.  gitweb writes out
1948 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
1949 sub to_utf8 {
1950         my $str = shift;
1951         return undef unless defined $str;
1952
1953         if (utf8::is_utf8($str) || utf8::decode($str)) {
1954                 return $str;
1955         } else {
1956                 return $encode_object->decode($str, Encode::FB_DEFAULT);
1957         }
1958 }
1959
1960 # quote unsafe chars, but keep the slash, even when it's not
1961 # correct, but quoted slashes look too horrible in bookmarks
1962 sub esc_param {
1963         my $str = shift;
1964         return undef unless defined $str;
1965         $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
1966         $str =~ s/ /\+/g;
1967         return $str;
1968 }
1969
1970 # the quoting rules for path_info fragment are slightly different
1971 sub esc_path_info {
1972         my $str = shift;
1973         return undef unless defined $str;
1974
1975         # path_info doesn't treat '+' as space (specially), but '?' must be escaped
1976         $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
1977
1978         return $str;
1979 }
1980
1981 # quote unsafe chars in whole URL, so some characters cannot be quoted
1982 sub esc_url {
1983         my $str = shift;
1984         return undef unless defined $str;
1985         $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
1986         $str =~ s/ /\+/g;
1987         return $str;
1988 }
1989
1990 # quote unsafe characters in HTML attributes
1991 sub esc_attr {
1992
1993         # for XHTML conformance escaping '"' to '&quot;' is not enough
1994         return esc_html(@_);
1995 }
1996
1997 # replace invalid utf8 character with SUBSTITUTION sequence
1998 sub esc_html {
1999         my $str = shift;
2000         my %opts = @_;
2001
2002         return undef unless defined $str;
2003
2004         $str = to_utf8($str);
2005         $str = $cgi->escapeHTML($str);
2006         if ($opts{'-nbsp'}) {
2007                 $str =~ s/ /&#160;/g;
2008         }
2009         use bytes;
2010         $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
2011         return $str;
2012 }
2013
2014 # quote control characters and escape filename to HTML
2015 sub esc_path {
2016         my $str = shift;
2017         my %opts = @_;
2018
2019         return undef unless defined $str;
2020
2021         $str = to_utf8($str);
2022         $str = $cgi->escapeHTML($str);
2023         if ($opts{'-nbsp'}) {
2024                 $str =~ s/ /&#160;/g;
2025         }
2026         use bytes;
2027         $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
2028         return $str;
2029 }
2030
2031 # Sanitize for use in XHTML + application/xml+xhtm (valid XML 1.0)
2032 sub sanitize {
2033         my $str = shift;
2034
2035         return undef unless defined $str;
2036
2037         $str = to_utf8($str);
2038         use bytes;
2039         $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
2040         return $str;
2041 }
2042
2043 # Make control characters "printable", using character escape codes (CEC)
2044 sub quot_cec {
2045         my $cntrl = shift;
2046         my %opts = @_;
2047         my %es = ( # character escape codes, aka escape sequences
2048                 "\t" => '\t',   # tab            (HT)
2049                 "\n" => '\n',   # line feed      (LF)
2050                 "\r" => '\r',   # carrige return (CR)
2051                 "\f" => '\f',   # form feed      (FF)
2052                 "\b" => '\b',   # backspace      (BS)
2053                 "\a" => '\a',   # alarm (bell)   (BEL)
2054                 "\e" => '\e',   # escape         (ESC)
2055                 "\013" => '\v', # vertical tab   (VT)
2056                 "\000" => '\0', # nul character  (NUL)
2057         );
2058         my $chr = ( (exists $es{$cntrl})
2059                     ? $es{$cntrl}
2060                     : sprintf('\x%02x', ord($cntrl)) );
2061         if ($opts{-nohtml}) {
2062                 return $chr;
2063         } else {
2064                 return "<span class=\"cntrl\">$chr</span>";
2065         }
2066 }
2067
2068 # Alternatively use unicode control pictures codepoints,
2069 # Unicode "printable representation" (PR)
2070 sub quot_upr {
2071         my $cntrl = shift;
2072         my %opts = @_;
2073
2074         my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
2075         if ($opts{-nohtml}) {
2076                 return $chr;
2077         } else {
2078                 return "<span class=\"cntrl\">$chr</span>";
2079         }
2080 }
2081
2082 # git may return quoted and escaped filenames
2083 sub unquote {
2084         my $str = shift;
2085
2086         sub unq {
2087                 my $seq = shift;
2088                 my %es = ( # character escape codes, aka escape sequences
2089                         't' => "\t",   # tab            (HT, TAB)
2090                         'n' => "\n",   # newline        (NL)
2091                         'r' => "\r",   # return         (CR)
2092                         'f' => "\f",   # form feed      (FF)
2093                         'b' => "\b",   # backspace      (BS)
2094                         'a' => "\a",   # alarm (bell)   (BEL)
2095                         'e' => "\e",   # escape         (ESC)
2096                         'v' => "\013", # vertical tab   (VT)
2097                 );
2098
2099                 if ($seq =~ m/^[0-7]{1,3}$/) {
2100                         # octal char sequence
2101                         return chr(oct($seq));
2102                 } elsif (exists $es{$seq}) {
2103                         # C escape sequence, aka character escape code
2104                         return $es{$seq};
2105                 }
2106                 # quoted ordinary character
2107                 return $seq;
2108         }
2109
2110         if ($str =~ m/^"(.*)"$/) {
2111                 # needs unquoting
2112                 $str = $1;
2113                 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
2114         }
2115         return $str;
2116 }
2117
2118 # escape tabs (convert tabs to spaces)
2119 sub untabify {
2120         my $line = shift;
2121
2122         while ((my $pos = index($line, "\t")) != -1) {
2123                 if (my $count = (8 - ($pos % 8))) {
2124                         my $spaces = ' ' x $count;
2125                         $line =~ s/\t/$spaces/;
2126                 }
2127         }
2128
2129         return $line;
2130 }
2131
2132 sub project_in_list {
2133         my $project = shift;
2134         my @list = git_get_projects_list();
2135         return @list && scalar(grep { $_->{'path'} eq $project } @list);
2136 }
2137
2138 sub cached_page_precondition_check {
2139         my $action = shift;
2140         return 1 unless
2141                 $action eq 'summary' &&
2142                 $projlist_cache_lifetime > 0 &&
2143                 gitweb_check_feature('forks');
2144
2145         # Note that ALL the 'forkchange' logic is in this function.
2146         # It does NOT belong in cached_action_page NOR in cached_action_start
2147         # NOR in cached_action_finish.  None of those functions should know anything
2148         # about nor do anything to any of the 'forkchange'/"$action.forkchange" files.
2149
2150         # besides the basic 'changed' "$action.changed" check, we may only use
2151         # a summary cache if:
2152         #
2153         #   1) we are not using a project list cache file
2154         #   -OR-
2155         #   2) we are not using the 'forks' feature
2156         #   -OR-
2157         #   3) there is no 'forkchange' nor "$action.forkchange" file in $html_cache_dir
2158         #   -OR-
2159         #   4) there is no cache file ("$cache_dir/$projlist_cache_name")
2160         #   -OR-
2161         #   5) the OLDER of 'forkchange'/"$action.forkchange" is NEWER than the cache file
2162         #
2163         # Otherwise we must re-generate the cache because we've had a fork change
2164         # (either a fork was added or a fork was removed) AND the change has been
2165         # picked up in the cache file AND we've not got that in our cached copy
2166         #
2167         # For (5) regenerating the cached page wouldn't get us anything if the project
2168         # cache file is older than the 'forkchange'/"$action.forkchange" because the
2169         # forks information comes from the project cache file and it's clearly not
2170         # picked up the changes yet so we may continue to use a cached page until it does.
2171
2172         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2173         my $fc_mt = (stat("$htmlcd/forkchange"))[9];
2174         my $afc_mt = (stat("$htmlcd/$action.forkchange"))[9];
2175         return 1 unless defined($fc_mt) || defined($afc_mt);
2176         my $prj_mt = (stat("$cache_dir/$projlist_cache_name"))[9];
2177         return 1 unless $prj_mt;
2178         my $old_mt = $fc_mt;
2179         $old_mt = $afc_mt if !defined($old_mt) || (defined($afc_mt) && $afc_mt < $old_mt);
2180         return 1 if $old_mt > $prj_mt;
2181
2182         # We're going to regenerate the cached page because we know the project cache
2183         # has new fork information that we cannot possibly have in our cached copy.
2184         #
2185         # However, if both 'forkchange' and "$action.forkchange" exist and one of
2186         # them is older than the project cache and one of them is newer, we still
2187         # need to regenerate the page cache, but we will also need to do it again
2188         # in the future because there's yet another fork update not yet in the cache.
2189         #
2190         # So we make sure to touch "$action.changed" to force a cache regeneration
2191         # and then we remove either or both of 'forkchange'/"$action.forkchange" if
2192         # they're older than the project cache (they've served their purpose, we're
2193         # forcing a page regeneration by touching "$action.changed" but the project
2194         # cache was rebuilt since then so there are no more pending fork updates to
2195         # pick up in the future and they need to go).
2196
2197         # For best results, the external code that touches 'forkchange' should always
2198         # touch 'forkchange' and additionally touch 'summary.forkchange' but only
2199         # if it does not already exist.  That way the cached page will be regenerated
2200         # each time it's requested and ANY fork updates are available in the proj
2201         # cache rather than waiting until they all are before updating.
2202
2203         # Note that we take a shortcut here and will zap 'forkchange' since we know
2204         # that it only affects the 'summary' cache.  If, in the future, it affects
2205         # other cache types, it will first need to be propogated down to
2206         # "$action.forkchange" for those types before we zap it.
2207
2208         my $fd;
2209         open $fd, '>', "$htmlcd/$action.changed" and close $fd;
2210         $fc_mt=undef, unlink "$htmlcd/forkchange" if defined $fc_mt && $fc_mt < $prj_mt;
2211         $afc_mt=undef, unlink "$htmlcd/$action.forkchange" if defined $afc_mt && $afc_mt < $prj_mt;
2212
2213         # Now we propagate 'forkchange' to "$action.forkchange" if we have the
2214         # one and not the other.
2215
2216         if (defined $fc_mt && ! defined $afc_mt) {
2217                 open $fd, '>', "$htmlcd/$action.forkchange" and close $fd;
2218                 -e "$htmlcd/$action.forkchange" and
2219                 utime($fc_mt, $fc_mt, "$htmlcd/$action.forkchange") and
2220                 unlink "$htmlcd/forkchange";
2221         }
2222
2223         return 0;
2224 }
2225
2226 sub cached_action_page {
2227         my $action = shift;
2228
2229         return undef unless $action && $html_cache_actions{$action} && $html_cache_dir;
2230         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2231         return undef if -e "$htmlcd/changed" || -e "$htmlcd/$action.changed";
2232         return undef unless cached_page_precondition_check($action);
2233         open my $fd, '<', "$htmlcd/$action" or return undef;
2234         binmode $fd;
2235         local $/;
2236         my $cached_page = <$fd>;
2237         close $fd or return undef;
2238         return $cached_page;
2239 }
2240
2241 package Git::Gitweb::CacheFile;
2242
2243 sub TIEHANDLE {
2244         use POSIX qw(:fcntl_h);
2245         my $class = shift;
2246         my $cachefile = shift;
2247
2248         sysopen(my $self, $cachefile, O_WRONLY|O_CREAT|O_EXCL, 0664)
2249                 or return undef;
2250         $$self->{'cachefile'} = $cachefile;
2251         $$self->{'opened'} = 1;
2252         $$self->{'contents'} = '';
2253         return bless $self, $class;
2254 }
2255
2256 sub CLOSE {
2257         my $self = shift;
2258         if ($$self->{'opened'}) {
2259                 $$self->{'opened'} = 0;
2260                 my $result = close $self;
2261                 unlink $$self->{'cachefile'} unless $result;
2262                 return $result;
2263         }
2264         return 0;
2265 }
2266
2267 sub DESTROY {
2268         my $self = shift;
2269         if ($$self->{'opened'}) {
2270                 $self->CLOSE() and unlink $$self->{'cachefile'};
2271         }
2272 }
2273
2274 sub PRINT {
2275         my $self = shift;
2276         @_ = (map {my $x=$_; utf8::encode($x); $x} @_) unless $fcgi_raw_mode;
2277         print $self @_ if $$self->{'opened'};
2278         $$self->{'contents'} .= join('', @_);
2279         return 1;
2280 }
2281
2282 sub PRINTF {
2283         my $self = shift;
2284         my $template = shift;
2285         return $self->PRINT(sprintf $template, @_);
2286 }
2287
2288 sub contents {
2289         my $self = shift;
2290         return $$self->{'contents'};
2291 }
2292
2293 package main;
2294
2295 # Caller is responsible for preserving STDOUT beforehand if needed
2296 sub cached_action_start {
2297         my $action = shift;
2298
2299         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2300         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2301         return undef unless -d $htmlcd;
2302         if (-e "$htmlcd/changed") {
2303                 foreach my $cacheable (keys(%html_cache_actions)) {
2304                         next unless $supported_cache_actions{$cacheable} &&
2305                                     $html_cache_actions{$cacheable};
2306                         my $fd;
2307                         open $fd, '>', "$htmlcd/$cacheable.changed"
2308                         and close $fd;
2309                 }
2310                 unlink "$htmlcd/changed";
2311         }
2312         local *CACHEFILE;
2313         tie *CACHEFILE, 'Git::Gitweb::CacheFile', "$htmlcd/$action.lock"  or return undef;
2314         *STDOUT = *CACHEFILE;
2315         unlink "$htmlcd/$action", "$htmlcd/$action.changed";
2316         return 1;
2317 }
2318
2319 # Caller is responsible for restoring STDOUT afterward if needed
2320 sub cached_action_finish {
2321         my $action = shift;
2322
2323         use File::Spec;
2324
2325         my $obj = tied *STDOUT;
2326         return undef unless ref($obj) eq 'Git::Gitweb::CacheFile';
2327         my $cached_page = $obj->contents;
2328         (my $result = close(STDOUT)) or warn "couldn't close cache file on STDOUT: $!";
2329         # Do not leave STDOUT file descriptor invalid!
2330         local *NULL;
2331         open(NULL, '>', File::Spec->devnull) or die "couldn't open NULL to devnull: $!";
2332         *STDOUT = *NULL;
2333         return $cached_page unless $result;
2334         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2335         return $cached_page unless -d $htmlcd;
2336         unlink "$htmlcd/$action.lock" unless rename "$htmlcd/$action.lock", "$htmlcd/$action";
2337         return $cached_page;
2338 }
2339
2340 my %expand_pi_subs;
2341 BEGIN {%expand_pi_subs = (
2342         'age_string'               => \&age_string,
2343         'age_string_date'          => \&age_string_date,
2344         'age_string_age'           => \&age_string_age,
2345         'compute_timed_interval'   => \&compute_timed_interval,
2346         'compute_commands_count'   => \&compute_commands_count,
2347         'format_lastrefresh_row'   => \&format_lastrefresh_row,
2348         'compute_stylesheet_links' => \&compute_stylesheet_links,
2349 )}
2350
2351 # Expands any <?gitweb...> processing instructions and returns the result
2352 sub expand_gitweb_pi {
2353         my $page = shift;
2354         $page .= '';
2355         my @time_now = gettimeofday();
2356         $page =~ s{<\?gitweb(?:\s+([^\s>]+)([^>]*))?\s*\?>}
2357                   {defined($1) ?
2358                           (ref($expand_pi_subs{$1}) eq 'CODE' ?
2359                                   $expand_pi_subs{$1}->(split(' ',$2), @time_now) :
2360                                   '') :
2361                           '' }goes;
2362         return $page;
2363 }
2364
2365 ## ----------------------------------------------------------------------
2366 ## HTML aware string manipulation
2367
2368 # Try to chop given string on a word boundary between position
2369 # $len and $len+$add_len. If there is no word boundary there,
2370 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
2371 # (marking chopped part) would be longer than given string.
2372 sub chop_str {
2373         my $str = shift;
2374         my $len = shift;
2375         my $add_len = shift || 10;
2376         my $where = shift || 'right'; # 'left' | 'center' | 'right'
2377
2378         # Make sure perl knows it is utf8 encoded so we don't
2379         # cut in the middle of a utf8 multibyte char.
2380         $str = to_utf8($str);
2381
2382         # allow only $len chars, but don't cut a word if it would fit in $add_len
2383         # if it doesn't fit, cut it if it's still longer than the dots we would add
2384         # remove chopped character entities entirely
2385
2386         # when chopping in the middle, distribute $len into left and right part
2387         # return early if chopping wouldn't make string shorter
2388         if ($where eq 'center') {
2389                 return $str if ($len + 5 >= length($str)); # filler is length 5
2390                 $len = int($len/2);
2391         } else {
2392                 return $str if ($len + 4 >= length($str)); # filler is length 4
2393         }
2394
2395         # regexps: ending and beginning with word part up to $add_len
2396         my $endre = qr/.{$len}\w{0,$add_len}/;
2397         my $begre = qr/\w{0,$add_len}.{$len}/;
2398
2399         if ($where eq 'left') {
2400                 $str =~ m/^(.*?)($begre)$/;
2401                 my ($lead, $body) = ($1, $2);
2402                 if (length($lead) > 4) {
2403                         $lead = " ...";
2404                 }
2405                 return "$lead$body";
2406
2407         } elsif ($where eq 'center') {
2408                 $str =~ m/^($endre)(.*)$/;
2409                 my ($left, $str)  = ($1, $2);
2410                 $str =~ m/^(.*?)($begre)$/;
2411                 my ($mid, $right) = ($1, $2);
2412                 if (length($mid) > 5) {
2413                         $mid = " ... ";
2414                 }
2415                 return "$left$mid$right";
2416
2417         } else {
2418                 $str =~ m/^($endre)(.*)$/;
2419                 my $body = $1;
2420                 my $tail = $2;
2421                 if (length($tail) > 4) {
2422                         $tail = "... ";
2423                 }
2424                 return "$body$tail";
2425         }
2426 }
2427
2428 # pass-through email filter, obfuscating it when possible
2429 sub email_obfuscate {
2430         our $email;
2431         my ($str) = @_;
2432         if ($email) {
2433                 $str = $email->escape_html($str);
2434                 # Stock HTML::Email::Obfuscate version likes to produce
2435                 # invalid XHTML...
2436                 $str =~ s#<(/?)B>#<$1b>#g;
2437                 return $str;
2438         } else {
2439                 $str = esc_html($str);
2440                 $str =~ s/@/&#x40;/;
2441                 return $str;
2442         }
2443 }
2444
2445 # takes the same arguments as chop_str, but also wraps a <span> around the
2446 # result with a title attribute if it does get chopped. Additionally, the
2447 # string is HTML-escaped.
2448 sub chop_and_escape_str {
2449         my ($str) = @_;
2450
2451         my $chopped = chop_str(@_);
2452         $str = to_utf8($str);
2453         if ($chopped eq $str) {
2454                 return email_obfuscate($chopped);
2455         } else {
2456                 use bytes;
2457                 $str =~ s/[[:cntrl:]]/?/g;
2458                 return $cgi->span({-title=>$str}, email_obfuscate($chopped));
2459         }
2460 }
2461
2462 # Highlight selected fragments of string, using given CSS class,
2463 # and escape HTML.  It is assumed that fragments do not overlap.
2464 # Regions are passed as list of pairs (array references).
2465 #
2466 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
2467 # '<span class="mark">foo</span>bar'
2468 sub esc_html_hl_regions {
2469         my ($str, $css_class, @sel) = @_;
2470         my %opts = grep { ref($_) ne 'ARRAY' } @sel;
2471         @sel     = grep { ref($_) eq 'ARRAY' } @sel;
2472         return esc_html($str, %opts) unless @sel;
2473
2474         my $out = '';
2475         my $pos = 0;
2476
2477         for my $s (@sel) {
2478                 my ($begin, $end) = @$s;
2479
2480                 # Don't create empty <span> elements.
2481                 next if $end <= $begin;
2482
2483                 my $escaped = esc_html(substr($str, $begin, $end - $begin),
2484                                        %opts);
2485
2486                 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
2487                         if ($begin - $pos > 0);
2488                 $out .= $cgi->span({-class => $css_class}, $escaped);
2489
2490                 $pos = $end;
2491         }
2492         $out .= esc_html(substr($str, $pos), %opts)
2493                 if ($pos < length($str));
2494
2495         return $out;
2496 }
2497
2498 # return positions of beginning and end of each match
2499 sub matchpos_list {
2500         my ($str, $regexp) = @_;
2501         return unless (defined $str && defined $regexp);
2502
2503         my @matches;
2504         while ($str =~ /$regexp/g) {
2505                 push @matches, [$-[0], $+[0]];
2506         }
2507         return @matches;
2508 }
2509
2510 # highlight match (if any), and escape HTML
2511 sub esc_html_match_hl {
2512         my ($str, $regexp) = @_;
2513         return esc_html($str) unless defined $regexp;
2514
2515         my @matches = matchpos_list($str, $regexp);
2516         return esc_html($str) unless @matches;
2517
2518         return esc_html_hl_regions($str, 'match', @matches);
2519 }
2520
2521
2522 # highlight match (if any) of shortened string, and escape HTML
2523 sub esc_html_match_hl_chopped {
2524         my ($str, $chopped, $regexp) = @_;
2525         return esc_html_match_hl($str, $regexp) unless defined $chopped;
2526
2527         my @matches = matchpos_list($str, $regexp);
2528         return esc_html($chopped) unless @matches;
2529
2530         # filter matches so that we mark chopped string
2531         my $tail = "... "; # see chop_str
2532         unless ($chopped =~ s/\Q$tail\E$//) {
2533                 $tail = '';
2534         }
2535         my $chop_len = length($chopped);
2536         my $tail_len = length($tail);
2537         my @filtered;
2538
2539         for my $m (@matches) {
2540                 if ($m->[0] > $chop_len) {
2541                         push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
2542                         last;
2543                 } elsif ($m->[1] > $chop_len) {
2544                         push @filtered, [ $m->[0], $chop_len + $tail_len ];
2545                         last;
2546                 }
2547                 push @filtered, $m;
2548         }
2549
2550         return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
2551 }
2552
2553 ## ----------------------------------------------------------------------
2554 ## functions returning short strings
2555
2556 # CSS class for given age epoch value (in seconds)
2557 # and reference time (optional, defaults to now) as second value
2558 sub age_class {
2559         my ($age_epoch, $time_now) = @_;
2560         return "noage" unless defined $age_epoch;
2561         defined $time_now or $time_now = time;
2562         my $age = $time_now - $age_epoch;
2563
2564         if ($age < 60*60*2) {
2565                 return "age0";
2566         } elsif ($age < 60*60*24*2) {
2567                 return "age1";
2568         } else {
2569                 return "age2";
2570         }
2571 }
2572
2573 # convert age epoch in seconds to "nn units ago" string
2574 # reference time used is now unless second argument passed in
2575 # to get the old behavior, pass 0 as the first argument and
2576 # the time in seconds as the second
2577 sub age_string {
2578         my ($age_epoch, $time_now) = @_;
2579         return "unknown" unless defined $age_epoch;
2580         return "<?gitweb age_string $age_epoch?>" if $cache_mode_active;
2581         defined $time_now or $time_now = time;
2582         my $age = $time_now - $age_epoch;
2583         my $age_str;
2584
2585         if ($age > 60*60*24*365*2) {
2586                 $age_str = (int $age/60/60/24/365);
2587                 $age_str .= " years ago";
2588         } elsif ($age > 60*60*24*(365/12)*2) {
2589                 $age_str = int $age/60/60/24/(365/12);
2590                 $age_str .= " months ago";
2591         } elsif ($age > 60*60*24*7*2) {
2592                 $age_str = int $age/60/60/24/7;
2593                 $age_str .= " weeks ago";
2594         } elsif ($age > 60*60*24*2) {
2595                 $age_str = int $age/60/60/24;
2596                 $age_str .= " days ago";
2597         } elsif ($age > 60*60*2) {
2598                 $age_str = int $age/60/60;
2599                 $age_str .= " hours ago";
2600         } elsif ($age > 60*2) {
2601                 $age_str = int $age/60;
2602                 $age_str .= " min ago";
2603         } elsif ($age > 2) {
2604                 $age_str = int $age;
2605                 $age_str .= " sec ago";
2606         } else {
2607                 $age_str .= " right now";
2608         }
2609         return $age_str;
2610 }
2611
2612 # returns age_string if the age is <= 2 weeks otherwise an absolute date
2613 # this is typically shown to the user directly with the age_string_age as a title
2614 sub age_string_date {
2615         my ($age_epoch, $time_now) = @_;
2616         return "unknown" unless defined $age_epoch;
2617         return "<?gitweb age_string_date $age_epoch?>" if $cache_mode_active;
2618         defined $time_now or $time_now = time;
2619         my $age = $time_now - $age_epoch;
2620
2621         if ($age > 60*60*24*7*2) {
2622                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2623                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2624         } else {
2625                 return age_string($age_epoch, $time_now);
2626         }
2627 }
2628
2629 # returns an absolute date if the age is <= 2 weeks otherwise age_string
2630 # this is typically used for the 'title' attribute so it will show as a tooltip
2631 sub age_string_age {
2632         my ($age_epoch, $time_now) = @_;
2633         return "unknown" unless defined $age_epoch;
2634         return "<?gitweb age_string_age $age_epoch?>" if $cache_mode_active;
2635         defined $time_now or $time_now = time;
2636         my $age = $time_now - $age_epoch;
2637
2638         if ($age > 60*60*24*7*2) {
2639                 return age_string($age_epoch, $time_now);
2640         } else {
2641                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2642                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2643         }
2644 }
2645
2646 use constant {
2647         S_IFINVALID => 0030000,
2648         S_IFGITLINK => 0160000,
2649 };
2650
2651 # submodule/subproject, a commit object reference
2652 sub S_ISGITLINK {
2653         my $mode = shift;
2654
2655         return (($mode & S_IFMT) == S_IFGITLINK)
2656 }
2657
2658 # convert file mode in octal to symbolic file mode string
2659 sub mode_str {
2660         my $mode = oct shift;
2661
2662         if (S_ISGITLINK($mode)) {
2663                 return 'm---------';
2664         } elsif (S_ISDIR($mode & S_IFMT)) {
2665                 return 'drwxr-xr-x';
2666         } elsif (S_ISLNK($mode)) {
2667                 return 'lrwxrwxrwx';
2668         } elsif (S_ISREG($mode)) {
2669                 # git cares only about the executable bit
2670                 if ($mode & S_IXUSR) {
2671                         return '-rwxr-xr-x';
2672                 } else {
2673                         return '-rw-r--r--';
2674                 };
2675         } else {
2676                 return '----------';
2677         }
2678 }
2679
2680 # convert file mode in octal to file type string
2681 sub file_type {
2682         my $mode = shift;
2683
2684         if ($mode !~ m/^[0-7]+$/) {
2685                 return $mode;
2686         } else {
2687                 $mode = oct $mode;
2688         }
2689
2690         if (S_ISGITLINK($mode)) {
2691                 return "submodule";
2692         } elsif (S_ISDIR($mode & S_IFMT)) {
2693                 return "directory";
2694         } elsif (S_ISLNK($mode)) {
2695                 return "symlink";
2696         } elsif (S_ISREG($mode)) {
2697                 return "file";
2698         } else {
2699                 return "unknown";
2700         }
2701 }
2702
2703 # convert file mode in octal to file type description string
2704 sub file_type_long {
2705         my $mode = shift;
2706
2707         if ($mode !~ m/^[0-7]+$/) {
2708                 return $mode;
2709         } else {
2710                 $mode = oct $mode;
2711         }
2712
2713         if (S_ISGITLINK($mode)) {
2714                 return "submodule";
2715         } elsif (S_ISDIR($mode & S_IFMT)) {
2716                 return "directory";
2717         } elsif (S_ISLNK($mode)) {
2718                 return "symlink";
2719         } elsif (S_ISREG($mode)) {
2720                 if ($mode & S_IXUSR) {
2721                         return "executable";
2722                 } else {
2723                         return "file";
2724                 };
2725         } else {
2726                 return "unknown";
2727         }
2728 }
2729
2730
2731 ## ----------------------------------------------------------------------
2732 ## functions returning short HTML fragments, or transforming HTML fragments
2733 ## which don't belong to other sections
2734
2735 # format line of commit message.
2736 sub format_log_line_html {
2737         my $line = shift;
2738
2739         $line = esc_html($line, -nbsp=>1);
2740         $line =~ s{\b([0-9a-fA-F]{8,40})\b}{
2741                 $cgi->a({-href => href(action=>"object", hash=>$1),
2742                                         -class => "text"}, $1);
2743         }eg unless $line =~ /^\s*git-svn-id:/;
2744
2745         return $line;
2746 }
2747
2748 # format marker of refs pointing to given object
2749
2750 # the destination action is chosen based on object type and current context:
2751 # - for annotated tags, we choose the tag view unless it's the current view
2752 #   already, in which case we go to shortlog view
2753 # - for other refs, we keep the current view if we're in history, shortlog or
2754 #   log view, and select shortlog otherwise
2755 sub format_ref_marker {
2756         my ($refs, $id) = @_;
2757         my $markers = '';
2758
2759         if (defined $refs->{$id}) {
2760                 foreach my $ref (@{$refs->{$id}}) {
2761                         # this code exploits the fact that non-lightweight tags are the
2762                         # only indirect objects, and that they are the only objects for which
2763                         # we want to use tag instead of shortlog as action
2764                         my ($type, $name) = qw();
2765                         my $indirect = ($ref =~ s/\^\{\}$//);
2766                         # e.g. tags/v2.6.11 or heads/next
2767                         if ($ref =~ m!^(.*?)s?/(.*)$!) {
2768                                 $type = $1;
2769                                 $name = $2;
2770                         } else {
2771                                 $type = "ref";
2772                                 $name = $ref;
2773                         }
2774
2775                         my $class = $type;
2776                         $class .= " indirect" if $indirect;
2777
2778                         my $dest_action = "shortlog";
2779
2780                         if ($indirect) {
2781                                 $dest_action = "tag" unless $action eq "tag";
2782                         } elsif ($action =~ /^(history|(short)?log)$/) {
2783                                 $dest_action = $action;
2784                         }
2785
2786                         my $dest = "";
2787                         $dest .= "refs/" unless $ref =~ m!^refs/!;
2788                         $dest .= $ref;
2789
2790                         my $link = $cgi->a({
2791                                 -href => href(
2792                                         action=>$dest_action,
2793                                         hash=>$dest
2794                                 )}, $name);
2795
2796                         $markers .= "<span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2797                                 $link . "</span>";
2798                 }
2799         }
2800
2801         if ($markers) {
2802                 return '<span class="refs">'. $markers . '</span>';
2803         } else {
2804                 return "";
2805         }
2806 }
2807
2808 # format, perhaps shortened and with markers, title line
2809 sub format_subject_html {
2810         my ($long, $short, $href, $extra) = @_;
2811         $extra = '' unless defined($extra);
2812
2813         if (length($short) < length($long)) {
2814                 use bytes;
2815                 $long =~ s/[[:cntrl:]]/?/g;
2816                 return $cgi->a({-href => $href, -class => "list subject",
2817                                 -title => to_utf8($long)},
2818                        esc_html($short)) . $extra;
2819         } else {
2820                 return $cgi->a({-href => $href, -class => "list subject"},
2821                        esc_html($long)) . $extra;
2822         }
2823 }
2824
2825 # Rather than recomputing the url for an email multiple times, we cache it
2826 # after the first hit. This gives a visible benefit in views where the avatar
2827 # for the same email is used repeatedly (e.g. shortlog).
2828 # The cache is shared by all avatar engines (currently gravatar only), which
2829 # are free to use it as preferred. Since only one avatar engine is used for any
2830 # given page, there's no risk for cache conflicts.
2831 our %avatar_cache = ();
2832
2833 # Compute the picon url for a given email, by using the picon search service over at
2834 # http://www.cs.indiana.edu/picons/search.html
2835 sub picon_url {
2836         my $email = lc shift;
2837         if (!$avatar_cache{$email}) {
2838                 my ($user, $domain) = split('@', $email);
2839                 $avatar_cache{$email} =
2840                         "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2841                         "$domain/$user/" .
2842                         "users+domains+unknown/up/single";
2843         }
2844         return $avatar_cache{$email};
2845 }
2846
2847 # Compute the gravatar url for a given email, if it's not in the cache already.
2848 # Gravatar stores only the part of the URL before the size, since that's the
2849 # one computationally more expensive. This also allows reuse of the cache for
2850 # different sizes (for this particular engine).
2851 sub gravatar_url {
2852         my $email = lc shift;
2853         my $size = shift;
2854         $avatar_cache{$email} ||=
2855                 "//www.gravatar.com/avatar/" .
2856                         Digest::MD5::md5_hex($email) . "?s=";
2857         return $avatar_cache{$email} . $size;
2858 }
2859
2860 # Insert an avatar for the given $email at the given $size if the feature
2861 # is enabled.
2862 sub git_get_avatar {
2863         my ($email, %opts) = @_;
2864         my $pre_white  = ($opts{-pad_before} ? "&#160;" : "");
2865         my $post_white = ($opts{-pad_after}  ? "&#160;" : "");
2866         $opts{-size} ||= 'default';
2867         my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2868         my $url = "";
2869         if ($git_avatar eq 'gravatar') {
2870                 $url = gravatar_url($email, $size);
2871         } elsif ($git_avatar eq 'picon') {
2872                 $url = picon_url($email);
2873         }
2874         # Other providers can be added by extending the if chain, defining $url
2875         # as needed. If no variant puts something in $url, we assume avatars
2876         # are completely disabled/unavailable.
2877         if ($url) {
2878                 return $pre_white .
2879                        "<img width=\"$size\" " .
2880                             "class=\"avatar\" " .
2881                             "src=\"".esc_url($url)."\" " .
2882                             "alt=\"\" " .
2883                        "/>" . $post_white;
2884         } else {
2885                 return "";
2886         }
2887 }
2888
2889 sub format_search_author {
2890         my ($author, $searchtype, $displaytext) = @_;
2891         my $have_search = gitweb_check_feature('search');
2892
2893         if ($have_search) {
2894                 my $performed = "";
2895                 if ($searchtype eq 'author') {
2896                         $performed = "authored";
2897                 } elsif ($searchtype eq 'committer') {
2898                         $performed = "committed";
2899                 }
2900
2901                 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2902                                 searchtext=>$author,
2903                                 searchtype=>$searchtype), class=>"list",
2904                                 title=>"Search for commits $performed by $author"},
2905                                 $displaytext);
2906
2907         } else {
2908                 return $displaytext;
2909         }
2910 }
2911
2912 # format the author name of the given commit with the given tag
2913 # the author name is chopped and escaped according to the other
2914 # optional parameters (see chop_str).
2915 sub format_author_html {
2916         my $tag = shift;
2917         my $co = shift;
2918         my $author = chop_and_escape_str($co->{'author_name'}, @_);
2919         return "<$tag class=\"author\">" .
2920                format_search_author($co->{'author_name'}, "author",
2921                        git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2922                        $author) .
2923                "</$tag>";
2924 }
2925
2926 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
2927 sub format_git_diff_header_line {
2928         my $line = shift;
2929         my $diffinfo = shift;
2930         my ($from, $to) = @_;
2931
2932         if ($diffinfo->{'nparents'}) {
2933                 # combined diff
2934                 $line =~ s!^(diff (.*?) )"?.*$!$1!;
2935                 if ($to->{'href'}) {
2936                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2937                                          esc_path($to->{'file'}));
2938                 } else { # file was deleted (no href)
2939                         $line .= esc_path($to->{'file'});
2940                 }
2941         } else {
2942                 # "ordinary" diff
2943                 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
2944                 if ($from->{'href'}) {
2945                         $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
2946                                          'a/' . esc_path($from->{'file'}));
2947                 } else { # file was added (no href)
2948                         $line .= 'a/' . esc_path($from->{'file'});
2949                 }
2950                 $line .= ' ';
2951                 if ($to->{'href'}) {
2952                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2953                                          'b/' . esc_path($to->{'file'}));
2954                 } else { # file was deleted
2955                         $line .= 'b/' . esc_path($to->{'file'});
2956                 }
2957         }
2958
2959         return "<div class=\"diff header\">$line</div>\n";
2960 }
2961
2962 # format extended diff header line, before patch itself
2963 sub format_extended_diff_header_line {
2964         my $line = shift;
2965         my $diffinfo = shift;
2966         my ($from, $to) = @_;
2967
2968         # match <path>
2969         if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
2970                 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2971                                        esc_path($from->{'file'}));
2972         }
2973         if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
2974                 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2975                                  esc_path($to->{'file'}));
2976         }
2977         # match single <mode>
2978         if ($line =~ m/\s(\d{6})$/) {
2979                 $line .= '<span class="info"> (' .
2980                          file_type_long($1) .
2981                          ')</span>';
2982         }
2983         # match <hash>
2984         if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
2985                 # can match only for combined diff
2986                 $line = 'index ';
2987                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2988                         if ($from->{'href'}[$i]) {
2989                                 $line .= $cgi->a({-href=>$from->{'href'}[$i],
2990                                                   -class=>"hash"},
2991                                                  substr($diffinfo->{'from_id'}[$i],0,7));
2992                         } else {
2993                                 $line .= '0' x 7;
2994                         }
2995                         # separator
2996                         $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
2997                 }
2998                 $line .= '..';
2999                 if ($to->{'href'}) {
3000                         $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
3001                                          substr($diffinfo->{'to_id'},0,7));
3002                 } else {
3003                         $line .= '0' x 7;
3004                 }
3005
3006         } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
3007                 # can match only for ordinary diff
3008                 my ($from_link, $to_link);
3009                 if ($from->{'href'}) {
3010                         $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
3011                                              substr($diffinfo->{'from_id'},0,7));
3012                 } else {
3013                         $from_link = '0' x 7;
3014                 }
3015                 if ($to->{'href'}) {
3016                         $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
3017                                            substr($diffinfo->{'to_id'},0,7));
3018                 } else {
3019                         $to_link = '0' x 7;
3020                 }
3021                 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
3022                 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
3023         }
3024
3025         return $line . "<br/>\n";
3026 }
3027
3028 # format from-file/to-file diff header
3029 sub format_diff_from_to_header {
3030         my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
3031         my $line;
3032         my $result = '';
3033
3034         $line = $from_line;
3035         #assert($line =~ m/^---/) if DEBUG;
3036         # no extra formatting for "^--- /dev/null"
3037         if (! $diffinfo->{'nparents'}) {
3038                 # ordinary (single parent) diff
3039                 if ($line =~ m!^--- "?a/!) {
3040                         if ($from->{'href'}) {
3041                                 $line = '--- a/' .
3042                                         $cgi->a({-href=>$from->{'href'}, -class=>"path"},
3043                                                 esc_path($from->{'file'}));
3044                         } else {
3045                                 $line = '--- a/' .
3046                                         esc_path($from->{'file'});
3047                         }
3048                 }
3049                 $result .= qq!<div class="diff from_file">$line</div>\n!;
3050
3051         } else {
3052                 # combined diff (merge commit)
3053                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3054                         if ($from->{'href'}[$i]) {
3055                                 $line = '--- ' .
3056                                         $cgi->a({-href=>href(action=>"blobdiff",
3057                                                              hash_parent=>$diffinfo->{'from_id'}[$i],
3058                                                              hash_parent_base=>$parents[$i],
3059                                                              file_parent=>$from->{'file'}[$i],
3060                                                              hash=>$diffinfo->{'to_id'},
3061                                                              hash_base=>$hash,
3062                                                              file_name=>$to->{'file'}),
3063                                                  -class=>"path",
3064                                                  -title=>"diff" . ($i+1)},
3065                                                 $i+1) .
3066                                         '/' .
3067                                         $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
3068                                                 esc_path($from->{'file'}[$i]));
3069                         } else {
3070                                 $line = '--- /dev/null';
3071                         }
3072                         $result .= qq!<div class="diff from_file">$line</div>\n!;
3073                 }
3074         }
3075
3076         $line = $to_line;
3077         #assert($line =~ m/^\+\+\+/) if DEBUG;
3078         # no extra formatting for "^+++ /dev/null"
3079         if ($line =~ m!^\+\+\+ "?b/!) {
3080                 if ($to->{'href'}) {
3081                         $line = '+++ b/' .
3082                                 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3083                                         esc_path($to->{'file'}));
3084                 } else {
3085                         $line = '+++ b/' .
3086                                 esc_path($to->{'file'});
3087                 }
3088         }
3089         $result .= qq!<div class="diff to_file">$line</div>\n!;
3090
3091         return $result;
3092 }
3093
3094 # create note for patch simplified by combined diff
3095 sub format_diff_cc_simplified {
3096         my ($diffinfo, @parents) = @_;
3097         my $result = '';
3098
3099         $result .= "<div class=\"diff header\">" .
3100                    "diff --cc ";
3101         if (!is_deleted($diffinfo)) {
3102                 $result .= $cgi->a({-href => href(action=>"blob",
3103                                                   hash_base=>$hash,
3104                                                   hash=>$diffinfo->{'to_id'},
3105                                                   file_name=>$diffinfo->{'to_file'}),
3106                                     -class => "path"},
3107                                    esc_path($diffinfo->{'to_file'}));
3108         } else {
3109                 $result .= esc_path($diffinfo->{'to_file'});
3110         }
3111         $result .= "</div>\n" . # class="diff header"
3112                    "<div class=\"diff nodifferences\">" .
3113                    "Simple merge" .
3114                    "</div>\n"; # class="diff nodifferences"
3115
3116         return $result;
3117 }
3118
3119 sub diff_line_class {
3120         my ($line, $from, $to) = @_;
3121
3122         # ordinary diff
3123         my $num_sign = 1;
3124         # combined diff
3125         if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
3126                 $num_sign = scalar @{$from->{'href'}};
3127         }
3128
3129         my @diff_line_classifier = (
3130                 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
3131                 { regexp => qr/^\\/,               class => "incomplete"  },
3132                 { regexp => qr/^ {$num_sign}/,     class => "ctx" },
3133                 # classifier for context must come before classifier add/rem,
3134                 # or we would have to use more complicated regexp, for example
3135                 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
3136                 { regexp => qr/^[+ ]{$num_sign}/,   class => "add" },
3137                 { regexp => qr/^[- ]{$num_sign}/,   class => "rem" },
3138         );
3139         for my $clsfy (@diff_line_classifier) {
3140                 return $clsfy->{'class'}
3141                         if ($line =~ $clsfy->{'regexp'});
3142         }
3143
3144         # fallback
3145         return "";
3146 }
3147
3148 # assumes that $from and $to are defined and correctly filled,
3149 # and that $line holds a line of chunk header for unified diff
3150 sub format_unidiff_chunk_header {
3151         my ($line, $from, $to) = @_;
3152
3153         my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
3154                 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
3155
3156         $from_lines = 0 unless defined $from_lines;
3157         $to_lines   = 0 unless defined $to_lines;
3158
3159         if ($from->{'href'}) {
3160                 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
3161                                      -class=>"list"}, $from_text);
3162         }
3163         if ($to->{'href'}) {
3164                 $to_text   = $cgi->a({-href=>"$to->{'href'}#l$to_start",
3165                                      -class=>"list"}, $to_text);
3166         }
3167         $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
3168                 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3169         return $line;
3170 }
3171
3172 # assumes that $from and $to are defined and correctly filled,
3173 # and that $line holds a line of chunk header for combined diff
3174 sub format_cc_diff_chunk_header {
3175         my ($line, $from, $to) = @_;
3176
3177         my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
3178         my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
3179
3180         @from_text = split(' ', $ranges);
3181         for (my $i = 0; $i < @from_text; ++$i) {
3182                 ($from_start[$i], $from_nlines[$i]) =
3183                         (split(',', substr($from_text[$i], 1)), 0);
3184         }
3185
3186         $to_text   = pop @from_text;
3187         $to_start  = pop @from_start;
3188         $to_nlines = pop @from_nlines;
3189
3190         $line = "<span class=\"chunk_info\">$prefix ";
3191         for (my $i = 0; $i < @from_text; ++$i) {
3192                 if ($from->{'href'}[$i]) {
3193                         $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
3194                                           -class=>"list"}, $from_text[$i]);
3195                 } else {
3196                         $line .= $from_text[$i];
3197                 }
3198                 $line .= " ";
3199         }
3200         if ($to->{'href'}) {
3201                 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
3202                                   -class=>"list"}, $to_text);
3203         } else {
3204                 $line .= $to_text;
3205         }
3206         $line .= " $prefix</span>" .
3207                  "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3208         return $line;
3209 }
3210
3211 # process patch (diff) line (not to be used for diff headers),
3212 # returning HTML-formatted (but not wrapped) line.
3213 # If the line is passed as a reference, it is treated as HTML and not
3214 # esc_html()'ed.
3215 sub format_diff_line {
3216         my ($line, $diff_class, $from, $to) = @_;
3217
3218         if (ref($line)) {
3219                 $line = $$line;
3220         } else {
3221                 chomp $line;
3222                 $line = untabify($line);
3223
3224                 if ($from && $to && $line =~ m/^\@{2} /) {
3225                         $line = format_unidiff_chunk_header($line, $from, $to);
3226                 } elsif ($from && $to && $line =~ m/^\@{3}/) {
3227                         $line = format_cc_diff_chunk_header($line, $from, $to);
3228                 } else {
3229                         $line = esc_html($line, -nbsp=>1);
3230                 }
3231         }
3232
3233         my $diff_classes = "diff diff_body";
3234         $diff_classes .= " $diff_class" if ($diff_class);
3235         $line = "<div class=\"$diff_classes\">$line</div>\n";
3236
3237         return $line;
3238 }
3239
3240 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
3241 # linked.  Pass the hash of the tree/commit to snapshot.
3242 sub format_snapshot_links {
3243         my ($hash) = @_;
3244         my $num_fmts = @snapshot_fmts;
3245         if ($num_fmts > 1) {
3246                 # A parenthesized list of links bearing format names.
3247                 # e.g. "snapshot (_tar.gz_ _zip_)"
3248                 return "<span class=\"snapshots\">snapshot (" . join(' ', map
3249                         $cgi->a({
3250                                 -href => href(
3251                                         action=>"snapshot",
3252                                         hash=>$hash,
3253                                         snapshot_format=>$_
3254                                 )
3255                         }, $known_snapshot_formats{$_}{'display'})
3256                 , @snapshot_fmts) . ")</span>";
3257         } elsif ($num_fmts == 1) {
3258                 # A single "snapshot" link whose tooltip bears the format name.
3259                 # i.e. "_snapshot_"
3260                 my ($fmt) = @snapshot_fmts;
3261                 return "<span class=\"snapshots\">" .
3262                         $cgi->a({
3263                                 -href => href(
3264                                         action=>"snapshot",
3265                                         hash=>$hash,
3266                                         snapshot_format=>$fmt
3267                                 ),
3268                                 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
3269                         }, "snapshot") . "</span>";
3270         } else { # $num_fmts == 0
3271                 return undef;
3272         }
3273 }
3274
3275 ## ......................................................................
3276 ## functions returning values to be passed, perhaps after some
3277 ## transformation, to other functions; e.g. returning arguments to href()
3278
3279 # returns hash to be passed to href to generate gitweb URL
3280 # in -title key it returns description of link
3281 sub get_feed_info {
3282         my $format = shift || 'Atom';
3283         my %res = (action => lc($format));
3284         my $matched_ref = 0;
3285
3286         # feed links are possible only for project views
3287         return unless (defined $project);
3288         # some views should link to OPML, or to generic project feed,
3289         # or don't have specific feed yet (so they should use generic)
3290         return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
3291
3292         my $branch = undef;
3293         # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
3294         # (fullname) to differentiate from tag links; this also makes
3295         # possible to detect branch links
3296         for my $ref (get_branch_refs()) {
3297                 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
3298                     (defined $hash      && $hash      =~ m!^refs/\Q$ref\E/(.*)$!)) {
3299                         $branch = $1;
3300                         $matched_ref = $ref;
3301                         last;
3302                 }
3303         }
3304         # find log type for feed description (title)
3305         my $type = 'log';
3306         if (defined $file_name) {
3307                 $type  = "history of $file_name";
3308                 $type .= "/" if ($action eq 'tree');
3309                 $type .= " on '$branch'" if (defined $branch);
3310         } else {
3311                 $type = "log of $branch" if (defined $branch);
3312         }
3313
3314         $res{-title} = $type;
3315         $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
3316         $res{'file_name'} = $file_name;
3317
3318         return %res;
3319 }
3320
3321 ## ----------------------------------------------------------------------
3322 ## git utility subroutines, invoking git commands
3323
3324 # returns path to the core git executable and the --git-dir parameter as list
3325 sub git_cmd {
3326         $number_of_git_cmds++;
3327         return $GIT, '--git-dir='.$git_dir;
3328 }
3329
3330 # opens a "-|" cmd pipe handle with 2>/dev/null and returns it
3331 sub cmd_pipe {
3332
3333         # In order to be compatible with FCGI mode we must use POSIX
3334         # and access the STDERR_FILENO file descriptor directly
3335
3336         use POSIX qw(STDERR_FILENO dup dup2);
3337
3338         open(my $null, '>', File::Spec->devnull) or die "couldn't open devnull: $!";
3339         (my $saveerr = dup(STDERR_FILENO)) or die "couldn't dup STDERR: $!";
3340         my $dup2ok = dup2(fileno($null), STDERR_FILENO);
3341         close($null) or !$dup2ok or die "couldn't close NULL: $!";
3342         $dup2ok or POSIX::close($saveerr), die "couldn't dup NULL to STDERR: $!";
3343         my $result = open(my $fd, "-|", @_);
3344         $dup2ok = dup2($saveerr, STDERR_FILENO);
3345         POSIX::close($saveerr) or !$dup2ok or die "couldn't close SAVEERR: $!";
3346         $dup2ok or die "couldn't dup SAVERR to STDERR: $!";
3347
3348         return $result ? $fd : undef;
3349 }
3350
3351 # opens a "-|" git_cmd pipe handle with 2>/dev/null and returns it
3352 sub git_cmd_pipe {
3353         return cmd_pipe git_cmd(), @_;
3354 }
3355
3356 # quote the given arguments for passing them to the shell
3357 # quote_command("command", "arg 1", "arg with ' and ! characters")
3358 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
3359 # Try to avoid using this function wherever possible.
3360 sub quote_command {
3361         return join(' ',
3362                 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
3363 }
3364
3365 # get HEAD ref of given project as hash
3366 sub git_get_head_hash {
3367         return git_get_full_hash(shift, 'HEAD');
3368 }
3369
3370 sub git_get_full_hash {
3371         return git_get_hash(@_);
3372 }
3373
3374 sub git_get_short_hash {
3375         return git_get_hash(@_, '--short=7');
3376 }
3377
3378 sub git_get_hash {
3379         my ($project, $hash, @options) = @_;
3380         my $o_git_dir = $git_dir;
3381         my $retval = undef;
3382         $git_dir = "$projectroot/$project";
3383         if (defined(my $fd = git_cmd_pipe 'rev-parse',
3384             '--verify', '-q', @options, $hash)) {
3385                 $retval = <$fd>;
3386                 chomp $retval if defined $retval;
3387                 close $fd;
3388         }
3389         if (defined $o_git_dir) {
3390                 $git_dir = $o_git_dir;
3391         }
3392         return $retval;
3393 }
3394
3395 # get type of given object
3396 sub git_get_type {
3397         my $hash = shift;
3398
3399         defined(my $fd = git_cmd_pipe "cat-file", '-t', $hash) or return;
3400         my $type = <$fd>;
3401         close $fd or return;
3402         chomp $type;
3403         return $type;
3404 }
3405
3406 # repository configuration
3407 our $config_file = '';
3408 our %config;
3409
3410 # store multiple values for single key as anonymous array reference
3411 # single values stored directly in the hash, not as [ <value> ]
3412 sub hash_set_multi {
3413         my ($hash, $key, $value) = @_;
3414
3415         if (!exists $hash->{$key}) {
3416                 $hash->{$key} = $value;
3417         } elsif (!ref $hash->{$key}) {
3418                 $hash->{$key} = [ $hash->{$key}, $value ];
3419         } else {
3420                 push @{$hash->{$key}}, $value;
3421         }
3422 }
3423
3424 # return hash of git project configuration
3425 # optionally limited to some section, e.g. 'gitweb'
3426 sub git_parse_project_config {
3427         my $section_regexp = shift;
3428         my %config;
3429
3430         local $/ = "\0";
3431
3432         defined(my $fh = git_cmd_pipe "config", '-z', '-l')
3433                 or return;
3434
3435         while (my $keyval = to_utf8(scalar <$fh>)) {
3436                 chomp $keyval;
3437                 my ($key, $value) = split(/\n/, $keyval, 2);
3438
3439                 hash_set_multi(\%config, $key, $value)
3440                         if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
3441         }
3442         close $fh;
3443
3444         return %config;
3445 }
3446
3447 # convert config value to boolean: 'true' or 'false'
3448 # no value, number > 0, 'true' and 'yes' values are true
3449 # rest of values are treated as false (never as error)
3450 sub config_to_bool {
3451         my $val = shift;
3452
3453         return 1 if !defined $val;             # section.key
3454
3455         # strip leading and trailing whitespace
3456         $val =~ s/^\s+//;
3457         $val =~ s/\s+$//;
3458
3459         return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
3460                 ($val =~ /^(?:true|yes)$/i));  # section.key = true
3461 }
3462
3463 # convert config value to simple decimal number
3464 # an optional value suffix of 'k', 'm', or 'g' will cause the value
3465 # to be multiplied by 1024, 1048576, or 1073741824
3466 sub config_to_int {
3467         my $val = shift;
3468
3469         # strip leading and trailing whitespace
3470         $val =~ s/^\s+//;
3471         $val =~ s/\s+$//;
3472
3473         if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
3474                 $unit = lc($unit);
3475                 # unknown unit is treated as 1
3476                 return $num * ($unit eq 'g' ? 1073741824 :
3477                                $unit eq 'm' ?    1048576 :
3478                                $unit eq 'k' ?       1024 : 1);
3479         }
3480         return $val;
3481 }
3482
3483 # convert config value to array reference, if needed
3484 sub config_to_multi {
3485         my $val = shift;
3486
3487         return ref($val) ? $val : (defined($val) ? [ $val ] : []);
3488 }
3489
3490 sub git_get_project_config {
3491         my ($key, $type) = @_;
3492
3493         return unless defined $git_dir;
3494
3495         # key sanity check
3496         return unless ($key);
3497         # only subsection, if exists, is case sensitive,
3498         # and not lowercased by 'git config -z -l'
3499         if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
3500                 $lo =~ s/_//g;
3501                 $key = join(".", lc($hi), $mi, lc($lo));
3502                 return if ($lo =~ /\W/ || $hi =~ /\W/);
3503         } else {
3504                 $key = lc($key);
3505                 $key =~ s/_//g;
3506                 return if ($key =~ /\W/);
3507         }
3508         $key =~ s/^gitweb\.//;
3509
3510         # type sanity check
3511         if (defined $type) {
3512                 $type =~ s/^--//;
3513                 $type = undef
3514                         unless ($type eq 'bool' || $type eq 'int');
3515         }
3516
3517         # get config
3518         if (!defined $config_file ||
3519             $config_file ne "$git_dir/config") {
3520                 %config = git_parse_project_config('gitweb');
3521                 $config_file = "$git_dir/config";
3522         }
3523
3524         # check if config variable (key) exists
3525         return unless exists $config{"gitweb.$key"};
3526
3527         # ensure given type
3528         if (!defined $type) {
3529                 return $config{"gitweb.$key"};
3530         } elsif ($type eq 'bool') {
3531                 # backward compatibility: 'git config --bool' returns true/false
3532                 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
3533         } elsif ($type eq 'int') {
3534                 return config_to_int($config{"gitweb.$key"});
3535         }
3536         return $config{"gitweb.$key"};
3537 }
3538
3539 # get hash of given path at given ref
3540 sub git_get_hash_by_path {
3541         my $base = shift;
3542         my $path = shift || return undef;
3543         my $type = shift;
3544
3545         $path =~ s,/+$,,;
3546
3547         defined(my $fd = git_cmd_pipe "ls-tree", $base, "--", $path)
3548                 or die_error(500, "Open git-ls-tree failed");
3549         my $line = to_utf8(scalar <$fd>);
3550         close $fd or return undef;
3551
3552         if (!defined $line) {
3553                 # there is no tree or hash given by $path at $base
3554                 return undef;
3555         }
3556
3557         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3558         $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
3559         if (defined $type && $type ne $2) {
3560                 # type doesn't match
3561                 return undef;
3562         }
3563         return $3;
3564 }
3565
3566 # get path of entry with given hash at given tree-ish (ref)
3567 # used to get 'from' filename for combined diff (merge commit) for renames
3568 sub git_get_path_by_hash {
3569         my $base = shift || return;
3570         my $hash = shift || return;
3571
3572         local $/ = "\0";
3573
3574         defined(my $fd = git_cmd_pipe "ls-tree", '-r', '-t', '-z', $base)
3575                 or return undef;
3576         while (my $line = to_utf8(scalar <$fd>)) {
3577                 chomp $line;
3578
3579                 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423  gitweb'
3580                 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f  gitweb/README'
3581                 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
3582                         close $fd;
3583                         return $1;
3584                 }
3585         }
3586         close $fd;
3587         return undef;
3588 }
3589
3590 ## ......................................................................
3591 ## git utility functions, directly accessing git repository
3592
3593 # get the value of config variable either from file named as the variable
3594 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
3595 # configuration variable in the repository config file.
3596 sub git_get_file_or_project_config {
3597         my ($path, $name) = @_;
3598
3599         $git_dir = "$projectroot/$path";
3600         open my $fd, '<', "$git_dir/$name"
3601                 or return git_get_project_config($name);
3602         my $conf = to_utf8(scalar <$fd>);
3603         close $fd;
3604         if (defined $conf) {
3605                 chomp $conf;
3606         }
3607         return $conf;
3608 }
3609
3610 sub git_get_project_description {
3611         my $path = shift;
3612         return git_get_file_or_project_config($path, 'description');
3613 }
3614
3615 sub git_get_project_category {
3616         my $path = shift;
3617         return git_get_file_or_project_config($path, 'category');
3618 }
3619
3620
3621 # supported formats:
3622 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
3623 #   - if its contents is a number, use it as tag weight,
3624 #   - otherwise add a tag with weight 1
3625 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
3626 #   the same value multiple times increases tag weight
3627 # * `gitweb.ctag' multi-valued repo config variable
3628 sub git_get_project_ctags {
3629         my $project = shift;
3630         my $ctags = {};
3631
3632         $git_dir = "$projectroot/$project";
3633         if (opendir my $dh, "$git_dir/ctags") {
3634                 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
3635                 foreach my $tagfile (@files) {
3636                         open my $ct, '<', $tagfile
3637                                 or next;
3638                         my $val = <$ct>;
3639                         chomp $val if $val;
3640                         close $ct;
3641
3642                         (my $ctag = $tagfile) =~ s#.*/##;
3643                         $ctag = to_utf8($ctag);
3644                         if ($val =~ /^\d+$/) {
3645                                 $ctags->{$ctag} = $val;
3646                         } else {
3647                                 $ctags->{$ctag} = 1;
3648                         }
3649                 }
3650                 closedir $dh;
3651
3652         } elsif (open my $fh, '<', "$git_dir/ctags") {
3653                 while (my $line = to_utf8(scalar <$fh>)) {
3654                         chomp $line;
3655                         $ctags->{$line}++ if $line;
3656                 }
3657                 close $fh;
3658
3659         } else {
3660                 my $taglist = config_to_multi(git_get_project_config('ctag'));
3661                 foreach my $tag (@$taglist) {
3662                         $ctags->{$tag}++;
3663                 }
3664         }
3665
3666         return $ctags;
3667 }
3668
3669 # return hash, where keys are content tags ('ctags'),
3670 # and values are sum of weights of given tag in every project
3671 sub git_gather_all_ctags {
3672         my $projects = shift;
3673         my $ctags = {};
3674
3675         foreach my $p (@$projects) {
3676                 foreach my $ct (keys %{$p->{'ctags'}}) {
3677                         $ctags->{$ct} += $p->{'ctags'}->{$ct};
3678                 }
3679         }
3680
3681         return $ctags;
3682 }
3683
3684 sub git_populate_project_tagcloud {
3685         my ($ctags, $action) = @_;
3686
3687         # First, merge different-cased tags; tags vote on casing
3688         my %ctags_lc;
3689         foreach (keys %$ctags) {
3690                 $ctags_lc{lc $_}->{count} += $ctags->{$_};
3691                 if (not $ctags_lc{lc $_}->{topcount}
3692                     or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
3693                         $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
3694                         $ctags_lc{lc $_}->{topname} = $_;
3695                 }
3696         }
3697
3698         my $cloud;
3699         my $matched = $input_params{'ctag_filter'};
3700         if (eval { require HTML::TagCloud; 1; }) {
3701                 $cloud = HTML::TagCloud->new;
3702                 foreach my $ctag (sort keys %ctags_lc) {
3703                         # Pad the title with spaces so that the cloud looks
3704                         # less crammed.
3705                         my $title = esc_html($ctags_lc{$ctag}->{topname});
3706                         $title =~ s/ /&#160;/g;
3707                         $title =~ s/^/&#160;/g;
3708                         $title =~ s/$/&#160;/g;
3709                         if (defined $matched && $matched eq $ctag) {
3710                                 $title = qq(<span class="match">$title</span>);
3711                         }
3712                         $cloud->add($title, href(-replay=>1, action=>$action, ctag_filter=>$ctag),
3713                                     $ctags_lc{$ctag}->{count});
3714                 }
3715         } else {
3716                 $cloud = {};
3717                 foreach my $ctag (keys %ctags_lc) {
3718                         my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3719                         if (defined $matched && $matched eq $ctag) {
3720                                 $title = qq(<span class="match">$title</span>);
3721                         }
3722                         $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3723                         $cloud->{$ctag}{ctag} =
3724                                 $cgi->a({-href=>href(-replay=>1, action=>$action, ctag_filter=>$ctag)}, $title);
3725                 }
3726         }
3727         return $cloud;
3728 }
3729
3730 sub git_show_project_tagcloud {
3731         my ($cloud, $count) = @_;
3732         if (ref $cloud eq 'HTML::TagCloud') {
3733                 return $cloud->html_and_css($count);
3734         } else {
3735                 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3736                 return
3737                         '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3738                         join (', ', map {
3739                                 $cloud->{$_}->{'ctag'}
3740                         } splice(@tags, 0, $count)) .
3741                         '</div>';
3742         }
3743 }
3744
3745 sub git_get_project_url_list {
3746         my $path = shift;
3747
3748         $git_dir = "$projectroot/$path";
3749         open my $fd, '<', "$git_dir/cloneurl"
3750                 or return wantarray ?
3751                 @{ config_to_multi(git_get_project_config('url')) } :
3752                    config_to_multi(git_get_project_config('url'));
3753         my @git_project_url_list = map { chomp; to_utf8($_) } <$fd>;
3754         close $fd;
3755
3756         return wantarray ? @git_project_url_list : \@git_project_url_list;
3757 }
3758
3759 sub git_get_projects_list {
3760         my $filter = shift || '';
3761         my $paranoid = shift;
3762         my @list;
3763
3764         if (-d $projects_list) {
3765                 # search in directory
3766                 my $dir = $projects_list;
3767                 # remove the trailing "/"
3768                 $dir =~ s!/+$!!;
3769                 my $pfxlen = length("$dir");
3770                 my $pfxdepth = ($dir =~ tr!/!!);
3771                 # when filtering, search only given subdirectory
3772                 if ($filter && !$paranoid) {
3773                         $dir .= "/$filter";
3774                         $dir =~ s!/+$!!;
3775                 }
3776
3777                 File::Find::find({
3778                         follow_fast => 1, # follow symbolic links
3779                         follow_skip => 2, # ignore duplicates
3780                         dangling_symlinks => 0, # ignore dangling symlinks, silently
3781                         wanted => sub {
3782                                 # global variables
3783                                 our $project_maxdepth;
3784                                 our $projectroot;
3785                                 # skip project-list toplevel, if we get it.
3786                                 return if (m!^[/.]$!);
3787                                 # only directories can be git repositories
3788                                 return unless (-d $_);
3789                                 # don't traverse too deep (Find is super slow on os x)
3790                                 # $project_maxdepth excludes depth of $projectroot
3791                                 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3792                                         $File::Find::prune = 1;
3793                                         return;
3794                                 }
3795
3796                                 my $path = substr($File::Find::name, $pfxlen + 1);
3797                                 # paranoidly only filter here
3798                                 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3799                                         next;
3800                                 }
3801                                 # we check related file in $projectroot
3802                                 if (check_export_ok("$projectroot/$path")) {
3803                                         push @list, { path => $path };
3804                                         $File::Find::prune = 1;
3805                                 }
3806                         },
3807                 }, "$dir");
3808
3809         } elsif (-f $projects_list) {
3810                 # read from file(url-encoded):
3811                 # 'git%2Fgit.git Linus+Torvalds'
3812                 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3813                 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3814                 open my $fd, '<', $projects_list or return;
3815         PROJECT:
3816                 while (my $line = <$fd>) {
3817                         chomp $line;
3818                         my ($path, $owner) = split ' ', $line;
3819                         $path = unescape($path);
3820                         $owner = unescape($owner);
3821                         if (!defined $path) {
3822                                 next;
3823                         }
3824                         # if $filter is rpovided, check if $path begins with $filter
3825                         if ($filter && $path !~ m!^\Q$filter\E/!) {
3826                                 next;
3827                         }
3828                         if (check_export_ok("$projectroot/$path")) {
3829                                 my $pr = {
3830                                         path => $path
3831                                 };
3832                                 if ($owner) {
3833                                         $pr->{'owner'} = to_utf8($owner);
3834                                 }
3835                                 push @list, $pr;
3836                         }
3837                 }
3838                 close $fd;
3839         }
3840         return @list;
3841 }
3842
3843 # written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
3844 # as side effects it sets 'forks' field to list of forks for forked projects
3845 sub filter_forks_from_projects_list {
3846         my $projects = shift;
3847
3848         my %trie; # prefix tree of directories (path components)
3849         # generate trie out of those directories that might contain forks
3850         foreach my $pr (@$projects) {
3851                 my $path = $pr->{'path'};
3852                 $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
3853                 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3854                 next unless ($path);      # skip '.git' repository: tests, git-instaweb
3855                 next unless (-d "$projectroot/$path"); # containing directory exists
3856                 $pr->{'forks'} = [];      # there can be 0 or more forks of project
3857
3858                 # add to trie
3859                 my @dirs = split('/', $path);
3860                 # walk the trie, until either runs out of components or out of trie
3861                 my $ref = \%trie;
3862                 while (scalar @dirs &&
3863                        exists($ref->{$dirs[0]})) {
3864                         $ref = $ref->{shift @dirs};
3865                 }
3866                 # create rest of trie structure from rest of components
3867                 foreach my $dir (@dirs) {
3868                         $ref = $ref->{$dir} = {};
3869                 }
3870                 # create end marker, store $pr as a data
3871                 $ref->{''} = $pr if (!exists $ref->{''});
3872         }
3873
3874         # filter out forks, by finding shortest prefix match for paths
3875         my @filtered;
3876  PROJECT:
3877         foreach my $pr (@$projects) {
3878                 # trie lookup
3879                 my $ref = \%trie;
3880         DIR:
3881                 foreach my $dir (split('/', $pr->{'path'})) {
3882                         if (exists $ref->{''}) {
3883                                 # found [shortest] prefix, is a fork - skip it
3884                                 push @{$ref->{''}{'forks'}}, $pr;
3885                                 next PROJECT;
3886                         }
3887                         if (!exists $ref->{$dir}) {
3888                                 # not in trie, cannot have prefix, not a fork
3889                                 push @filtered, $pr;
3890                                 next PROJECT;
3891                         }
3892                         # If the dir is there, we just walk one step down the trie.
3893                         $ref = $ref->{$dir};
3894                 }
3895                 # we ran out of trie
3896                 # (shouldn't happen: it's either no match, or end marker)
3897                 push @filtered, $pr;
3898         }
3899
3900         return @filtered;
3901 }
3902
3903 # note: fill_project_list_info must be run first,
3904 # for 'descr_long' and 'ctags' to be filled
3905 sub search_projects_list {
3906         my ($projlist, %opts) = @_;
3907         my $tagfilter  = $opts{'tagfilter'};
3908         my $search_re = $opts{'search_regexp'};
3909
3910         return @$projlist
3911                 unless ($tagfilter || $search_re);
3912
3913         # searching projects require filling to be run before it;
3914         fill_project_list_info($projlist,
3915                                $tagfilter  ? 'ctags' : (),
3916                                $search_re ? ('path', 'descr') : ());
3917         my @projects;
3918  PROJECT:
3919         foreach my $pr (@$projlist) {
3920
3921                 if ($tagfilter) {
3922                         next unless ref($pr->{'ctags'}) eq 'HASH';
3923                         next unless
3924                                 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3925                 }
3926
3927                 if ($search_re) {
3928                         my $path = $pr->{'path'};
3929                         $path =~ s/\.git$//; # should not be included in search
3930                         next unless
3931                                 $path =~ /$search_re/ ||
3932                                 $pr->{'descr_long'} =~ /$search_re/;
3933                 }
3934
3935                 push @projects, $pr;
3936         }
3937
3938         return @projects;
3939 }
3940
3941 our $gitweb_project_owner = undef;
3942 sub git_get_project_list_from_file {
3943
3944         return if (defined $gitweb_project_owner);
3945
3946         $gitweb_project_owner = {};
3947         # read from file (url-encoded):
3948         # 'git%2Fgit.git Linus+Torvalds'
3949         # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3950         # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3951         if (-f $projects_list) {
3952                 open(my $fd, '<', $projects_list);
3953                 while (my $line = <$fd>) {
3954                         chomp $line;
3955                         my ($pr, $ow) = split ' ', $line;
3956                         $pr = unescape($pr);
3957                         $ow = unescape($ow);
3958                         $gitweb_project_owner->{$pr} = to_utf8($ow);
3959                 }
3960                 close $fd;
3961         }
3962 }
3963
3964 sub git_get_project_owner {
3965         my $proj = shift;
3966         my $owner;
3967
3968         return undef unless $proj;
3969         $git_dir = "$projectroot/$proj";
3970
3971         if (defined $project && $proj eq $project) {
3972                 $owner = git_get_project_config('owner');
3973         }
3974         if (!defined $owner && !defined $gitweb_project_owner) {
3975                 git_get_project_list_from_file();
3976         }
3977         if (!defined $owner && exists $gitweb_project_owner->{$proj}) {
3978                 $owner = $gitweb_project_owner->{$proj};
3979         }
3980         if (!defined $owner && (!defined $project || $proj ne $project)) {
3981                 $owner = git_get_project_config('owner');
3982         }
3983         if (!defined $owner) {
3984                 $owner = get_file_owner("$git_dir");
3985         }
3986
3987         return $owner;
3988 }
3989
3990 sub parse_activity_date {
3991         my $dstr = shift;
3992
3993         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
3994                 # Unix timestamp
3995                 return 0 + $1;
3996         }
3997         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt _](\d{1,2}):(\d{2}):(\d{2})(?:[ _]?([Zz]|(?:[-+]\d{1,2}:?\d{2})))?\s*$/) {
3998                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
3999                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, $Y-1900);
4000                 defined($z) && $z ne '' or $z = 'Z';
4001                 $z =~ s/://;
4002                 substr($z,1,0) = '0' if length($z) == 4;
4003                 my $off = 0;
4004                 if (uc($z) ne 'Z') {
4005                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
4006                         $off = -$off if substr($z,0,1) eq '-';
4007                 }
4008                 return $seconds - $off;
4009         }
4010         return undef;
4011 }
4012
4013 # If $quick is true only look at $lastactivity_file
4014 sub git_get_last_activity {
4015         my ($path, $quick) = @_;
4016         my $fd;
4017
4018         $git_dir = "$projectroot/$path";
4019         if ($lastactivity_file && open($fd, "<", "$git_dir/$lastactivity_file")) {
4020                 my $activity = <$fd>;
4021                 close $fd;
4022                 return (undef) unless defined $activity;
4023                 chomp $activity;
4024                 return (undef) if $activity eq '';
4025                 if (my $timestamp = parse_activity_date($activity)) {
4026                         return ($timestamp);
4027                 }
4028         }
4029         return (undef) if $quick;
4030         defined($fd = git_cmd_pipe 'for-each-ref',
4031              '--format=%(committer)',
4032              '--sort=-committerdate',
4033              '--count=1',
4034              map { "refs/$_" } get_branch_refs ()) or return;
4035         my $most_recent = <$fd>;
4036         close $fd or return (undef);
4037         if (defined $most_recent &&
4038             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
4039                 my $timestamp = $1;
4040                 return ($timestamp);
4041         }
4042         return (undef);
4043 }
4044
4045 # Implementation note: when a single remote is wanted, we cannot use 'git
4046 # remote show -n' because that command always work (assuming it's a remote URL
4047 # if it's not defined), and we cannot use 'git remote show' because that would
4048 # try to make a network roundtrip. So the only way to find if that particular
4049 # remote is defined is to walk the list provided by 'git remote -v' and stop if
4050 # and when we find what we want.
4051 sub git_get_remotes_list {
4052         my $wanted = shift;
4053         my %remotes = ();
4054
4055         my $fd = git_cmd_pipe 'remote', '-v';
4056         return unless $fd;
4057         while (my $remote = to_utf8(scalar <$fd>)) {
4058                 chomp $remote;
4059                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
4060                 next if $wanted and not $remote eq $wanted;
4061                 my ($url, $key) = ($1, $2);
4062
4063                 $remotes{$remote} ||= { 'heads' => [] };
4064                 $remotes{$remote}{$key} = $url;
4065         }
4066         close $fd or return;
4067         return wantarray ? %remotes : \%remotes;
4068 }
4069
4070 # Takes a hash of remotes as first parameter and fills it by adding the
4071 # available remote heads for each of the indicated remotes.
4072 sub fill_remote_heads {
4073         my $remotes = shift;
4074         my @heads = map { "remotes/$_" } keys %$remotes;
4075         my @remoteheads = git_get_heads_list(undef, @heads);
4076         foreach my $remote (keys %$remotes) {
4077                 $remotes->{$remote}{'heads'} = [ grep {
4078                         $_->{'name'} =~ s!^$remote/!!
4079                         } @remoteheads ];
4080         }
4081 }
4082
4083 sub git_get_references {
4084         my $type = shift || "";
4085         my %refs;
4086         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
4087         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
4088         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
4089                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
4090                 or return;
4091
4092         while (my $line = to_utf8(scalar <$fd>)) {
4093                 chomp $line;
4094                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
4095                         if (defined $refs{$1}) {
4096                                 push @{$refs{$1}}, $2;
4097                         } else {
4098                                 $refs{$1} = [ $2 ];
4099                         }
4100                 }
4101         }
4102         close $fd or return;
4103         return \%refs;
4104 }
4105
4106 sub git_get_rev_name_tags {
4107         my $hash = shift || return undef;
4108
4109         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
4110                 or return;
4111         my $name_rev = to_utf8(scalar <$fd>);
4112         close $fd;
4113
4114         if ($name_rev =~ m|^$hash tags/(.*)$|) {
4115                 return $1;
4116         } else {
4117                 # catches also '$hash undefined' output
4118                 return undef;
4119         }
4120 }
4121
4122 ## ----------------------------------------------------------------------
4123 ## parse to hash functions
4124
4125 sub parse_date {
4126         my $epoch = shift;
4127         my $tz = shift || "-0000";
4128
4129         my %date;
4130         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
4131         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
4132         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
4133         $date{'hour'} = $hour;
4134         $date{'minute'} = $min;
4135         $date{'mday'} = $mday;
4136         $date{'day'} = $days[$wday];
4137         $date{'month'} = $months[$mon];
4138         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
4139                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
4140         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
4141                              $mday, $months[$mon], $hour ,$min;
4142         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
4143                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
4144
4145         my ($tz_sign, $tz_hour, $tz_min) =
4146                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
4147         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
4148         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
4149         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
4150         $date{'hour_local'} = $hour;
4151         $date{'minute_local'} = $min;
4152         $date{'mday_local'} = $mday;
4153         $date{'tz_local'} = $tz;
4154         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
4155                                   1900+$year, $mon+1, $mday,
4156                                   $hour, $min, $sec, $tz);
4157         return %date;
4158 }
4159
4160 sub parse_file_date {
4161         my $file = shift;
4162         my $mtime = (stat("$projectroot/$project/$file"))[9];
4163         return () unless defined $mtime;
4164         my $tzoffset = timegm((localtime($mtime))[0..5]) - $mtime;
4165         my $tzstring = '+';
4166         if ($tzoffset <= 0) {
4167                 $tzstring = '-';
4168                 $tzoffset *= -1;
4169         }
4170         $tzoffset = int($tzoffset/60);
4171         $tzstring .= sprintf("%02d%02d", int($tzoffset/60), $tzoffset%60);
4172         return parse_date($mtime, $tzstring);
4173 }
4174
4175 sub parse_tag {
4176         my $tag_id = shift;
4177         my %tag;
4178         my @comment;
4179
4180         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
4181         $tag{'id'} = $tag_id;
4182         while (my $line = to_utf8(scalar <$fd>)) {
4183                 chomp $line;
4184                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
4185                         $tag{'object'} = $1;
4186                 } elsif ($line =~ m/^type (.+)$/) {
4187                         $tag{'type'} = $1;
4188                 } elsif ($line =~ m/^tag (.+)$/) {
4189                         $tag{'name'} = $1;
4190                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
4191                         $tag{'author'} = $1;
4192                         $tag{'author_epoch'} = $2;
4193                         $tag{'author_tz'} = $3;
4194                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4195                                 $tag{'author_name'}  = $1;
4196                                 $tag{'author_email'} = $2;
4197                         } else {
4198                                 $tag{'author_name'} = $tag{'author'};
4199                         }
4200                 } elsif ($line =~ m/--BEGIN/) {
4201                         push @comment, $line;
4202                         last;
4203                 } elsif ($line eq "") {
4204                         last;
4205                 }
4206         }
4207         push @comment, map(to_utf8($_), <$fd>);
4208         $tag{'comment'} = \@comment;
4209         close $fd or return;
4210         if (!defined $tag{'name'}) {
4211                 return
4212         };
4213         return %tag
4214 }
4215
4216 sub parse_commit_text {
4217         my ($commit_text, $withparents) = @_;
4218         my @commit_lines = split '\n', $commit_text;
4219         my %co;
4220
4221         pop @commit_lines; # Remove '\0'
4222
4223         if (! @commit_lines) {
4224                 return;
4225         }
4226
4227         my $header = shift @commit_lines;
4228         if ($header !~ m/^[0-9a-fA-F]{40}/) {
4229                 return;
4230         }
4231         ($co{'id'}, my @parents) = split ' ', $header;
4232         while (my $line = shift @commit_lines) {
4233                 last if $line eq "\n";
4234                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
4235                         $co{'tree'} = $1;
4236                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
4237                         push @parents, $1;
4238                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
4239                         $co{'author'} = to_utf8($1);
4240                         $co{'author_epoch'} = $2;
4241                         $co{'author_tz'} = $3;
4242                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4243                                 $co{'author_name'}  = $1;
4244                                 $co{'author_email'} = $2;
4245                         } else {
4246                                 $co{'author_name'} = $co{'author'};
4247                         }
4248                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
4249                         $co{'committer'} = to_utf8($1);
4250                         $co{'committer_epoch'} = $2;
4251                         $co{'committer_tz'} = $3;
4252                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
4253                                 $co{'committer_name'}  = $1;
4254                                 $co{'committer_email'} = $2;
4255                         } else {
4256                                 $co{'committer_name'} = $co{'committer'};
4257                         }
4258                 }
4259         }
4260         if (!defined $co{'tree'}) {
4261                 return;
4262         };
4263         $co{'parents'} = \@parents;
4264         $co{'parent'} = $parents[0];
4265
4266         @commit_lines = map to_utf8($_), @commit_lines;
4267         foreach my $title (@commit_lines) {
4268                 $title =~ s/^    //;
4269                 if ($title ne "") {
4270                         $co{'title'} = chop_str($title, 80, 5);
4271                         # remove leading stuff of merges to make the interesting part visible
4272                         if (length($title) > 50) {
4273                                 $title =~ s/^Automatic //;
4274                                 $title =~ s/^merge (of|with) /Merge ... /i;
4275                                 if (length($title) > 50) {
4276                                         $title =~ s/(http|rsync):\/\///;
4277                                 }
4278                                 if (length($title) > 50) {
4279                                         $title =~ s/(master|www|rsync)\.//;
4280                                 }
4281                                 if (length($title) > 50) {
4282                                         $title =~ s/kernel.org:?//;
4283                                 }
4284                                 if (length($title) > 50) {
4285                                         $title =~ s/\/pub\/scm//;
4286                                 }
4287                         }
4288                         $co{'title_short'} = chop_str($title, 50, 5);
4289                         last;
4290                 }
4291         }
4292         if (! defined $co{'title'} || $co{'title'} eq "") {
4293                 $co{'title'} = $co{'title_short'} = '(no commit message)';
4294         }
4295         # remove added spaces
4296         foreach my $line (@commit_lines) {
4297                 $line =~ s/^    //;
4298         }
4299         $co{'comment'} = \@commit_lines;
4300
4301         my $age_epoch = $co{'committer_epoch'};
4302         $co{'age_epoch'} = $age_epoch;
4303         my $time_now = time;
4304         $co{'age_string'} = age_string($age_epoch, $time_now);
4305         $co{'age_string_date'} = age_string_date($age_epoch, $time_now);
4306         $co{'age_string_age'} = age_string_age($age_epoch, $time_now);
4307         return %co;
4308 }
4309
4310 sub parse_commit {
4311         my ($commit_id) = @_;
4312         my %co;
4313
4314         local $/ = "\0";
4315
4316         defined(my $fd = git_cmd_pipe "rev-list",
4317                 "--parents",
4318                 "--header",
4319                 "--max-count=1",
4320                 $commit_id,
4321                 "--")
4322                 or die_error(500, "Open git-rev-list failed");
4323         %co = parse_commit_text(<$fd>, 1);
4324         close $fd;
4325
4326         return %co;
4327 }
4328
4329 sub parse_commits {
4330         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
4331         my @cos;
4332
4333         $maxcount ||= 1;
4334         $skip ||= 0;
4335
4336         local $/ = "\0";
4337
4338         defined(my $fd = git_cmd_pipe "rev-list",
4339                 "--header",
4340                 @args,
4341                 ("--max-count=" . $maxcount),
4342                 ("--skip=" . $skip),
4343                 @extra_options,
4344                 $commit_id,
4345                 "--",
4346                 ($filename ? ($filename) : ()))
4347                 or die_error(500, "Open git-rev-list failed");
4348         while (my $line = <$fd>) {
4349                 my %co = parse_commit_text($line);
4350                 push @cos, \%co;
4351         }
4352         close $fd;
4353
4354         return wantarray ? @cos : \@cos;
4355 }
4356
4357 # parse line of git-diff-tree "raw" output
4358 sub parse_difftree_raw_line {
4359         my $line = shift;
4360         my %res;
4361
4362         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
4363         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
4364         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
4365                 $res{'from_mode'} = $1;
4366                 $res{'to_mode'} = $2;
4367                 $res{'from_id'} = $3;
4368                 $res{'to_id'} = $4;
4369                 $res{'status'} = $5;
4370                 $res{'similarity'} = $6;
4371                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
4372                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
4373                 } else {
4374                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
4375                 }
4376         }
4377         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
4378         # combined diff (for merge commit)
4379         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
4380                 $res{'nparents'}  = length($1);
4381                 $res{'from_mode'} = [ split(' ', $2) ];
4382                 $res{'to_mode'} = pop @{$res{'from_mode'}};
4383                 $res{'from_id'} = [ split(' ', $3) ];
4384                 $res{'to_id'} = pop @{$res{'from_id'}};
4385                 $res{'status'} = [ split('', $4) ];
4386                 $res{'to_file'} = unquote($5);
4387         }
4388         # 'c512b523472485aef4fff9e57b229d9d243c967f'
4389         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
4390                 $res{'commit'} = $1;
4391         }
4392
4393         return wantarray ? %res : \%res;
4394 }
4395
4396 # wrapper: return parsed line of git-diff-tree "raw" output
4397 # (the argument might be raw line, or parsed info)
4398 sub parsed_difftree_line {
4399         my $line_or_ref = shift;
4400
4401         if (ref($line_or_ref) eq "HASH") {
4402                 # pre-parsed (or generated by hand)
4403                 return $line_or_ref;
4404         } else {
4405                 return parse_difftree_raw_line($line_or_ref);
4406         }
4407 }
4408
4409 # parse line of git-ls-tree output
4410 sub parse_ls_tree_line {
4411         my $line = shift;
4412         my %opts = @_;
4413         my %res;
4414
4415         if ($opts{'-l'}) {
4416                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
4417                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
4418
4419                 $res{'mode'} = $1;
4420                 $res{'type'} = $2;
4421                 $res{'hash'} = $3;
4422                 $res{'size'} = $4;
4423                 if ($opts{'-z'}) {
4424                         $res{'name'} = $5;
4425                 } else {
4426                         $res{'name'} = unquote($5);
4427                 }
4428         } else {
4429                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
4430                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
4431
4432                 $res{'mode'} = $1;
4433                 $res{'type'} = $2;
4434                 $res{'hash'} = $3;
4435                 if ($opts{'-z'}) {
4436                         $res{'name'} = $4;
4437                 } else {
4438                         $res{'name'} = unquote($4);
4439                 }
4440         }
4441
4442         return wantarray ? %res : \%res;
4443 }
4444
4445 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4446 sub parse_from_to_diffinfo {
4447         my ($diffinfo, $from, $to, @parents) = @_;
4448
4449         if ($diffinfo->{'nparents'}) {
4450                 # combined diff
4451                 $from->{'file'} = [];
4452                 $from->{'href'} = [];
4453                 fill_from_file_info($diffinfo, @parents)
4454                         unless exists $diffinfo->{'from_file'};
4455                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4456                         $from->{'file'}[$i] =
4457                                 defined $diffinfo->{'from_file'}[$i] ?
4458                                         $diffinfo->{'from_file'}[$i] :
4459                                         $diffinfo->{'to_file'};
4460                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4461                                 $from->{'href'}[$i] = href(action=>"blob",
4462                                                            hash_base=>$parents[$i],
4463                                                            hash=>$diffinfo->{'from_id'}[$i],
4464                                                            file_name=>$from->{'file'}[$i]);
4465                         } else {
4466                                 $from->{'href'}[$i] = undef;
4467                         }
4468                 }
4469         } else {
4470                 # ordinary (not combined) diff
4471                 $from->{'file'} = $diffinfo->{'from_file'};
4472                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4473                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4474                                                hash=>$diffinfo->{'from_id'},
4475                                                file_name=>$from->{'file'});
4476                 } else {
4477                         delete $from->{'href'};
4478                 }
4479         }
4480
4481         $to->{'file'} = $diffinfo->{'to_file'};
4482         if (!is_deleted($diffinfo)) { # file exists in result
4483                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4484                                      hash=>$diffinfo->{'to_id'},
4485                                      file_name=>$to->{'file'});
4486         } else {
4487                 delete $to->{'href'};
4488         }
4489 }
4490
4491 ## ......................................................................
4492 ## parse to array of hashes functions
4493
4494 sub git_get_heads_list {
4495         my ($limit, @classes) = @_;
4496         @classes = get_branch_refs() unless @classes;
4497         my @patterns = map { "refs/$_" } @classes;
4498         my @headslist;
4499
4500         defined(my $fd = git_cmd_pipe 'for-each-ref',
4501                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4502                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4503                 @patterns)
4504                 or return;
4505         while (my $line = to_utf8(scalar <$fd>)) {
4506                 my %ref_item;
4507
4508                 chomp $line;
4509                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4510                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4511                 my ($committer, $epoch, $tz) =
4512                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4513                 $ref_item{'fullname'}  = $name;
4514                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4515                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4516                 $ref_item{'name'} = $name;
4517                 # for refs neither in 'heads' nor 'remotes' we want to
4518                 # show their ref dir
4519                 my $ref_dir = (defined $1) ? $1 : '';
4520                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4521                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4522                 }
4523
4524                 $ref_item{'id'}    = $hash;
4525                 $ref_item{'title'} = $title || '(no commit message)';
4526                 $ref_item{'epoch'} = $epoch;
4527                 if ($epoch) {
4528                         $ref_item{'age'} = age_string($ref_item{'epoch'});
4529                 } else {
4530                         $ref_item{'age'} = "unknown";
4531                 }
4532
4533                 push @headslist, \%ref_item;
4534         }
4535         close $fd;
4536
4537         return wantarray ? @headslist : \@headslist;
4538 }
4539
4540 sub git_get_tags_list {
4541         my $limit = shift;
4542         my @tagslist;
4543         my $all = shift || 0;
4544         my $order = shift || $default_refs_order;
4545         my $sortkey = $all && $order eq 'name' ? 'refname' : '-creatordate';
4546
4547         defined(my $fd = git_cmd_pipe 'for-each-ref',
4548                 ($limit ? '--count='.($limit+1) : ()), "--sort=$sortkey",
4549                 '--format=%(objectname) %(objecttype) %(refname) '.
4550                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4551                 ($all ? 'refs' : 'refs/tags'))
4552                 or return;
4553         while (my $line = to_utf8(scalar <$fd>)) {
4554                 my %ref_item;
4555
4556                 chomp $line;
4557                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4558                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4559                 my ($creator, $epoch, $tz) =
4560                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4561                 $ref_item{'fullname'} = $name;
4562                 $name =~ s!^refs/!! if $all;
4563                 $name =~ s!^refs/tags/!! unless $all;
4564
4565                 $ref_item{'type'} = $type;
4566                 $ref_item{'id'} = $id;
4567                 $ref_item{'name'} = $name;
4568                 if ($type eq "tag") {
4569                         $ref_item{'subject'} = $title;
4570                         $ref_item{'reftype'} = $reftype;
4571                         $ref_item{'refid'}   = $refid;
4572                 } else {
4573                         $ref_item{'reftype'} = $type;
4574                         $ref_item{'refid'}   = $id;
4575                 }
4576
4577                 if ($type eq "tag" || $type eq "commit") {
4578                         $ref_item{'epoch'} = $epoch;
4579                         if ($epoch) {
4580                                 $ref_item{'age'} = age_string($ref_item{'epoch'});
4581                         } else {
4582                                 $ref_item{'age'} = "unknown";
4583                         }
4584                 }
4585
4586                 push @tagslist, \%ref_item;
4587         }
4588         close $fd;
4589
4590         return wantarray ? @tagslist : \@tagslist;
4591 }
4592
4593 ## ----------------------------------------------------------------------
4594 ## filesystem-related functions
4595
4596 sub get_file_owner {
4597         my $path = shift;
4598
4599         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4600         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4601         if (!defined $gcos) {
4602                 return undef;
4603         }
4604         my $owner = $gcos;
4605         $owner =~ s/[,;].*$//;
4606         return to_utf8($owner);
4607 }
4608
4609 # assume that file exists
4610 sub insert_file {
4611         my $filename = shift;
4612
4613         open my $fd, '<', $filename;
4614         while (<$fd>) {
4615                 print to_utf8($_);
4616         }
4617         close $fd;
4618 }
4619
4620 # return undef on failure
4621 sub collect_output {
4622         defined(my $fd = cmd_pipe @_) or return undef;
4623         if (eof $fd) {
4624                 close $fd;
4625                 return undef;
4626         }
4627         my $result = join('', map({ to_utf8($_) } <$fd>));
4628         close $fd or return undef;
4629         return $result;
4630 }
4631
4632 # return undef on failure
4633 # return '' if only comments
4634 sub collect_html_file {
4635         my $filename = shift;
4636
4637         open my $fd, '<', $filename or return undef;
4638         my $result = join('', map({ to_utf8($_) } <$fd>));
4639         close $fd or return undef;
4640         return undef unless defined($result);
4641         my $test = $result;
4642         $test =~ s/<!--(?:[^-]|(?:-(?!-)))*-->//gs;
4643         $test =~ s/\s+//s;
4644         return $test eq '' ? '' : $result;
4645 }
4646
4647 ## ......................................................................
4648 ## mimetype related functions
4649
4650 sub mimetype_guess_file {
4651         my $filename = shift;
4652         my $mimemap = shift;
4653         my $rawmode = shift;
4654         -r $mimemap or return undef;
4655
4656         my %mimemap;
4657         open(my $mh, '<', $mimemap) or return undef;
4658         while (<$mh>) {
4659                 next if m/^#/; # skip comments
4660                 my ($mimetype, @exts) = split(/\s+/);
4661                 foreach my $ext (@exts) {
4662                         $mimemap{$ext} = $mimetype;
4663                 }
4664         }
4665         close($mh);
4666
4667         my ($ext, $ans);
4668         $ext = $1 if $filename =~ /\.([^.]*)$/;
4669         $ans = $mimemap{$ext} if $ext;
4670         if (defined $ans) {
4671                 my $l = lc($ans);
4672                 $ans = 'text/html' if $l eq 'application/xhtml+xml';
4673                 if (!$rawmode) {
4674                         $ans = 'text/xml' if $l =~ m!^application/[^\s:;,=]+\+xml$! ||
4675                                              $l eq 'image/svg+xml' ||
4676                                              $l eq 'application/xml-dtd' ||
4677                                              $l eq 'application/xml-external-parsed-entity';
4678                 }
4679         }
4680         return $ans;
4681 }
4682
4683 sub mimetype_guess {
4684         my $filename = shift;
4685         my $rawmode = shift;
4686         my $mime;
4687         $filename =~ /\./ or return undef;
4688
4689         if ($mimetypes_file) {
4690                 my $file = $mimetypes_file;
4691                 if ($file !~ m!^/!) { # if it is relative path
4692                         # it is relative to project
4693                         $file = "$projectroot/$project/$file";
4694                 }
4695                 $mime = mimetype_guess_file($filename, $file, $rawmode);
4696         }
4697         $mime ||= mimetype_guess_file($filename, '/etc/mime.types', $rawmode);
4698         return $mime;
4699 }
4700
4701 sub blob_mimetype {
4702         my $fd = shift;
4703         my $filename = shift;
4704         my $rawmode = shift;
4705         my $mime;
4706
4707         # The -T/-B file operators produce the wrong result unless a perlio
4708         # layer is present when the file handle is a pipe that delivers less
4709         # than 512 bytes of data before reaching EOF.
4710         #
4711         # If we are running in a Perl that uses the stdio layer rather than the
4712         # unix+perlio layers we will end up adding a perlio layer on top of the
4713         # stdio layer and get a second level of buffering.  This is harmless
4714         # and it makes the -T/-B file operators work properly in all cases.
4715
4716         binmode $fd, ":perlio" or die_error(500, "Adding perlio layer failed")
4717                 unless grep /^perlio$/, PerlIO::get_layers($fd);
4718
4719         $mime = mimetype_guess($filename, $rawmode) if defined $filename;
4720
4721         if (!$mime && $filename) {
4722                 if ($filename =~ m/\.html?$/i) {
4723                         $mime = 'text/html';
4724                 } elsif ($filename =~ m/\.xht(?:ml)?$/i) {
4725                         $mime = 'text/html';
4726                 } elsif ($filename =~ m/\.te?xt?$/i) {
4727                         $mime = 'text/plain';
4728                 } elsif ($filename =~ m/\.(?:markdown|md)$/i) {
4729                         $mime = 'text/plain';
4730                 } elsif ($filename =~ m/\.png$/i) {
4731                         $mime = 'image/png';
4732                 } elsif ($filename =~ m/\.gif$/i) {
4733                         $mime = 'image/gif';
4734                 } elsif ($filename =~ m/\.jpe?g$/i) {
4735                         $mime = 'image/jpeg';
4736                 } elsif ($filename =~ m/\.svgz?$/i) {
4737                         $mime = 'image/svg+xml';
4738                 }
4739         }
4740
4741         # just in case
4742         return $default_blob_plain_mimetype || 'application/octet-stream' unless $fd || $mime;
4743
4744         $mime = -T $fd ? 'text/plain' : 'application/octet-stream' unless $mime;
4745
4746         return $mime;
4747 }
4748
4749 sub is_ascii {
4750         use bytes;
4751         my $data = shift;
4752         return scalar($data =~ /^[\x00-\x7f]*$/);
4753 }
4754
4755 sub is_valid_utf8 {
4756         my $data = shift;
4757         return utf8::decode($data);
4758 }
4759
4760 sub extract_html_charset {
4761         return undef unless $_[0] && "$_[0]</head>" =~ m#<head(?:\s+[^>]*)?(?<!/)>(.*?)</head\s*>#is;
4762         my $head = $1;
4763         return $2 if $head =~ m#<meta\s+charset\s*=\s*(['"])\s*([a-z0-9(:)_.+-]+)\s*\1\s*/?>#is;
4764         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) {
4765                 my %kv = (lc($1) => $3, lc($4) => $6);
4766                 my ($he, $c) = (lc($kv{'http-equiv'}), $kv{'content'});
4767                 return $1 if $he && $c && $he eq 'content-type' &&
4768                         $c =~ m!\s*text/html\s*;\s*charset\s*=\s*([a-z0-9(:)_.+-]+)\s*$!is;
4769         }
4770         return undef;
4771 }
4772
4773 sub blob_contenttype {
4774         my ($fd, $file_name, $type) = @_;
4775
4776         $type ||= blob_mimetype($fd, $file_name, 1);
4777         return $type unless $type =~ m!^text/.+!i;
4778         my ($leader, $charset, $htmlcharset);
4779         if ($fd && read($fd, $leader, 32768)) {{
4780                 $charset='US-ASCII' if is_ascii($leader);
4781                 return ("$type; charset=UTF-8", $leader) if !$charset && is_valid_utf8($leader);
4782                 $charset='ISO-8859-1' unless $charset;
4783                 $htmlcharset = extract_html_charset($leader) if $type eq 'text/html';
4784                 if ($htmlcharset && $charset ne 'US-ASCII') {
4785                         $htmlcharset = undef if $htmlcharset =~ /^(?:utf-8|us-ascii)$/i
4786                 }
4787         }}
4788         return ("$type; charset=$htmlcharset", $leader) if $htmlcharset;
4789         my $defcharset = $default_text_plain_charset || '';
4790         $defcharset =~ s/^\s+//;
4791         $defcharset =~ s/\s+$//;
4792         $defcharset = '' if $charset && $charset ne 'US-ASCII' && $defcharset =~ /^(?:utf-8|us-ascii)$/i;
4793         return ("$type; charset=" . ($defcharset || 'ISO-8859-1'), $leader);
4794 }
4795
4796 # peek the first upto 128 bytes off a file handle
4797 sub peek128bytes {
4798         my $fd = shift;
4799
4800         use IO::Handle;
4801         use bytes;
4802
4803         my $prefix128;
4804         return '' unless $fd && read($fd, $prefix128, 128);
4805
4806         # In the general case, we're guaranteed only to be able to ungetc one
4807         # character (provided, of course, we actually got a character first).
4808         #
4809         # However, we know:
4810         #
4811         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4812         #    already been called at least once on the file handle before us
4813         #
4814         # 2) we have an $fd positioned at the start of the input stream and
4815         #    therefore know we were positioned at a buffer boundary before
4816         #    reading the initial upto 128 bytes
4817         #
4818         # 3) the buffer size is at least 512 bytes
4819         #
4820         # 4) we are careful to only unget raw bytes
4821         #
4822         # 5) we are attempting to unget exactly the same number of bytes we got
4823         #
4824         # Given the above conditions we will ALWAYS be able to safely unget
4825         # the $prefix128 value we just got.
4826         #
4827         # In fact, we could read up to 511 bytes and still be sure.
4828         # (Reading 512 might pop us into the next internal buffer, but probably
4829         # not since that could break the always able to unget at least the one
4830         # you just got guarantee.)
4831
4832         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4833
4834         return $prefix128;
4835 }
4836
4837 # guess file syntax for syntax highlighting; return undef if no highlighting
4838 # the name of syntax can (in the future) depend on syntax highlighter used
4839 sub guess_file_syntax {
4840         my ($fd, $mimetype, $file_name) = @_;
4841         return undef unless $fd && defined $file_name &&
4842                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4843         my $basename = basename($file_name, '.in');
4844         return $highlight_basename{$basename}
4845                 if exists $highlight_basename{$basename};
4846
4847         # Peek to see if there's a shebang or xml line.
4848         # We always operate on bytes when testing this.
4849         {
4850                 use bytes;
4851                 my $shebang = peek128bytes($fd);
4852                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4853                         foreach my $key (keys %highlight_shebang) {
4854                                 my $ar = ref($highlight_shebang{$key}) ?
4855                                         $highlight_shebang{$key} :
4856                                         [$highlight_shebang{key}];
4857                                 map {return $key if $shebang =~ /$_/} @$ar;
4858                         }
4859                 }
4860                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4861         }
4862
4863         $basename =~ /\.([^.]*)$/;
4864         my $ext = $1 or return undef;
4865         return $highlight_ext{$ext}
4866                 if exists $highlight_ext{$ext};
4867
4868         return undef;
4869 }
4870
4871 # run highlighter and return FD of its output,
4872 # or return original FD if no highlighting
4873 sub run_highlighter {
4874         my ($fd, $syntax) = @_;
4875         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4876
4877         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4878                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4879                 quote_command($highlight_bin).
4880                 " --replace-tabs=8 --fragment --syntax $syntax")
4881                 or die_error(500, "Couldn't open file or run syntax highlighter");
4882         if (eof $hifd) {
4883                 # just in case, should not happen as we tested !eof($fd) above
4884                 return $fd if close($hifd);
4885
4886                 # should not happen
4887                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4888
4889                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4890                 # instead of dying horribly on this, just skip the highlighting
4891                 # but do output a message about it to STDERR that will end up in the log
4892                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4893                         sprintf("child exit status 0x%x\n", $?);
4894                 return $fd
4895         }
4896         close $fd;
4897         return ($hifd, 1);
4898 }
4899
4900 ## ======================================================================
4901 ## functions printing HTML: header, footer, error page
4902
4903 sub get_page_title {
4904         my $title = to_utf8($site_name);
4905
4906         unless (defined $project) {
4907                 if (defined $project_filter) {
4908                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4909                 }
4910                 return $title;
4911         }
4912         $title .= " - " . to_utf8($project);
4913
4914         return $title unless (defined $action);
4915         my $action_print = $action eq 'blame_incremental' ? 'blame' : $action;
4916         $title .= "/$action_print"; # $action is US-ASCII (7bit ASCII)
4917
4918         return $title unless (defined $file_name);
4919         $title .= " - " . esc_path($file_name);
4920         if ($action eq "tree" && $file_name !~ m|/$|) {
4921                 $title .= "/";
4922         }
4923
4924         return $title;
4925 }
4926
4927 sub get_content_type_html {
4928         # We do not ever emit application/xhtml+xml since that gives us
4929         # no benefits and it makes many browsers (e.g. Firefox) exceedingly
4930         # strict, which is troublesome for example when showing user-supplied
4931         # README.html files.
4932         return 'text/html';
4933 }
4934
4935 sub print_feed_meta {
4936         if (defined $project) {
4937                 my %href_params = get_feed_info();
4938                 if (!exists $href_params{'-title'}) {
4939                         $href_params{'-title'} = 'log';
4940                 }
4941
4942                 foreach my $format (qw(RSS Atom)) {
4943                         my $type = lc($format);
4944                         my %link_attr = (
4945                                 '-rel' => 'alternate',
4946                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
4947                                 '-type' => "application/$type+xml"
4948                         );
4949
4950                         $href_params{'extra_options'} = undef;
4951                         $href_params{'action'} = $type;
4952                         $link_attr{'-href'} = href(%href_params);
4953                         print "<link ".
4954                               "rel=\"$link_attr{'-rel'}\" ".
4955                               "title=\"$link_attr{'-title'}\" ".
4956                               "href=\"$link_attr{'-href'}\" ".
4957                               "type=\"$link_attr{'-type'}\" ".
4958                               "/>\n";
4959
4960                         $href_params{'extra_options'} = '--no-merges';
4961                         $link_attr{'-href'} = href(%href_params);
4962                         $link_attr{'-title'} .= ' (no merges)';
4963                         print "<link ".
4964                               "rel=\"$link_attr{'-rel'}\" ".
4965                               "title=\"$link_attr{'-title'}\" ".
4966                               "href=\"$link_attr{'-href'}\" ".
4967                               "type=\"$link_attr{'-type'}\" ".
4968                               "/>\n";
4969                 }
4970
4971         } else {
4972                 printf('<link rel="alternate" title="%s projects list" '.
4973                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
4974                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
4975                 printf('<link rel="alternate" title="%s projects feeds" '.
4976                        'href="%s" type="text/x-opml" />'."\n",
4977                        esc_attr($site_name), href(project=>undef, action=>"opml"));
4978         }
4979 }
4980
4981 sub compute_stylesheet_links {
4982         return "<?gitweb compute_stylesheet_links?>" if $cache_mode_active;
4983
4984         # include each stylesheet that exists, providing backwards capability
4985         # for those people who defined $stylesheet in a config file
4986         if (defined $stylesheet) {
4987                 return '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4988         } else {
4989                 my $sheets = '';
4990                 foreach my $stylesheet (@stylesheets) {
4991                         next unless $stylesheet;
4992                         $sheets .= '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4993                 }
4994                 return $sheets;
4995         }
4996 }
4997
4998 sub print_header_links {
4999         my $status = shift;
5000
5001         print compute_stylesheet_links();
5002         print_feed_meta()
5003                 if ($status eq '200 OK');
5004         if (defined $favicon) {
5005                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
5006         }
5007 }
5008
5009 sub print_nav_breadcrumbs_path {
5010         my $dirprefix = undef;
5011         while (my $part = shift) {
5012                 $dirprefix .= "/" if defined $dirprefix;
5013                 $dirprefix .= $part;
5014                 print $cgi->a({-href => href(project => undef,
5015                                              project_filter => $dirprefix,
5016                                              action => "project_list")},
5017                               esc_html($part)) . " / ";
5018         }
5019 }
5020
5021 sub print_nav_breadcrumbs {
5022         my %opts = @_;
5023
5024         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
5025                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
5026         }
5027         if (defined $project) {
5028                 my @dirname = split '/', $project;
5029                 my $projectbasename = pop @dirname;
5030                 print_nav_breadcrumbs_path(@dirname);
5031                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
5032                 if (defined $action) {
5033                         my $action_print = $action ;
5034                         $action_print = 'blame' if $action_print eq 'blame_incremental';
5035                         if (defined $opts{-action_extra}) {
5036                                 $action_print = $cgi->a({-href => href(action=>$action)},
5037                                         $action);
5038                         }
5039                         print " / $action_print";
5040                 }
5041                 if (defined $opts{-action_extra}) {
5042                         print " / $opts{-action_extra}";
5043                 }
5044                 print "\n";
5045         } elsif (defined $project_filter) {
5046                 print_nav_breadcrumbs_path(split '/', $project_filter);
5047         }
5048 }
5049
5050 sub print_search_form {
5051         if (!defined $searchtext) {
5052                 $searchtext = "";
5053         }
5054         my $search_hash;
5055         if (defined $hash_base) {
5056                 $search_hash = $hash_base;
5057         } elsif (defined $hash) {
5058                 $search_hash = $hash;
5059         } else {
5060                 $search_hash = "HEAD";
5061         }
5062         # We can't use href() here because we need to encode the
5063         # URL parameters into the form, not into the action link.
5064         my $action = $my_uri;
5065         my $use_pathinfo = gitweb_check_feature('pathinfo');
5066         if ($use_pathinfo) {
5067                 # See notes about doubled / in href()
5068                 $action =~ s,/$,,;
5069                 $action .= "/".esc_path_info($project);
5070         }
5071         print $cgi->start_form(-method => "get", -action => $action) .
5072               "<div class=\"search\">\n" .
5073               (!$use_pathinfo &&
5074               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
5075               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
5076               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
5077               $cgi->popup_menu(-name => 'st', -default => 'commit',
5078                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
5079               $cgi->sup($cgi->a({-href => href(action=>"search_help"),
5080                                  -title => "search help" },
5081                                 "<span style=\"padding-bottom:1em\">?&#160;</span>")) . " search:\n",
5082               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
5083               "<span title=\"Extended regular expression\">" .
5084               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5085                              -checked => $search_use_regexp) .
5086               "</span>" .
5087               "</div>" .
5088               $cgi->end_form() . "\n";
5089 }
5090
5091 sub git_header_html {
5092         my $status = shift || "200 OK";
5093         my $expires = shift;
5094         my %opts = @_;
5095
5096         my $title = get_page_title();
5097         my $content_type = get_content_type_html();
5098         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
5099                            -status=> $status, -expires => $expires)
5100                 unless ($opts{'-no_http_header'});
5101         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
5102         print <<EOF;
5103 <?xml version="1.0" encoding="utf-8"?>
5104 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
5105 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
5106 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
5107 <!-- git core binaries version $git_version -->
5108 <head>
5109 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
5110 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
5111 <meta name="robots" content="index, nofollow"/>
5112 <title>$title</title>
5113 <script type="text/javascript">/* <![CDATA[ */
5114 function fixBlameLinks() {
5115         var allLinks = document.getElementsByTagName("a");
5116         for (var i = 0; i < allLinks.length; i++) {
5117                 var link = allLinks.item(i);
5118                 if (link.className == 'blamelink')
5119                         link.href = link.href.replace("/blame/", "/blame_incremental/");
5120         }
5121 }
5122 /* ]]> */</script>
5123 EOF
5124         # the stylesheet, favicon etc urls won't work correctly with path_info
5125         # unless we set the appropriate base URL
5126         if ($ENV{'PATH_INFO'}) {
5127                 print "<base href=\"".esc_url($base_url)."\" />\n";
5128         }
5129         print_header_links($status);
5130
5131         if (defined $site_html_head_string) {
5132                 print to_utf8($site_html_head_string);
5133         }
5134
5135         print "</head>\n" .
5136               "<body><span class=\"body\">\n";
5137
5138         if (defined $site_header && -f $site_header) {
5139                 insert_file($site_header);
5140         }
5141
5142         print "<div class=\"page_header\">\n";
5143         print "<span class=\"logo-container\"><span class=\"logo-default\">";
5144         if (defined $logo) {
5145                 print $cgi->a({-href => esc_url($logo_url),
5146                                -title => $logo_label,
5147                                -class => "logo-link"},
5148                               $cgi->img({-src => esc_url($logo),
5149                                          -width => 72, -height => 27,
5150                                          -alt => "git",
5151                                          -class => "logo"}));
5152         }
5153         print "</span></span><span class=\"banner-container\">";
5154         print_nav_breadcrumbs(%opts);
5155         print "</span></div>\n";
5156
5157         my $have_search = gitweb_check_feature('search');
5158         if (defined $project && $have_search) {
5159                 print_search_form();
5160         }
5161 }
5162
5163 sub compute_timed_interval {
5164         return "<?gitweb compute_timed_interval?>" if $cache_mode_active;
5165         return tv_interval($t0, [ gettimeofday() ]);
5166 }
5167
5168 sub compute_commands_count {
5169         return "<?gitweb compute_commands_count?>" if $cache_mode_active;
5170         my $s = $number_of_git_cmds == 1 ? '' : 's';
5171         return '<span id="generating_cmd">'.
5172                 $number_of_git_cmds.
5173                 "</span> git command$s";
5174 }
5175
5176 sub git_footer_html {
5177         my $feed_class = 'rss_logo';
5178
5179         print "<div class=\"page_footer\">\n";
5180         if (defined $project) {
5181                 my $descr = git_get_project_description($project);
5182                 if (defined $descr) {
5183                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
5184                 }
5185
5186                 my %href_params = get_feed_info();
5187                 if (!%href_params) {
5188                         $feed_class .= ' generic';
5189                 }
5190                 $href_params{'-title'} ||= 'log';
5191
5192                 foreach my $format (qw(RSS Atom)) {
5193                         $href_params{'action'} = lc($format);
5194                         print $cgi->a({-href => href(%href_params),
5195                                       -title => "$href_params{'-title'} $format feed",
5196                                       -class => $feed_class}, $format)."\n";
5197                 }
5198
5199         } else {
5200                 print $cgi->a({-href => href(project=>undef, action=>"opml",
5201                                              project_filter => $project_filter),
5202                               -class => $feed_class}, "OPML") . " ";
5203                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
5204                                              project_filter => $project_filter),
5205                               -class => $feed_class}, "TXT") . "\n";
5206         }
5207         print "</div>\n"; # class="page_footer"
5208
5209         if (defined $t0 && gitweb_check_feature('timed')) {
5210                 print "<div id=\"generating_info\">\n";
5211                 print 'This page took '.
5212                       '<span id="generating_time" class="time_span">'.
5213                       compute_timed_interval().
5214                       ' seconds </span>'.
5215                       ' and '.
5216                       compute_commands_count().
5217                       " to generate.\n";
5218                 print "</div>\n"; # class="page_footer"
5219         }
5220
5221         if (defined $site_footer && -f $site_footer) {
5222                 insert_file($site_footer);
5223         }
5224
5225         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
5226         if (defined $action &&
5227             $action eq 'blame_incremental') {
5228                 print qq!<script type="text/javascript">\n!.
5229                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
5230                       qq!           "!. href() .qq!");\n!.
5231                       qq!</script>\n!;
5232         } else {
5233                 my ($jstimezone, $tz_cookie, $datetime_class) =
5234                         gitweb_get_feature('javascript-timezone');
5235
5236                 print qq!<script type="text/javascript">\n!.
5237                       qq!window.onload = function () {\n!;
5238                 if (gitweb_check_feature('blame_incremental')) {
5239                         print qq!       fixBlameLinks();\n!;
5240                 }
5241                 if (gitweb_check_feature('javascript-actions')) {
5242                         print qq!       fixLinks();\n!;
5243                 }
5244                 if ($jstimezone && $tz_cookie && $datetime_class) {
5245                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
5246                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
5247                 }
5248                 print qq!};\n!.
5249                       qq!</script>\n!;
5250         }
5251
5252         print "</span></body>\n" .
5253               "</html>";
5254 }
5255
5256 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
5257 # Example: die_error(404, 'Hash not found')
5258 # By convention, use the following status codes (as defined in RFC 2616):
5259 # 400: Invalid or missing CGI parameters, or
5260 #      requested object exists but has wrong type.
5261 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
5262 #      this server or project.
5263 # 404: Requested object/revision/project doesn't exist.
5264 # 500: The server isn't configured properly, or
5265 #      an internal error occurred (e.g. failed assertions caused by bugs), or
5266 #      an unknown error occurred (e.g. the git binary died unexpectedly).
5267 # 503: The server is currently unavailable (because it is overloaded,
5268 #      or down for maintenance).  Generally, this is a temporary state.
5269 sub die_error {
5270         my $status = shift || 500;
5271         my $error = esc_html(shift) || "Internal Server Error";
5272         my $extra = shift;
5273         my %opts = @_;
5274
5275         my %http_responses = (
5276                 400 => '400 Bad Request',
5277                 403 => '403 Forbidden',
5278                 404 => '404 Not Found',
5279                 500 => '500 Internal Server Error',
5280                 503 => '503 Service Unavailable',
5281         );
5282         git_header_html($http_responses{$status}, undef, %opts);
5283         print <<EOF;
5284 <div class="page_body">
5285 <br /><br />
5286 $status - $error
5287 <br />
5288 EOF
5289         if (defined $extra) {
5290                 print "<hr />\n" .
5291                       "$extra\n";
5292         }
5293         print "</div>\n";
5294
5295         git_footer_html();
5296         CORE::die
5297                 unless ($opts{'-error_handler'});
5298 }
5299
5300 ## ----------------------------------------------------------------------
5301 ## functions printing or outputting HTML: navigation
5302
5303 # $content is wrapped in a span with class 'tab'
5304 # If $selected is true it also has class 'selected'
5305 # If $disabled is true it also has class 'disabled'
5306 # Whether or not a tab can be disabled and selected at the same time
5307 # is up to the caller
5308 # If $extra_classes is non-empty, it is a whitespace-separated list of
5309 # additional class names to include
5310 # Note that $content MUST already be html-escaped as needed because
5311 # it is included verbatim.  And so are any extra class names.
5312 sub tabspan {
5313         my ($content, $selected, $disabled, $extra_classes) = @_;
5314         my @classes = ("tab");
5315         push(@classes, "selected") if $selected;
5316         push(@classes, "disabled") if $disabled;
5317         push(@classes, split(' ', $extra_classes)) if $extra_classes;
5318         return "<span class=\"" . join(" ", @classes) . "\">". $content . "</span>";
5319 }
5320
5321 sub git_print_page_nav {
5322         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
5323         $extra = '' if !defined $extra; # pager or formats
5324         $extra = "<span class=\"page_nav_sub\">".$extra."</span>" if $extra ne '';
5325
5326         my @navs = qw(summary log commit commitdiff tree refs);
5327         if ($suppress) {
5328                 @navs = grep { $_ ne $suppress } @navs;
5329         }
5330
5331         my %arg = map { $_ => {action=>$_} } @navs;
5332         if (defined $head) {
5333                 for (qw(commit commitdiff)) {
5334                         $arg{$_}{'hash'} = $head;
5335                 }
5336                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
5337                         $arg{'log'}{'hash'} = $head;
5338                 }
5339         }
5340
5341         $arg{'log'}{'action'} = 'shortlog';
5342         if ($current eq 'log') {
5343                 $current = 'shortlog';
5344         } elsif ($current eq 'shortlog') {
5345                 $current = 'log';
5346         }
5347         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
5348         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
5349
5350         my @actions = gitweb_get_feature('actions');
5351         my $escname = $project;
5352         $escname =~ s/[+]/%2B/g;
5353         my %repl = (
5354                 '%' => '%',
5355                 'n' => $project,         # project name
5356                 'f' => $git_dir,         # project path within filesystem
5357                 'h' => $treehead || '',  # current hash ('h' parameter)
5358                 'b' => $treebase || '',  # hash base ('hb' parameter)
5359                 'e' => $escname,         # project name with '+' escaped
5360         );
5361         while (@actions) {
5362                 my ($label, $link, $pos) = splice(@actions,0,3);
5363                 # insert
5364                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
5365                 # munch munch
5366                 $link =~ s/%([%nfhbe])/$repl{$1}/g;
5367                 $arg{$label}{'_href'} = $link;
5368         }
5369
5370         print "<div class=\"page_nav\">\n" .
5371                 (join $barsep,
5372                  map { $_ eq $current ?
5373                        tabspan($_, 1) :
5374                        tabspan($cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_"))
5375                  } @navs);
5376         print "<br/>\n$extra<br/>\n" .
5377               "</div>\n";
5378 }
5379
5380 # returns a submenu for the nagivation of the refs views (tags, heads,
5381 # remotes) with the current view disabled and the remotes view only
5382 # available if the feature is enabled
5383 sub format_ref_views {
5384         my ($current) = @_;
5385         my @ref_views = qw{tags heads};
5386         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
5387         return join $barsep, map {
5388                 $_ eq $current ? tabspan($_, 1) :
5389                 tabspan($cgi->a({-href => href(action=>$_)}, $_))
5390         } @ref_views
5391 }
5392
5393 sub format_paging_nav {
5394         my ($action, $page, $has_next_link) = @_;
5395         my $paging_nav = "<span class=\"paging_nav\">";
5396
5397         if ($page > 0) {
5398                 $paging_nav .= tabspan(
5399                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first")) .
5400                         $mdotsep . tabspan(
5401                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
5402                                  -accesskey => "p", -title => "Alt-p"}, "prev"));
5403         } else {
5404                 $paging_nav .= tabspan("first", 1).${mdotsep}.tabspan("prev", 0, 1);
5405         }
5406
5407         if ($has_next_link) {
5408                 $paging_nav .= $mdotsep . tabspan(
5409                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
5410                                  -accesskey => "n", -title => "Alt-n"}, "next"));
5411         } else {
5412                 $paging_nav .= ${mdotsep}.tabspan("next", 0, 1);
5413         }
5414
5415         return $paging_nav."</span>";
5416 }
5417
5418 sub format_log_nav {
5419         my ($action, $page, $has_next_link, $extra) = @_;
5420         my $paging_nav;
5421         defined $extra or $extra = '';
5422         $extra eq '' or $extra .= $barsep;
5423
5424         if ($action eq 'shortlog') {
5425                 $paging_nav .= tabspan('shortlog', 1);
5426         } else {
5427                 $paging_nav .= tabspan($cgi->a({-href => href(action=>'shortlog', -replay=>1)}, 'shortlog'));
5428         }
5429         $paging_nav .= $barsep;
5430         if ($action eq 'log') {
5431                 $paging_nav .= tabspan('fulllog', 1);
5432         } else {
5433                 $paging_nav .= tabspan($cgi->a({-href => href(action=>'log', -replay=>1)}, 'fulllog'));
5434         }
5435
5436         $paging_nav .= $barsep . $extra . format_paging_nav($action, $page, $has_next_link);
5437         return $paging_nav;
5438 }
5439
5440 ## ......................................................................
5441 ## functions printing or outputting HTML: div
5442
5443 sub git_print_header_div {
5444         my ($action, $title, $hash, $hash_base, $extra) = @_;
5445         my %args = ();
5446         defined $extra or $extra = '';
5447
5448         $args{'action'} = $action;
5449         $args{'hash'} = $hash if $hash;
5450         $args{'hash_base'} = $hash_base if $hash_base;
5451
5452         my $link1 = $cgi->a({-href => href(%args), -class => "title"},
5453                             $title ? $title : $action);
5454         my $link2 = $cgi->a({-href => href(%args), -class => "cover"}, "");
5455         print "<div class=\"header\">\n" . '<span class="title">' .
5456               $link1 . $extra . $link2 . '</span>' . "\n</div>\n";
5457 }
5458
5459 sub format_repo_url {
5460         my ($name, $url) = @_;
5461         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
5462 }
5463
5464 # Group output by placing it in a DIV element and adding a header.
5465 # Options for start_div() can be provided by passing a hash reference as the
5466 # first parameter to the function.
5467 # Options to git_print_header_div() can be provided by passing an array
5468 # reference. This must follow the options to start_div if they are present.
5469 # The content can be a scalar, which is output as-is, a scalar reference, which
5470 # is output after html escaping, an IO handle passed either as *handle or
5471 # *handle{IO}, or a function reference. In the latter case all following
5472 # parameters will be taken as argument to the content function call.
5473 sub git_print_section {
5474         my ($div_args, $header_args, $content);
5475         my $arg = shift;
5476         if (ref($arg) eq 'HASH') {
5477                 $div_args = $arg;
5478                 $arg = shift;
5479         }
5480         if (ref($arg) eq 'ARRAY') {
5481                 $header_args = $arg;
5482                 $arg = shift;
5483         }
5484         $content = $arg;
5485
5486         print $cgi->start_div($div_args);
5487         git_print_header_div(@$header_args);
5488
5489         if (ref($content) eq 'CODE') {
5490                 $content->(@_);
5491         } elsif (ref($content) eq 'SCALAR') {
5492                 print esc_html($$content);
5493         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
5494                 while (<$content>) {
5495                         print to_utf8($_);
5496                 }
5497         } elsif (!ref($content) && defined($content)) {
5498                 print $content;
5499         }
5500
5501         print $cgi->end_div;
5502 }
5503
5504 sub format_timestamp_html {
5505         my $date = shift;
5506         my $useatnight = shift;
5507         defined($useatnight) or $useatnight = 1;
5508         my $strtime = $date->{'rfc2822'};
5509
5510         my (undef, undef, $datetime_class) =
5511                 gitweb_get_feature('javascript-timezone');
5512         if ($datetime_class) {
5513                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
5514         }
5515
5516         my $localtime_format = '(%d %02d:%02d %s)';
5517         if ($useatnight && $date->{'hour_local'} < 6) {
5518                 $localtime_format = '(%d <span class="atnight">%02d:%02d</span> %s)';
5519         }
5520         $strtime .= ' ' .
5521                     sprintf($localtime_format, $date->{'mday_local'},
5522                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
5523
5524         return $strtime;
5525 }
5526
5527 sub format_lastrefresh_row {
5528         return "<?gitweb format_lastrefresh_row?>" if $cache_mode_active;
5529         my %rd = parse_file_date('.last_refresh');
5530         if (defined $rd{'rfc2822'}) {
5531                 return "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td>" .
5532                        "<td>".format_timestamp_html(\%rd,0)."</td></tr>";
5533         }
5534         return "";
5535 }
5536
5537 # Outputs the author name and date in long form
5538 sub git_print_authorship {
5539         my $co = shift;
5540         my %opts = @_;
5541         my $tag = $opts{-tag} || 'div';
5542         my $author = $co->{'author_name'};
5543
5544         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
5545         print "<$tag class=\"author_date\">" .
5546               format_search_author($author, "author", esc_html($author)) .
5547               " [".format_timestamp_html(\%ad)."]".
5548               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
5549               "</$tag>\n";
5550 }
5551
5552 # Outputs table rows containing the full author or committer information,
5553 # in the format expected for 'commit' view (& similar).
5554 # Parameters are a commit hash reference, followed by the list of people
5555 # to output information for. If the list is empty it defaults to both
5556 # author and committer.
5557 sub git_print_authorship_rows {
5558         my $co = shift;
5559         # too bad we can't use @people = @_ || ('author', 'committer')
5560         my @people = @_;
5561         @people = ('author', 'committer') unless @people;
5562         foreach my $who (@people) {
5563                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
5564                 print "<tr><td>$who</td><td>" .
5565                       format_search_author($co->{"${who}_name"}, $who,
5566                                            esc_html($co->{"${who}_name"})) . " " .
5567                       format_search_author($co->{"${who}_email"}, $who,
5568                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
5569                       "</td><td rowspan=\"2\">" .
5570                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
5571                       "</td></tr>\n" .
5572                       "<tr>" .
5573                       "<td></td><td>" .
5574                       format_timestamp_html(\%wd) .
5575                       "</td>" .
5576                       "</tr>\n";
5577         }
5578 }
5579
5580 sub git_print_page_path {
5581         my $name = shift;
5582         my $type = shift;
5583         my $hb = shift;
5584
5585
5586         print "<div class=\"page_path\">";
5587         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
5588                       -title => 'tree root'}, to_utf8("[$project]"));
5589         print " / ";
5590         if (defined $name) {
5591                 my @dirname = split '/', $name;
5592                 my $basename = pop @dirname;
5593                 my $fullname = '';
5594
5595                 foreach my $dir (@dirname) {
5596                         $fullname .= ($fullname ? '/' : '') . $dir;
5597                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
5598                                                      hash_base=>$hb),
5599                                       -title => $fullname}, esc_path($dir));
5600                         print " / ";
5601                 }
5602                 if (defined $type && $type eq 'blob') {
5603                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
5604                                                      hash_base=>$hb),
5605                                       -title => $name}, esc_path($basename));
5606                 } elsif (defined $type && $type eq 'tree') {
5607                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
5608                                                      hash_base=>$hb),
5609                                       -title => $name}, esc_path($basename));
5610                         print " / ";
5611                 } else {
5612                         print esc_path($basename);
5613                 }
5614         }
5615         print "<br/></div>\n";
5616 }
5617
5618 sub git_print_log {
5619         my $log = shift;
5620         my %opts = @_;
5621
5622         if ($opts{'-remove_title'}) {
5623                 # remove title, i.e. first line of log
5624                 shift @$log;
5625         }
5626         # remove leading empty lines
5627         while (defined $log->[0] && $log->[0] eq "") {
5628                 shift @$log;
5629         }
5630
5631         # print log
5632         my $skip_blank_line = 0;
5633         foreach my $line (@$log) {
5634                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5635                         if (! $opts{'-remove_signoff'}) {
5636                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5637                                 $skip_blank_line = 1;
5638                         }
5639                         next;
5640                 }
5641
5642                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5643                         if (! $opts{'-remove_signoff'}) {
5644                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5645                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5646                                         "</span><br/>\n";
5647                                 $skip_blank_line = 1;
5648                         }
5649                         next;
5650                 }
5651
5652                 # print only one empty line
5653                 # do not print empty line after signoff
5654                 if ($line eq "") {
5655                         next if ($skip_blank_line);
5656                         $skip_blank_line = 1;
5657                 } else {
5658                         $skip_blank_line = 0;
5659                 }
5660
5661                 print format_log_line_html($line) . "<br/>\n";
5662         }
5663
5664         if ($opts{'-final_empty_line'}) {
5665                 # end with single empty line
5666                 print "<br/>\n" unless $skip_blank_line;
5667         }
5668 }
5669
5670 # return link target (what link points to)
5671 sub git_get_link_target {
5672         my $hash = shift;
5673         my $link_target;
5674
5675         # read link
5676         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5677                 or return;
5678         {
5679                 local $/ = undef;
5680                 $link_target = to_utf8(scalar <$fd>);
5681         }
5682         close $fd
5683                 or return;
5684
5685         return $link_target;
5686 }
5687
5688 # given link target, and the directory (basedir) the link is in,
5689 # return target of link relative to top directory (top tree);
5690 # return undef if it is not possible (including absolute links).
5691 sub normalize_link_target {
5692         my ($link_target, $basedir) = @_;
5693
5694         # absolute symlinks (beginning with '/') cannot be normalized
5695         return if (substr($link_target, 0, 1) eq '/');
5696
5697         # normalize link target to path from top (root) tree (dir)
5698         my $path;
5699         if ($basedir) {
5700                 $path = $basedir . '/' . $link_target;
5701         } else {
5702                 # we are in top (root) tree (dir)
5703                 $path = $link_target;
5704         }
5705
5706         # remove //, /./, and /../
5707         my @path_parts;
5708         foreach my $part (split('/', $path)) {
5709                 # discard '.' and ''
5710                 next if (!$part || $part eq '.');
5711                 # handle '..'
5712                 if ($part eq '..') {
5713                         if (@path_parts) {
5714                                 pop @path_parts;
5715                         } else {
5716                                 # link leads outside repository (outside top dir)
5717                                 return;
5718                         }
5719                 } else {
5720                         push @path_parts, $part;
5721                 }
5722         }
5723         $path = join('/', @path_parts);
5724
5725         return $path;
5726 }
5727
5728 # print tree entry (row of git_tree), but without encompassing <tr> element
5729 sub git_print_tree_entry {
5730         my ($t, $basedir, $hash_base, $have_blame) = @_;
5731
5732         my %base_key = ();
5733         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5734
5735         # The format of a table row is: mode list link.  Where mode is
5736         # the mode of the entry, list is the name of the entry, an href,
5737         # and link is the action links of the entry.
5738
5739         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5740         if (exists $t->{'size'}) {
5741                 print "<td class=\"size\">$t->{'size'}</td>\n";
5742         }
5743         if ($t->{'type'} eq "blob") {
5744                 print "<td class=\"list\">" .
5745                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5746                                                file_name=>"$basedir$t->{'name'}", %base_key),
5747                                 -class => "list"}, esc_path($t->{'name'}));
5748                 if (S_ISLNK(oct $t->{'mode'})) {
5749                         my $link_target = git_get_link_target($t->{'hash'});
5750                         if ($link_target) {
5751                                 my $norm_target = normalize_link_target($link_target, $basedir);
5752                                 if (defined $norm_target) {
5753                                         print " -> " .
5754                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5755                                                                      file_name=>$norm_target),
5756                                                        -title => $norm_target}, esc_path($link_target));
5757                                 } else {
5758                                         print " -> " . esc_path($link_target);
5759                                 }
5760                         }
5761                 }
5762                 print "</td>\n";
5763                 print "<td class=\"link\">";
5764                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5765                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5766                               "blob");
5767                 if ($have_blame) {
5768                         print $barsep .
5769                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5770                                                      file_name=>"$basedir$t->{'name'}", %base_key),
5771                                       -class => "blamelink"},
5772                                       "blame");
5773                 }
5774                 if (defined $hash_base) {
5775                         print $barsep .
5776                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5777                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5778                                       "history");
5779                 }
5780                 print $barsep .
5781                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5782                                                file_name=>"$basedir$t->{'name'}")},
5783                                 "raw");
5784                 print "</td>\n";
5785
5786         } elsif ($t->{'type'} eq "tree") {
5787                 print "<td class=\"list\">";
5788                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5789                                              file_name=>"$basedir$t->{'name'}",
5790                                              %base_key)},
5791                               esc_path($t->{'name'}));
5792                 print "</td>\n";
5793                 print "<td class=\"link\">";
5794                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5795                                              file_name=>"$basedir$t->{'name'}",
5796                                              %base_key)},
5797                               "tree");
5798                 if (defined $hash_base) {
5799                         print $barsep .
5800                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5801                                                      file_name=>"$basedir$t->{'name'}")},
5802                                       "history");
5803                 }
5804                 print "</td>\n";
5805         } else {
5806                 # unknown object: we can only present history for it
5807                 # (this includes 'commit' object, i.e. submodule support)
5808                 print "<td class=\"list\">" .
5809                       esc_path($t->{'name'}) .
5810                       "</td>\n";
5811                 print "<td class=\"link\">";
5812                 if (defined $hash_base) {
5813                         print $cgi->a({-href => href(action=>"history",
5814                                                      hash_base=>$hash_base,
5815                                                      file_name=>"$basedir$t->{'name'}")},
5816                                       "history");
5817                 }
5818                 print "</td>\n";
5819         }
5820 }
5821
5822 ## ......................................................................
5823 ## functions printing large fragments of HTML
5824
5825 # get pre-image filenames for merge (combined) diff
5826 sub fill_from_file_info {
5827         my ($diff, @parents) = @_;
5828
5829         $diff->{'from_file'} = [ ];
5830         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5831         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5832                 if ($diff->{'status'}[$i] eq 'R' ||
5833                     $diff->{'status'}[$i] eq 'C') {
5834                         $diff->{'from_file'}[$i] =
5835                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5836                 }
5837         }
5838
5839         return $diff;
5840 }
5841
5842 # is current raw difftree line of file deletion
5843 sub is_deleted {
5844         my $diffinfo = shift;
5845
5846         return $diffinfo->{'to_id'} eq ('0' x 40);
5847 }
5848
5849 # does patch correspond to [previous] difftree raw line
5850 # $diffinfo  - hashref of parsed raw diff format
5851 # $patchinfo - hashref of parsed patch diff format
5852 #              (the same keys as in $diffinfo)
5853 sub is_patch_split {
5854         my ($diffinfo, $patchinfo) = @_;
5855
5856         return defined $diffinfo && defined $patchinfo
5857                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5858 }
5859
5860
5861 sub git_difftree_body {
5862         my ($difftree, $hash, @parents) = @_;
5863         my ($parent) = $parents[0];
5864         my $have_blame = gitweb_check_feature('blame');
5865         print "<div class=\"list_head\">\n";
5866         if ($#{$difftree} > 10) {
5867                 print(($#{$difftree} + 1) . " files changed:\n");
5868         }
5869         print "</div>\n";
5870
5871         print "<table class=\"" .
5872               (@parents > 1 ? "combined " : "") .
5873               "diff_tree\">\n";
5874
5875         # header only for combined diff in 'commitdiff' view
5876         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5877         if ($has_header) {
5878                 # table header
5879                 print "<thead><tr>\n" .
5880                        "<th></th><th></th>\n"; # filename, patchN link
5881                 for (my $i = 0; $i < @parents; $i++) {
5882                         my $par = $parents[$i];
5883                         print "<th>" .
5884                               $cgi->a({-href => href(action=>"commitdiff",
5885                                                      hash=>$hash, hash_parent=>$par),
5886                                        -title => 'commitdiff to parent number ' .
5887                                                   ($i+1) . ': ' . substr($par,0,7)},
5888                                       $i+1) .
5889                               "&#160;</th>\n";
5890                 }
5891                 print "</tr></thead>\n<tbody>\n";
5892         }
5893
5894         my $alternate = 1;
5895         my $patchno = 0;
5896         foreach my $line (@{$difftree}) {
5897                 my $diff = parsed_difftree_line($line);
5898
5899                 if ($alternate) {
5900                         print "<tr class=\"dark\">\n";
5901                 } else {
5902                         print "<tr class=\"light\">\n";
5903                 }
5904                 $alternate ^= 1;
5905
5906                 if (exists $diff->{'nparents'}) { # combined diff
5907
5908                         fill_from_file_info($diff, @parents)
5909                                 unless exists $diff->{'from_file'};
5910
5911                         if (!is_deleted($diff)) {
5912                                 # file exists in the result (child) commit
5913                                 print "<td>" .
5914                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5915                                                              file_name=>$diff->{'to_file'},
5916                                                              hash_base=>$hash),
5917                                               -class => "list"}, esc_path($diff->{'to_file'})) .
5918                                       "</td>\n";
5919                         } else {
5920                                 print "<td>" .
5921                                       esc_path($diff->{'to_file'}) .
5922                                       "</td>\n";
5923                         }
5924
5925                         if ($action eq 'commitdiff') {
5926                                 # link to patch
5927                                 $patchno++;
5928                                 print "<td class=\"link\">" .
5929                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
5930                                               "patch") .
5931                                       $barsep .
5932                                       "</td>\n";
5933                         }
5934
5935                         my $has_history = 0;
5936                         my $not_deleted = 0;
5937                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5938                                 my $hash_parent = $parents[$i];
5939                                 my $from_hash = $diff->{'from_id'}[$i];
5940                                 my $from_path = $diff->{'from_file'}[$i];
5941                                 my $status = $diff->{'status'}[$i];
5942
5943                                 $has_history ||= ($status ne 'A');
5944                                 $not_deleted ||= ($status ne 'D');
5945
5946                                 if ($status eq 'A') {
5947                                         print "<td  class=\"link\" align=\"right\">$barsep</td>\n";
5948                                 } elsif ($status eq 'D') {
5949                                         print "<td class=\"link\">" .
5950                                               $cgi->a({-href => href(action=>"blob",
5951                                                                      hash_base=>$hash,
5952                                                                      hash=>$from_hash,
5953                                                                      file_name=>$from_path)},
5954                                                       "blob" . ($i+1)) .
5955                                               "$barsep</td>\n";
5956                                 } else {
5957                                         if ($diff->{'to_id'} eq $from_hash) {
5958                                                 print "<td class=\"link nochange\">";
5959                                         } else {
5960                                                 print "<td class=\"link\">";
5961                                         }
5962                                         print $cgi->a({-href => href(action=>"blobdiff",
5963                                                                      hash=>$diff->{'to_id'},
5964                                                                      hash_parent=>$from_hash,
5965                                                                      hash_base=>$hash,
5966                                                                      hash_parent_base=>$hash_parent,
5967                                                                      file_name=>$diff->{'to_file'},
5968                                                                      file_parent=>$from_path)},
5969                                                       "diff" . ($i+1)) .
5970                                               "$barsep</td>\n";
5971                                 }
5972                         }
5973
5974                         print "<td class=\"link\">";
5975                         if ($not_deleted) {
5976                                 print $cgi->a({-href => href(action=>"blob",
5977                                                              hash=>$diff->{'to_id'},
5978                                                              file_name=>$diff->{'to_file'},
5979                                                              hash_base=>$hash)},
5980                                               "blob");
5981                                 print $barsep if ($has_history);
5982                         }
5983                         if ($has_history) {
5984                                 print $cgi->a({-href => href(action=>"history",
5985                                                              file_name=>$diff->{'to_file'},
5986                                                              hash_base=>$hash)},
5987                                               "history");
5988                         }
5989                         print "</td>\n";
5990
5991                         print "</tr>\n";
5992                         next; # instead of 'else' clause, to avoid extra indent
5993                 }
5994                 # else ordinary diff
5995
5996                 my ($to_mode_oct, $to_mode_str, $to_file_type);
5997                 my ($from_mode_oct, $from_mode_str, $from_file_type);
5998                 if ($diff->{'to_mode'} ne ('0' x 6)) {
5999                         $to_mode_oct = oct $diff->{'to_mode'};
6000                         if (S_ISREG($to_mode_oct)) { # only for regular file
6001                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
6002                         }
6003                         $to_file_type = file_type($diff->{'to_mode'});
6004                 }
6005                 if ($diff->{'from_mode'} ne ('0' x 6)) {
6006                         $from_mode_oct = oct $diff->{'from_mode'};
6007                         if (S_ISREG($from_mode_oct)) { # only for regular file
6008                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
6009                         }
6010                         $from_file_type = file_type($diff->{'from_mode'});
6011                 }
6012
6013                 if ($diff->{'status'} eq "A") { # created
6014                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
6015                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
6016                         $mode_chng   .= "]</span>";
6017                         print "<td>";
6018                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6019                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6020                                       -class => "list"}, esc_path($diff->{'file'}));
6021                         print "</td>\n";
6022                         print "<td>$mode_chng</td>\n";
6023                         print "<td class=\"link\">";
6024                         if ($action eq 'commitdiff') {
6025                                 # link to patch
6026                                 $patchno++;
6027                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6028                                               "patch") .
6029                                       $barsep;
6030                         }
6031                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6032                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6033                                       "blob");
6034                         print "</td>\n";
6035
6036                 } elsif ($diff->{'status'} eq "D") { # deleted
6037                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
6038                         print "<td>";
6039                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
6040                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
6041                                        -class => "list"}, esc_path($diff->{'file'}));
6042                         print "</td>\n";
6043                         print "<td>$mode_chng</td>\n";
6044                         print "<td class=\"link\">";
6045                         if ($action eq 'commitdiff') {
6046                                 # link to patch
6047                                 $patchno++;
6048                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6049                                               "patch") .
6050                                       $barsep;
6051                         }
6052                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
6053                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
6054                                       "blob") . $barsep;
6055                         if ($have_blame) {
6056                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
6057                                                              file_name=>$diff->{'file'}),
6058                                               -class => "blamelink"},
6059                                               "blame") . $barsep;
6060                         }
6061                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
6062                                                      file_name=>$diff->{'file'})},
6063                                       "history");
6064                         print "</td>\n";
6065
6066                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
6067                         my $mode_chnge = "";
6068                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6069                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
6070                                 if ($from_file_type ne $to_file_type) {
6071                                         $mode_chnge .= " from $from_file_type to $to_file_type";
6072                                 }
6073                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
6074                                         if ($from_mode_str && $to_mode_str) {
6075                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
6076                                         } elsif ($to_mode_str) {
6077                                                 $mode_chnge .= " mode: $to_mode_str";
6078                                         }
6079                                 }
6080                                 $mode_chnge .= "]</span>\n";
6081                         }
6082                         print "<td>";
6083                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6084                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6085                                       -class => "list"}, esc_path($diff->{'file'}));
6086                         print "</td>\n";
6087                         print "<td>$mode_chnge</td>\n";
6088                         print "<td class=\"link\">";
6089                         if ($action eq 'commitdiff') {
6090                                 # link to patch
6091                                 $patchno++;
6092                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6093                                               "patch") .
6094                                       $barsep;
6095                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6096                                 # "commit" view and modified file (not onlu mode changed)
6097                                 print $cgi->a({-href => href(action=>"blobdiff",
6098                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6099                                                              hash_base=>$hash, hash_parent_base=>$parent,
6100                                                              file_name=>$diff->{'file'})},
6101                                               "diff") .
6102                                       $barsep;
6103                         }
6104                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6105                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6106                                        "blob") . $barsep;
6107                         if ($have_blame) {
6108                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6109                                                              file_name=>$diff->{'file'}),
6110                                               -class => "blamelink"},
6111                                               "blame") . $barsep;
6112                         }
6113                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6114                                                      file_name=>$diff->{'file'})},
6115                                       "history");
6116                         print "</td>\n";
6117
6118                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
6119                         my %status_name = ('R' => 'moved', 'C' => 'copied');
6120                         my $nstatus = $status_name{$diff->{'status'}};
6121                         my $mode_chng = "";
6122                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6123                                 # mode also for directories, so we cannot use $to_mode_str
6124                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
6125                         }
6126                         print "<td>" .
6127                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
6128                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
6129                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
6130                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
6131                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
6132                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
6133                                       -class => "list"}, esc_path($diff->{'from_file'})) .
6134                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
6135                               "<td class=\"link\">";
6136                         if ($action eq 'commitdiff') {
6137                                 # link to patch
6138                                 $patchno++;
6139                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6140                                               "patch") .
6141                                       $barsep;
6142                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6143                                 # "commit" view and modified file (not only pure rename or copy)
6144                                 print $cgi->a({-href => href(action=>"blobdiff",
6145                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6146                                                              hash_base=>$hash, hash_parent_base=>$parent,
6147                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
6148                                               "diff") .
6149                                       $barsep;
6150                         }
6151                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6152                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
6153                                       "blob") . $barsep;
6154                         if ($have_blame) {
6155                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6156                                                              file_name=>$diff->{'to_file'}),
6157                                               -class => "blamelink"},
6158                                               "blame") . $barsep;
6159                         }
6160                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6161                                                     file_name=>$diff->{'to_file'})},
6162                                       "history");
6163                         print "</td>\n";
6164
6165                 } # we should not encounter Unmerged (U) or Unknown (X) status
6166                 print "</tr>\n";
6167         }
6168         print "</tbody>" if $has_header;
6169         print "</table>\n";
6170 }
6171
6172 # Print context lines and then rem/add lines in a side-by-side manner.
6173 sub print_sidebyside_diff_lines {
6174         my ($ctx, $rem, $add) = @_;
6175
6176         # print context block before add/rem block
6177         if (@$ctx) {
6178                 print join '',
6179                         '<div class="chunk_block ctx">',
6180                                 '<div class="old">',
6181                                 @$ctx,
6182                                 '</div>',
6183                                 '<div class="new">',
6184                                 @$ctx,
6185                                 '</div>',
6186                         '</div>';
6187         }
6188
6189         if (!@$add) {
6190                 # pure removal
6191                 print join '',
6192                         '<div class="chunk_block rem">',
6193                                 '<div class="old">',
6194                                 @$rem,
6195                                 '</div>',
6196                         '</div>';
6197         } elsif (!@$rem) {
6198                 # pure addition
6199                 print join '',
6200                         '<div class="chunk_block add">',
6201                                 '<div class="new">',
6202                                 @$add,
6203                                 '</div>',
6204                         '</div>';
6205         } else {
6206                 print join '',
6207                         '<div class="chunk_block chg">',
6208                                 '<div class="old">',
6209                                 @$rem,
6210                                 '</div>',
6211                                 '<div class="new">',
6212                                 @$add,
6213                                 '</div>',
6214                         '</div>';
6215         }
6216 }
6217
6218 # Print context lines and then rem/add lines in inline manner.
6219 sub print_inline_diff_lines {
6220         my ($ctx, $rem, $add) = @_;
6221
6222         print @$ctx, @$rem, @$add;
6223 }
6224
6225 # Format removed and added line, mark changed part and HTML-format them.
6226 # Implementation is based on contrib/diff-highlight
6227 sub format_rem_add_lines_pair {
6228         my ($rem, $add, $num_parents) = @_;
6229
6230         # We need to untabify lines before split()'ing them;
6231         # otherwise offsets would be invalid.
6232         chomp $rem;
6233         chomp $add;
6234         $rem = untabify($rem);
6235         $add = untabify($add);
6236
6237         my @rem = split(//, $rem);
6238         my @add = split(//, $add);
6239         my ($esc_rem, $esc_add);
6240         # Ignore leading +/- characters for each parent.
6241         my ($prefix_len, $suffix_len) = ($num_parents, 0);
6242         my ($prefix_has_nonspace, $suffix_has_nonspace);
6243
6244         my $shorter = (@rem < @add) ? @rem : @add;
6245         while ($prefix_len < $shorter) {
6246                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
6247
6248                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
6249                 $prefix_len++;
6250         }
6251
6252         while ($prefix_len + $suffix_len < $shorter) {
6253                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
6254
6255                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
6256                 $suffix_len++;
6257         }
6258
6259         # Mark lines that are different from each other, but have some common
6260         # part that isn't whitespace.  If lines are completely different, don't
6261         # mark them because that would make output unreadable, especially if
6262         # diff consists of multiple lines.
6263         if ($prefix_has_nonspace || $suffix_has_nonspace) {
6264                 $esc_rem = esc_html_hl_regions($rem, 'marked',
6265                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
6266                 $esc_add = esc_html_hl_regions($add, 'marked',
6267                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
6268         } else {
6269                 $esc_rem = esc_html($rem, -nbsp=>1);
6270                 $esc_add = esc_html($add, -nbsp=>1);
6271         }
6272
6273         return format_diff_line(\$esc_rem, 'rem'),
6274                format_diff_line(\$esc_add, 'add');
6275 }
6276
6277 # HTML-format diff context, removed and added lines.
6278 sub format_ctx_rem_add_lines {
6279         my ($ctx, $rem, $add, $num_parents) = @_;
6280         my (@new_ctx, @new_rem, @new_add);
6281         my $can_highlight = 0;
6282         my $is_combined = ($num_parents > 1);
6283
6284         # Highlight if every removed line has a corresponding added line.
6285         if (@$add > 0 && @$add == @$rem) {
6286                 $can_highlight = 1;
6287
6288                 # Highlight lines in combined diff only if the chunk contains
6289                 # diff between the same version, e.g.
6290                 #
6291                 #    - a
6292                 #   -  b
6293                 #    + c
6294                 #   +  d
6295                 #
6296                 # Otherwise the highlightling would be confusing.
6297                 if ($is_combined) {
6298                         for (my $i = 0; $i < @$add; $i++) {
6299                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
6300                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
6301
6302                                 $prefix_rem =~ s/-/+/g;
6303
6304                                 if ($prefix_rem ne $prefix_add) {
6305                                         $can_highlight = 0;
6306                                         last;
6307                                 }
6308                         }
6309                 }
6310         }
6311
6312         if ($can_highlight) {
6313                 for (my $i = 0; $i < @$add; $i++) {
6314                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
6315                                 $rem->[$i], $add->[$i], $num_parents);
6316                         push @new_rem, $line_rem;
6317                         push @new_add, $line_add;
6318                 }
6319         } else {
6320                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
6321                 @new_add = map { format_diff_line($_, 'add') } @$add;
6322         }
6323
6324         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
6325
6326         return (\@new_ctx, \@new_rem, \@new_add);
6327 }
6328
6329 # Print context lines and then rem/add lines.
6330 sub print_diff_lines {
6331         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
6332         my $is_combined = $num_parents > 1;
6333
6334         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
6335                 $num_parents);
6336
6337         if ($diff_style eq 'sidebyside' && !$is_combined) {
6338                 print_sidebyside_diff_lines($ctx, $rem, $add);
6339         } else {
6340                 # default 'inline' style and unknown styles
6341                 print_inline_diff_lines($ctx, $rem, $add);
6342         }
6343 }
6344
6345 sub print_diff_chunk {
6346         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
6347         my (@ctx, @rem, @add);
6348
6349         # The class of the previous line.
6350         my $prev_class = '';
6351
6352         return unless @chunk;
6353
6354         # incomplete last line might be among removed or added lines,
6355         # or both, or among context lines: find which
6356         for (my $i = 1; $i < @chunk; $i++) {
6357                 if ($chunk[$i][0] eq 'incomplete') {
6358                         $chunk[$i][0] = $chunk[$i-1][0];
6359                 }
6360         }
6361
6362         # guardian
6363         push @chunk, ["", ""];
6364
6365         foreach my $line_info (@chunk) {
6366                 my ($class, $line) = @$line_info;
6367
6368                 # print chunk headers
6369                 if ($class && $class eq 'chunk_header') {
6370                         print format_diff_line($line, $class, $from, $to);
6371                         next;
6372                 }
6373
6374                 ## print from accumulator when have some add/rem lines or end
6375                 # of chunk (flush context lines), or when have add and rem
6376                 # lines and new block is reached (otherwise add/rem lines could
6377                 # be reordered)
6378                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
6379                     (@rem && @add && $class ne $prev_class)) {
6380                         print_diff_lines(\@ctx, \@rem, \@add,
6381                                          $diff_style, $num_parents);
6382                         @ctx = @rem = @add = ();
6383                 }
6384
6385                 ## adding lines to accumulator
6386                 # guardian value
6387                 last unless $line;
6388                 # rem, add or change
6389                 if ($class eq 'rem') {
6390                         push @rem, $line;
6391                 } elsif ($class eq 'add') {
6392                         push @add, $line;
6393                 }
6394                 # context line
6395                 if ($class eq 'ctx') {
6396                         push @ctx, $line;
6397                 }
6398
6399                 $prev_class = $class;
6400         }
6401 }
6402
6403 sub git_patchset_body {
6404         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
6405         my ($hash_parent) = $hash_parents[0];
6406
6407         my $is_combined = (@hash_parents > 1);
6408         my $patch_idx = 0;
6409         my $patch_number = 0;
6410         my $patch_line;
6411         my $diffinfo;
6412         my $to_name;
6413         my (%from, %to);
6414         my @chunk; # for side-by-side diff
6415
6416         print "<div class=\"patchset\">\n";
6417
6418         # skip to first patch
6419         while ($patch_line = to_utf8(scalar <$fd>)) {
6420                 chomp $patch_line;
6421
6422                 last if ($patch_line =~ m/^diff /);
6423         }
6424
6425  PATCH:
6426         while ($patch_line) {
6427
6428                 # parse "git diff" header line
6429                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
6430                         # $1 is from_name, which we do not use
6431                         $to_name = unquote($2);
6432                         $to_name =~ s!^b/!!;
6433                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
6434                         # $1 is 'cc' or 'combined', which we do not use
6435                         $to_name = unquote($2);
6436                 } else {
6437                         $to_name = undef;
6438                 }
6439
6440                 # check if current patch belong to current raw line
6441                 # and parse raw git-diff line if needed
6442                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
6443                         # this is continuation of a split patch
6444                         print "<div class=\"patch cont\">\n";
6445                 } else {
6446                         # advance raw git-diff output if needed
6447                         $patch_idx++ if defined $diffinfo;
6448
6449                         # read and prepare patch information
6450                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6451
6452                         # compact combined diff output can have some patches skipped
6453                         # find which patch (using pathname of result) we are at now;
6454                         if ($is_combined) {
6455                                 while ($to_name ne $diffinfo->{'to_file'}) {
6456                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6457                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
6458                                               "</div>\n";  # class="patch"
6459
6460                                         $patch_idx++;
6461                                         $patch_number++;
6462
6463                                         last if $patch_idx > $#$difftree;
6464                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6465                                 }
6466                         }
6467
6468                         # modifies %from, %to hashes
6469                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
6470
6471                         # this is first patch for raw difftree line with $patch_idx index
6472                         # we index @$difftree array from 0, but number patches from 1
6473                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
6474                 }
6475
6476                 # git diff header
6477                 #assert($patch_line =~ m/^diff /) if DEBUG;
6478                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
6479                 $patch_number++;
6480                 # print "git diff" header
6481                 print format_git_diff_header_line($patch_line, $diffinfo,
6482                                                   \%from, \%to);
6483
6484                 # print extended diff header
6485                 print "<div class=\"diff extended_header\">\n";
6486         EXTENDED_HEADER:
6487                 while ($patch_line = to_utf8(scalar<$fd>)) {
6488                         chomp $patch_line;
6489
6490                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
6491
6492                         print format_extended_diff_header_line($patch_line, $diffinfo,
6493                                                                \%from, \%to);
6494                 }
6495                 print "</div>\n"; # class="diff extended_header"
6496
6497                 # from-file/to-file diff header
6498                 if (! $patch_line) {
6499                         print "</div>\n"; # class="patch"
6500                         last PATCH;
6501                 }
6502                 next PATCH if ($patch_line =~ m/^diff /);
6503                 #assert($patch_line =~ m/^---/) if DEBUG;
6504
6505                 my $last_patch_line = $patch_line;
6506                 $patch_line = to_utf8(scalar <$fd>);
6507                 chomp $patch_line;
6508                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
6509
6510                 print format_diff_from_to_header($last_patch_line, $patch_line,
6511                                                  $diffinfo, \%from, \%to,
6512                                                  @hash_parents);
6513
6514                 # the patch itself
6515         LINE:
6516                 while ($patch_line = to_utf8(scalar <$fd>)) {
6517                         chomp $patch_line;
6518
6519                         next PATCH if ($patch_line =~ m/^diff /);
6520
6521                         my $class = diff_line_class($patch_line, \%from, \%to);
6522
6523                         if ($class eq 'chunk_header') {
6524                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6525                                 @chunk = ();
6526                         }
6527
6528                         push @chunk, [ $class, $patch_line ];
6529                 }
6530
6531         } continue {
6532                 if (@chunk) {
6533                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6534                         @chunk = ();
6535                 }
6536                 print "</div>\n"; # class="patch"
6537         }
6538
6539         # for compact combined (--cc) format, with chunk and patch simplification
6540         # the patchset might be empty, but there might be unprocessed raw lines
6541         for (++$patch_idx if $patch_number > 0;
6542              $patch_idx < @$difftree;
6543              ++$patch_idx) {
6544                 # read and prepare patch information
6545                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6546
6547                 # generate anchor for "patch" links in difftree / whatchanged part
6548                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6549                       format_diff_cc_simplified($diffinfo, @hash_parents) .
6550                       "</div>\n";  # class="patch"
6551
6552                 $patch_number++;
6553         }
6554
6555         if ($patch_number == 0) {
6556                 if (@hash_parents > 1) {
6557                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
6558                 } else {
6559                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
6560                 }
6561         }
6562
6563         print "</div>\n"; # class="patchset"
6564 }
6565
6566 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6567
6568 sub git_project_search_form {
6569         my ($searchtext, $search_use_regexp) = @_;
6570
6571         my $limit = '';
6572         if ($project_filter) {
6573                 $limit = " in '$project_filter'";
6574         }
6575
6576         print "<div class=\"projsearch\">\n";
6577         print $cgi->start_form(-method => 'get', -action => $my_uri) .
6578               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
6579         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
6580                 if (defined $project_filter);
6581         print $cgi->textfield(-name => 's', -value => $searchtext,
6582                               -title => "Search project by name and description$limit",
6583                               -size => 60) . "\n" .
6584               "<span title=\"Extended regular expression\">" .
6585               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
6586                              -checked => $search_use_regexp) .
6587               "</span>\n" .
6588               $cgi->submit(-name => 'btnS', -value => 'Search') .
6589               $cgi->end_form() . "\n" .
6590               "<span class=\"projectlist_link\">" .
6591               $cgi->a({-href => href(project => undef, searchtext => undef,
6592                                      action => 'project_list',
6593                                      project_filter => $project_filter)},
6594                       esc_html("List all projects$limit")) . "</span><br />\n";
6595         print "<span class=\"projectlist_link\">" .
6596               $cgi->a({-href => href(project => undef, searchtext => undef,
6597                                      action => 'project_list',
6598                                      project_filter => undef)},
6599                       esc_html("List all projects")) . "</span>\n" if $project_filter;
6600         print "</div>\n";
6601 }
6602
6603 # entry for given @keys needs filling if at least one of keys in list
6604 # is not present in %$project_info
6605 sub project_info_needs_filling {
6606         my ($project_info, @keys) = @_;
6607
6608         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
6609         foreach my $key (@keys) {
6610                 if (!exists $project_info->{$key}) {
6611                         return 1;
6612                 }
6613         }
6614         return;
6615 }
6616
6617 sub git_cache_file_format {
6618         return GITWEB_CACHE_FORMAT .
6619                 (gitweb_check_feature('forks') ? " (forks)" : "");
6620 }
6621
6622 sub git_retrieve_cache_file {
6623         my $cache_file = shift;
6624
6625         use Storable qw(retrieve);
6626
6627         if ((my $dump = eval { retrieve($cache_file) })) {
6628                 return $$dump[1] if
6629                         ref($dump) eq 'ARRAY' &&
6630                         @$dump == 2 &&
6631                         ref($$dump[1]) eq 'ARRAY' &&
6632                         @{$$dump[1]} == 2 &&
6633                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
6634                         ref(${$$dump[1]}[1]) eq 'HASH' &&
6635                         $$dump[0] eq git_cache_file_format();
6636         }
6637
6638         return undef;
6639 }
6640
6641 sub git_store_cache_file {
6642         my ($cache_file, $cachedata) = @_;
6643
6644         use File::Basename qw(dirname);
6645         use File::stat;
6646         use POSIX qw(:fcntl_h);
6647         use Storable qw(store_fd);
6648
6649         my $result = undef;
6650         my $cache_d = dirname($cache_file);
6651         my $mask = umask();
6652         umask($mask & ~0070) if $cache_grpshared;
6653         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6654             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6655                 store_fd([git_cache_file_format(), $cachedata], $fd);
6656                 close $fd;
6657                 rename "$cache_file.lock", $cache_file;
6658                 $result = stat($cache_file)->mtime;
6659         }
6660         umask($mask) if $cache_grpshared;
6661         return $result;
6662 }
6663
6664 sub verify_cached_project {
6665         my ($hashref, $path) = @_;
6666         return undef unless $path;
6667         delete $$hashref{$path}, return undef unless is_valid_project($path);
6668         return $$hashref{$path} if exists $$hashref{$path};
6669
6670         # A valid project was requested but it's not yet in the cache
6671         # Manufacture a minimal project entry (path, name, description)
6672         # Also provide age, but only if it's available via $lastactivity_file
6673
6674         my %proj = ('path' => $path);
6675         my $val = git_get_project_description($path);
6676         defined $val or $val = '';
6677         $proj{'descr_long'} = $val;
6678         $proj{'descr'} = chop_str($val, $projects_list_description_width, 5);
6679         unless ($omit_owner) {
6680                 $val = git_get_project_owner($path);
6681                 defined $val or $val = '';
6682                 $proj{'owner'} = $val;
6683         }
6684         unless ($omit_age_column) {
6685                 ($val) = git_get_last_activity($path, 1);
6686                 $proj{'age_epoch'} = $val if defined $val;
6687         }
6688         $$hashref{$path} = \%proj;
6689         return \%proj;
6690 }
6691
6692 sub git_filter_cached_projects {
6693         my ($cache, $projlist, $verify) = @_;
6694         my $hashref = $$cache[1];
6695         my $sub = $verify ?
6696                 sub {verify_cached_project($hashref, $_[0])} :
6697                 sub {$$hashref{$_[0]}};
6698         return map {
6699                 my $c = &$sub($_->{'path'});
6700                 defined $c ? ($_ = $c) : ()
6701         } @$projlist;
6702 }
6703
6704 # fills project list info (age, description, owner, category, forks, etc.)
6705 # for each project in the list, removing invalid projects from
6706 # returned list, or fill only specified info.
6707 #
6708 # Invalid projects are removed from the returned list if and only if you
6709 # ask 'age_epoch' to be filled, because they are the only fields
6710 # that run unconditionally git command that requires repository, and
6711 # therefore do always check if project repository is invalid.
6712 #
6713 # USAGE:
6714 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6715 #   ensures that 'descr_long' and 'ctags' fields are filled
6716 # * @project_list = fill_project_list_info(\@project_list)
6717 #   ensures that all fields are filled (and invalid projects removed)
6718 #
6719 # NOTE: modifies $projlist, but does not remove entries from it
6720 sub fill_project_list_info {
6721         my ($projlist, @wanted_keys) = @_;
6722
6723         my $rebuild = @wanted_keys && $wanted_keys[0] eq 'rebuild-cache' && shift @wanted_keys;
6724         return fill_project_list_info_uncached($projlist, @wanted_keys)
6725                 unless $projlist_cache_lifetime && $projlist_cache_lifetime > 0;
6726
6727         use File::stat;
6728
6729         my $cache_lifetime = $rebuild ? 0 : $projlist_cache_lifetime;
6730         my $cache_file = "$cache_dir/$projlist_cache_name";
6731
6732         my @projects;
6733         my $stale = 0;
6734         my $now = time();
6735         my $cache_mtime;
6736         if ($cache_lifetime && -f $cache_file) {
6737                 $cache_mtime = stat($cache_file)->mtime;
6738                 $cache_dump = undef if $cache_mtime &&
6739                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6740         }
6741         if (defined $cache_mtime && # caching is on and $cache_file exists
6742             $cache_mtime + $cache_lifetime*60 > $now &&
6743             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6744                 # Cache hit.
6745                 $cache_dump_mtime = $cache_mtime;
6746                 $stale = $now - $cache_mtime;
6747                 my $verify = ($action eq 'summary' || $action eq 'forks') &&
6748                         gitweb_check_feature('forks');
6749                 @projects = git_filter_cached_projects($cache_dump, $projlist, $verify);
6750
6751         } else { # Cache miss.
6752                 if (defined $cache_mtime) {
6753                         # Postpone timeout by two minutes so that we get
6754                         # enough time to do our job, or to be more exact
6755                         # make cache expire after two minutes from now.
6756                         my $time = $now - $cache_lifetime*60 + 120;
6757                         utime $time, $time, $cache_file;
6758                 }
6759                 my @all_projects = git_get_projects_list();
6760                 my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6761                         fill_project_list_info_uncached(\@all_projects);
6762                 map { $all_projects_filled{$_->{'path'}} = $_ }
6763                         filter_forks_from_projects_list([values(%all_projects_filled)])
6764                         if gitweb_check_feature('forks');
6765                 $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6766                                \%all_projects_filled];
6767                 $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6768                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6769         }
6770
6771         if ($cache_lifetime && $stale > 0) {
6772                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6773                         unless $shown_stale_message;
6774                 $shown_stale_message = 1;
6775         }
6776
6777         return @projects;
6778 }
6779
6780 sub fill_project_list_info_uncached {
6781         my ($projlist, @wanted_keys) = @_;
6782         my @projects;
6783         my $filter_set = sub { return @_; };
6784         if (@wanted_keys) {
6785                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6786                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6787         }
6788
6789         my $show_ctags = gitweb_check_feature('ctags');
6790  PROJECT:
6791         foreach my $pr (@$projlist) {
6792                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6793                         my (@activity) = git_get_last_activity($pr->{'path'});
6794                         unless (@activity) {
6795                                 next PROJECT;
6796                         }
6797                         ($pr->{'age_epoch'}) = @activity;
6798                 }
6799                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6800                         my $descr = git_get_project_description($pr->{'path'}) || "";
6801                         $descr = to_utf8($descr);
6802                         $pr->{'descr_long'} = $descr;
6803                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6804                 }
6805                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6806                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6807                 }
6808                 if ($show_ctags &&
6809                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6810                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6811                 }
6812                 if ($projects_list_group_categories &&
6813                     project_info_needs_filling($pr, $filter_set->('category'))) {
6814                         my $cat = git_get_project_category($pr->{'path'}) ||
6815                                                            $project_list_default_category;
6816                         $pr->{'category'} = to_utf8($cat);
6817                 }
6818
6819                 push @projects, $pr;
6820         }
6821
6822         return @projects;
6823 }
6824
6825 sub sort_projects_list {
6826         my ($projlist, $order) = @_;
6827
6828         sub order_str {
6829                 my $key = shift;
6830                 return sub { lc($a->{$key}) cmp lc($b->{$key}) };
6831         }
6832
6833         sub order_reverse_num_then_undef {
6834                 my $key = shift;
6835                 return sub {
6836                         defined $a->{$key} ?
6837                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6838                                 (defined $b->{$key} ? 1 : 0)
6839                 };
6840         }
6841
6842         my %orderings = (
6843                 project => order_str('path'),
6844                 descr => order_str('descr_long'),
6845                 owner => order_str('owner'),
6846                 age => order_reverse_num_then_undef('age_epoch'),
6847         );
6848
6849         my $ordering = $orderings{$order};
6850         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6851 }
6852
6853 # returns a hash of categories, containing the list of project
6854 # belonging to each category
6855 sub build_projlist_by_category {
6856         my ($projlist, $from, $to) = @_;
6857         my %categories;
6858
6859         $from = 0 unless defined $from;
6860         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6861
6862         for (my $i = $from; $i <= $to; $i++) {
6863                 my $pr = $projlist->[$i];
6864                 push @{$categories{ $pr->{'category'} }}, $pr;
6865         }
6866
6867         return wantarray ? %categories : \%categories;
6868 }
6869
6870 # print 'sort by' <th> element, generating 'sort by $name' replay link
6871 # if that order is not selected
6872 sub print_sort_th {
6873         print format_sort_th(@_);
6874 }
6875
6876 sub format_sort_th {
6877         my ($name, $order, $header) = @_;
6878         my $sort_th = "";
6879         $header ||= ucfirst($name);
6880
6881         if ($order eq $name) {
6882                 $sort_th .= "<th>$header</th>\n";
6883         } else {
6884                 $sort_th .= "<th>" .
6885                             $cgi->a({-href => href(-replay=>1, order=>$name),
6886                                      -class => "header"}, $header) .
6887                             "</th>\n";
6888         }
6889
6890         return $sort_th;
6891 }
6892
6893 sub git_project_list_rows {
6894         my ($projlist, $from, $to, $check_forks) = @_;
6895
6896         $from = 0 unless defined $from;
6897         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6898
6899         my $now = time;
6900         my $alternate = 1;
6901         for (my $i = $from; $i <= $to; $i++) {
6902                 my $pr = $projlist->[$i];
6903
6904                 if ($alternate) {
6905                         print "<tr class=\"dark\">\n";
6906                 } else {
6907                         print "<tr class=\"light\">\n";
6908                 }
6909                 $alternate ^= 1;
6910
6911                 if ($check_forks) {
6912                         print "<td>";
6913                         if ($pr->{'forks'}) {
6914                                 my $nforks = scalar @{$pr->{'forks'}};
6915                                 my $s = $nforks == 1 ? '' : 's';
6916                                 if ($nforks > 0) {
6917                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
6918                                                        -title => "$nforks fork$s"}, "+");
6919                                 } else {
6920                                         print $cgi->span({-title => "$nforks fork$s"}, "+");
6921                                 }
6922                         }
6923                         print "</td>\n";
6924                 }
6925                 my $path = $pr->{'path'};
6926                 my $dotgit = $path =~ s/\.git$// ? '.git' : '';
6927                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6928                                         -class => "list"},
6929                                        esc_html_match_hl($path, $search_regexp).$dotgit) .
6930                       "</td>\n" .
6931                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6932                                         -class => "list",
6933                                         -title => $pr->{'descr_long'}},
6934                                         $search_regexp
6935                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
6936                                                                     $pr->{'descr'}, $search_regexp)
6937                                         : esc_html($pr->{'descr'})) .
6938                       "</td>\n";
6939                 unless ($omit_owner) {
6940                         print "<td><i>" . ($owner_link_hook
6941                                           ? $cgi->a({-href => $owner_link_hook->($pr->{'owner'}), -class => "list"},
6942                                                     chop_and_escape_str($pr->{'owner'}, 15))
6943                                           : chop_and_escape_str($pr->{'owner'}, 15)) . "</i></td>\n";
6944                 }
6945                 unless ($omit_age_column) {
6946                         my ($age_epoch, $age_string) = ($pr->{'age_epoch'});
6947                         $age_string = defined $age_epoch ? age_string($age_epoch, $now) : "No commits";
6948                         print "<td class=\"". age_class($age_epoch, $now) . "\">" . $age_string . "</td>\n";
6949                 }
6950                 print"<td class=\"link\">" .
6951                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . $barsep .
6952                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "log") . $barsep .
6953                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
6954                       ($pr->{'forks'} ? $barsep . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
6955                       "</td>\n" .
6956                       "</tr>\n";
6957         }
6958 }
6959
6960 sub git_project_list_body {
6961         # actually uses global variable $project
6962         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action, $keep_top) = @_;
6963         my @projects = @$projlist;
6964
6965         my $check_forks = gitweb_check_feature('forks');
6966         my $show_ctags  = gitweb_check_feature('ctags');
6967         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
6968         $check_forks = undef
6969                 if ($tagfilter || $search_regexp);
6970
6971         # filtering out forks before filling info allows us to do less work
6972         if ($check_forks) {
6973                 @projects = filter_forks_from_projects_list(\@projects);
6974                 push @projects, { 'path' => "$project_filter.git" }
6975                         if $project_filter && $keep_top && is_valid_project("$project_filter.git");
6976         }
6977         # search_projects_list pre-fills required info
6978         @projects = search_projects_list(\@projects,
6979                                          'search_regexp' => $search_regexp,
6980                                          'tagfilter'  => $tagfilter)
6981                 if ($tagfilter || $search_regexp);
6982         # fill the rest
6983         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
6984         push @all_fields, 'age_epoch' unless($omit_age_column);
6985         push @all_fields, 'owner' unless($omit_owner);
6986         @projects = fill_project_list_info(\@projects, @all_fields);
6987
6988         $order ||= $default_projects_order;
6989         $from = 0 unless defined $from;
6990         $to = $#projects if (!defined $to || $#projects < $to);
6991
6992         # short circuit
6993         if ($from > $to) {
6994                 print "<center>\n".
6995                       "<b>No such projects found</b><br />\n".
6996                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
6997                       "</center>\n<br />\n";
6998                 return;
6999         }
7000
7001         @projects = sort_projects_list(\@projects, $order);
7002
7003         if ($show_ctags) {
7004                 my $ctags = git_gather_all_ctags(\@projects);
7005                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
7006                 print git_show_project_tagcloud($cloud, 64);
7007         }
7008
7009         print "<table class=\"project_list\">\n";
7010         unless ($no_header) {
7011                 print "<tr>\n";
7012                 if ($check_forks) {
7013                         print "<th></th>\n";
7014                 }
7015                 print_sort_th('project', $order, 'Project');
7016                 print_sort_th('descr', $order, 'Description');
7017                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
7018                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
7019                 print "<th></th>\n" . # for links
7020                       "</tr>\n";
7021         }
7022
7023         if ($projects_list_group_categories) {
7024                 # only display categories with projects in the $from-$to window
7025                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
7026                 my %categories = build_projlist_by_category(\@projects, $from, $to);
7027                 foreach my $cat (sort keys %categories) {
7028                         unless ($cat eq "") {
7029                                 print "<tr>\n";
7030                                 if ($check_forks) {
7031                                         print "<td></td>\n";
7032                                 }
7033                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
7034                                 print "</tr>\n";
7035                         }
7036
7037                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
7038                 }
7039         } else {
7040                 git_project_list_rows(\@projects, $from, $to, $check_forks);
7041         }
7042
7043         if (defined $extra) {
7044                 print "<tr class=\"extra\">\n";
7045                 if ($check_forks) {
7046                         print "<td></td>\n";
7047                 }
7048                 print "<td colspan=\"5\" class=\"extra\">$extra</td>\n" .
7049                       "</tr>\n";
7050         }
7051         print "</table>\n";
7052 }
7053
7054 sub git_log_body {
7055         # uses global variable $project
7056         my ($commitlist, $from, $to, $refs, $extra) = @_;
7057
7058         $from = 0 unless defined $from;
7059         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7060
7061         for (my $i = 0; $i <= $to; $i++) {
7062                 my %co = %{$commitlist->[$i]};
7063                 next if !%co;
7064                 my $commit = $co{'id'};
7065                 my $ref = format_ref_marker($refs, $commit);
7066                 git_print_header_div('commit',
7067                                "<span class=\"age\">$co{'age_string'}</span>" .
7068                                esc_html($co{'title'}),
7069                                $commit, undef, $ref);
7070                 print "<div class=\"title_text\">\n" .
7071                       "<div class=\"log_link\">\n" .
7072                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
7073                       $barsep .
7074                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
7075                       $barsep .
7076                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
7077                       "<br/>\n" .
7078                       "</div>\n";
7079                       git_print_authorship(\%co, -tag => 'span');
7080                       print "<br/>\n</div>\n";
7081
7082                 print "<div class=\"log_body\">\n";
7083                 git_print_log($co{'comment'}, -final_empty_line=> 1);
7084                 print "</div>\n";
7085         }
7086         if ($extra) {
7087                 print "<div class=\"page_nav_trailer\">\n";
7088                 print "$extra\n";
7089                 print "</div>\n";
7090         }
7091 }
7092
7093 sub git_shortlog_body {
7094         # uses global variable $project
7095         my ($commitlist, $from, $to, $refs, $extra) = @_;
7096
7097         $from = 0 unless defined $from;
7098         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7099
7100         print "<table class=\"shortlog\">\n";
7101         my $alternate = 1;
7102         for (my $i = $from; $i <= $to; $i++) {
7103                 my %co = %{$commitlist->[$i]};
7104                 my $commit = $co{'id'};
7105                 my $ref = format_ref_marker($refs, $commit);
7106                 if ($alternate) {
7107                         print "<tr class=\"dark\">\n";
7108                 } else {
7109                         print "<tr class=\"light\">\n";
7110                 }
7111                 $alternate ^= 1;
7112                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
7113                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7114                       format_author_html('td', \%co, 10) . "<td>";
7115                 print format_subject_html($co{'title'}, $co{'title_short'},
7116                                           href(action=>"commit", hash=>$commit), $ref);
7117                 print "</td>\n" .
7118                       "<td class=\"link\">" .
7119                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . $barsep .
7120                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . $barsep .
7121                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
7122                 my $snapshot_links = format_snapshot_links($commit);
7123                 if (defined $snapshot_links) {
7124                         print $barsep . $snapshot_links;
7125                 }
7126                 print "</td>\n" .
7127                       "</tr>\n";
7128         }
7129         if (defined $extra) {
7130                 print "<tr class=\"extra\">\n" .
7131                       "<td colspan=\"4\" class=\"extra\">$extra</td>\n" .
7132                       "</tr>\n";
7133         }
7134         print "</table>\n";
7135 }
7136
7137 sub git_history_body {
7138         # Warning: assumes constant type (blob or tree) during history
7139         my ($commitlist, $from, $to, $refs, $extra,
7140             $file_name, $file_hash, $ftype) = @_;
7141
7142         $from = 0 unless defined $from;
7143         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
7144
7145         print "<table class=\"history\">\n";
7146         my $alternate = 1;
7147         for (my $i = $from; $i <= $to; $i++) {
7148                 my %co = %{$commitlist->[$i]};
7149                 if (!%co) {
7150                         next;
7151                 }
7152                 my $commit = $co{'id'};
7153
7154                 my $ref = format_ref_marker($refs, $commit);
7155
7156                 if ($alternate) {
7157                         print "<tr class=\"dark\">\n";
7158                 } else {
7159                         print "<tr class=\"light\">\n";
7160                 }
7161                 $alternate ^= 1;
7162                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7163         # shortlog:   format_author_html('td', \%co, 10)
7164                       format_author_html('td', \%co, 15, 3) . "<td>";
7165                 # originally git_history used chop_str($co{'title'}, 50)
7166                 print format_subject_html($co{'title'}, $co{'title_short'},
7167                                           href(action=>"commit", hash=>$commit), $ref);
7168                 print "</td>\n" .
7169                       "<td class=\"link\">" .
7170                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . $barsep .
7171                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
7172
7173                 if ($ftype eq 'blob') {
7174                         my $blob_current = $file_hash;
7175                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
7176                         if (defined $blob_current && defined $blob_parent &&
7177                                         $blob_current ne $blob_parent) {
7178                                 print $barsep .
7179                                         $cgi->a({-href => href(action=>"blobdiff",
7180                                                                hash=>$blob_current, hash_parent=>$blob_parent,
7181                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
7182                                                                file_name=>$file_name)},
7183                                                 "diff to current");
7184                         }
7185                 }
7186                 print "</td>\n" .
7187                       "</tr>\n";
7188         }
7189         if (defined $extra) {
7190                 print "<tr class=\"extra\">\n" .
7191                       "<td colspan=\"4\" class=\"extra\">$extra</td>\n" .
7192                       "</tr>\n";
7193         }
7194         print "</table>\n";
7195 }
7196
7197 sub git_tags_body {
7198         # uses global variable $project
7199         my ($taglist, $from, $to, $extra, $head_at, $full, $order) = @_;
7200         $from = 0 unless defined $from;
7201         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
7202         $order ||= $default_refs_order;
7203
7204         print "<table class=\"tags\">\n";
7205         if ($full) {
7206                 print "<tr class=\"tags_header\">\n";
7207                 print_sort_th('age', $order, 'Last Change');
7208                 print_sort_th('name', $order, 'Name');
7209                 print "<th></th>\n" . # for comment
7210                       "<th></th>\n" . # for tag
7211                       "<th></th>\n" . # for links
7212                       "</tr>\n";
7213         }
7214         my $alternate = 1;
7215         for (my $i = $from; $i <= $to; $i++) {
7216                 my $entry = $taglist->[$i];
7217                 my %tag = %$entry;
7218                 my $comment = $tag{'subject'};
7219                 my $comment_short;
7220                 if (defined $comment) {
7221                         $comment_short = chop_str($comment, 30, 5);
7222                 }
7223                 my $curr = defined $head_at && $tag{'id'} eq $head_at;
7224                 if ($alternate) {
7225                         print "<tr class=\"dark\">\n";
7226                 } else {
7227                         print "<tr class=\"light\">\n";
7228                 }
7229                 $alternate ^= 1;
7230                 if (defined $tag{'age'}) {
7231                         print "<td><i>$tag{'age'}</i></td>\n";
7232                 } else {
7233                         print "<td></td>\n";
7234                 }
7235                 print(($curr ? "<td class=\"current_head\">" : "<td>") .
7236                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
7237                                -class => "list name"}, esc_html($tag{'name'})) .
7238                       "</td>\n" .
7239                       "<td>");
7240                 if (defined $comment) {
7241                         print format_subject_html($comment, $comment_short,
7242                                                   href(action=>"tag", hash=>$tag{'id'}));
7243                 }
7244                 print "</td>\n" .
7245                       "<td class=\"selflink\">";
7246                 if ($tag{'type'} eq "tag") {
7247                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
7248                 } else {
7249                         print "&#160;";
7250                 }
7251                 print "</td>\n" .
7252                       "<td class=\"link\">" . $barsep .
7253                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
7254                 if ($tag{'reftype'} eq "commit") {
7255                         print $barsep . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "log");
7256                         print $barsep . $cgi->a({-href => href(action=>"tree", hash=>$tag{'fullname'})}, "tree") if $full;
7257                 } elsif ($tag{'reftype'} eq "blob") {
7258                         print $barsep . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
7259                 }
7260                 print "</td>\n" .
7261                       "</tr>";
7262         }
7263         if (defined $extra) {
7264                 print "<tr class=\"extra\">\n" .
7265                       "<td colspan=\"5\" class=\"extra\">$extra</td>\n" .
7266                       "</tr>\n";
7267         }
7268         print "</table>\n";
7269 }
7270
7271 sub git_heads_body {
7272         # uses global variable $project
7273         my ($headlist, $head_at, $from, $to, $extra) = @_;
7274         $from = 0 unless defined $from;
7275         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
7276
7277         print "<table class=\"heads\">\n";
7278         my $alternate = 1;
7279         for (my $i = $from; $i <= $to; $i++) {
7280                 my $entry = $headlist->[$i];
7281                 my %ref = %$entry;
7282                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
7283                 if ($alternate) {
7284                         print "<tr class=\"dark\">\n";
7285                 } else {
7286                         print "<tr class=\"light\">\n";
7287                 }
7288                 $alternate ^= 1;
7289                 print "<td><i>$ref{'age'}</i></td>\n" .
7290                       ($curr ? "<td class=\"current_head\">" : "<td>") .
7291                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
7292                                -class => "list name"},esc_html($ref{'name'})) .
7293                       "</td>\n" .
7294                       "<td class=\"link\">" .
7295                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "log") . $barsep .
7296                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
7297                       "</td>\n" .
7298                       "</tr>";
7299         }
7300         if (defined $extra) {
7301                 print "<tr class=\"extra\">\n" .
7302                       "<td colspan=\"3\" class=\"extra\">$extra</td>\n" .
7303                       "</tr>\n";
7304         }
7305         print "</table>\n";
7306 }
7307
7308 # Display a single remote block
7309 sub git_remote_block {
7310         my ($remote, $rdata, $limit, $head) = @_;
7311
7312         my $heads = $rdata->{'heads'};
7313         my $fetch = $rdata->{'fetch'};
7314         my $push = $rdata->{'push'};
7315
7316         my $urls_table = "<table class=\"projects_list\">\n" ;
7317
7318         if (defined $fetch) {
7319                 if ($fetch eq $push) {
7320                         $urls_table .= format_repo_url("URL", $fetch);
7321                 } else {
7322                         $urls_table .= format_repo_url("Fetch&#160;URL", $fetch);
7323                         $urls_table .= format_repo_url("Push&#160;URL", $push) if defined $push;
7324                 }
7325         } elsif (defined $push) {
7326                 $urls_table .= format_repo_url("Push&#160;URL", $push);
7327         } else {
7328                 $urls_table .= format_repo_url("", "No remote URL");
7329         }
7330
7331         $urls_table .= "</table>\n";
7332
7333         my $dots;
7334         if (defined $limit && $limit < @$heads) {
7335                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
7336         }
7337
7338         print $urls_table;
7339         git_heads_body($heads, $head, 0, $limit, $dots);
7340 }
7341
7342 # Display a list of remote names with the respective fetch and push URLs
7343 sub git_remotes_list {
7344         my ($remotedata, $limit) = @_;
7345         print "<table class=\"heads\">\n";
7346         my $alternate = 1;
7347         my @remotes = sort keys %$remotedata;
7348
7349         my $limited = $limit && $limit < @remotes;
7350
7351         $#remotes = $limit - 1 if $limited;
7352
7353         while (my $remote = shift @remotes) {
7354                 my $rdata = $remotedata->{$remote};
7355                 my $fetch = $rdata->{'fetch'};
7356                 my $push = $rdata->{'push'};
7357                 if ($alternate) {
7358                         print "<tr class=\"dark\">\n";
7359                 } else {
7360                         print "<tr class=\"light\">\n";
7361                 }
7362                 $alternate ^= 1;
7363                 print "<td>" .
7364                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
7365                                -class=> "list name"},esc_html($remote)) .
7366                       "</td>";
7367                 print "<td class=\"link\">" .
7368                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
7369                       $barsep .
7370                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
7371                       "</td>";
7372
7373                 print "</tr>\n";
7374         }
7375
7376         if ($limited) {
7377                 print "<tr>\n" .
7378                       "<td colspan=\"3\">" .
7379                       $cgi->a({-href => href(action=>"remotes")}, "...") .
7380                       "</td>\n" . "</tr>\n";
7381         }
7382
7383         print "</table>";
7384 }
7385
7386 # Display remote heads grouped by remote, unless there are too many
7387 # remotes, in which case we only display the remote names
7388 sub git_remotes_body {
7389         my ($remotedata, $limit, $head) = @_;
7390         if ($limit and $limit < keys %$remotedata) {
7391                 git_remotes_list($remotedata, $limit);
7392         } else {
7393                 fill_remote_heads($remotedata);
7394                 while (my ($remote, $rdata) = each %$remotedata) {
7395                         git_print_section({-class=>"remote", -id=>$remote},
7396                                 ["remotes", $remote, $remote], sub {
7397                                         git_remote_block($remote, $rdata, $limit, $head);
7398                                 });
7399                 }
7400         }
7401 }
7402
7403 sub git_search_message {
7404         my %co = @_;
7405
7406         my $greptype;
7407         if ($searchtype eq 'commit') {
7408                 $greptype = "--grep=";
7409         } elsif ($searchtype eq 'author') {
7410                 $greptype = "--author=";
7411         } elsif ($searchtype eq 'committer') {
7412                 $greptype = "--committer=";
7413         }
7414         $greptype .= $searchtext;
7415         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
7416                                        $greptype, '--regexp-ignore-case',
7417                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
7418
7419         my $paging_nav = "<span class=\"paging_nav\">";
7420         if ($page > 0) {
7421                 $paging_nav .= tabspan(
7422                         $cgi->a({-href => href(-replay=>1, page=>undef)},
7423                                 "first")) .
7424                         $mdotsep . tabspan(
7425                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
7426                                  -accesskey => "p", -title => "Alt-p"}, "prev"));
7427         } else {
7428                 $paging_nav .= tabspan("first", 1, 0).${mdotsep}.tabspan("prev", 0, 1);
7429         }
7430         my $next_link = '';
7431         if ($#commitlist >= 100) {
7432                 $next_link = tabspan(
7433                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7434                                  -accesskey => "n", -title => "Alt-n"}, "next"));
7435                 $paging_nav .= "${mdotsep}$next_link";
7436         } else {
7437                 $paging_nav .= ${mdotsep}.tabspan("next", 0, 1);
7438         }
7439
7440         git_header_html();
7441
7442         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav."</span>");
7443         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7444         if ($page == 0 && !@commitlist) {
7445                 print "<p>No match.</p>\n";
7446         } else {
7447                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
7448         }
7449
7450         git_footer_html();
7451 }
7452
7453 sub git_search_changes {
7454         my %co = @_;
7455
7456         local $/ = "\n";
7457         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
7458                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
7459                 ($search_use_regexp ? '--pickaxe-regex' : ()))
7460                         or die_error(500, "Open git-log failed");
7461
7462         git_header_html();
7463
7464         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7465         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7466
7467         print "<table class=\"pickaxe search\">\n";
7468         my $alternate = 1;
7469         undef %co;
7470         my @files;
7471         while (my $line = to_utf8(scalar <$fd>)) {
7472                 chomp $line;
7473                 next unless $line;
7474
7475                 my %set = parse_difftree_raw_line($line);
7476                 if (defined $set{'commit'}) {
7477                         # finish previous commit
7478                         if (%co) {
7479                                 print "</td>\n" .
7480                                       "<td class=\"link\">" .
7481                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7482                                               "commit") .
7483                                       $barsep .
7484                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7485                                                              hash_base=>$co{'id'})},
7486                                               "tree") .
7487                                       "</td>\n" .
7488                                       "</tr>\n";
7489                         }
7490
7491                         if ($alternate) {
7492                                 print "<tr class=\"dark\">\n";
7493                         } else {
7494                                 print "<tr class=\"light\">\n";
7495                         }
7496                         $alternate ^= 1;
7497                         %co = parse_commit($set{'commit'});
7498                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
7499                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7500                               "<td><i>$author</i></td>\n" .
7501                               "<td>" .
7502                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7503                                       -class => "list subject"},
7504                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
7505                 } elsif (defined $set{'to_id'}) {
7506                         next if ($set{'to_id'} =~ m/^0{40}$/);
7507
7508                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
7509                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
7510                                       -class => "list"},
7511                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
7512                               "<br/>\n";
7513                 }
7514         }
7515         close $fd;
7516
7517         # finish last commit (warning: repetition!)
7518         if (%co) {
7519                 print "</td>\n" .
7520                       "<td class=\"link\">" .
7521                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7522                               "commit") .
7523                       $barsep .
7524                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7525                                              hash_base=>$co{'id'})},
7526                               "tree") .
7527                       "</td>\n" .
7528                       "</tr>\n";
7529         }
7530
7531         print "</table>\n";
7532
7533         git_footer_html();
7534 }
7535
7536 sub git_search_files {
7537         my %co = @_;
7538
7539         local $/ = "\n";
7540         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
7541                 $search_use_regexp ? ('-E', '-i') : '-F',
7542                 $searchtext, $co{'tree'})
7543                         or die_error(500, "Open git-grep failed");
7544
7545         git_header_html();
7546
7547         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7548         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7549
7550         print "<table class=\"grep_search\">\n";
7551         my $alternate = 1;
7552         my $matches = 0;
7553         my $lastfile = '';
7554         my $file_href;
7555         while (my $line = to_utf8(scalar <$fd>)) {
7556                 chomp $line;
7557                 my ($file, $lno, $ltext, $binary);
7558                 last if ($matches++ > 1000);
7559                 if ($line =~ /^Binary file (.+) matches$/) {
7560                         $file = $1;
7561                         $binary = 1;
7562                 } else {
7563                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
7564                         $file =~ s/^$co{'tree'}://;
7565                 }
7566                 if ($file ne $lastfile) {
7567                         $lastfile and print "</td></tr>\n";
7568                         if ($alternate++) {
7569                                 print "<tr class=\"dark\">\n";
7570                         } else {
7571                                 print "<tr class=\"light\">\n";
7572                         }
7573                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
7574                                           file_name=>$file);
7575                         print "<td class=\"list\">".
7576                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
7577                         print "</td><td>\n";
7578                         $lastfile = $file;
7579                 }
7580                 if ($binary) {
7581                         print "<div class=\"binary\">Binary file</div>\n";
7582                 } else {
7583                         $ltext = untabify($ltext);
7584                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
7585                                 $ltext = esc_html($1, -nbsp=>1);
7586                                 $ltext .= '<span class="match">';
7587                                 $ltext .= esc_html($2, -nbsp=>1);
7588                                 $ltext .= '</span>';
7589                                 $ltext .= esc_html($3, -nbsp=>1);
7590                         } else {
7591                                 $ltext = esc_html($ltext, -nbsp=>1);
7592                         }
7593                         print "<div class=\"pre\">" .
7594                                 $cgi->a({-href => $file_href.'#l'.$lno,
7595                                         -class => "linenr"}, sprintf('%4i', $lno)) .
7596                                 ' ' .  $ltext . "</div>\n";
7597                 }
7598         }
7599         if ($lastfile) {
7600                 print "</td></tr>\n";
7601                 if ($matches > 1000) {
7602                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
7603                 }
7604         } else {
7605                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
7606         }
7607         close $fd;
7608
7609         print "</table>\n";
7610
7611         git_footer_html();
7612 }
7613
7614 sub git_search_grep_body {
7615         my ($commitlist, $from, $to, $extra) = @_;
7616         $from = 0 unless defined $from;
7617         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7618
7619         print "<table class=\"commit_search\">\n";
7620         my $alternate = 1;
7621         for (my $i = $from; $i <= $to; $i++) {
7622                 my %co = %{$commitlist->[$i]};
7623                 if (!%co) {
7624                         next;
7625                 }
7626                 my $commit = $co{'id'};
7627                 if ($alternate) {
7628                         print "<tr class=\"dark\">\n";
7629                 } else {
7630                         print "<tr class=\"light\">\n";
7631                 }
7632                 $alternate ^= 1;
7633                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7634                       format_author_html('td', \%co, 15, 5) .
7635                       "<td>" .
7636                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7637                                -class => "list subject"},
7638                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
7639                 my $comment = $co{'comment'};
7640                 foreach my $line (@$comment) {
7641                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
7642                                 my ($lead, $match, $trail) = ($1, $2, $3);
7643                                 $match = chop_str($match, 70, 5, 'center');
7644                                 my $contextlen = int((80 - length($match))/2);
7645                                 $contextlen = 30 if ($contextlen > 30);
7646                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
7647                                 $trail = chop_str($trail, $contextlen, 10, 'right');
7648
7649                                 $lead  = esc_html($lead);
7650                                 $match = esc_html($match);
7651                                 $trail = esc_html($trail);
7652
7653                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
7654                         }
7655                 }
7656                 print "</td>\n" .
7657                       "<td class=\"link\">" .
7658                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7659                       $barsep .
7660                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7661                       $barsep .
7662                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7663                 print "</td>\n" .
7664                       "</tr>\n";
7665         }
7666         if (defined $extra) {
7667                 print "<tr class=\"extra\">\n" .
7668                       "<td colspan=\"3\" class=\"extra\">$extra</td>\n" .
7669                       "</tr>\n";
7670         }
7671         print "</table>\n";
7672 }
7673
7674 ## ======================================================================
7675 ## ======================================================================
7676 ## actions
7677
7678 sub git_project_list_load {
7679         my $empty_list_ok = shift;
7680         my $order = $input_params{'order'};
7681         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7682                 die_error(400, "Unknown order parameter");
7683         }
7684
7685         my @list = git_get_projects_list($project_filter, $strict_export);
7686         if ($project_filter && (!@list || !gitweb_check_feature('forks'))) {
7687                 push @list, { 'path' => "$project_filter.git" }
7688                         if is_valid_project("$project_filter.git");
7689         }
7690         if (!@list) {
7691                 die_error(404, "No projects found") unless $empty_list_ok;
7692         }
7693
7694         return (\@list, $order);
7695 }
7696
7697 sub git_frontpage {
7698         my ($projlist, $order);
7699
7700         if ($frontpage_no_project_list) {
7701                 $project = undef;
7702                 $project_filter = undef;
7703         } else {
7704                 ($projlist, $order) = git_project_list_load(1);
7705         }
7706         git_header_html();
7707         if (defined $home_text && -f $home_text) {
7708                 print "<div class=\"index_include\">\n";
7709                 insert_file($home_text);
7710                 print "</div>\n";
7711         }
7712         git_project_search_form($searchtext, $search_use_regexp);
7713         if ($frontpage_no_project_list) {
7714                 my $show_ctags = gitweb_check_feature('ctags');
7715                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7716                         my @projects = git_get_projects_list($project_filter, $strict_export);
7717                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7718                         @projects = fill_project_list_info(\@projects, 'ctags');
7719                         my $ctags = git_gather_all_ctags(\@projects);
7720                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7721                         print git_show_project_tagcloud($cloud, 64);
7722                 }
7723         } else {
7724                 git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7725         }
7726         git_footer_html();
7727 }
7728
7729 sub git_project_list {
7730         my ($projlist, $order) = git_project_list_load();
7731         git_header_html();
7732         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7733                 print "<div class=\"index_include\">\n";
7734                 insert_file($home_text);
7735                 print "</div>\n";
7736         }
7737         git_project_search_form();
7738         git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7739         git_footer_html();
7740 }
7741
7742 sub git_forks {
7743         my $order = $input_params{'order'};
7744         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7745                 die_error(400, "Unknown order parameter");
7746         }
7747
7748         my $filter = $project;
7749         $filter =~ s/\.git$//;
7750         my @list = git_get_projects_list($filter);
7751         if (!@list) {
7752                 die_error(404, "No forks found");
7753         }
7754
7755         git_header_html();
7756         git_print_page_nav('','');
7757         git_print_header_div('summary', "$project forks");
7758         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7759         git_footer_html();
7760 }
7761
7762 sub git_project_index {
7763         my @projects = git_get_projects_list($project_filter, $strict_export);
7764         if (!@projects) {
7765                 die_error(404, "No projects found");
7766         }
7767
7768         print $cgi->header(
7769                 -type => 'text/plain',
7770                 -charset => 'utf-8',
7771                 -content_disposition => 'inline; filename="index.aux"');
7772
7773         foreach my $pr (@projects) {
7774                 if (!exists $pr->{'owner'}) {
7775                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7776                 }
7777
7778                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7779                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7780                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7781                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7782                 $path  =~ s/ /\+/g;
7783                 $owner =~ s/ /\+/g;
7784
7785                 print "$path $owner\n";
7786         }
7787 }
7788
7789 sub git_summary {
7790         my $descr = git_get_project_description($project) || "none";
7791         my %co = parse_commit("HEAD");
7792         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7793         my $head = $co{'id'};
7794         my $remote_heads = gitweb_check_feature('remote_heads');
7795
7796         my $owner = git_get_project_owner($project);
7797         my $homepage = git_get_project_config('homepage');
7798         my $base_url = git_get_project_config('baseurl');
7799
7800         my $refs = git_get_references();
7801         # These get_*_list functions return one more to allow us to see if
7802         # there are more ...
7803         my @taglist  = git_get_tags_list(16);
7804         my @headlist = git_get_heads_list(16);
7805         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7806         my @forklist;
7807         my $check_forks = gitweb_check_feature('forks');
7808
7809         if ($check_forks) {
7810                 # find forks of a project
7811                 my $filter = $project;
7812                 $filter =~ s/\.git$//;
7813                 @forklist = git_get_projects_list($filter);
7814                 # filter out forks of forks
7815                 @forklist = filter_forks_from_projects_list(\@forklist)
7816                         if (@forklist);
7817         }
7818
7819         git_header_html();
7820         git_print_page_nav('summary','', $head);
7821
7822         if ($check_forks and $project =~ m#/#) {
7823                 my $xproject = $project; $xproject =~ s#/[^/]+$#.git#; #
7824                 my $r = $cgi->a({-href=> href(project => $xproject, action => 'summary')}, $xproject);
7825                 print <<EOT;
7826 <div class="forkinfo">
7827 This project is a fork of the $r project. If you have that one
7828 already cloned locally, you can use
7829 <pre>git clone --reference /path/to/your/$xproject/incarnation mirror_URL</pre>
7830 to save bandwidth during cloning.
7831 </div>
7832 EOT
7833         }
7834
7835         print "<div class=\"title\">&#160;</div>\n";
7836         print "<table class=\"projects_list\">\n" .
7837               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7838         if ($homepage) {
7839                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7840         }
7841         if ($base_url) {
7842                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7843         }
7844         if ($owner and not $omit_owner) {
7845                 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . ($owner_link_hook
7846                         ? $cgi->a({-href => $owner_link_hook->($owner)}, email_obfuscate($owner))
7847                         : email_obfuscate($owner)) . "</td></tr>\n";
7848         }
7849         if (defined $cd{'rfc2822'}) {
7850                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7851                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7852         }
7853         print format_lastrefresh_row(), "\n";
7854
7855         # use per project git URL list in $projectroot/$project/cloneurl
7856         # or make project git URL from git base URL and project name
7857         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7858         my @url_list = git_get_project_url_list($project);
7859         @url_list = map { "$_/$project" } @git_base_url_list unless @url_list;
7860         foreach my $git_url (@url_list) {
7861                 next unless $git_url;
7862                 print format_repo_url($url_tag, $git_url);
7863                 $url_tag = "";
7864         }
7865         @url_list = map { "$_/$project" } @git_base_push_urls;
7866         if ((git_get_project_config("showpush", '--bool')||'false') eq "true" ||
7867             -f "$projectroot/$project/.nofetch") {
7868                 $url_tag = "push&#160;URL";
7869                 foreach my $git_push_url (@url_list) {
7870                         next unless $git_push_url;
7871                         my $hint = $https_hint_html && $git_push_url =~ /^https:/i ?
7872                                 "&#160;$https_hint_html" : '';
7873                         print "<tr class=\"metadata_pushurl\"><td>$url_tag</td><td>$git_push_url$hint</td></tr>\n";
7874                         $url_tag = "";
7875                 }
7876         }
7877
7878         if (defined($git_base_bundles_url) && -d "$projectroot/$project/bundles") {
7879                 my $projname = $project;
7880                 $projname =~ s|^.*/||;
7881                 my $url = "$git_base_bundles_url/$project/bundles";
7882                 print format_repo_url(
7883                         "bundle&#160;info",
7884                         "<a rel='nofollow' href='$url'>$projname downloadable bundles</a>");
7885         }
7886
7887         # Tag cloud
7888         my $show_ctags = gitweb_check_feature('ctags');
7889         if ($show_ctags) {
7890                 my $ctags = git_get_project_ctags($project);
7891                 if (%$ctags || $show_ctags !~ /^\d+$/) {
7892                         # without ability to add tags, don't show if there are none
7893                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7894                         print "<tr id=\"metadata_ctags\">" .
7895                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
7896                         print "</td>\n<td>" unless %$ctags;
7897                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
7898                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
7899                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
7900                               unless $show_ctags =~ /^\d+$/;
7901                         print "</td>\n<td>" if %$ctags;
7902                         print git_show_project_tagcloud($cloud, 48)."</td>" .
7903                               "</tr>\n";
7904                 }
7905         }
7906
7907         print "</table>\n";
7908
7909         # If XSS prevention is on, we don't include README.html.
7910         # TODO: Allow a readme in some safe format.
7911         if (!$prevent_xss) {
7912                 my $readme = -s "$projectroot/$project/README.html"
7913                         ? collect_html_file("$projectroot/$project/README.html")
7914                         : collect_output($git_automatic_readme_html, "$projectroot/$project");
7915                 if (defined($readme)) {
7916                         $readme =~ s/^\s+//s;
7917                         $readme =~ s/\s+$//s;
7918                         print "<div class=\"title\">readme</div>\n",
7919                               "<div id=\"readme\" class=\"readme\">\n",
7920                               $readme,
7921                               "\n</div>\n"
7922                         if $readme ne '';
7923                 }
7924         }
7925
7926         # we need to request one more than 16 (0..15) to check if
7927         # those 16 are all
7928         my @commitlist = $head ? parse_commits($head, 17) : ();
7929         if (@commitlist) {
7930                 git_print_header_div('shortlog');
7931                 git_shortlog_body(\@commitlist, 0, 15, $refs,
7932                                   $#commitlist <=  15 ? undef :
7933                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
7934         }
7935
7936         if (@taglist) {
7937                 git_print_header_div('tags');
7938                 git_tags_body(\@taglist, 0, 15,
7939                               $#taglist <=  15 ? undef :
7940                               $cgi->a({-href => href(action=>"tags")}, "..."));
7941         }
7942
7943         if (@headlist) {
7944                 git_print_header_div('heads');
7945                 git_heads_body(\@headlist, $head, 0, 15,
7946                                $#headlist <= 15 ? undef :
7947                                $cgi->a({-href => href(action=>"heads")}, "..."));
7948         }
7949
7950         if (%remotedata) {
7951                 git_print_header_div('remotes');
7952                 git_remotes_body(\%remotedata, 15, $head);
7953         }
7954
7955         if (@forklist) {
7956                 git_print_header_div('forks');
7957                 git_project_list_body(\@forklist, 'age', 0, 15,
7958                                       $#forklist <= 15 ? undef :
7959                                       $cgi->a({-href => href(action=>"forks")}, "..."),
7960                                       'no_header', 'forks');
7961         }
7962
7963         git_footer_html();
7964 }
7965
7966 sub git_tag {
7967         my %tag = parse_tag($hash);
7968
7969         if (! %tag) {
7970                 die_error(404, "Unknown tag object");
7971         }
7972
7973         my $fullhash;
7974         $fullhash = $hash if $hash =~ m/^[0-9a-fA-F]{40}$/;
7975         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
7976
7977         my $head = git_get_head_hash($project);
7978         git_header_html();
7979         git_print_page_nav('','', $head,undef,$head);
7980         git_print_header_div('commit', esc_html($tag{'name'}), $hash);
7981         print "<div class=\"title_text\">\n" .
7982               "<table class=\"object_header\">\n" .
7983               "<tr><td>tag</td><td class=\"sha1\">$fullhash</td></tr>\n" .
7984               "<tr>\n" .
7985               "<td>object</td>\n" .
7986               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7987                                $tag{'object'}) . "</td>\n" .
7988               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7989                                               $tag{'type'}) . "</td>\n" .
7990               "</tr>\n";
7991         if (defined($tag{'author'})) {
7992                 git_print_authorship_rows(\%tag, 'author');
7993         }
7994         print "</table>\n\n" .
7995               "</div>\n";
7996         print "<div class=\"page_body\">";
7997         my $comment = $tag{'comment'};
7998         foreach my $line (@$comment) {
7999                 chomp $line;
8000                 print esc_html($line, -nbsp=>1) . "<br/>\n";
8001         }
8002         print "</div>\n";
8003         git_footer_html();
8004 }
8005
8006 sub git_blame_common {
8007         my $format = shift || 'porcelain';
8008         if ($format eq 'porcelain' && $input_params{'javascript'}) {
8009                 $format = 'incremental';
8010                 $action = 'blame_incremental'; # for page title etc
8011         }
8012
8013         # permissions
8014         gitweb_check_feature('blame')
8015                 or die_error(403, "Blame view not allowed");
8016
8017         # error checking
8018         die_error(400, "No file name given") unless $file_name;
8019         $hash_base ||= git_get_head_hash($project);
8020         die_error(404, "Couldn't find base commit") unless $hash_base;
8021         my %co = parse_commit($hash_base)
8022                 or die_error(404, "Commit not found");
8023         my $ftype = "blob";
8024         if (!defined $hash) {
8025                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
8026                         or die_error(404, "Error looking up file");
8027         } else {
8028                 $ftype = git_get_type($hash);
8029                 if ($ftype !~ "blob") {
8030                         die_error(400, "Object is not a blob");
8031                 }
8032         }
8033
8034         my $fd;
8035         if ($format eq 'incremental') {
8036                 # get file contents (as base)
8037                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
8038                         or die_error(500, "Open git-cat-file failed");
8039         } elsif ($format eq 'data') {
8040                 # run git-blame --incremental
8041                 defined($fd = git_cmd_pipe "blame", "--incremental",
8042                         $hash_base, "--", $file_name)
8043                         or die_error(500, "Open git-blame --incremental failed");
8044         } else {
8045                 # run git-blame --porcelain
8046                 defined($fd = git_cmd_pipe "blame", '-p',
8047                         $hash_base, '--', $file_name)
8048                         or die_error(500, "Open git-blame --porcelain failed");
8049         }
8050
8051         # incremental blame data returns early
8052         if ($format eq 'data') {
8053                 print $cgi->header(
8054                         -type=>"text/plain", -charset => "utf-8",
8055                         -status=> "200 OK");
8056                 local $| = 1; # output autoflush
8057                 while (<$fd>) {
8058                         print to_utf8($_);
8059                 }
8060                 close $fd
8061                         or print "ERROR $!\n";
8062
8063                 print 'END';
8064                 if (defined $t0 && gitweb_check_feature('timed')) {
8065                         print ' '.
8066                               tv_interval($t0, [ gettimeofday() ]).
8067                               ' '.$number_of_git_cmds;
8068                 }
8069                 print "\n";
8070
8071                 return;
8072         }
8073
8074         # page header
8075         git_header_html();
8076         my $formats_nav = tabspan(
8077                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
8078                         "blob"));
8079         $formats_nav .=
8080                 $barsep . tabspan(
8081                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8082                         "history")) .
8083                 $barsep . tabspan(
8084                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
8085                         "HEAD"));
8086         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8087         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8088         git_print_page_path($file_name, $ftype, $hash_base);
8089
8090         # page body
8091         if ($format eq 'incremental') {
8092                 print "<noscript>\n<div class=\"error\"><center><b>\n".
8093                       "This page requires JavaScript to run.\n Use ".
8094                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
8095                               'this page').
8096                       " instead.\n".
8097                       "</b></center></div>\n</noscript>\n";
8098
8099                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
8100         }
8101
8102         print qq!<div class="page_body">\n!;
8103         print qq!<div id="progress_info">... / ...</div>\n!
8104                 if ($format eq 'incremental');
8105         print qq!<table id="blame_table" class="blame" width="100%">\n!.
8106               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
8107               qq!<thead>\n!.
8108               qq!<tr><th nowrap="nowrap" style="white-space:nowrap">!.
8109               qq!Commit&#160;<a href="javascript:extra_blame_columns()" id="columns_expander" !.
8110               qq!title="toggles blame author information display">[+]</a></th>!.
8111               qq!<th class="extra_column">Author</th><th class="extra_column">Date</th>!.
8112               qq!<th>Line</th><th width="100%">Data</th></tr>\n!.
8113               qq!</thead>\n!.
8114               qq!<tbody>\n!;
8115
8116         my @rev_color = qw(light dark);
8117         my $num_colors = scalar(@rev_color);
8118         my $current_color = 0;
8119
8120         if ($format eq 'incremental') {
8121                 my $color_class = $rev_color[$current_color];
8122
8123                 #contents of a file
8124                 my $linenr = 0;
8125         LINE:
8126                 while (my $line = to_utf8(scalar <$fd>)) {
8127                         chomp $line;
8128                         $linenr++;
8129
8130                         print qq!<tr id="l$linenr" class="$color_class">!.
8131                               qq!<td class="sha1"><a href=""> </a></td>!.
8132                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8133                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8134                               qq!<td class="linenr">!.
8135                               qq!<a class="linenr" href="">$linenr</a></td>!;
8136                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
8137                         print qq!</tr>\n!;
8138                 }
8139
8140         } else { # porcelain, i.e. ordinary blame
8141                 my %metainfo = (); # saves information about commits
8142
8143                 # blame data
8144         LINE:
8145                 while (my $line = to_utf8(scalar <$fd>)) {
8146                         chomp $line;
8147                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
8148                         # no <lines in group> for subsequent lines in group of lines
8149                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
8150                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
8151                         if (!exists $metainfo{$full_rev}) {
8152                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
8153                         }
8154                         my $meta = $metainfo{$full_rev};
8155                         my $data;
8156                         while ($data = to_utf8(scalar <$fd>)) {
8157                                 chomp $data;
8158                                 last if ($data =~ s/^\t//); # contents of line
8159                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
8160                                         $meta->{$1} = $2 unless exists $meta->{$1};
8161                                 }
8162                                 if ($data =~ /^previous /) {
8163                                         $meta->{'nprevious'}++;
8164                                 }
8165                         }
8166                         my $short_rev = substr($full_rev, 0, 8);
8167                         my $author = $meta->{'author'};
8168                         my %date =
8169                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
8170                         my $date = $date{'iso-tz'};
8171                         if ($group_size) {
8172                                 $current_color = ($current_color + 1) % $num_colors;
8173                         }
8174                         my $tr_class = $rev_color[$current_color];
8175                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
8176                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
8177                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
8178                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
8179                         if ($group_size) {
8180                                 my $rowspan = $group_size > 1 ? " rowspan=\"$group_size\"" : "";
8181                                 print "<td class=\"sha1\"";
8182                                 print " title=\"". esc_html($author) . ", $date\"";
8183                                 print "$rowspan>";
8184                                 print $cgi->a({-href => href(action=>"commit",
8185                                                              hash=>$full_rev,
8186                                                              file_name=>$file_name)},
8187                                               esc_html($short_rev));
8188                                 if ($group_size >= 2) {
8189                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
8190                                         if (@author_initials) {
8191                                                 print "<br />" .
8192                                                       esc_html(join('', @author_initials));
8193                                                 #           or join('.', ...)
8194                                         }
8195                                 }
8196                                 print "</td>\n";
8197                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". esc_html($author) . "</td>";
8198                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". $date . "</td>";
8199                         }
8200                         # 'previous' <sha1 of parent commit> <filename at commit>
8201                         if (exists $meta->{'previous'} &&
8202                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
8203                                 $meta->{'parent'} = $1;
8204                                 $meta->{'file_parent'} = unquote($2);
8205                         }
8206                         my $linenr_commit =
8207                                 exists($meta->{'parent'}) ?
8208                                 $meta->{'parent'} : $full_rev;
8209                         my $linenr_filename =
8210                                 exists($meta->{'file_parent'}) ?
8211                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
8212                         my $blamed = href(action => 'blame',
8213                                           file_name => $linenr_filename,
8214                                           hash_base => $linenr_commit);
8215                         print "<td class=\"linenr\">";
8216                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
8217                                         -class => "linenr" },
8218                                       esc_html($lineno));
8219                         print "</td>";
8220                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
8221                         print "</tr>\n";
8222                 } # end while
8223
8224         }
8225
8226         # footer
8227         print "</tbody>\n".
8228               "</table>\n"; # class="blame"
8229         print "</div>\n";   # class="blame_body"
8230         close $fd
8231                 or print "Reading blob failed\n";
8232
8233         git_footer_html();
8234 }
8235
8236 sub git_blame {
8237         git_blame_common();
8238 }
8239
8240 sub git_blame_incremental {
8241         git_blame_common('incremental');
8242 }
8243
8244 sub git_blame_data {
8245         git_blame_common('data');
8246 }
8247
8248 sub git_tags {
8249         my $head = git_get_head_hash($project);
8250         git_header_html();
8251         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
8252         git_print_header_div('summary', $project);
8253
8254         my @tagslist = git_get_tags_list();
8255         if (@tagslist) {
8256                 git_tags_body(\@tagslist);
8257         }
8258         git_footer_html();
8259 }
8260
8261 sub git_refs {
8262         my $order = $input_params{'order'};
8263         if (defined $order && $order !~ m/age|name/) {
8264                 die_error(400, "Unknown order parameter");
8265         }
8266
8267         my $head = git_get_head_hash($project);
8268         git_header_html();
8269         git_print_page_nav('','', $head,undef,$head,format_ref_views('refs'));
8270         git_print_header_div('summary', $project);
8271
8272         my @refslist = git_get_tags_list(undef, 1, $order);
8273         if (@refslist) {
8274                 git_tags_body(\@refslist, undef, undef, undef, $head, 1, $order);
8275         }
8276         git_footer_html();
8277 }
8278
8279 sub git_heads {
8280         my $head = git_get_head_hash($project);
8281         git_header_html();
8282         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
8283         git_print_header_div('summary', $project);
8284
8285         my @headslist = git_get_heads_list();
8286         if (@headslist) {
8287                 git_heads_body(\@headslist, $head);
8288         }
8289         git_footer_html();
8290 }
8291
8292 # used both for single remote view and for list of all the remotes
8293 sub git_remotes {
8294         gitweb_check_feature('remote_heads')
8295                 or die_error(403, "Remote heads view is disabled");
8296
8297         my $head = git_get_head_hash($project);
8298         my $remote = $input_params{'hash'};
8299
8300         my $remotedata = git_get_remotes_list($remote);
8301         die_error(500, "Unable to get remote information") unless defined $remotedata;
8302
8303         unless (%$remotedata) {
8304                 die_error(404, defined $remote ?
8305                         "Remote $remote not found" :
8306                         "No remotes found");
8307         }
8308
8309         git_header_html(undef, undef, -action_extra => $remote);
8310         git_print_page_nav('', '',  $head, undef, $head,
8311                 format_ref_views($remote ? '' : 'remotes'));
8312
8313         fill_remote_heads($remotedata);
8314         if (defined $remote) {
8315                 git_print_header_div('remotes', "$remote remote for $project");
8316                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
8317         } else {
8318                 git_print_header_div('summary', "$project remotes");
8319                 git_remotes_body($remotedata, undef, $head);
8320         }
8321
8322         git_footer_html();
8323 }
8324
8325 sub git_blob_plain {
8326         my $type = shift;
8327         my $expires;
8328
8329         if (!defined $hash) {
8330                 if (defined $file_name) {
8331                         my $base = $hash_base || git_get_head_hash($project);
8332                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8333                                 or die_error(404, "Cannot find file");
8334                 } else {
8335                         die_error(400, "No file name defined");
8336                 }
8337         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8338                 # blobs defined by non-textual hash id's can be cached
8339                 $expires = "+1d";
8340         }
8341
8342         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8343                 or die_error(500, "Open git-cat-file blob '$hash' failed");
8344         binmode($fd);
8345
8346         # content-type (can include charset)
8347         my $leader;
8348         ($type, $leader) = blob_contenttype($fd, $file_name, $type);
8349
8350         # "save as" filename, even when no $file_name is given
8351         my $save_as = "$hash";
8352         if (defined $file_name) {
8353                 $save_as = $file_name;
8354         } elsif ($type =~ m/^text\//) {
8355                 $save_as .= '.txt';
8356         }
8357
8358         # With XSS prevention on, blobs of all types except a few known safe
8359         # ones are served with "Content-Disposition: attachment" to make sure
8360         # they don't run in our security domain.  For certain image types,
8361         # blob view writes an <img> tag referring to blob_plain view, and we
8362         # want to be sure not to break that by serving the image as an
8363         # attachment (though Firefox 3 doesn't seem to care).
8364         my $sandbox = $prevent_xss &&
8365                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
8366
8367         # serve text/* as text/plain
8368         if ($prevent_xss &&
8369             ($type =~ m!^text/[a-z]+\b(.*)$! ||
8370              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
8371                 my $rest = $1;
8372                 $rest = defined $rest ? $rest : '';
8373                 $type = "text/plain$rest";
8374         }
8375
8376         print $cgi->header(
8377                 -type => $type,
8378                 -expires => $expires,
8379                 -content_disposition =>
8380                         ($sandbox ? 'attachment' : 'inline')
8381                         . '; filename="' . $save_as . '"');
8382         binmode STDOUT, ':raw';
8383         $fcgi_raw_mode = 1;
8384         print $leader if defined $leader;
8385         my $buf;
8386         while (read($fd, $buf, 32768)) {
8387                 print $buf;
8388         }
8389         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8390         $fcgi_raw_mode = 0;
8391         close $fd;
8392 }
8393
8394 sub git_blob {
8395         my $expires;
8396
8397         my $fullhash;
8398         if (!defined $hash) {
8399                 if (defined $file_name) {
8400                         my $base = $hash_base || git_get_head_hash($project);
8401                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8402                                 or die_error(404, "Cannot find file");
8403                         $fullhash = $hash;
8404                 } else {
8405                         die_error(400, "No file name defined");
8406                 }
8407         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8408                 # blobs defined by non-textual hash id's can be cached
8409                 $expires = "+1d";
8410                 $fullhash = $hash;
8411         }
8412         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8413
8414         my $have_blame = gitweb_check_feature('blame');
8415         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8416                 or die_error(500, "Couldn't cat $file_name, $hash");
8417         binmode($fd);
8418         my $mimetype = blob_mimetype($fd, $file_name);
8419         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
8420         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
8421                 close $fd;
8422                 return git_blob_plain($mimetype);
8423         }
8424         # we can have blame only for text/* mimetype
8425         $have_blame &&= ($mimetype =~ m!^text/!);
8426
8427         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
8428         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
8429         my $highlight_mode_active;
8430         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
8431
8432         git_header_html(undef, $expires);
8433         my $formats_nav = '';
8434         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8435                 if (defined $file_name) {
8436                         if ($have_blame) {
8437                                 $formats_nav .= tabspan(
8438                                         $cgi->a({-href => href(action=>"blame", -replay=>1),
8439                                                 -class => "blamelink"},
8440                                                 "blame")) .
8441                                         $barsep;
8442                         }
8443                         $formats_nav .= tabspan(
8444                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8445                                         "history")) .
8446                                 $barsep . tabspan(
8447                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8448                                         "raw")) .
8449                                 $barsep . tabspan(
8450                                 $cgi->a({-href => href(action=>"blob",
8451                                                        hash_base=>"HEAD", file_name=>$file_name)},
8452                                         "HEAD"));
8453                 } else {
8454                         $formats_nav .= tabspan(
8455                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8456                                         "raw"));
8457                 }
8458                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8459                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8460         } else {
8461                 print "<div class=\"page_nav\">\n" .
8462                       "<br/><br/></div>\n" .
8463                       "<div class=\"title\">".esc_html($hash)."</div>\n";
8464         }
8465         git_print_page_path($file_name, "blob", $hash_base);
8466         print "<div class=\"title_text\">\n" .
8467               "<table class=\"object_header\">\n";
8468         print "<tr><td>blob</td><td class=\"sha1\">$fullhash</td></tr>\n";
8469         print "</table>".
8470               "</div>\n";
8471         print "<div class=\"page_body\">\n";
8472         if ($mimetype =~ m!^image/!) {
8473                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
8474                 if ($file_name) {
8475                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
8476                 }
8477                 print qq! src="! .
8478                       href(action=>"blob_plain", hash=>$hash,
8479                            hash_base=>$hash_base, file_name=>$file_name) .
8480                       qq!" />\n!;
8481         } else {
8482                 my $nr;
8483                 while (my $line = to_utf8(scalar <$fd>)) {
8484                         chomp $line;
8485                         $nr++;
8486                         $line = untabify($line);
8487                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i</a> %s</div>\n!,
8488                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
8489                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
8490                 }
8491         }
8492         close $fd
8493                 or print "Reading blob failed.\n";
8494         print "</div>";
8495         git_footer_html();
8496 }
8497
8498 sub git_tree {
8499         my $fullhash;
8500         if (!defined $hash_base) {
8501                 $hash_base = "HEAD";
8502         }
8503         if (!defined $hash) {
8504                 if (defined $file_name) {
8505                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
8506                         $fullhash = $hash;
8507                 } else {
8508                         $hash = $hash_base;
8509                 }
8510         }
8511         die_error(404, "No such tree") unless defined($hash);
8512         $fullhash = $hash if !$fullhash && $hash =~ m/^[0-9a-fA-F]{40}$/;
8513         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8514
8515         my $show_sizes = gitweb_check_feature('show-sizes');
8516         my $have_blame = gitweb_check_feature('blame');
8517
8518         my @entries = ();
8519         {
8520                 local $/ = "\0";
8521                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
8522                         ($show_sizes ? '-l' : ()), @extra_options, $hash)
8523                         or die_error(500, "Open git-ls-tree failed");
8524                 @entries = map { chomp; to_utf8($_) } <$fd>;
8525                 close $fd
8526                         or die_error(404, "Reading tree failed");
8527         }
8528
8529         git_header_html();
8530         my $basedir = '';
8531         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8532                 my $refs = git_get_references();
8533                 my $ref = format_ref_marker($refs, $co{'id'});
8534                 my @views_nav = ();
8535                 if (defined $file_name) {
8536                         push @views_nav,
8537                                 tabspan($cgi->a({-href => href(action=>"history", -replay=>1)},
8538                                                 "history")),
8539                                 tabspan($cgi->a({-href => href(action=>"tree",
8540                                                                hash_base=>"HEAD", file_name=>$file_name)},
8541                                                  "HEAD")),
8542                 }
8543                 my $snapshot_links = format_snapshot_links($hash);
8544                 if (defined $snapshot_links) {
8545                         # FIXME: Should be available when we have no hash base as well.
8546                         push @views_nav, $snapshot_links;
8547                 }
8548                 git_print_page_nav('tree','', $hash_base, undef, undef,
8549                                    join($barsep, @views_nav));
8550                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base, undef, $ref);
8551         } else {
8552                 undef $hash_base;
8553                 print "<div class=\"page_nav\">\n";
8554                 print "<br/><br/></div>\n";
8555                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8556         }
8557         if (defined $file_name) {
8558                 $basedir = $file_name;
8559                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
8560                         $basedir .= '/';
8561                 }
8562                 git_print_page_path($file_name, 'tree', $hash_base);
8563         }
8564         print "<div class=\"title_text\">\n" .
8565               "<table class=\"object_header\">\n";
8566         print "<tr><td>tree</td><td class=\"sha1\">$fullhash</td></tr>\n";
8567         print "</table>".
8568               "</div>\n";
8569         print "<div class=\"page_body\">\n";
8570         print "<table class=\"tree\">\n";
8571         my $alternate = 1;
8572         # '..' (top directory) link if possible
8573         if (defined $hash_base &&
8574             defined $file_name && $file_name =~ m![^/]+$!) {
8575                 if ($alternate) {
8576                         print "<tr class=\"dark\">\n";
8577                 } else {
8578                         print "<tr class=\"light\">\n";
8579                 }
8580                 $alternate ^= 1;
8581
8582                 my $up = $file_name;
8583                 $up =~ s!/?[^/]+$!!;
8584                 undef $up unless $up;
8585                 # based on git_print_tree_entry
8586                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
8587                 print '<td class="size">&#160;</td>'."\n" if $show_sizes;
8588                 print '<td class="list">';
8589                 print $cgi->a({-href => href(action=>"tree",
8590                                              hash_base=>$hash_base,
8591                                              file_name=>$up)},
8592                               "..");
8593                 print "</td>\n";
8594                 print "<td class=\"link\"></td>\n";
8595
8596                 print "</tr>\n";
8597         }
8598         foreach my $line (@entries) {
8599                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
8600
8601                 if ($alternate) {
8602                         print "<tr class=\"dark\">\n";
8603                 } else {
8604                         print "<tr class=\"light\">\n";
8605                 }
8606                 $alternate ^= 1;
8607
8608                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
8609
8610                 print "</tr>\n";
8611         }
8612         print "</table>\n" .
8613               "</div>";
8614         git_footer_html();
8615 }
8616
8617 sub sanitize_for_filename {
8618     my $name = shift;
8619
8620     $name =~ s!/!-!g;
8621     $name =~ s/[^[:alnum:]_.-]//g;
8622
8623     return $name;
8624 }
8625
8626 sub snapshot_name {
8627         my ($project, $hash) = @_;
8628
8629         # path/to/project.git  -> project
8630         # path/to/project/.git -> project
8631         my $name = to_utf8($project);
8632         $name =~ s,([^/])/*\.git$,$1,;
8633         $name = sanitize_for_filename(basename($name));
8634
8635         my $ver = $hash;
8636         if ($hash =~ /^[0-9a-fA-F]+$/) {
8637                 # shorten SHA-1 hash
8638                 my $full_hash = git_get_full_hash($project, $hash);
8639                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
8640                         $ver = git_get_short_hash($project, $hash);
8641                 }
8642         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
8643                 # tags don't need shortened SHA-1 hash
8644                 $ver = $1;
8645         } else {
8646                 # branches and other need shortened SHA-1 hash
8647                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
8648                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
8649                         my $ref_dir = (defined $1) ? $1 : '';
8650                         $ver = $2;
8651
8652                         $ref_dir = sanitize_for_filename($ref_dir);
8653                         # for refs neither in heads nor remotes we want to
8654                         # add a ref dir to archive name
8655                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
8656                                 $ver = $ref_dir . '-' . $ver;
8657                         }
8658                 }
8659                 $ver .= '-' . git_get_short_hash($project, $hash);
8660         }
8661         # special case of sanitization for filename - we change
8662         # slashes to dots instead of dashes
8663         # in case of hierarchical branch names
8664         $ver =~ s!/!.!g;
8665         $ver =~ s/[^[:alnum:]_.-]//g;
8666
8667         # name = project-version_string
8668         $name = "$name-$ver";
8669
8670         return wantarray ? ($name, $name) : $name;
8671 }
8672
8673 sub exit_if_unmodified_since {
8674         my ($latest_epoch) = @_;
8675         our $cgi;
8676
8677         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
8678         if (defined $if_modified) {
8679                 my $since;
8680                 if (eval { require HTTP::Date; 1; }) {
8681                         $since = HTTP::Date::str2time($if_modified);
8682                 } elsif (eval { require Time::ParseDate; 1; }) {
8683                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
8684                 }
8685                 if (defined $since && $latest_epoch <= $since) {
8686                         my %latest_date = parse_date($latest_epoch);
8687                         print $cgi->header(
8688                                 -last_modified => $latest_date{'rfc2822'},
8689                                 -status => '304 Not Modified');
8690                         CORE::die;
8691                 }
8692         }
8693 }
8694
8695 sub git_snapshot {
8696         my $format = $input_params{'snapshot_format'};
8697         if (!@snapshot_fmts) {
8698                 die_error(403, "Snapshots not allowed");
8699         }
8700         # default to first supported snapshot format
8701         $format ||= $snapshot_fmts[0];
8702         if ($format !~ m/^[a-z0-9]+$/) {
8703                 die_error(400, "Invalid snapshot format parameter");
8704         } elsif (!exists($known_snapshot_formats{$format})) {
8705                 die_error(400, "Unknown snapshot format");
8706         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
8707                 die_error(403, "Snapshot format not allowed");
8708         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
8709                 die_error(403, "Unsupported snapshot format");
8710         }
8711
8712         my $type = git_get_type("$hash^{}");
8713         if (!$type) {
8714                 die_error(404, 'Object does not exist');
8715         }  elsif ($type eq 'blob') {
8716                 die_error(400, 'Object is not a tree-ish');
8717         }
8718
8719         my ($name, $prefix) = snapshot_name($project, $hash);
8720         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
8721
8722         my %co = parse_commit($hash);
8723         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
8724
8725         my @cmd = (
8726                 git_cmd(), 'archive',
8727                 "--format=$known_snapshot_formats{$format}{'format'}",
8728                 "--prefix=$prefix/", $hash);
8729         if (exists $known_snapshot_formats{$format}{'compressor'}) {
8730                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
8731                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
8732         }
8733
8734         $filename =~ s/(["\\])/\\$1/g;
8735         my %latest_date;
8736         if (%co) {
8737                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
8738         }
8739
8740         print $cgi->header(
8741                 -type => $known_snapshot_formats{$format}{'type'},
8742                 -content_disposition => 'inline; filename="' . $filename . '"',
8743                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8744                 -status => '200 OK');
8745
8746         defined(my $fd = cmd_pipe @cmd)
8747                 or die_error(500, "Execute git-archive failed");
8748         binmode($fd);
8749         binmode STDOUT, ':raw';
8750         $fcgi_raw_mode = 1;
8751         my $buf;
8752         while (read($fd, $buf, 32768)) {
8753                 print $buf;
8754         }
8755         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8756         $fcgi_raw_mode = 0;
8757         close $fd;
8758 }
8759
8760 sub git_log_generic {
8761         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8762
8763         my $head = git_get_head_hash($project);
8764         if (!defined $base) {
8765                 $base = $head;
8766         }
8767         if (!defined $page) {
8768                 $page = 0;
8769         }
8770         my $refs = git_get_references();
8771
8772         my $commit_hash = $base;
8773         if (defined $parent) {
8774                 $commit_hash = "$parent..$base";
8775         }
8776         my @commitlist =
8777                 parse_commits($commit_hash, 101, (100 * $page),
8778                               defined $file_name ? ($file_name, "--full-history") : ());
8779
8780         my $ftype;
8781         if (!defined $file_hash && defined $file_name) {
8782                 # some commits could have deleted file in question,
8783                 # and not have it in tree, but one of them has to have it
8784                 for (my $i = 0; $i < @commitlist; $i++) {
8785                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8786                         last if defined $file_hash;
8787                 }
8788         }
8789         if (defined $file_hash) {
8790                 $ftype = git_get_type($file_hash);
8791         }
8792         if (defined $file_name && !defined $ftype) {
8793                 die_error(500, "Unknown type of object");
8794         }
8795         my %co;
8796         if (defined $file_name) {
8797                 %co = parse_commit($base)
8798                         or die_error(404, "Unknown commit object");
8799         }
8800
8801
8802         my $next_link = '';
8803         if ($#commitlist >= 100) {
8804                 $next_link =
8805                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8806                                  -accesskey => "n", -title => "Alt-n"}, "next");
8807         }
8808         my $extra = '';
8809         my ($patch_max) = gitweb_get_feature('patches');
8810         if ($patch_max && !defined $file_name) {
8811                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8812                         $extra = $cgi->a({-href => href(action=>"patches", -replay=>1)},
8813                                         "patches");
8814                 }
8815         }
8816         my $paging_nav = format_log_nav($fmt_name, $page, $#commitlist >= 100, $extra);
8817
8818         {
8819                 local $action = 'fulllog';
8820                 git_header_html();
8821         }
8822         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8823         if (defined $file_name) {
8824                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8825         } else {
8826                 git_print_header_div('summary', $project)
8827         }
8828         git_print_page_path($file_name, $ftype, $hash_base)
8829                 if (defined $file_name);
8830
8831         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8832                      $file_name, $file_hash, $ftype);
8833
8834         git_footer_html();
8835 }
8836
8837 sub git_log {
8838         git_log_generic('log', \&git_log_body,
8839                         $hash, $hash_parent);
8840 }
8841
8842 sub git_commit {
8843         $hash ||= $hash_base || "HEAD";
8844         my %co = parse_commit($hash)
8845             or die_error(404, "Unknown commit object");
8846
8847         my $parent  = $co{'parent'};
8848         my $parents = $co{'parents'}; # listref
8849
8850         # we need to prepare $formats_nav before any parameter munging
8851         my $formats_nav;
8852         if (!defined $parent) {
8853                 # --root commitdiff
8854                 $formats_nav .= '<span class="parents none">(initial)</span>';
8855         } elsif (@$parents == 1) {
8856                 # single parent commit
8857                 $formats_nav .=
8858                         '<span class="parents single">(parent:&#160;' .
8859                         $cgi->a({-href => href(action=>"commit",
8860                                                hash=>$parent)},
8861                                 esc_html(substr($parent, 0, 7))) .
8862                         ')</span>';
8863         } else {
8864                 # merge commit
8865                 $formats_nav .=
8866                         '<span class="parents multiple">(merge:&#160;' .
8867                         join(' ', map {
8868                                 $cgi->a({-href => href(action=>"commit",
8869                                                        hash=>$_)},
8870                                         esc_html(substr($_, 0, 7)));
8871                         } @$parents ) .
8872                         ')</span>';
8873         }
8874         if (gitweb_check_feature('patches') && @$parents <= 1) {
8875                 $formats_nav .= $barsep . tabspan(
8876                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
8877                                 "patch"));
8878         }
8879
8880         if (!defined $parent) {
8881                 $parent = "--root";
8882         }
8883         my @difftree;
8884         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
8885                 @diff_opts,
8886                 (@$parents <= 1 ? $parent : '-c'),
8887                 $hash, "--")
8888                 or die_error(500, "Open git-diff-tree failed");
8889         @difftree = map { chomp; to_utf8($_) } <$fd>;
8890         close $fd or die_error(404, "Reading git-diff-tree failed");
8891
8892         # non-textual hash id's can be cached
8893         my $expires;
8894         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8895                 $expires = "+1d";
8896         }
8897         my $refs = git_get_references();
8898         my $ref = format_ref_marker($refs, $co{'id'});
8899
8900         git_header_html(undef, $expires);
8901         git_print_page_nav('commit', '',
8902                            $hash, $co{'tree'}, $hash,
8903                            $formats_nav);
8904
8905         if (defined $co{'parent'}) {
8906                 git_print_header_div('commitdiff', esc_html($co{'title'}), $hash, undef, $ref);
8907         } else {
8908                 git_print_header_div('tree', esc_html($co{'title'}), $co{'tree'}, $hash, $ref);
8909         }
8910         print "<div class=\"title_text\">\n" .
8911               "<table class=\"object_header\">\n";
8912         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
8913         git_print_authorship_rows(\%co);
8914         print "<tr>" .
8915               "<td>tree</td>" .
8916               "<td class=\"sha1\">" .
8917               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
8918                        class => "list"}, $co{'tree'}) .
8919               "</td>" .
8920               "<td class=\"link\">" .
8921               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
8922                       "tree");
8923         my $snapshot_links = format_snapshot_links($hash);
8924         if (defined $snapshot_links) {
8925                 print $barsep . $snapshot_links;
8926         }
8927         print "</td>" .
8928               "</tr>\n";
8929
8930         foreach my $par (@$parents) {
8931                 print "<tr>" .
8932                       "<td>parent</td>" .
8933                       "<td class=\"sha1\">" .
8934                       $cgi->a({-href => href(action=>"commit", hash=>$par),
8935                                class => "list"}, $par) .
8936                       "</td>" .
8937                       "<td class=\"link\">" .
8938                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
8939                       $barsep .
8940                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
8941                       "</td>" .
8942                       "</tr>\n";
8943         }
8944         print "</table>".
8945               "</div>\n";
8946
8947         print "<div class=\"page_body\">\n";
8948         git_print_log($co{'comment'});
8949         print "</div>\n";
8950
8951         git_difftree_body(\@difftree, $hash, @$parents);
8952
8953         git_footer_html();
8954 }
8955
8956 sub git_object {
8957         # object is defined by:
8958         # - hash or hash_base alone
8959         # - hash_base and file_name
8960         my $type;
8961
8962         # - hash or hash_base alone
8963         if ($hash || ($hash_base && !defined $file_name)) {
8964                 my $object_id = $hash || $hash_base;
8965
8966                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
8967                         or die_error(404, "Object does not exist");
8968                 $type = <$fd>;
8969                 chomp $type;
8970                 close $fd
8971                         or die_error(404, "Object does not exist");
8972
8973         # - hash_base and file_name
8974         } elsif ($hash_base && defined $file_name) {
8975                 $file_name =~ s,/+$,,;
8976
8977                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
8978                         or die_error(404, "Base object does not exist");
8979
8980                 # here errors should not happen
8981                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
8982                         or die_error(500, "Open git-ls-tree failed");
8983                 my $line = to_utf8(scalar <$fd>);
8984                 close $fd;
8985
8986                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
8987                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
8988                         die_error(404, "File or directory for given base does not exist");
8989                 }
8990                 $type = $2;
8991                 $hash = $3;
8992         } else {
8993                 die_error(400, "Not enough information to find object");
8994         }
8995
8996         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
8997                                           hash=>$hash, hash_base=>$hash_base,
8998                                           file_name=>$file_name),
8999                              -status => '302 Found');
9000 }
9001
9002 sub git_blobdiff {
9003         my $format = shift || 'html';
9004         my $diff_style = $input_params{'diff_style'} || 'inline';
9005
9006         my $fd;
9007         my @difftree;
9008         my %diffinfo;
9009         my $expires;
9010
9011         # preparing $fd and %diffinfo for git_patchset_body
9012         # new style URI
9013         if (defined $hash_base && defined $hash_parent_base) {
9014                 if (defined $file_name) {
9015                         # read raw output
9016                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9017                                 $hash_parent_base, $hash_base,
9018                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
9019                                 or die_error(500, "Open git-diff-tree failed");
9020                         @difftree = map { chomp; to_utf8($_) } <$fd>;
9021                         close $fd
9022                                 or die_error(404, "Reading git-diff-tree failed");
9023                         @difftree
9024                                 or die_error(404, "Blob diff not found");
9025
9026                 } elsif (defined $hash &&
9027                          $hash =~ /[0-9a-fA-F]{40}/) {
9028                         # try to find filename from $hash
9029
9030                         # read filtered raw output
9031                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9032                                 $hash_parent_base, $hash_base, "--")
9033                                 or die_error(500, "Open git-diff-tree failed");
9034                         @difftree =
9035                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
9036                                 # $hash == to_id
9037                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
9038                                 map { chomp; to_utf8($_) } <$fd>;
9039                         close $fd
9040                                 or die_error(404, "Reading git-diff-tree failed");
9041                         @difftree
9042                                 or die_error(404, "Blob diff not found");
9043
9044                 } else {
9045                         die_error(400, "Missing one of the blob diff parameters");
9046                 }
9047
9048                 if (@difftree > 1) {
9049                         die_error(400, "Ambiguous blob diff specification");
9050                 }
9051
9052                 %diffinfo = parse_difftree_raw_line($difftree[0]);
9053                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
9054                 $file_name   ||= $diffinfo{'to_file'};
9055
9056                 $hash_parent ||= $diffinfo{'from_id'};
9057                 $hash        ||= $diffinfo{'to_id'};
9058
9059                 # non-textual hash id's can be cached
9060                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
9061                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
9062                         $expires = '+1d';
9063                 }
9064
9065                 # open patch output
9066                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9067                         '-p', ($format eq 'html' ? "--full-index" : ()),
9068                         $hash_parent_base, $hash_base,
9069                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
9070                         or die_error(500, "Open git-diff-tree failed");
9071         }
9072
9073         # old/legacy style URI -- not generated anymore since 1.4.3.
9074         if (!%diffinfo) {
9075                 die_error('404 Not Found', "Missing one of the blob diff parameters")
9076         }
9077
9078         # header
9079         if ($format eq 'html') {
9080                 my $formats_nav =
9081                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
9082                                 "raw");
9083                 $formats_nav .= diff_style_nav($diff_style);
9084                 git_header_html(undef, $expires);
9085                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
9086                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
9087                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
9088                 } else {
9089                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
9090                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
9091                 }
9092                 if (defined $file_name) {
9093                         git_print_page_path($file_name, "blob", $hash_base);
9094                 } else {
9095                         print "<div class=\"page_path\"></div>\n";
9096                 }
9097
9098         } elsif ($format eq 'plain') {
9099                 print $cgi->header(
9100                         -type => 'text/plain',
9101                         -charset => 'utf-8',
9102                         -expires => $expires,
9103                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
9104
9105                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9106
9107         } else {
9108                 die_error(400, "Unknown blobdiff format");
9109         }
9110
9111         # patch
9112         if ($format eq 'html') {
9113                 print "<div class=\"page_body\">\n";
9114
9115                 git_patchset_body($fd, $diff_style,
9116                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
9117                 close $fd;
9118
9119                 print "</div>\n"; # class="page_body"
9120                 git_footer_html();
9121
9122         } else {
9123                 while (my $line = to_utf8(scalar <$fd>)) {
9124                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
9125                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
9126
9127                         print $line;
9128
9129                         last if $line =~ m!^\+\+\+!;
9130                 }
9131                 while (<$fd>) {
9132                         print to_utf8($_);
9133                 }
9134                 close $fd;
9135         }
9136 }
9137
9138 sub git_blobdiff_plain {
9139         git_blobdiff('plain');
9140 }
9141
9142 # assumes that it is added as later part of already existing navigation,
9143 # so it returns "| foo | bar" rather than just "foo | bar"
9144 sub diff_style_nav {
9145         my ($diff_style, $is_combined) = @_;
9146         $diff_style ||= 'inline';
9147
9148         return "" if ($is_combined);
9149
9150         my @styles = (inline => 'inline', 'sidebyside' => 'side&#160;by&#160;side');
9151         my %styles = @styles;
9152         @styles =
9153                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
9154
9155         return $barsep . '<span class="diffstyles">' . join($barsep,
9156                 map {
9157                         $_ eq $diff_style ?
9158                         '<span class="diffstyle selected">' . $styles{$_} . '</span>' :
9159                         '<span class="diffstyle">' .
9160                                 $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_}) .
9161                                 '</span>'
9162                 } @styles) . '</span>';
9163 }
9164
9165 sub git_commitdiff {
9166         my %params = @_;
9167         my $format = $params{-format} || 'html';
9168         my $diff_style = $input_params{'diff_style'} || 'inline';
9169
9170         my ($patch_max) = gitweb_get_feature('patches');
9171         if ($format eq 'patch') {
9172                 die_error(403, "Patch view not allowed") unless $patch_max;
9173         }
9174
9175         $hash ||= $hash_base || "HEAD";
9176         my %co = parse_commit($hash)
9177             or die_error(404, "Unknown commit object");
9178
9179         # choose format for commitdiff for merge
9180         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
9181                 $hash_parent = '--cc';
9182         }
9183         # we need to prepare $formats_nav before almost any parameter munging
9184         my $formats_nav;
9185         if ($format eq 'html') {
9186                 $formats_nav = tabspan(
9187                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
9188                                 "raw"));
9189                 if ($patch_max && @{$co{'parents'}} <= 1) {
9190                         $formats_nav .= $barsep . tabspan(
9191                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
9192                                         "patch"));
9193                 }
9194                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
9195
9196                 if (defined $hash_parent &&
9197                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
9198                         # commitdiff with two commits given
9199                         my $hash_parent_short = $hash_parent;
9200                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
9201                                 $hash_parent_short = substr($hash_parent, 0, 7);
9202                         }
9203                         $formats_nav .= $spcsep . '<span class="parents multiple">' .
9204                                 '(from';
9205                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
9206                                 if ($co{'parents'}[$i] eq $hash_parent) {
9207                                         $formats_nav .= '&#160;parent&#160;' . ($i+1);
9208                                         last;
9209                                 }
9210                         }
9211                         $formats_nav .= ':&#160;' .
9212                                 $cgi->a({-href => href(-replay=>1,
9213                                                        hash=>$hash_parent, hash_base=>undef)},
9214                                         esc_html($hash_parent_short)) .
9215                                 ')</span>';
9216                 } elsif (!$co{'parent'}) {
9217                         # --root commitdiff
9218                         $formats_nav .= $spcsep . '<span class="parents none">(initial)</span>';
9219                 } elsif (scalar @{$co{'parents'}} == 1) {
9220                         # single parent commit
9221                         $formats_nav .= $spcsep .
9222                                 '<span class="parents single">(parent:&#160;' .
9223                                 $cgi->a({-href => href(-replay=>1,
9224                                                        hash=>$co{'parent'}, hash_base=>undef)},
9225                                         esc_html(substr($co{'parent'}, 0, 7))) .
9226                                 ')</span>';
9227                 } else {
9228                         # merge commit
9229                         if ($hash_parent eq '--cc') {
9230                                 $formats_nav .= $barsep . tabspan(
9231                                         $cgi->a({-href => href(-replay=>1,
9232                                                                hash=>$hash, hash_parent=>'-c')},
9233                                                 'combined'));
9234                         } else { # $hash_parent eq '-c'
9235                                 $formats_nav .= $barsep . tabspan(
9236                                         $cgi->a({-href => href(-replay=>1,
9237                                                                hash=>$hash, hash_parent=>'--cc')},
9238                                                 'compact'));
9239                         }
9240                         $formats_nav .= $spcsep .
9241                                 '<span class="parents multiple">(merge:&#160;' .
9242                                 join(' ', map {
9243                                         $cgi->a({-href => href(-replay=>1,
9244                                                                hash=>$_, hash_base=>undef)},
9245                                                 esc_html(substr($_, 0, 7)));
9246                                 } @{$co{'parents'}} ) .
9247                                 ')</span>';
9248                 }
9249         }
9250
9251         my $hash_parent_param = $hash_parent;
9252         if (!defined $hash_parent_param) {
9253                 # --cc for multiple parents, --root for parentless
9254                 $hash_parent_param =
9255                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
9256         }
9257
9258         # read commitdiff
9259         my $fd;
9260         my @difftree;
9261         if ($format eq 'html') {
9262                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9263                         "--no-commit-id", "--patch-with-raw", "--full-index",
9264                         $hash_parent_param, $hash, "--")
9265                         or die_error(500, "Open git-diff-tree failed");
9266
9267                 while (my $line = to_utf8(scalar <$fd>)) {
9268                         chomp $line;
9269                         # empty line ends raw part of diff-tree output
9270                         last unless $line;
9271                         push @difftree, scalar parse_difftree_raw_line($line);
9272                 }
9273
9274         } elsif ($format eq 'plain') {
9275                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9276                         '-p', $hash_parent_param, $hash, "--")
9277                         or die_error(500, "Open git-diff-tree failed");
9278         } elsif ($format eq 'patch') {
9279                 # For commit ranges, we limit the output to the number of
9280                 # patches specified in the 'patches' feature.
9281                 # For single commits, we limit the output to a single patch,
9282                 # diverging from the git-format-patch default.
9283                 my @commit_spec = ();
9284                 if ($hash_parent) {
9285                         if ($patch_max > 0) {
9286                                 push @commit_spec, "-$patch_max";
9287                         }
9288                         push @commit_spec, '-n', "$hash_parent..$hash";
9289                 } else {
9290                         if ($params{-single}) {
9291                                 push @commit_spec, '-1';
9292                         } else {
9293                                 if ($patch_max > 0) {
9294                                         push @commit_spec, "-$patch_max";
9295                                 }
9296                                 push @commit_spec, "-n";
9297                         }
9298                         push @commit_spec, '--root', $hash;
9299                 }
9300                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
9301                         '--encoding=utf8', '--stdout', @commit_spec)
9302                         or die_error(500, "Open git-format-patch failed");
9303         } else {
9304                 die_error(400, "Unknown commitdiff format");
9305         }
9306
9307         # non-textual hash id's can be cached
9308         my $expires;
9309         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9310                 $expires = "+1d";
9311         }
9312
9313         # write commit message
9314         if ($format eq 'html') {
9315                 my $refs = git_get_references();
9316                 my $ref = format_ref_marker($refs, $co{'id'});
9317
9318                 git_header_html(undef, $expires);
9319                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
9320                 git_print_header_div('commit', esc_html($co{'title'}), $hash, undef, $ref);
9321                 print "<div class=\"title_text\">\n" .
9322                       "<table class=\"object_header\">\n";
9323                 git_print_authorship_rows(\%co);
9324                 print "</table>".
9325                       "</div>\n";
9326                 print "<div class=\"page_body\">\n";
9327                 if (@{$co{'comment'}} > 1) {
9328                         print "<div class=\"log\">\n";
9329                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
9330                         print "</div>\n"; # class="log"
9331                 }
9332
9333         } elsif ($format eq 'plain') {
9334                 my $refs = git_get_references("tags");
9335                 my $tagname = git_get_rev_name_tags($hash);
9336                 my $filename = basename($project) . "-$hash.patch";
9337
9338                 print $cgi->header(
9339                         -type => 'text/plain',
9340                         -charset => 'utf-8',
9341                         -expires => $expires,
9342                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9343                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
9344                 print "From: " . to_utf8($co{'author'}) . "\n";
9345                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
9346                 print "Subject: " . to_utf8($co{'title'}) . "\n";
9347
9348                 print "X-Git-Tag: $tagname\n" if $tagname;
9349                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9350
9351                 foreach my $line (@{$co{'comment'}}) {
9352                         print to_utf8($line) . "\n";
9353                 }
9354                 print "---\n\n";
9355         } elsif ($format eq 'patch') {
9356                 my $filename = basename($project) . "-$hash.patch";
9357
9358                 print $cgi->header(
9359                         -type => 'text/plain',
9360                         -charset => 'utf-8',
9361                         -expires => $expires,
9362                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9363         }
9364
9365         # write patch
9366         if ($format eq 'html') {
9367                 my $use_parents = !defined $hash_parent ||
9368                         $hash_parent eq '-c' || $hash_parent eq '--cc';
9369                 git_difftree_body(\@difftree, $hash,
9370                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9371                 print "<br/>\n";
9372
9373                 git_patchset_body($fd, $diff_style,
9374                                   \@difftree, $hash,
9375                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9376                 close $fd;
9377                 print "</div>\n"; # class="page_body"
9378                 git_footer_html();
9379
9380         } elsif ($format eq 'plain') {
9381                 while (<$fd>) {
9382                         print to_utf8($_);
9383                 }
9384                 close $fd
9385                         or print "Reading git-diff-tree failed\n";
9386         } elsif ($format eq 'patch') {
9387                 while (<$fd>) {
9388                         print to_utf8($_);
9389                 }
9390                 close $fd
9391                         or print "Reading git-format-patch failed\n";
9392         }
9393 }
9394
9395 sub git_commitdiff_plain {
9396         git_commitdiff(-format => 'plain');
9397 }
9398
9399 # format-patch-style patches
9400 sub git_patch {
9401         git_commitdiff(-format => 'patch', -single => 1);
9402 }
9403
9404 sub git_patches {
9405         git_commitdiff(-format => 'patch');
9406 }
9407
9408 sub git_history {
9409         git_log_generic('history', \&git_history_body,
9410                         $hash_base, $hash_parent_base,
9411                         $file_name, $hash);
9412 }
9413
9414 sub git_search {
9415         $searchtype ||= 'commit';
9416
9417         # check if appropriate features are enabled
9418         gitweb_check_feature('search')
9419                 or die_error(403, "Search is disabled");
9420         if ($searchtype eq 'pickaxe') {
9421                 # pickaxe may take all resources of your box and run for several minutes
9422                 # with every query - so decide by yourself how public you make this feature
9423                 gitweb_check_feature('pickaxe')
9424                         or die_error(403, "Pickaxe search is disabled");
9425         }
9426         if ($searchtype eq 'grep') {
9427                 # grep search might be potentially CPU-intensive, too
9428                 gitweb_check_feature('grep')
9429                         or die_error(403, "Grep search is disabled");
9430         }
9431
9432         if (!defined $searchtext) {
9433                 die_error(400, "Text field is empty");
9434         }
9435         if (!defined $hash) {
9436                 $hash = git_get_head_hash($project);
9437         }
9438         my %co = parse_commit($hash);
9439         if (!%co) {
9440                 die_error(404, "Unknown commit object");
9441         }
9442         if (!defined $page) {
9443                 $page = 0;
9444         }
9445
9446         if ($searchtype eq 'commit' ||
9447             $searchtype eq 'author' ||
9448             $searchtype eq 'committer') {
9449                 git_search_message(%co);
9450         } elsif ($searchtype eq 'pickaxe') {
9451                 git_search_changes(%co);
9452         } elsif ($searchtype eq 'grep') {
9453                 git_search_files(%co);
9454         } else {
9455                 die_error(400, "Unknown search type");
9456         }
9457 }
9458
9459 sub git_search_help {
9460         git_header_html();
9461         git_print_page_nav('','', $hash,$hash,$hash);
9462         print <<EOT;
9463 <div class="search_help">
9464 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
9465 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
9466 the pattern entered is recognized as the POSIX extended
9467 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
9468 insensitive).</p>
9469 <dl>
9470 <dt><b>commit</b></dt>
9471 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
9472 EOT
9473         my $have_grep = gitweb_check_feature('grep');
9474         if ($have_grep) {
9475                 print <<EOT;
9476 <dt><b>grep</b></dt>
9477 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
9478     a different one) are searched for the given pattern. On large trees, this search can take
9479 a while and put some strain on the server, so please use it with some consideration. Note that
9480 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
9481 case-sensitive.</dd>
9482 EOT
9483         }
9484         print <<EOT;
9485 <dt><b>author</b></dt>
9486 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
9487 <dt><b>committer</b></dt>
9488 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
9489 EOT
9490         my $have_pickaxe = gitweb_check_feature('pickaxe');
9491         if ($have_pickaxe) {
9492                 print <<EOT;
9493 <dt><b>pickaxe</b></dt>
9494 <dd>All commits that caused the string to appear or disappear from any file (changes that
9495 added, removed or "modified" the string) will be listed. This search can take a while and
9496 takes a lot of strain on the server, so please use it wisely. Note that since you may be
9497 interested even in changes just changing the case as well, this search is case sensitive.</dd>
9498 EOT
9499         }
9500         print "</dl>\n</div>\n";
9501         git_footer_html();
9502 }
9503
9504 sub git_shortlog {
9505         git_log_generic('shortlog', \&git_shortlog_body,
9506                         $hash, $hash_parent);
9507 }
9508
9509 ## ......................................................................
9510 ## feeds (RSS, Atom; OPML)
9511
9512 sub git_feed {
9513         my $format = shift || 'atom';
9514         my $have_blame = gitweb_check_feature('blame');
9515
9516         # Atom: http://www.atomenabled.org/developers/syndication/
9517         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
9518         if ($format ne 'rss' && $format ne 'atom') {
9519                 die_error(400, "Unknown web feed format");
9520         }
9521
9522         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
9523         my $head = $hash || 'HEAD';
9524         my @commitlist = parse_commits($head, 150, 0, $file_name);
9525
9526         my %latest_commit;
9527         my %latest_date;
9528         my $content_type = "application/$format+xml";
9529         if (defined $cgi->http('HTTP_ACCEPT') &&
9530                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
9531                 # browser (feed reader) prefers text/xml
9532                 $content_type = 'text/xml';
9533         }
9534         if (defined($commitlist[0])) {
9535                 %latest_commit = %{$commitlist[0]};
9536                 my $latest_epoch = $latest_commit{'committer_epoch'};
9537                 exit_if_unmodified_since($latest_epoch);
9538                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
9539         }
9540         print $cgi->header(
9541                 -type => $content_type,
9542                 -charset => 'utf-8',
9543                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
9544                 -status => '200 OK');
9545
9546         # Optimization: skip generating the body if client asks only
9547         # for Last-Modified date.
9548         return if ($cgi->request_method() eq 'HEAD');
9549
9550         # header variables
9551         my $title = "$site_name - $project/$action";
9552         my $feed_type = 'log';
9553         if (defined $hash) {
9554                 $title .= " - '$hash'";
9555                 $feed_type = 'branch log';
9556                 if (defined $file_name) {
9557                         $title .= " :: $file_name";
9558                         $feed_type = 'history';
9559                 }
9560         } elsif (defined $file_name) {
9561                 $title .= " - $file_name";
9562                 $feed_type = 'history';
9563         }
9564         $title .= " $feed_type";
9565         $title = esc_html($title);
9566         my $descr = git_get_project_description($project);
9567         if (defined $descr) {
9568                 $descr = esc_html($descr);
9569         } else {
9570                 $descr = "$project " .
9571                          ($format eq 'rss' ? 'RSS' : 'Atom') .
9572                          " feed";
9573         }
9574         my $owner = git_get_project_owner($project);
9575         $owner = esc_html($owner);
9576
9577         #header
9578         my $alt_url;
9579         if (defined $file_name) {
9580                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
9581         } elsif (defined $hash) {
9582                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
9583         } else {
9584                 $alt_url = href(-full=>1, action=>"summary");
9585         }
9586         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
9587         if ($format eq 'rss') {
9588                 print <<XML;
9589 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
9590 <channel>
9591 XML
9592                 print "<title>$title</title>\n" .
9593                       "<link>$alt_url</link>\n" .
9594                       "<description>$descr</description>\n" .
9595                       "<language>en</language>\n" .
9596                       # project owner is responsible for 'editorial' content
9597                       "<managingEditor>$owner</managingEditor>\n";
9598                 if (defined $logo || defined $favicon) {
9599                         # prefer the logo to the favicon, since RSS
9600                         # doesn't allow both
9601                         my $img = esc_url($logo || $favicon);
9602                         print "<image>\n" .
9603                               "<url>$img</url>\n" .
9604                               "<title>$title</title>\n" .
9605                               "<link>$alt_url</link>\n" .
9606                               "</image>\n";
9607                 }
9608                 if (%latest_date) {
9609                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
9610                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
9611                 }
9612                 print "<generator>gitweb v.$version/$git_version</generator>\n";
9613         } elsif ($format eq 'atom') {
9614                 print <<XML;
9615 <feed xmlns="http://www.w3.org/2005/Atom">
9616 XML
9617                 print "<title>$title</title>\n" .
9618                       "<subtitle>$descr</subtitle>\n" .
9619                       '<link rel="alternate" type="text/html" href="' .
9620                       $alt_url . '" />' . "\n" .
9621                       '<link rel="self" type="' . $content_type . '" href="' .
9622                       $cgi->self_url() . '" />' . "\n" .
9623                       "<id>" . href(-full=>1) . "</id>\n" .
9624                       # use project owner for feed author
9625                       '<author><name>'. email_obfuscate($owner) . '</name></author>\n';
9626                 if (defined $favicon) {
9627                         print "<icon>" . esc_url($favicon) . "</icon>\n";
9628                 }
9629                 if (defined $logo) {
9630                         # not twice as wide as tall: 72 x 27 pixels
9631                         print "<logo>" . esc_url($logo) . "</logo>\n";
9632                 }
9633                 if (! %latest_date) {
9634                         # dummy date to keep the feed valid until commits trickle in:
9635                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
9636                 } else {
9637                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
9638                 }
9639                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
9640         }
9641
9642         # contents
9643         for (my $i = 0; $i <= $#commitlist; $i++) {
9644                 my %co = %{$commitlist[$i]};
9645                 my $commit = $co{'id'};
9646                 # we read 150, we always show 30 and the ones more recent than 48 hours
9647                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
9648                         last;
9649                 }
9650                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
9651
9652                 # get list of changed files
9653                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9654                         $co{'parent'} || "--root",
9655                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
9656                         or next;
9657                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
9658                 close $fd
9659                         or next;
9660
9661                 # print element (entry, item)
9662                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
9663                 if ($format eq 'rss') {
9664                         print "<item>\n" .
9665                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
9666                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
9667                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
9668                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
9669                               "<link>$co_url</link>\n" .
9670                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
9671                               "<content:encoded>" .
9672                               "<![CDATA[\n";
9673                 } elsif ($format eq 'atom') {
9674                         print "<entry>\n" .
9675                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
9676                               "<updated>$cd{'iso-8601'}</updated>\n" .
9677                               "<author>\n" .
9678                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
9679                         if ($co{'author_email'}) {
9680                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
9681                         }
9682                         print "</author>\n" .
9683                               # use committer for contributor
9684                               "<contributor>\n" .
9685                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
9686                         if ($co{'committer_email'}) {
9687                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
9688                         }
9689                         print "</contributor>\n" .
9690                               "<published>$cd{'iso-8601'}</published>\n" .
9691                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
9692                               "<id>$co_url</id>\n" .
9693                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
9694                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
9695                 }
9696                 my $comment = $co{'comment'};
9697                 print "<pre>\n";
9698                 foreach my $line (@$comment) {
9699                         $line = esc_html($line);
9700                         print "$line\n";
9701                 }
9702                 print "</pre><ul>\n";
9703                 foreach my $difftree_line (@difftree) {
9704                         my %difftree = parse_difftree_raw_line($difftree_line);
9705                         next if !$difftree{'from_id'};
9706
9707                         my $file = $difftree{'file'} || $difftree{'to_file'};
9708
9709                         print "<li>" .
9710                               "[" .
9711                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
9712                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
9713                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
9714                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
9715                                       -title => "diff"}, 'D');
9716                         if ($have_blame) {
9717                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
9718                                                              file_name=>$file, hash_base=>$commit),
9719                                               -class => "blamelink",
9720                                               -title => "blame"}, 'B');
9721                         }
9722                         # if this is not a feed of a file history
9723                         if (!defined $file_name || $file_name ne $file) {
9724                                 print $cgi->a({-href => href(-full=>1, action=>"history",
9725                                                              file_name=>$file, hash=>$commit),
9726                                               -title => "history"}, 'H');
9727                         }
9728                         $file = esc_path($file);
9729                         print "] ".
9730                               "$file</li>\n";
9731                 }
9732                 if ($format eq 'rss') {
9733                         print "</ul>]]>\n" .
9734                               "</content:encoded>\n" .
9735                               "</item>\n";
9736                 } elsif ($format eq 'atom') {
9737                         print "</ul>\n</div>\n" .
9738                               "</content>\n" .
9739                               "</entry>\n";
9740                 }
9741         }
9742
9743         # end of feed
9744         if ($format eq 'rss') {
9745                 print "</channel>\n</rss>\n";
9746         } elsif ($format eq 'atom') {
9747                 print "</feed>\n";
9748         }
9749 }
9750
9751 sub git_rss {
9752         git_feed('rss');
9753 }
9754
9755 sub git_atom {
9756         git_feed('atom');
9757 }
9758
9759 sub git_opml {
9760         my @list = git_get_projects_list($project_filter, $strict_export);
9761         if (!@list) {
9762                 die_error(404, "No projects found");
9763         }
9764
9765         print $cgi->header(
9766                 -type => 'text/xml',
9767                 -charset => 'utf-8',
9768                 -content_disposition => 'inline; filename="opml.xml"');
9769
9770         my $title = esc_html($site_name);
9771         my $filter = " within subdirectory ";
9772         if (defined $project_filter) {
9773                 $filter .= esc_html($project_filter);
9774         } else {
9775                 $filter = "";
9776         }
9777         print <<XML;
9778 <?xml version="1.0" encoding="utf-8"?>
9779 <opml version="1.0">
9780 <head>
9781   <title>$title OPML Export$filter</title>
9782 </head>
9783 <body>
9784 <outline text="git RSS feeds">
9785 XML
9786
9787         foreach my $pr (@list) {
9788                 my %proj = %$pr;
9789                 my $head = git_get_head_hash($proj{'path'});
9790                 if (!defined $head) {
9791                         next;
9792                 }
9793                 $git_dir = "$projectroot/$proj{'path'}";
9794                 my %co = parse_commit($head);
9795                 if (!%co) {
9796                         next;
9797                 }
9798
9799                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9800                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9801                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9802                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9803         }
9804         print <<XML;
9805 </outline>
9806 </body>
9807 </opml>
9808 XML
9809 }