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 constant GITWEB_CACHE_FORMAT => "Gitweb Cache Format 3";
  23 binmode STDOUT, ':utf8';
  24
  25 if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
  26         eval 'sub CGI::multi_param { CGI::param(@_) }'
  27 }
  28
  29 our $t0 = [ gettimeofday() ];
  30 our $number_of_git_cmds = 0;
  31
  32 BEGIN {
  33         CGI->compile() if $ENV{'MOD_PERL'};
  34 }
  35
  36 our $version = "++GIT_VERSION++";
  37
  38 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
  39 sub evaluate_uri {
  40         our $cgi;
  41
  42         our $my_url = $cgi->url();
  43         our $my_uri = $cgi->url(-absolute => 1);
  44
  45         # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
  46         # needed and used only for URLs with nonempty PATH_INFO
  47         our $base_url = $my_url;
  48
  49         # When the script is used as DirectoryIndex, the URL does not contain the name
  50         # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
  51         # have to do it ourselves. We make $path_info global because it's also used
  52         # later on.
  53         #
  54         # Another issue with the script being the DirectoryIndex is that the resulting
  55         # $my_url data is not the full script URL: this is good, because we want
  56         # generated links to keep implying the script name if it wasn't explicitly
  57         # indicated in the URL we're handling, but it means that $my_url cannot be used
  58         # as base URL.
  59         # Therefore, if we needed to strip PATH_INFO, then we know that we have
  60         # to build the base URL ourselves:
  61         our $path_info = decode_utf8($ENV{"PATH_INFO"});
  62         if ($path_info) {
  63                 # $path_info has already been URL-decoded by the web server, but
  64                 # $my_url and $my_uri have not. URL-decode them so we can properly
  65                 # strip $path_info.
  66                 $my_url = unescape($my_url);
  67                 $my_uri = unescape($my_uri);
  68                 if ($my_url =~ s,\Q$path_info\E$,, &&
  69                     $my_uri =~ s,\Q$path_info\E$,, &&
  70                     defined $ENV{'SCRIPT_NAME'}) {
  71                         $base_url = $cgi->url(-base => 1) . $ENV{'SCRIPT_NAME'};
  72                 }
  73         }
  74
  75         # target of the home link on top of all pages
  76         our $home_link = $my_uri || "/";
  77 }
  78
  79 # core git executable to use
  80 # this can just be "git" if your webserver has a sensible PATH
  81 our $GIT = "++GIT_BINDIR++/git";
  82
  83 # absolute fs-path which will be prepended to the project path
  84 #our $projectroot = "/pub/scm";
  85 our $projectroot = "++GITWEB_PROJECTROOT++";
  86
  87 # fs traversing limit for getting project list
  88 # the number is relative to the projectroot
  89 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
  90
  91 # string of the home link on top of all pages
  92 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
  93
  94 # extra breadcrumbs preceding the home link
  95 our @extra_breadcrumbs = ();
  96
  97 # name of your site or organization to appear in page titles
  98 # replace this with something more descriptive for clearer bookmarks
  99 our $site_name = "++GITWEB_SITENAME++"
 100                  || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
 101
 102 # html snippet to include in the <head> section of each page
 103 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
 104 # filename of html text to include at top of each page
 105 our $site_header = "++GITWEB_SITE_HEADER++";
 106 # html text to include at home page
 107 our $home_text = "++GITWEB_HOMETEXT++";
 108 # filename of html text to include at bottom of each page
 109 our $site_footer = "++GITWEB_SITE_FOOTER++";
 110
 111 # URI of stylesheets
 112 our @stylesheets = ("++GITWEB_CSS++");
 113 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
 114 our $stylesheet = undef;
 115 # URI of GIT logo (72x27 size)
 116 our $logo = "++GITWEB_LOGO++";
 117 # URI of GIT favicon, assumed to be image/png type
 118 our $favicon = "++GITWEB_FAVICON++";
 119 # URI of gitweb.js (JavaScript code for gitweb)
 120 our $javascript = "++GITWEB_JS++";
 121
 122 # URI and label (title) of GIT logo link
 123 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
 124 #our $logo_label = "git documentation";
 125 our $logo_url = "http://git-scm.com/";
 126 our $logo_label = "git homepage";
 127
 128 # source of projects list
 129 our $projects_list = "++GITWEB_LIST++";
 130
 131 # the width (in characters) of the projects list "Description" column
 132 our $projects_list_description_width = 25;
 133
 134 # group projects by category on the projects list
 135 # (enabled if this variable evaluates to true)
 136 our $projects_list_group_categories = 0;
 137
 138 # default category if none specified
 139 # (leave the empty string for no category)
 140 our $project_list_default_category = "";
 141
 142 # default order of projects list
 143 # valid values are none, project, descr, owner, and age
 144 our $default_projects_order = "project";
 145
 146 # default order of refs list
 147 # valid values are age and name
 148 our $default_refs_order = "age";
 149
 150 # show repository only if this file exists
 151 # (only effective if this variable evaluates to true)
 152 our $export_ok = "++GITWEB_EXPORT_OK++";
 153
 154 # don't generate age column on the projects list page
 155 our $omit_age_column = 0;
 156
 157 # use contents of this file (in iso, iso-strict or raw format) as
 158 # the last activity data if it exists and is a valid date
 159 our $lastactivity_file = undef;
 160
 161 # don't generate information about owners of repositories
 162 our $omit_owner=0;
 163
 164 # owner link hook given owner name (full and NOT obfuscated)
 165 # should return full URL-escaped link to attach to owner, for example:
 166 #    sub { return "/showowner.cgi?owner=".CGI::Util::escape($_[0]); }
 167 our $owner_link_hook = undef;
 168
 169 # show repository only if this subroutine returns true
 170 # when given the path to the project, for example:
 171 #    sub { return -e "$_[0]/git-daemon-export-ok"; }
 172 our $export_auth_hook = undef;
 173
 174 # only allow viewing of repositories also shown on the overview page
 175 our $strict_export = "++GITWEB_STRICT_EXPORT++";
 176
 177 # list of git base URLs used for URL to where fetch project from,
 178 # i.e. full URL is "$git_base_url/$project"
 179 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
 180
 181 # URLs designated for pushing new changes, extended by the
 182 # project name (i.e. "$git_base_push_url[0]/$project")
 183 our @git_base_push_urls = ();
 184
 185 # https hint html inserted right after any https push URL (undef for none)
 186 our $https_hint_html = undef;
 187
 188 # default blob_plain mimetype and default charset for text/plain blob
 189 our $default_blob_plain_mimetype = 'application/octet-stream';
 190 our $default_text_plain_charset  = undef;
 191
 192 # file to use for guessing MIME types before trying /etc/mime.types
 193 # (relative to the current git repository)
 194 our $mimetypes_file = undef;
 195
 196 # assume this charset if line contains non-UTF-8 characters;
 197 # it should be valid encoding (see Encoding::Supported(3pm) for list),
 198 # for which encoding all byte sequences are valid, for example
 199 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
 200 # could be even 'utf-8' for the old behavior)
 201 our $fallback_encoding = 'latin1';
 202
 203 # rename detection options for git-diff and git-diff-tree
 204 # - default is '-M', with the cost proportional to
 205 #   (number of removed files) * (number of new files).
 206 # - more costly is '-C' (which implies '-M'), with the cost proportional to
 207 #   (number of changed files + number of removed files) * (number of new files)
 208 # - even more costly is '-C', '--find-copies-harder' with cost
 209 #   (number of files in the original tree) * (number of new files)
 210 # - one might want to include '-B' option, e.g. '-B', '-M'
 211 our @diff_opts = ('-M'); # taken from git_commit
 212
 213 # cache directory (relative to $GIT_DIR) for project-specific html page caches.
 214 # the directory must exist and be writable by the process running gitweb.
 215 # additionally some actions must be selected for caching in %html_cache_actions
 216 # - default is 'htmlcache'
 217 our $html_cache_dir = 'htmlcache';
 218
 219 # which actions to cache in $html_cache_dir
 220 # if $html_cache_dir exists (relative to $GIT_DIR) and is writable by the
 221 # process running gitweb, then any actions selected here will have their output
 222 # cached and the cache file will be returned instead of regenerating the page
 223 # if it exists.  For this to be useful, an external process must remove the
 224 # cached file or create a $action.changed file whenever the information it
 225 # contains becomes out of date so that it will be regenerated the next time
 226 # it's requested.  Creating the $action.changed file is preferred as it avoids
 227 # race conditions where the data changes while the cache is being regenerated.
 228 # - default is none
 229 #   currently only caching of the summary page is supported
 230 # - to enable caching of the summary page use:
 231 #   $html_cache_actions{'summary'} = 1;
 232 our %html_cache_actions = ();
 233
 234 # Disables features that would allow repository owners to inject script into
 235 # the gitweb domain.
 236 our $prevent_xss = 0;
 237
 238 # Path to a POSIX shell.  Needed to run $highlight_bin and a snapshot compressor.
 239 # Only used when highlight is enabled or snapshots with compressors are enabled.
 240 our $posix_shell_bin = "++POSIX_SHELL_BIN++";
 241
 242 # Path to the highlight executable to use (must be the one from
 243 # http://www.andre-simon.de due to assumptions about parameters and output).
 244 # Useful if highlight is not installed on your webserver's PATH.
 245 # [Default: highlight]
 246 our $highlight_bin = "++HIGHLIGHT_BIN++";
 247
 248 # Whether to include project list on the gitweb front page; 0 means yes,
 249 # 1 means no list but show tag cloud if enabled (all projects still need
 250 # to be scanned, unless the info is cached), 2 means no list and no tag cloud
 251 # (very fast)
 252 our $frontpage_no_project_list = 0;
 253
 254 # projects list cache for busy sites with many projects;
 255 # if you set this to non-zero, it will be used as the cached
 256 # index lifetime in minutes
 257 #
 258 # the cached list version is stored in $cache_dir/$cache_name and can
 259 # be tweaked by other scripts running with the same uid as gitweb -
 260 # use this ONLY at secure installations; only single gitweb project
 261 # root per system is supported, unless you tweak configuration!
 262 our $projlist_cache_lifetime = 0; # in minutes
 263 # FHS compliant $cache_dir would be "/var/cache/gitweb"
 264 our $cache_dir =
 265         (defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp').'/gitweb';
 266 our $projlist_cache_name = 'gitweb.index.cache';
 267 our $cache_grpshared = 0;
 268
 269 # information about snapshot formats that gitweb is capable of serving
 270 our %known_snapshot_formats = (
 271         # name => {
 272         #       'display' => display name,
 273         #       'type' => mime type,
 274         #       'suffix' => filename suffix,
 275         #       'format' => --format for git-archive,
 276         #       'compressor' => [compressor command and arguments]
 277         #                       (array reference, optional)
 278         #       'disabled' => boolean (optional)}
 279         #
 280         'tgz' => {
 281                 'display' => 'tar.gz',
 282                 'type' => 'application/x-gzip',
 283                 'suffix' => '.tar.gz',
 284                 'format' => 'tar',
 285                 'compressor' => ['gzip', '-n']},
 286
 287         'tbz2' => {
 288                 'display' => 'tar.bz2',
 289                 'type' => 'application/x-bzip2',
 290                 'suffix' => '.tar.bz2',
 291                 'format' => 'tar',
 292                 'compressor' => ['bzip2']},
 293
 294         'txz' => {
 295                 'display' => 'tar.xz',
 296                 'type' => 'application/x-xz',
 297                 'suffix' => '.tar.xz',
 298                 'format' => 'tar',
 299                 'compressor' => ['xz'],
 300                 'disabled' => 1},
 301
 302         'zip' => {
 303                 'display' => 'zip',
 304                 'type' => 'application/x-zip',
 305                 'suffix' => '.zip',
 306                 'format' => 'zip'},
 307 );
 308
 309 # Aliases so we understand old gitweb.snapshot values in repository
 310 # configuration.
 311 our %known_snapshot_format_aliases = (
 312         'gzip'  => 'tgz',
 313         'bzip2' => 'tbz2',
 314         'xz'    => 'txz',
 315
 316         # backward compatibility: legacy gitweb config support
 317         'x-gzip' => undef, 'gz' => undef,
 318         'x-bzip2' => undef, 'bz2' => undef,
 319         'x-zip' => undef, '' => undef,
 320 );
 321
 322 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
 323 # are changed, it may be appropriate to change these values too via
 324 # $GITWEB_CONFIG.
 325 our %avatar_size = (
 326         'default' => 16,
 327         'double'  => 32
 328 );
 329
 330 # Used to set the maximum load that we will still respond to gitweb queries.
 331 # If server load exceed this value then return "503 server busy" error.
 332 # If gitweb cannot determined server load, it is taken to be 0.
 333 # Leave it undefined (or set to 'undef') to turn off load checking.
 334 our $maxload = 300;
 335
 336 # configuration for 'highlight' (http://www.andre-simon.de/)
 337 # match by basename
 338 our %highlight_basename = (
 339         #'Program' => 'py',
 340         #'Library' => 'py',
 341         'SConstruct' => 'py', # SCons equivalent of Makefile
 342         'Makefile' => 'make',
 343         'makefile' => 'make',
 344         'GNUmakefile' => 'make',
 345         'BSDmakefile' => 'make',
 346 );
 347 # match by shebang regex
 348 our %highlight_shebang = (
 349         # Each entry has a key which is the syntax to use and
 350         # a value which is either a qr regex or an array of qr regexs to match
 351         # against the first 128 (less if the blob is shorter) BYTES of the blob.
 352         # We match /usr/bin/env items separately to require "/usr/bin/env" and
 353         # allow a limited subset of NAME=value items to appear.
 354         'awk'    => [ qr,^#!\s*/(?:\w+/)*(?:[gnm]?awk)(?:\s|$),mo,
 355                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[gnm]?awk)(?:\s|$),mo ],
 356         'make'   => [ qr,^#!\s*/(?:\w+/)*(?:g?make)(?:\s|$),mo,
 357                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:g?make)(?:\s|$),mo ],
 358         'php'    => [ qr,^#!\s*/(?:\w+/)*(?:php)(?:\s|$),mo,
 359                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:php)(?:\s|$),mo ],
 360         'pl'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 361                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 362         'py'     => [ qr,^#!\s*/(?:\w+/)*(?:python)(?:\s|$),mo,
 363                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:python)(?:\s|$),mo ],
 364         'sh'     => [ qr,^#!\s*/(?:\w+/)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo,
 365                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo ],
 366         'rb'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 367                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 368 );
 369 # match by extension
 370 our %highlight_ext = (
 371         # main extensions, defining name of syntax;
 372         # see files in /usr/share/highlight/langDefs/ directory
 373         (map { $_ => $_ } qw(
 374                 4gl a4c abnf abp ada agda ahk ampl amtrix applescript arc
 375                 arm as asm asp aspect ats au3 avenue awk bat bb bbcode bib
 376                 bms bnf boo c cb cfc chl clipper clojure clp cob cs css d
 377                 diff dot dylan e ebnf erl euphoria exp f90 flx for frink fs
 378                 go haskell hcl html httpd hx icl icn idl idlang ili
 379                 inc_luatex ini inp io iss j java js jsp lbn ldif lgt lhs
 380                 lisp lotos ls lsl lua ly make mel mercury mib miranda ml mo
 381                 mod2 mod3 mpl ms mssql n nas nbc nice nrx nsi nut nxc oberon
 382                 objc octave oorexx os oz pas php pike pl pl1 pov pro
 383                 progress ps ps1 psl pure py pyx q qmake qu r rb rebol rexx
 384                 rnc s sas sc scala scilab sh sma smalltalk sml sno spec spn
 385                 sql sybase tcl tcsh tex ttcn3 vala vb verilog vhd xml xpp y
 386                 yaiff znn)),
 387         # alternate extensions, see /etc/highlight/filetypes.conf
 388         (map { $_ => '4gl' } qw(informix)),
 389         (map { $_ => 'a4c' } qw(ascend)),
 390         (map { $_ => 'abp' } qw(abp4)),
 391         (map { $_ => 'ada' } qw(a adb ads gnad)),
 392         (map { $_ => 'ahk' } qw(autohotkey)),
 393         (map { $_ => 'ampl' } qw(dat run)),
 394         (map { $_ => 'amtrix' } qw(hnd s4 s4h s4t t4)),
 395         (map { $_ => 'as' } qw(actionscript)),
 396         (map { $_ => 'asm' } qw(29k 68s 68x a51 assembler x68 x86)),
 397         (map { $_ => 'asp' } qw(asa)),
 398         (map { $_ => 'aspect' } qw(was wud)),
 399         (map { $_ => 'ats' } qw(dats)),
 400         (map { $_ => 'au3' } qw(autoit)),
 401         (map { $_ => 'bat' } qw(cmd)),
 402         (map { $_ => 'bb' } qw(blitzbasic)),
 403         (map { $_ => 'bib' } qw(bibtex)),
 404         (map { $_ => 'c' } qw(c++ cc cpp cu cxx h hh hpp hxx)),
 405         (map { $_ => 'cb' } qw(clearbasic)),
 406         (map { $_ => 'cfc' } qw(cfm coldfusion)),
 407         (map { $_ => 'chl' } qw(chill)),
 408         (map { $_ => 'cob' } qw(cbl cobol)),
 409         (map { $_ => 'cs' } qw(csharp)),
 410         (map { $_ => 'diff' } qw(patch)),
 411         (map { $_ => 'dot' } qw(graphviz)),
 412         (map { $_ => 'e' } qw(eiffel se)),
 413         (map { $_ => 'erl' } qw(erlang hrl)),
 414         (map { $_ => 'euphoria' } qw(eu ew ex exu exw wxu)),
 415         (map { $_ => 'exp' } qw(express)),
 416         (map { $_ => 'f90' } qw(f95)),
 417         (map { $_ => 'flx' } qw(felix)),
 418         (map { $_ => 'for' } qw(f f77 ftn)),
 419         (map { $_ => 'fs' } qw(fsharp fsx)),
 420         (map { $_ => 'haskell' } qw(hs)),
 421         (map { $_ => 'html' } qw(htm xhtml)),
 422         (map { $_ => 'hx' } qw(haxe)),
 423         (map { $_ => 'icl' } qw(clean)),
 424         (map { $_ => 'icn' } qw(icon)),
 425         (map { $_ => 'ili' } qw(interlis)),
 426         (map { $_ => 'inp' } qw(fame)),
 427         (map { $_ => 'iss' } qw(innosetup)),
 428         (map { $_ => 'j' } qw(jasmin)),
 429         (map { $_ => 'java' } qw(groovy grv)),
 430         (map { $_ => 'lbn' } qw(luban)),
 431         (map { $_ => 'lgt' } qw(logtalk)),
 432         (map { $_ => 'lisp' } qw(cl clisp el lsp sbcl scom)),
 433         (map { $_ => 'ls' } qw(lotus)),
 434         (map { $_ => 'lsl' } qw(lindenscript)),
 435         (map { $_ => 'ly' } qw(lilypond)),
 436         (map { $_ => 'make' } qw(mak mk kmk)),
 437         (map { $_ => 'mel' } qw(maya)),
 438         (map { $_ => 'mib' } qw(smi snmp)),
 439         (map { $_ => 'ml' } qw(mli ocaml)),
 440         (map { $_ => 'mo' } qw(modelica)),
 441         (map { $_ => 'mod2' } qw(def mod)),
 442         (map { $_ => 'mod3' } qw(i3 m3)),
 443         (map { $_ => 'mpl' } qw(maple)),
 444         (map { $_ => 'n' } qw(nemerle)),
 445         (map { $_ => 'nas' } qw(nasal)),
 446         (map { $_ => 'nrx' } qw(netrexx)),
 447         (map { $_ => 'nsi' } qw(nsis)),
 448         (map { $_ => 'nut' } qw(squirrel)),
 449         (map { $_ => 'oberon' } qw(ooc)),
 450         (map { $_ => 'objc' } qw(M m mm)),
 451         (map { $_ => 'php' } qw(php3 php4 php5 php6)),
 452         (map { $_ => 'pike' } qw(pmod)),
 453         (map { $_ => 'pl' } qw(perl plex plx pm)),
 454         (map { $_ => 'pl1' } qw(bdy ff fp fpp rpp sf sp spb spe spp sps wf wp wpb wpp wps)),
 455         (map { $_ => 'progress' } qw(i p w)),
 456         (map { $_ => 'py' } qw(python)),
 457         (map { $_ => 'pyx' } qw(pyrex)),
 458         (map { $_ => 'rb' } qw(pp rjs ruby)),
 459         (map { $_ => 'rexx' } qw(rex rx the)),
 460         (map { $_ => 'sc' } qw(paradox)),
 461         (map { $_ => 'scilab' } qw(sce sci)),
 462         (map { $_ => 'sh' } qw(bash ebuild eclass ksh zsh)),
 463         (map { $_ => 'sma' } qw(small)),
 464         (map { $_ => 'smalltalk' } qw(gst sq st)),
 465         (map { $_ => 'sno' } qw(snobal)),
 466         (map { $_ => 'sybase' } qw(sp)),
 467         (map { $_ => 'tcl' } qw(itcl wish)),
 468         (map { $_ => 'tex' } qw(cls sty)),
 469         (map { $_ => 'vb' } qw(bas basic bi vbs)),
 470         (map { $_ => 'verilog' } qw(v)),
 471         (map { $_ => 'xml' } qw(dtd ecf ent hdr hub jnlp nrm plist resx sgm sgml svg tld vxml wml xsd xsl)),
 472         (map { $_ => 'y' } qw(bison)),
 473 );
 474
 475 # You define site-wide feature defaults here; override them with
 476 # $GITWEB_CONFIG as necessary.
 477 our %feature = (
 478         # feature => {
 479         #       'sub' => feature-sub (subroutine),
 480         #       'override' => allow-override (boolean),
 481         #       'default' => [ default options...] (array reference)}
 482         #
 483         # if feature is overridable (it means that allow-override has true value),
 484         # then feature-sub will be called with default options as parameters;
 485         # return value of feature-sub indicates if to enable specified feature
 486         #
 487         # if there is no 'sub' key (no feature-sub), then feature cannot be
 488         # overridden
 489         #
 490         # use gitweb_get_feature(<feature>) to retrieve the <feature> value
 491         # (an array) or gitweb_check_feature(<feature>) to check if <feature>
 492         # is enabled
 493
 494         # Enable the 'blame' blob view, showing the last commit that modified
 495         # each line in the file. This can be very CPU-intensive.
 496
 497         # To enable system wide have in $GITWEB_CONFIG
 498         # $feature{'blame'}{'default'} = [1];
 499         # To have project specific config enable override in $GITWEB_CONFIG
 500         # $feature{'blame'}{'override'} = 1;
 501         # and in project config gitweb.blame = 0|1;
 502         'blame' => {
 503                 'sub' => sub { feature_bool('blame', @_) },
 504                 'override' => 0,
 505                 'default' => [0]},
 506
 507         # Enable the 'incremental blame' blob view, which uses javascript to
 508         # incrementally show the revisions of lines as they are discovered
 509         # in the history. It is better for large histories, files and slow
 510         # servers, but requires javascript in the client and can slow down the
 511         # browser on large files.
 512
 513         # To enable system wide have in $GITWEB_CONFIG
 514         # $feature{'blame_incremental'}{'default'} = [1];
 515         # To have project specific config enable override in $GITWEB_CONFIG
 516         # $feature{'blame_incremental'}{'override'} = 1;
 517         # and in project config gitweb.blame_incremental = 0|1;
 518         'blame_incremental' => {
 519                 'sub' => sub { feature_bool('blame_incremental', @_) },
 520                 'override' => 0,
 521                 'default' => [0]},
 522
 523         # Enable the 'snapshot' link, providing a compressed archive of any
 524         # tree. This can potentially generate high traffic if you have large
 525         # project.
 526
 527         # Value is a list of formats defined in %known_snapshot_formats that
 528         # you wish to offer.
 529         # To disable system wide have in $GITWEB_CONFIG
 530         # $feature{'snapshot'}{'default'} = [];
 531         # To have project specific config enable override in $GITWEB_CONFIG
 532         # $feature{'snapshot'}{'override'} = 1;
 533         # and in project config, a comma-separated list of formats or "none"
 534         # to disable.  Example: gitweb.snapshot = tbz2,zip;
 535         'snapshot' => {
 536                 'sub' => \&feature_snapshot,
 537                 'override' => 0,
 538                 'default' => ['tgz']},
 539
 540         # Enable text search, which will list the commits which match author,
 541         # committer or commit text to a given string.  Enabled by default.
 542         # Project specific override is not supported.
 543         #
 544         # Note that this controls all search features, which means that if
 545         # it is disabled, then 'grep' and 'pickaxe' search would also be
 546         # disabled.
 547         'search' => {
 548                 'override' => 0,
 549                 'default' => [1]},
 550
 551         # Enable grep search, which will list the files in currently selected
 552         # tree containing the given string. Enabled by default. This can be
 553         # potentially CPU-intensive, of course.
 554         # Note that you need to have 'search' feature enabled too.
 555
 556         # To enable system wide have in $GITWEB_CONFIG
 557         # $feature{'grep'}{'default'} = [1];
 558         # To have project specific config enable override in $GITWEB_CONFIG
 559         # $feature{'grep'}{'override'} = 1;
 560         # and in project config gitweb.grep = 0|1;
 561         'grep' => {
 562                 'sub' => sub { feature_bool('grep', @_) },
 563                 'override' => 0,
 564                 'default' => [1]},
 565
 566         # Enable the pickaxe search, which will list the commits that modified
 567         # a given string in a file. This can be practical and quite faster
 568         # alternative to 'blame', but still potentially CPU-intensive.
 569         # Note that you need to have 'search' feature enabled too.
 570
 571         # To enable system wide have in $GITWEB_CONFIG
 572         # $feature{'pickaxe'}{'default'} = [1];
 573         # To have project specific config enable override in $GITWEB_CONFIG
 574         # $feature{'pickaxe'}{'override'} = 1;
 575         # and in project config gitweb.pickaxe = 0|1;
 576         'pickaxe' => {
 577                 'sub' => sub { feature_bool('pickaxe', @_) },
 578                 'override' => 0,
 579                 'default' => [1]},
 580
 581         # Enable showing size of blobs in a 'tree' view, in a separate
 582         # column, similar to what 'ls -l' does.  This cost a bit of IO.
 583
 584         # To disable system wide have in $GITWEB_CONFIG
 585         # $feature{'show-sizes'}{'default'} = [0];
 586         # To have project specific config enable override in $GITWEB_CONFIG
 587         # $feature{'show-sizes'}{'override'} = 1;
 588         # and in project config gitweb.showsizes = 0|1;
 589         'show-sizes' => {
 590                 'sub' => sub { feature_bool('showsizes', @_) },
 591                 'override' => 0,
 592                 'default' => [1]},
 593
 594         # Make gitweb use an alternative format of the URLs which can be
 595         # more readable and natural-looking: project name is embedded
 596         # directly in the path and the query string contains other
 597         # auxiliary information. All gitweb installations recognize
 598         # URL in either format; this configures in which formats gitweb
 599         # generates links.
 600
 601         # To enable system wide have in $GITWEB_CONFIG
 602         # $feature{'pathinfo'}{'default'} = [1];
 603         # Project specific override is not supported.
 604
 605         # Note that you will need to change the default location of CSS,
 606         # favicon, logo and possibly other files to an absolute URL. Also,
 607         # if gitweb.cgi serves as your indexfile, you will need to force
 608         # $my_uri to contain the script name in your $GITWEB_CONFIG (and you
 609         # will also likely want to set $home_link if you're setting $my_uri).
 610         'pathinfo' => {
 611                 'override' => 0,
 612                 'default' => [0]},
 613
 614         # Make gitweb consider projects in project root subdirectories
 615         # to be forks of existing projects. Given project $projname.git,
 616         # projects matching $projname/*.git will not be shown in the main
 617         # projects list, instead a '+' mark will be added to $projname
 618         # there and a 'forks' view will be enabled for the project, listing
 619         # all the forks. If project list is taken from a file, forks have
 620         # to be listed after the main project.
 621
 622         # To enable system wide have in $GITWEB_CONFIG
 623         # $feature{'forks'}{'default'} = [1];
 624         # Project specific override is not supported.
 625         'forks' => {
 626                 'override' => 0,
 627                 'default' => [0]},
 628
 629         # Insert custom links to the action bar of all project pages.
 630         # This enables you mainly to link to third-party scripts integrating
 631         # into gitweb; e.g. git-browser for graphical history representation
 632         # or custom web-based repository administration interface.
 633
 634         # The 'default' value consists of a list of triplets in the form
 635         # (label, link, position) where position is the label after which
 636         # to insert the link and link is a format string where %n expands
 637         # to the project name, %f to the project path within the filesystem,
 638         # %h to the current hash (h gitweb parameter) and %b to the current
 639         # hash base (hb gitweb parameter); %% expands to %.  %e expands to the
 640         # project name where all '+' characters have been replaced with '%2B'.
 641
 642         # To enable system wide have in $GITWEB_CONFIG e.g.
 643         # $feature{'actions'}{'default'} = [('graphiclog',
 644         #       '/git-browser/by-commit.html?r=%n', 'summary')];
 645         # Project specific override is not supported.
 646         'actions' => {
 647                 'override' => 0,
 648                 'default' => []},
 649
 650         # Allow gitweb scan project content tags of project repository,
 651         # and display the popular Web 2.0-ish "tag cloud" near the projects
 652         # list.  Note that this is something COMPLETELY different from the
 653         # normal Git tags.
 654
 655         # gitweb by itself can show existing tags, but it does not handle
 656         # tagging itself; you need to do it externally, outside gitweb.
 657         # The format is described in git_get_project_ctags() subroutine.
 658         # You may want to install the HTML::TagCloud Perl module to get
 659         # a pretty tag cloud instead of just a list of tags.
 660
 661         # To enable system wide have in $GITWEB_CONFIG
 662         # $feature{'ctags'}{'default'} = [1];
 663         # Project specific override is not supported.
 664
 665         # A value of 0 means no ctags display or editing.  A value of
 666         # 1 enables ctags display but never editing.  A non-empty value
 667         # that is not a string of digits enables ctags display AND the
 668         # ability to add tags using a form that uses method POST and
 669         # an action value set to the configured 'ctags' value.
 670         'ctags' => {
 671                 'override' => 0,
 672                 'default' => [0]},
 673
 674         # The maximum number of patches in a patchset generated in patch
 675         # view. Set this to 0 or undef to disable patch view, or to a
 676         # negative number to remove any limit.
 677
 678         # To disable system wide have in $GITWEB_CONFIG
 679         # $feature{'patches'}{'default'} = [0];
 680         # To have project specific config enable override in $GITWEB_CONFIG
 681         # $feature{'patches'}{'override'} = 1;
 682         # and in project config gitweb.patches = 0|n;
 683         # where n is the maximum number of patches allowed in a patchset.
 684         'patches' => {
 685                 'sub' => \&feature_patches,
 686                 'override' => 0,
 687                 'default' => [16]},
 688
 689         # Avatar support. When this feature is enabled, views such as
 690         # shortlog or commit will display an avatar associated with
 691         # the email of the committer(s) and/or author(s).
 692
 693         # Currently available providers are gravatar and picon.
 694         # If an unknown provider is specified, the feature is disabled.
 695
 696         # Gravatar depends on Digest::MD5.
 697         # Picon currently relies on the indiana.edu database.
 698
 699         # To enable system wide have in $GITWEB_CONFIG
 700         # $feature{'avatar'}{'default'} = ['<provider>'];
 701         # where <provider> is either gravatar or picon.
 702         # To have project specific config enable override in $GITWEB_CONFIG
 703         # $feature{'avatar'}{'override'} = 1;
 704         # and in project config gitweb.avatar = <provider>;
 705         'avatar' => {
 706                 'sub' => \&feature_avatar,
 707                 'override' => 0,
 708                 'default' => ['']},
 709
 710         # Enable displaying how much time and how many git commands
 711         # it took to generate and display page.  Disabled by default.
 712         # Project specific override is not supported.
 713         'timed' => {
 714                 'override' => 0,
 715                 'default' => [0]},
 716
 717         # Enable turning some links into links to actions which require
 718         # JavaScript to run (like 'blame_incremental').  Not enabled by
 719         # default.  Project specific override is currently not supported.
 720         'javascript-actions' => {
 721                 'override' => 0,
 722                 'default' => [0]},
 723
 724         # Enable and configure ability to change common timezone for dates
 725         # in gitweb output via JavaScript.  Enabled by default.
 726         # Project specific override is not supported.
 727         'javascript-timezone' => {
 728                 'override' => 0,
 729                 'default' => [
 730                         'local',     # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
 731                                      # or undef to turn off this feature
 732                         'gitweb_tz', # name of cookie where to store selected timezone
 733                         'datetime',  # CSS class used to mark up dates for manipulation
 734                 ]},
 735
 736         # Syntax highlighting support. This is based on Daniel Svensson's
 737         # and Sham Chukoury's work in gitweb-xmms2.git.
 738         # It requires the 'highlight' program present in $PATH,
 739         # and therefore is disabled by default.
 740
 741         # To enable system wide have in $GITWEB_CONFIG
 742         # $feature{'highlight'}{'default'} = [1];
 743
 744         'highlight' => {
 745                 'sub' => sub { feature_bool('highlight', @_) },
 746                 'override' => 0,
 747                 'default' => [0]},
 748
 749         # Enable displaying of remote heads in the heads list
 750
 751         # To enable system wide have in $GITWEB_CONFIG
 752         # $feature{'remote_heads'}{'default'} = [1];
 753         # To have project specific config enable override in $GITWEB_CONFIG
 754         # $feature{'remote_heads'}{'override'} = 1;
 755         # and in project config gitweb.remoteheads = 0|1;
 756         'remote_heads' => {
 757                 'sub' => sub { feature_bool('remote_heads', @_) },
 758                 'override' => 0,
 759                 'default' => [0]},
 760
 761         # Enable showing branches under other refs in addition to heads
 762
 763         # To set system wide extra branch refs have in $GITWEB_CONFIG
 764         # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
 765         # To have project specific config enable override in $GITWEB_CONFIG
 766         # $feature{'extra-branch-refs'}{'override'} = 1;
 767         # and in project config gitweb.extrabranchrefs = dirs of choice
 768         # Every directory is separated with whitespace.
 769
 770         'extra-branch-refs' => {
 771                 'sub' => \&feature_extra_branch_refs,
 772                 'override' => 0,
 773                 'default' => []},
 774 );
 775
 776 sub gitweb_get_feature {
 777         my ($name) = @_;
 778         return unless exists $feature{$name};
 779         my ($sub, $override, @defaults) = (
 780                 $feature{$name}{'sub'},
 781                 $feature{$name}{'override'},
 782                 @{$feature{$name}{'default'}});
 783         # project specific override is possible only if we have project
 784         our $git_dir; # global variable, declared later
 785         if (!$override || !defined $git_dir) {
 786                 return @defaults;
 787         }
 788         if (!defined $sub) {
 789                 warn "feature $name is not overridable";
 790                 return @defaults;
 791         }
 792         return $sub->(@defaults);
 793 }
 794
 795 # A wrapper to check if a given feature is enabled.
 796 # With this, you can say
 797 #
 798 #   my $bool_feat = gitweb_check_feature('bool_feat');
 799 #   gitweb_check_feature('bool_feat') or somecode;
 800 #
 801 # instead of
 802 #
 803 #   my ($bool_feat) = gitweb_get_feature('bool_feat');
 804 #   (gitweb_get_feature('bool_feat'))[0] or somecode;
 805 #
 806 sub gitweb_check_feature {
 807         return (gitweb_get_feature(@_))[0];
 808 }
 809
 810
 811 sub feature_bool {
 812         my $key = shift;
 813         my ($val) = git_get_project_config($key, '--bool');
 814
 815         if (!defined $val) {
 816                 return ($_[0]);
 817         } elsif ($val eq 'true') {
 818                 return (1);
 819         } elsif ($val eq 'false') {
 820                 return (0);
 821         }
 822 }
 823
 824 sub feature_snapshot {
 825         my (@fmts) = @_;
 826
 827         my ($val) = git_get_project_config('snapshot');
 828
 829         if ($val) {
 830                 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
 831         }
 832
 833         return @fmts;
 834 }
 835
 836 sub feature_patches {
 837         my @val = (git_get_project_config('patches', '--int'));
 838
 839         if (@val) {
 840                 return @val;
 841         }
 842
 843         return ($_[0]);
 844 }
 845
 846 sub feature_avatar {
 847         my @val = (git_get_project_config('avatar'));
 848
 849         return @val ? @val : @_;
 850 }
 851
 852 sub feature_extra_branch_refs {
 853         my (@branch_refs) = @_;
 854         my $values = git_get_project_config('extrabranchrefs');
 855
 856         if ($values) {
 857                 $values = config_to_multi ($values);
 858                 @branch_refs = ();
 859                 foreach my $value (@{$values}) {
 860                         push @branch_refs, split /\s+/, $value;
 861                 }
 862         }
 863
 864         return @branch_refs;
 865 }
 866
 867 # checking HEAD file with -e is fragile if the repository was
 868 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
 869 # and then pruned.
 870 sub check_head_link {
 871         my ($dir) = @_;
 872         my $headfile = "$dir/HEAD";
 873         return ((-e $headfile) ||
 874                 (-l $headfile && readlink($headfile) =~ /^refs\/heads\//));
 875 }
 876
 877 sub check_export_ok {
 878         my ($dir) = @_;
 879         return (check_head_link($dir) &&
 880                 (!$export_ok || -e "$dir/$export_ok") &&
 881                 (!$export_auth_hook || $export_auth_hook->($dir)));
 882 }
 883
 884 # process alternate names for backward compatibility
 885 # filter out unsupported (unknown) snapshot formats
 886 sub filter_snapshot_fmts {
 887         my @fmts = @_;
 888
 889         @fmts = map {
 890                 exists $known_snapshot_format_aliases{$_} ?
 891                        $known_snapshot_format_aliases{$_} : $_} @fmts;
 892         @fmts = grep {
 893                 exists $known_snapshot_formats{$_} &&
 894                 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
 895 }
 896
 897 sub filter_and_validate_refs {
 898         my @refs = @_;
 899         my %unique_refs = ();
 900
 901         foreach my $ref (@refs) {
 902                 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
 903                 # 'heads' are added implicitly in get_branch_refs().
 904                 $unique_refs{$ref} = 1 if ($ref ne 'heads');
 905         }
 906         return sort keys %unique_refs;
 907 }
 908
 909 # If it is set to code reference, it is code that it is to be run once per
 910 # request, allowing updating configurations that change with each request,
 911 # while running other code in config file only once.
 912 #
 913 # Otherwise, if it is false then gitweb would process config file only once;
 914 # if it is true then gitweb config would be run for each request.
 915 our $per_request_config = 1;
 916
 917 # If true and fileno STDIN is 0 and getsockname succeeds, then FCGI mode will
 918 # be activated automatically as though the --fcgi option was given.
 919 our $auto_fcgi = 0;
 920
 921 # read and parse gitweb config file given by its parameter.
 922 # returns true on success, false on recoverable error, allowing
 923 # to chain this subroutine, using first file that exists.
 924 # dies on errors during parsing config file, as it is unrecoverable.
 925 sub read_config_file {
 926         my $filename = shift;
 927         return unless defined $filename;
 928         # die if there are errors parsing config file
 929         if (-e $filename) {
 930                 do $filename;
 931                 die $@ if $@;
 932                 return 1;
 933         }
 934         return;
 935 }
 936
 937 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
 938 sub evaluate_gitweb_config {
 939         our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
 940         our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
 941         our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
 942
 943         # Protect against duplications of file names, to not read config twice.
 944         # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
 945         # there possibility of duplication of filename there doesn't matter.
 946         $GITWEB_CONFIG = ""        if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
 947         $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
 948
 949         # Common system-wide settings for convenience.
 950         # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
 951         read_config_file($GITWEB_CONFIG_COMMON);
 952
 953         # Use first config file that exists.  This means use the per-instance
 954         # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
 955         read_config_file($GITWEB_CONFIG) and return;
 956         read_config_file($GITWEB_CONFIG_SYSTEM);
 957 }
 958
 959 our $encode_object;
 960
 961 sub evaluate_encoding {
 962         my $requested = $fallback_encoding || 'ISO-8859-1';
 963         my $obj = Encode::find_encoding($requested) or
 964                 die_error(400, "Requested fallback encoding not found");
 965         if ($obj->name eq 'iso-8859-1') {
 966                 # Use Windows-1252 instead as required by the HTML 5 standard
 967                 my $altobj = Encode::find_encoding('Windows-1252');
 968                 $obj = $altobj if $altobj;
 969         }
 970         $encode_object = $obj;
 971 }
 972
 973 sub evaluate_email_obfuscate {
 974         # email obfuscation
 975         our $email;
 976         if (!$email && eval { require HTML::Email::Obfuscate; 1 }) {
 977                 $email = HTML::Email::Obfuscate->new(lite => 1);
 978         }
 979 }
 980
 981 # Get loadavg of system, to compare against $maxload.
 982 # Currently it requires '/proc/loadavg' present to get loadavg;
 983 # if it is not present it returns 0, which means no load checking.
 984 sub get_loadavg {
 985         if( -e '/proc/loadavg' ){
 986                 open my $fd, '<', '/proc/loadavg'
 987                         or return 0;
 988                 my @load = split(/\s+/, scalar <$fd>);
 989                 close $fd;
 990
 991                 # The first three columns measure CPU and IO utilization of the last one,
 992                 # five, and 10 minute periods.  The fourth column shows the number of
 993                 # currently running processes and the total number of processes in the m/n
 994                 # format.  The last column displays the last process ID used.
 995                 return $load[0] || 0;
 996         }
 997         # additional checks for load average should go here for things that don't export
 998         # /proc/loadavg
 999
1000         return 0;
1001 }
1002
1003 # version of the core git binary
1004 our $git_version;
1005 sub evaluate_git_version {
1006         our $git_version = $version;
1007 }
1008
1009 sub check_loadavg {
1010         if (defined $maxload && get_loadavg() > $maxload) {
1011                 die_error(503, "The load average on the server is too high");
1012         }
1013 }
1014
1015 # ======================================================================
1016 # input validation and dispatch
1017
1018 # input parameters can be collected from a variety of sources (presently, CGI
1019 # and PATH_INFO), so we define an %input_params hash that collects them all
1020 # together during validation: this allows subsequent uses (e.g. href()) to be
1021 # agnostic of the parameter origin
1022
1023 our %input_params = ();
1024
1025 # input parameters are stored with the long parameter name as key. This will
1026 # also be used in the href subroutine to convert parameters to their CGI
1027 # equivalent, and since the href() usage is the most frequent one, we store
1028 # the name -> CGI key mapping here, instead of the reverse.
1029 #
1030 # XXX: Warning: If you touch this, check the search form for updating,
1031 # too.
1032
1033 our @cgi_param_mapping = (
1034         project => "p",
1035         action => "a",
1036         file_name => "f",
1037         file_parent => "fp",
1038         hash => "h",
1039         hash_parent => "hp",
1040         hash_base => "hb",
1041         hash_parent_base => "hpb",
1042         page => "pg",
1043         order => "o",
1044         searchtext => "s",
1045         searchtype => "st",
1046         snapshot_format => "sf",
1047         ctag_filter => 't',
1048         extra_options => "opt",
1049         search_use_regexp => "sr",
1050         ctag => "by_tag",
1051         diff_style => "ds",
1052         project_filter => "pf",
1053         # this must be last entry (for manipulation from JavaScript)
1054         javascript => "js"
1055 );
1056 our %cgi_param_mapping = @cgi_param_mapping;
1057
1058 # we will also need to know the possible actions, for validation
1059 our %actions = (
1060         "blame" => \&git_blame,
1061         "blame_incremental" => \&git_blame_incremental,
1062         "blame_data" => \&git_blame_data,
1063         "blobdiff" => \&git_blobdiff,
1064         "blobdiff_plain" => \&git_blobdiff_plain,
1065         "blob" => \&git_blob,
1066         "blob_plain" => \&git_blob_plain,
1067         "commitdiff" => \&git_commitdiff,
1068         "commitdiff_plain" => \&git_commitdiff_plain,
1069         "commit" => \&git_commit,
1070         "forks" => \&git_forks,
1071         "heads" => \&git_heads,
1072         "history" => \&git_history,
1073         "log" => \&git_log,
1074         "patch" => \&git_patch,
1075         "patches" => \&git_patches,
1076         "refs" => \&git_refs,
1077         "remotes" => \&git_remotes,
1078         "rss" => \&git_rss,
1079         "atom" => \&git_atom,
1080         "search" => \&git_search,
1081         "search_help" => \&git_search_help,
1082         "shortlog" => \&git_shortlog,
1083         "summary" => \&git_summary,
1084         "tag" => \&git_tag,
1085         "tags" => \&git_tags,
1086         "tree" => \&git_tree,
1087         "snapshot" => \&git_snapshot,
1088         "object" => \&git_object,
1089         # those below don't need $project
1090         "opml" => \&git_opml,
1091         "frontpage" => \&git_frontpage,
1092         "project_list" => \&git_project_list,
1093         "project_index" => \&git_project_index,
1094 );
1095
1096 # the only actions we will allow to be cached
1097 our %supported_cache_actions = map {( $_ => 1 )} qw(summary);
1098
1099 # finally, we have the hash of allowed extra_options for the commands that
1100 # allow them
1101 our %allowed_options = (
1102         "--no-merges" => [ qw(rss atom log shortlog history) ],
1103 );
1104
1105 # fill %input_params with the CGI parameters. All values except for 'opt'
1106 # should be single values, but opt can be an array. We should probably
1107 # build an array of parameters that can be multi-valued, but since for the time
1108 # being it's only this one, we just single it out
1109 sub evaluate_query_params {
1110         our $cgi;
1111
1112         while (my ($name, $symbol) = each %cgi_param_mapping) {
1113                 if ($symbol eq 'opt') {
1114                         $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
1115                 } else {
1116                         $input_params{$name} = decode_utf8($cgi->param($symbol));
1117                 }
1118         }
1119
1120         # Backwards compatibility - by_tag= <=> t=
1121         if ($input_params{'ctag'}) {
1122                 $input_params{'ctag_filter'} = $input_params{'ctag'};
1123         }
1124 }
1125
1126 # now read PATH_INFO and update the parameter list for missing parameters
1127 sub evaluate_path_info {
1128         return if defined $input_params{'project'};
1129         return if !$path_info;
1130         $path_info =~ s,^/+,,;
1131         return if !$path_info;
1132
1133         # find which part of PATH_INFO is project
1134         my $project = $path_info;
1135         $project =~ s,/+$,,;
1136         while ($project && !check_head_link("$projectroot/$project")) {
1137                 $project =~ s,/*[^/]*$,,;
1138         }
1139         return unless $project;
1140         $input_params{'project'} = $project;
1141
1142         # do not change any parameters if an action is given using the query string
1143         return if $input_params{'action'};
1144         $path_info =~ s,^\Q$project\E/*,,;
1145
1146         # next, check if we have an action
1147         my $action = $path_info;
1148         $action =~ s,/.*$,,;
1149         if (exists $actions{$action}) {
1150                 $path_info =~ s,^$action/*,,;
1151                 $input_params{'action'} = $action;
1152         }
1153
1154         # list of actions that want hash_base instead of hash, but can have no
1155         # pathname (f) parameter
1156         my @wants_base = (
1157                 'tree',
1158                 'history',
1159         );
1160
1161         # we want to catch, among others
1162         # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
1163         my ($parentrefname, $parentpathname, $refname, $pathname) =
1164                 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
1165
1166         # first, analyze the 'current' part
1167         if (defined $pathname) {
1168                 # we got "branch:filename" or "branch:dir/"
1169                 # we could use git_get_type(branch:pathname), but:
1170                 # - it needs $git_dir
1171                 # - it does a git() call
1172                 # - the convention of terminating directories with a slash
1173                 #   makes it superfluous
1174                 # - embedding the action in the PATH_INFO would make it even
1175                 #   more superfluous
1176                 $pathname =~ s,^/+,,;
1177                 if (!$pathname || substr($pathname, -1) eq "/") {
1178                         $input_params{'action'} ||= "tree";
1179                         $pathname =~ s,/$,,;
1180                 } else {
1181                         # the default action depends on whether we had parent info
1182                         # or not
1183                         if ($parentrefname) {
1184                                 $input_params{'action'} ||= "blobdiff_plain";
1185                         } else {
1186                                 $input_params{'action'} ||= "blob_plain";
1187                         }
1188                 }
1189                 $input_params{'hash_base'} ||= $refname;
1190                 $input_params{'file_name'} ||= $pathname;
1191         } elsif (defined $refname) {
1192                 # we got "branch". In this case we have to choose if we have to
1193                 # set hash or hash_base.
1194                 #
1195                 # Most of the actions without a pathname only want hash to be
1196                 # set, except for the ones specified in @wants_base that want
1197                 # hash_base instead. It should also be noted that hand-crafted
1198                 # links having 'history' as an action and no pathname or hash
1199                 # set will fail, but that happens regardless of PATH_INFO.
1200                 if (defined $parentrefname) {
1201                         # if there is parent let the default be 'shortlog' action
1202                         # (for http://git.example.com/repo.git/A..B links); if there
1203                         # is no parent, dispatch will detect type of object and set
1204                         # action appropriately if required (if action is not set)
1205                         $input_params{'action'} ||= "shortlog";
1206                 }
1207                 if ($input_params{'action'} &&
1208                     grep { $_ eq $input_params{'action'} } @wants_base) {
1209                         $input_params{'hash_base'} ||= $refname;
1210                 } else {
1211                         $input_params{'hash'} ||= $refname;
1212                 }
1213         }
1214
1215         # next, handle the 'parent' part, if present
1216         if (defined $parentrefname) {
1217                 # a missing pathspec defaults to the 'current' filename, allowing e.g.
1218                 # someproject/blobdiff/oldrev..newrev:/filename
1219                 if ($parentpathname) {
1220                         $parentpathname =~ s,^/+,,;
1221                         $parentpathname =~ s,/$,,;
1222                         $input_params{'file_parent'} ||= $parentpathname;
1223                 } else {
1224                         $input_params{'file_parent'} ||= $input_params{'file_name'};
1225                 }
1226                 # we assume that hash_parent_base is wanted if a path was specified,
1227                 # or if the action wants hash_base instead of hash
1228                 if (defined $input_params{'file_parent'} ||
1229                         grep { $_ eq $input_params{'action'} } @wants_base) {
1230                         $input_params{'hash_parent_base'} ||= $parentrefname;
1231                 } else {
1232                         $input_params{'hash_parent'} ||= $parentrefname;
1233                 }
1234         }
1235
1236         # for the snapshot action, we allow URLs in the form
1237         # $project/snapshot/$hash.ext
1238         # where .ext determines the snapshot and gets removed from the
1239         # passed $refname to provide the $hash.
1240         #
1241         # To be able to tell that $refname includes the format extension, we
1242         # require the following two conditions to be satisfied:
1243         # - the hash input parameter MUST have been set from the $refname part
1244         #   of the URL (i.e. they must be equal)
1245         # - the snapshot format MUST NOT have been defined already (e.g. from
1246         #   CGI parameter sf)
1247         # It's also useless to try any matching unless $refname has a dot,
1248         # so we check for that too
1249         if (defined $input_params{'action'} &&
1250                 $input_params{'action'} eq 'snapshot' &&
1251                 defined $refname && index($refname, '.') != -1 &&
1252                 $refname eq $input_params{'hash'} &&
1253                 !defined $input_params{'snapshot_format'}) {
1254                 # We loop over the known snapshot formats, checking for
1255                 # extensions. Allowed extensions are both the defined suffix
1256                 # (which includes the initial dot already) and the snapshot
1257                 # format key itself, with a prepended dot
1258                 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1259                         my $hash = $refname;
1260                         unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1261                                 next;
1262                         }
1263                         my $sfx = $1;
1264                         # a valid suffix was found, so set the snapshot format
1265                         # and reset the hash parameter
1266                         $input_params{'snapshot_format'} = $fmt;
1267                         $input_params{'hash'} = $hash;
1268                         # we also set the format suffix to the one requested
1269                         # in the URL: this way a request for e.g. .tgz returns
1270                         # a .tgz instead of a .tar.gz
1271                         $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1272                         last;
1273                 }
1274         }
1275 }
1276
1277 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1278      $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1279      $searchtext, $search_regexp, $project_filter);
1280 sub evaluate_and_validate_params {
1281         our $action = $input_params{'action'};
1282         if (defined $action) {
1283                 if (!is_valid_action($action)) {
1284                         die_error(400, "Invalid action parameter");
1285                 }
1286         }
1287
1288         # parameters which are pathnames
1289         our $project = $input_params{'project'};
1290         if (defined $project) {
1291                 if (!is_valid_project($project)) {
1292                         undef $project;
1293                         die_error(404, "No such project");
1294                 }
1295         }
1296
1297         our $project_filter = $input_params{'project_filter'};
1298         if (defined $project_filter) {
1299                 if (!is_valid_pathname($project_filter)) {
1300                         die_error(404, "Invalid project_filter parameter");
1301                 }
1302         }
1303
1304         our $file_name = $input_params{'file_name'};
1305         if (defined $file_name) {
1306                 if (!is_valid_pathname($file_name)) {
1307                         die_error(400, "Invalid file parameter");
1308                 }
1309         }
1310
1311         our $file_parent = $input_params{'file_parent'};
1312         if (defined $file_parent) {
1313                 if (!is_valid_pathname($file_parent)) {
1314                         die_error(400, "Invalid file parent parameter");
1315                 }
1316         }
1317
1318         # parameters which are refnames
1319         our $hash = $input_params{'hash'};
1320         if (defined $hash) {
1321                 if (!is_valid_refname($hash)) {
1322                         die_error(400, "Invalid hash parameter");
1323                 }
1324         }
1325
1326         our $hash_parent = $input_params{'hash_parent'};
1327         if (defined $hash_parent) {
1328                 if (!is_valid_refname($hash_parent)) {
1329                         die_error(400, "Invalid hash parent parameter");
1330                 }
1331         }
1332
1333         our $hash_base = $input_params{'hash_base'};
1334         if (defined $hash_base) {
1335                 if (!is_valid_refname($hash_base)) {
1336                         die_error(400, "Invalid hash base parameter");
1337                 }
1338         }
1339
1340         our @extra_options = @{$input_params{'extra_options'}};
1341         # @extra_options is always defined, since it can only be (currently) set from
1342         # CGI, and $cgi->param() returns the empty array in array context if the param
1343         # is not set
1344         foreach my $opt (@extra_options) {
1345                 if (not exists $allowed_options{$opt}) {
1346                         die_error(400, "Invalid option parameter");
1347                 }
1348                 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1349                         die_error(400, "Invalid option parameter for this action");
1350                 }
1351         }
1352
1353         our $hash_parent_base = $input_params{'hash_parent_base'};
1354         if (defined $hash_parent_base) {
1355                 if (!is_valid_refname($hash_parent_base)) {
1356                         die_error(400, "Invalid hash parent base parameter");
1357                 }
1358         }
1359
1360         # other parameters
1361         our $page = $input_params{'page'};
1362         if (defined $page) {
1363                 if ($page =~ m/[^0-9]/) {
1364                         die_error(400, "Invalid page parameter");
1365                 }
1366         }
1367
1368         our $searchtype = $input_params{'searchtype'};
1369         if (defined $searchtype) {
1370                 if ($searchtype =~ m/[^a-z]/) {
1371                         die_error(400, "Invalid searchtype parameter");
1372                 }
1373         }
1374
1375         our $search_use_regexp = $input_params{'search_use_regexp'};
1376
1377         our $searchtext = $input_params{'searchtext'};
1378         our $search_regexp = undef;
1379         if (defined $searchtext) {
1380                 if (length($searchtext) < 2) {
1381                         die_error(403, "At least two characters are required for search parameter");
1382                 }
1383                 if ($search_use_regexp) {
1384                         $search_regexp = $searchtext;
1385                         if (!eval { qr/$search_regexp/; 1; }) {
1386                                 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1387                                 die_error(400, "Invalid search regexp '$search_regexp'",
1388                                           esc_html($error));
1389                         }
1390                 } else {
1391                         $search_regexp = quotemeta $searchtext;
1392                 }
1393         }
1394 }
1395
1396 # path to the current git repository
1397 our $git_dir;
1398 sub evaluate_git_dir {
1399         our $git_dir = "$projectroot/$project" if $project;
1400 }
1401
1402 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1403 sub configure_gitweb_features {
1404         # list of supported snapshot formats
1405         our @snapshot_fmts = gitweb_get_feature('snapshot');
1406         @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1407
1408         # check that the avatar feature is set to a known provider name,
1409         # and for each provider check if the dependencies are satisfied.
1410         # if the provider name is invalid or the dependencies are not met,
1411         # reset $git_avatar to the empty string.
1412         our ($git_avatar) = gitweb_get_feature('avatar');
1413         if ($git_avatar eq 'gravatar') {
1414                 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1415         } elsif ($git_avatar eq 'picon') {
1416                 # no dependencies
1417         } else {
1418                 $git_avatar = '';
1419         }
1420
1421         our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1422         @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1423 }
1424
1425 sub get_branch_refs {
1426         return ('heads', @extra_branch_refs);
1427 }
1428
1429 # custom error handler: 'die <message>' is Internal Server Error
1430 sub handle_errors_html {
1431         my $msg = shift; # it is already HTML escaped
1432
1433         # to avoid infinite loop where error occurs in die_error,
1434         # change handler to default handler, disabling handle_errors_html
1435         set_message("Error occurred when inside die_error:\n$msg");
1436
1437         # you cannot jump out of die_error when called as error handler;
1438         # the subroutine set via CGI::Carp::set_message is called _after_
1439         # HTTP headers are already written, so it cannot write them itself
1440         die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1441 }
1442 set_message(\&handle_errors_html);
1443
1444 our $shown_stale_message = 0;
1445 our $cache_dump = undef;
1446 our $cache_dump_mtime = undef;
1447
1448 # dispatch
1449 sub dispatch {
1450         $shown_stale_message = 0;
1451         if (!defined $action) {
1452                 if (defined $hash) {
1453                         $action = git_get_type($hash);
1454                         $action or die_error(404, "Object does not exist");
1455                 } elsif (defined $hash_base && defined $file_name) {
1456                         $action = git_get_type("$hash_base:$file_name");
1457                         $action or die_error(404, "File or directory does not exist");
1458                 } elsif (defined $project) {
1459                         $action = 'summary';
1460                 } else {
1461                         $action = 'frontpage';
1462                 }
1463         }
1464         if (!defined($actions{$action})) {
1465                 die_error(400, "Unknown action");
1466         }
1467         if ($action !~ m/^(?:opml|frontpage|project_list|project_index)$/ &&
1468             !$project) {
1469                 die_error(400, "Project needed");
1470         }
1471
1472         my $cached_page = $supported_cache_actions{$action}
1473                 ? cached_action_page($action)
1474                 : undef;
1475         print($cached_page), return if $cached_page;
1476         local *SAVEOUT = *STDOUT;
1477         my $caching_page = $supported_cache_actions{$action}
1478                 ? cached_action_start($action)
1479                 : undef;
1480
1481         $actions{$action}->();
1482
1483         if ($caching_page) {
1484                 $cached_page = cached_action_finish($action);
1485                 *STDOUT = *SAVEOUT;
1486                 if (!$cached_page) {
1487                         # Some other failure, redo without cache
1488                         print STDERR "re-generating $action page after caching failure\n";
1489                         $actions{$action}->();
1490                 } else {
1491                         print $cached_page;
1492                 }
1493         }
1494 }
1495
1496 sub reset_timer {
1497         our $t0 = [ gettimeofday() ]
1498                 if defined $t0;
1499         our $number_of_git_cmds = 0;
1500 }
1501
1502 our $first_request = 1;
1503 our $evaluate_uri_force = undef;
1504 sub run_request {
1505         reset_timer();
1506
1507         # Only allow GET and HEAD methods
1508         if (!$ENV{'REQUEST_METHOD'} || ($ENV{'REQUEST_METHOD'} ne 'GET' && $ENV{'REQUEST_METHOD'} ne 'HEAD')) {
1509                 print <<EOT;
1510 Status: 405 Method Not Allowed
1511 Content-Type: text/plain
1512 Allow: GET,HEAD
1513
1514 405 Method Not Allowed
1515 EOT
1516                 return;
1517         }
1518
1519         evaluate_uri();
1520         &$evaluate_uri_force() if $evaluate_uri_force;
1521         if ($per_request_config) {
1522                 if (ref($per_request_config) eq 'CODE') {
1523                         $per_request_config->();
1524                 } elsif (!$first_request) {
1525                         evaluate_gitweb_config();
1526                         evaluate_email_obfuscate();
1527                 }
1528         }
1529         check_loadavg();
1530
1531         # $projectroot and $projects_list might be set in gitweb config file
1532         $projects_list ||= $projectroot;
1533
1534         evaluate_query_params();
1535         evaluate_path_info();
1536         evaluate_and_validate_params();
1537         evaluate_git_dir();
1538
1539         configure_gitweb_features();
1540
1541         dispatch();
1542 }
1543
1544 our $is_last_request = sub { 1 };
1545 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1546 our $CGI = 'CGI';
1547 our $cgi;
1548 our $fcgi_mode = 0;
1549 our $fcgi_raw_mode = 0;
1550 sub configure_as_fcgi {
1551         return if $fcgi_mode;
1552
1553         require FCGI;
1554         require CGI::Fast;
1555
1556         # We have gone to great effort to make sure that all incoming data has
1557         # been converted from whatever format it was in into UTF-8.  We have
1558         # even taken care to make sure the output handle is in ':utf8' mode.
1559         # Now along comes FCGI and blows it with:
1560         #
1561         #     Use of wide characters in FCGI::Stream::PRINT is deprecated
1562         #      and will stop wprking[sic] in a future version of FCGI
1563         #
1564         # To fix this we replace FCGI::Stream::PRINT with our own routine that
1565         # first encodes everything and then calls the original routine, but
1566         # not if $fcgi_raw_mode is true (then we just call the original routine).
1567         #
1568         # Note that we could do this by using utf8::is_utf8 to check instead
1569         # of having a $fcgi_raw_mode global, but that would be slower to run
1570         # the test on each element and much slower than skipping the conversion
1571         # entirely when we know we're outputting raw bytes.
1572         my $orig = \&FCGI::Stream::PRINT;
1573         undef *FCGI::Stream::PRINT;
1574         *FCGI::Stream::PRINT = sub {
1575                 @_ = (shift, map {my $x=$_; utf8::encode($x); $x} @_)
1576                         unless $fcgi_raw_mode;
1577                 goto $orig;
1578         };
1579
1580         our $CGI = 'CGI::Fast';
1581
1582         $fcgi_mode = 1;
1583         $first_request = 0;
1584         my $request_number = 0;
1585         # let each child service 100 requests
1586         our $is_last_request = sub { ++$request_number > 100 };
1587 }
1588 sub evaluate_argv {
1589         my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1590         configure_as_fcgi()
1591                 if $script_name =~ /\.fcgi$/
1592                 or $auto_fcgi && defined fileno STDIN && fileno STDIN == 0 && getsockname(STDIN);
1593
1594         return unless (@ARGV);
1595
1596         require Getopt::Long;
1597         Getopt::Long::GetOptions(
1598                 'fastcgi|fcgi|f' => \&configure_as_fcgi,
1599                 'nproc|n=i' => sub {
1600                         my ($arg, $val) = @_;
1601                         return unless eval { require FCGI::ProcManager; 1; };
1602                         my $proc_manager = FCGI::ProcManager->new({
1603                                 n_processes => $val,
1604                         });
1605                         our $pre_listen_hook    = sub { $proc_manager->pm_manage()        };
1606                         our $pre_dispatch_hook  = sub { $proc_manager->pm_pre_dispatch()  };
1607                         our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1608                 },
1609         );
1610 }
1611
1612 sub run {
1613         evaluate_gitweb_config();
1614         evaluate_encoding();
1615         evaluate_email_obfuscate();
1616         evaluate_git_version();
1617         my ($mu, $hl, $subroutine) = ($my_uri, $home_link, '');
1618         $subroutine .= '$my_uri = $mu;' if defined $my_uri && $my_uri ne '';
1619         $subroutine .= '$home_link = $hl;' if defined $home_link && $home_link ne '';
1620         $evaluate_uri_force = eval "sub {$subroutine}" if $subroutine;
1621         $first_request = 1;
1622         evaluate_argv();
1623
1624         $pre_listen_hook->()
1625                 if $pre_listen_hook;
1626
1627  REQUEST:
1628         while ($cgi = $CGI->new()) {
1629                 $pre_dispatch_hook->()
1630                         if $pre_dispatch_hook;
1631
1632                 run_request();
1633
1634                 $post_dispatch_hook->()
1635                         if $post_dispatch_hook;
1636                 $first_request = 0;
1637
1638                 last REQUEST if ($is_last_request->());
1639         }
1640
1641  DONE_GITWEB:
1642         1;
1643 }
1644
1645 run();
1646
1647 if (defined caller) {
1648         # wrapped in a subroutine processing requests,
1649         # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1650         return;
1651 } else {
1652         # pure CGI script, serving single request
1653         exit;
1654 }
1655
1656 ## ======================================================================
1657 ## action links
1658
1659 # possible values of extra options
1660 # -full => 0|1      - use absolute/full URL ($my_uri/$my_url as base)
1661 # -replay => 1      - start from a current view (replay with modifications)
1662 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1663 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1664 sub href {
1665         my %params = @_;
1666         # default is to use -absolute url() i.e. $my_uri
1667         my $href = $params{-full} ? $my_url : $my_uri;
1668
1669         # implicit -replay, must be first of implicit params
1670         $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1671
1672         $params{'project'} = $project unless exists $params{'project'};
1673
1674         if ($params{-replay}) {
1675                 while (my ($name, $symbol) = each %cgi_param_mapping) {
1676                         if (!exists $params{$name}) {
1677                                 $params{$name} = $input_params{$name};
1678                         }
1679                 }
1680         }
1681
1682         my $use_pathinfo = gitweb_check_feature('pathinfo');
1683         if (defined $params{'project'} &&
1684             (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1685                 # try to put as many parameters as possible in PATH_INFO:
1686                 #   - project name
1687                 #   - action
1688                 #   - hash_parent or hash_parent_base:/file_parent
1689                 #   - hash or hash_base:/filename
1690                 #   - the snapshot_format as an appropriate suffix
1691
1692                 # When the script is the root DirectoryIndex for the domain,
1693                 # $href here would be something like http://gitweb.example.com/
1694                 # Thus, we strip any trailing / from $href, to spare us double
1695                 # slashes in the final URL
1696                 $href =~ s,/$,,;
1697
1698                 # Then add the project name, if present
1699                 $href .= "/".esc_path_info($params{'project'});
1700                 delete $params{'project'};
1701
1702                 # since we destructively absorb parameters, we keep this
1703                 # boolean that remembers if we're handling a snapshot
1704                 my $is_snapshot = $params{'action'} eq 'snapshot';
1705
1706                 # Summary just uses the project path URL, any other action is
1707                 # added to the URL
1708                 if (defined $params{'action'}) {
1709                         $href .= "/".esc_path_info($params{'action'})
1710                                 unless $params{'action'} eq 'summary';
1711                         delete $params{'action'};
1712                 }
1713
1714                 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1715                 # stripping nonexistent or useless pieces
1716                 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1717                         || $params{'hash_parent'} || $params{'hash'});
1718                 if (defined $params{'hash_base'}) {
1719                         if (defined $params{'hash_parent_base'}) {
1720                                 $href .= esc_path_info($params{'hash_parent_base'});
1721                                 # skip the file_parent if it's the same as the file_name
1722                                 if (defined $params{'file_parent'}) {
1723                                         if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1724                                                 delete $params{'file_parent'};
1725                                         } elsif ($params{'file_parent'} !~ /\.\./) {
1726                                                 $href .= ":/".esc_path_info($params{'file_parent'});
1727                                                 delete $params{'file_parent'};
1728                                         }
1729                                 }
1730                                 $href .= "..";
1731                                 delete $params{'hash_parent'};
1732                                 delete $params{'hash_parent_base'};
1733                         } elsif (defined $params{'hash_parent'}) {
1734                                 $href .= esc_path_info($params{'hash_parent'}). "..";
1735                                 delete $params{'hash_parent'};
1736                         }
1737
1738                         $href .= esc_path_info($params{'hash_base'});
1739                         if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1740                                 $href .= ":/".esc_path_info($params{'file_name'});
1741                                 delete $params{'file_name'};
1742                         }
1743                         delete $params{'hash'};
1744                         delete $params{'hash_base'};
1745                 } elsif (defined $params{'hash'}) {
1746                         $href .= esc_path_info($params{'hash'});
1747                         delete $params{'hash'};
1748                 }
1749
1750                 # If the action was a snapshot, we can absorb the
1751                 # snapshot_format parameter too
1752                 if ($is_snapshot) {
1753                         my $fmt = $params{'snapshot_format'};
1754                         # snapshot_format should always be defined when href()
1755                         # is called, but just in case some code forgets, we
1756                         # fall back to the default
1757                         $fmt ||= $snapshot_fmts[0];
1758                         $href .= $known_snapshot_formats{$fmt}{'suffix'};
1759                         delete $params{'snapshot_format'};
1760                 }
1761         }
1762
1763         # now encode the parameters explicitly
1764         my @result = ();
1765         for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1766                 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1767                 if (defined $params{$name}) {
1768                         if (ref($params{$name}) eq "ARRAY") {
1769                                 foreach my $par (@{$params{$name}}) {
1770                                         push @result, $symbol . "=" . esc_param($par);
1771                                 }
1772                         } else {
1773                                 push @result, $symbol . "=" . esc_param($params{$name});
1774                         }
1775                 }
1776         }
1777         $href .= "?" . join(';', @result) if scalar @result;
1778
1779         # final transformation: trailing spaces must be escaped (URI-encoded)
1780         $href =~ s/(\s+)$/CGI::escape($1)/e;
1781
1782         if ($params{-anchor}) {
1783                 $href .= "#".esc_param($params{-anchor});
1784         }
1785
1786         return $href;
1787 }
1788
1789
1790 ## ======================================================================
1791 ## validation, quoting/unquoting and escaping
1792
1793 sub is_valid_action {
1794         my $input = shift;
1795         return undef unless exists $actions{$input};
1796         return 1;
1797 }
1798
1799 sub is_valid_project {
1800         my $input = shift;
1801
1802         return unless defined $input;
1803         if (!is_valid_pathname($input) ||
1804                 !(-d "$projectroot/$input") ||
1805                 !check_export_ok("$projectroot/$input") ||
1806                 ($strict_export && !project_in_list($input))) {
1807                 return undef;
1808         } else {
1809                 return 1;
1810         }
1811 }
1812
1813 sub is_valid_pathname {
1814         my $input = shift;
1815
1816         return undef unless defined $input;
1817         # no '.' or '..' as elements of path, i.e. no '.' or '..'
1818         # at the beginning, at the end, and between slashes.
1819         # also this catches doubled slashes
1820         if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1821                 return undef;
1822         }
1823         # no null characters
1824         if ($input =~ m!\0!) {
1825                 return undef;
1826         }
1827         return 1;
1828 }
1829
1830 sub is_valid_ref_format {
1831         my $input = shift;
1832
1833         return undef unless defined $input;
1834         # restrictions on ref name according to git-check-ref-format
1835         if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1836                 return undef;
1837         }
1838         return 1;
1839 }
1840
1841 sub is_valid_refname {
1842         my $input = shift;
1843
1844         return undef unless defined $input;
1845         # textual hashes are O.K.
1846         if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1847                 return 1;
1848         }
1849         # it must be correct pathname
1850         is_valid_pathname($input) or return undef;
1851         # check git-check-ref-format restrictions
1852         is_valid_ref_format($input) or return undef;
1853         return 1;
1854 }
1855
1856 # decode sequences of octets in utf8 into Perl's internal form,
1857 # which is utf-8 with utf8 flag set if needed.  gitweb writes out
1858 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
1859 sub to_utf8 {
1860         my $str = shift;
1861         return undef unless defined $str;
1862
1863         if (utf8::is_utf8($str) || utf8::decode($str)) {
1864                 return $str;
1865         } else {
1866                 return $encode_object->decode($str, Encode::FB_DEFAULT);
1867         }
1868 }
1869
1870 # quote unsafe chars, but keep the slash, even when it's not
1871 # correct, but quoted slashes look too horrible in bookmarks
1872 sub esc_param {
1873         my $str = shift;
1874         return undef unless defined $str;
1875         $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
1876         $str =~ s/ /\+/g;
1877         return $str;
1878 }
1879
1880 # the quoting rules for path_info fragment are slightly different
1881 sub esc_path_info {
1882         my $str = shift;
1883         return undef unless defined $str;
1884
1885         # path_info doesn't treat '+' as space (specially), but '?' must be escaped
1886         $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
1887
1888         return $str;
1889 }
1890
1891 # quote unsafe chars in whole URL, so some characters cannot be quoted
1892 sub esc_url {
1893         my $str = shift;
1894         return undef unless defined $str;
1895         $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
1896         $str =~ s/ /\+/g;
1897         return $str;
1898 }
1899
1900 # quote unsafe characters in HTML attributes
1901 sub esc_attr {
1902
1903         # for XHTML conformance escaping '"' to '&quot;' is not enough
1904         return esc_html(@_);
1905 }
1906
1907 # replace invalid utf8 character with SUBSTITUTION sequence
1908 sub esc_html {
1909         my $str = shift;
1910         my %opts = @_;
1911
1912         return undef unless defined $str;
1913
1914         $str = to_utf8($str);
1915         $str = $cgi->escapeHTML($str);
1916         if ($opts{'-nbsp'}) {
1917                 $str =~ s/ /&#160;/g;
1918         }
1919         use bytes;
1920         $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
1921         return $str;
1922 }
1923
1924 # quote control characters and escape filename to HTML
1925 sub esc_path {
1926         my $str = shift;
1927         my %opts = @_;
1928
1929         return undef unless defined $str;
1930
1931         $str = to_utf8($str);
1932         $str = $cgi->escapeHTML($str);
1933         if ($opts{'-nbsp'}) {
1934                 $str =~ s/ /&#160;/g;
1935         }
1936         use bytes;
1937         $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
1938         return $str;
1939 }
1940
1941 # Sanitize for use in XHTML + application/xml+xhtm (valid XML 1.0)
1942 sub sanitize {
1943         my $str = shift;
1944
1945         return undef unless defined $str;
1946
1947         $str = to_utf8($str);
1948         use bytes;
1949         $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
1950         return $str;
1951 }
1952
1953 # Make control characters "printable", using character escape codes (CEC)
1954 sub quot_cec {
1955         my $cntrl = shift;
1956         my %opts = @_;
1957         my %es = ( # character escape codes, aka escape sequences
1958                 "\t" => '\t',   # tab            (HT)
1959                 "\n" => '\n',   # line feed      (LF)
1960                 "\r" => '\r',   # carrige return (CR)
1961                 "\f" => '\f',   # form feed      (FF)
1962                 "\b" => '\b',   # backspace      (BS)
1963                 "\a" => '\a',   # alarm (bell)   (BEL)
1964                 "\e" => '\e',   # escape         (ESC)
1965                 "\013" => '\v', # vertical tab   (VT)
1966                 "\000" => '\0', # nul character  (NUL)
1967         );
1968         my $chr = ( (exists $es{$cntrl})
1969                     ? $es{$cntrl}
1970                     : sprintf('\x%02x', ord($cntrl)) );
1971         if ($opts{-nohtml}) {
1972                 return $chr;
1973         } else {
1974                 return "<span class=\"cntrl\">$chr</span>";
1975         }
1976 }
1977
1978 # Alternatively use unicode control pictures codepoints,
1979 # Unicode "printable representation" (PR)
1980 sub quot_upr {
1981         my $cntrl = shift;
1982         my %opts = @_;
1983
1984         my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
1985         if ($opts{-nohtml}) {
1986                 return $chr;
1987         } else {
1988                 return "<span class=\"cntrl\">$chr</span>";
1989         }
1990 }
1991
1992 # git may return quoted and escaped filenames
1993 sub unquote {
1994         my $str = shift;
1995
1996         sub unq {
1997                 my $seq = shift;
1998                 my %es = ( # character escape codes, aka escape sequences
1999                         't' => "\t",   # tab            (HT, TAB)
2000                         'n' => "\n",   # newline        (NL)
2001                         'r' => "\r",   # return         (CR)
2002                         'f' => "\f",   # form feed      (FF)
2003                         'b' => "\b",   # backspace      (BS)
2004                         'a' => "\a",   # alarm (bell)   (BEL)
2005                         'e' => "\e",   # escape         (ESC)
2006                         'v' => "\013", # vertical tab   (VT)
2007                 );
2008
2009                 if ($seq =~ m/^[0-7]{1,3}$/) {
2010                         # octal char sequence
2011                         return chr(oct($seq));
2012                 } elsif (exists $es{$seq}) {
2013                         # C escape sequence, aka character escape code
2014                         return $es{$seq};
2015                 }
2016                 # quoted ordinary character
2017                 return $seq;
2018         }
2019
2020         if ($str =~ m/^"(.*)"$/) {
2021                 # needs unquoting
2022                 $str = $1;
2023                 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
2024         }
2025         return $str;
2026 }
2027
2028 # escape tabs (convert tabs to spaces)
2029 sub untabify {
2030         my $line = shift;
2031
2032         while ((my $pos = index($line, "\t")) != -1) {
2033                 if (my $count = (8 - ($pos % 8))) {
2034                         my $spaces = ' ' x $count;
2035                         $line =~ s/\t/$spaces/;
2036                 }
2037         }
2038
2039         return $line;
2040 }
2041
2042 sub project_in_list {
2043         my $project = shift;
2044         my @list = git_get_projects_list();
2045         return @list && scalar(grep { $_->{'path'} eq $project } @list);
2046 }
2047
2048 sub cached_action_page {
2049         my $action = shift;
2050         my $precious = shift;
2051
2052         use POSIX qw(fstat strftime);
2053
2054         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2055         my $cache_file = "$projectroot/$project/$html_cache_dir/$action";
2056         return undef if !$precious && -e "$cache_file.changed";
2057         open my $fd, '<', "$projectroot/$project/$html_cache_dir/$action" or
2058                 return undef;
2059         local $/;
2060         my $cached_page = <$fd>;
2061         my ($ino, $sz, $mtime) = (fstat(fileno $fd))[1,7,9];
2062         close $fd && $ino && $sz && $mtime or return undef;
2063         my $offset = length($1) if $cached_page =~ /^(Status\s*:.*\n)/i;
2064         my $hdrs = "Last-Modified: " .
2065                 strftime("%a, %d %b %Y %H:%M:%S GMT", gmtime($mtime)) . "\r\n";
2066         $hdrs .= "ETag: \"" .
2067                 sprintf("%x-%x-%x", $ino, $sz, $mtime) . "\"\r\n";
2068         substr($cached_page, $offset||0, 0) = $hdrs;
2069         return $cached_page;
2070 }
2071
2072 # Caller is responsible for preserving STDOUT beforehand if needed
2073 sub cached_action_start {
2074         my $action = shift;
2075
2076         use POSIX qw(:fcntl_h);
2077
2078         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2079         local *CACHEFILE;
2080         my $cache_file = "$projectroot/$project/$html_cache_dir/$action";
2081         sysopen(CACHEFILE, "$cache_file.lock",
2082                 O_WRONLY|O_CREAT|O_EXCL, 0664) or return undef;
2083         *STDOUT = *CACHEFILE;
2084         unlink "$cache_file.changed";
2085         return 1;
2086 }
2087
2088 # Caller is responsible for restoring STDOUT afterward if needed
2089 sub cached_action_finish {
2090         my $action = shift;
2091
2092         use File::Spec;
2093
2094         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2095         my $cache_file = "$projectroot/$project/$html_cache_dir/$action";
2096         close(STDOUT) or die "couldn't close cache file on STDOUT: $!";
2097         # Do not leave STDOUT file descriptor invalid!
2098         local *NULL;
2099         open(NULL, '>', File::Spec->devnull) or die "couldn't open NULL to devnull: $!";
2100         *STDOUT = *NULL;
2101         unlink "$cache_file.lock" unless rename "$cache_file.lock", $cache_file;
2102         return cached_action_page($action, 1);
2103 }
2104
2105 ## ----------------------------------------------------------------------
2106 ## HTML aware string manipulation
2107
2108 # Try to chop given string on a word boundary between position
2109 # $len and $len+$add_len. If there is no word boundary there,
2110 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
2111 # (marking chopped part) would be longer than given string.
2112 sub chop_str {
2113         my $str = shift;
2114         my $len = shift;
2115         my $add_len = shift || 10;
2116         my $where = shift || 'right'; # 'left' | 'center' | 'right'
2117
2118         # Make sure perl knows it is utf8 encoded so we don't
2119         # cut in the middle of a utf8 multibyte char.
2120         $str = to_utf8($str);
2121
2122         # allow only $len chars, but don't cut a word if it would fit in $add_len
2123         # if it doesn't fit, cut it if it's still longer than the dots we would add
2124         # remove chopped character entities entirely
2125
2126         # when chopping in the middle, distribute $len into left and right part
2127         # return early if chopping wouldn't make string shorter
2128         if ($where eq 'center') {
2129                 return $str if ($len + 5 >= length($str)); # filler is length 5
2130                 $len = int($len/2);
2131         } else {
2132                 return $str if ($len + 4 >= length($str)); # filler is length 4
2133         }
2134
2135         # regexps: ending and beginning with word part up to $add_len
2136         my $endre = qr/.{$len}\w{0,$add_len}/;
2137         my $begre = qr/\w{0,$add_len}.{$len}/;
2138
2139         if ($where eq 'left') {
2140                 $str =~ m/^(.*?)($begre)$/;
2141                 my ($lead, $body) = ($1, $2);
2142                 if (length($lead) > 4) {
2143                         $lead = " ...";
2144                 }
2145                 return "$lead$body";
2146
2147         } elsif ($where eq 'center') {
2148                 $str =~ m/^($endre)(.*)$/;
2149                 my ($left, $str)  = ($1, $2);
2150                 $str =~ m/^(.*?)($begre)$/;
2151                 my ($mid, $right) = ($1, $2);
2152                 if (length($mid) > 5) {
2153                         $mid = " ... ";
2154                 }
2155                 return "$left$mid$right";
2156
2157         } else {
2158                 $str =~ m/^($endre)(.*)$/;
2159                 my $body = $1;
2160                 my $tail = $2;
2161                 if (length($tail) > 4) {
2162                         $tail = "... ";
2163                 }
2164                 return "$body$tail";
2165         }
2166 }
2167
2168 # pass-through email filter, obfuscating it when possible
2169 sub email_obfuscate {
2170         our $email;
2171         my ($str) = @_;
2172         if ($email) {
2173                 $str = $email->escape_html($str);
2174                 # Stock HTML::Email::Obfuscate version likes to produce
2175                 # invalid XHTML...
2176                 $str =~ s#<(/?)B>#<$1b>#g;
2177                 return $str;
2178         } else {
2179                 $str = esc_html($str);
2180                 $str =~ s/@/&#x40;/;
2181                 return $str;
2182         }
2183 }
2184
2185 # takes the same arguments as chop_str, but also wraps a <span> around the
2186 # result with a title attribute if it does get chopped. Additionally, the
2187 # string is HTML-escaped.
2188 sub chop_and_escape_str {
2189         my ($str) = @_;
2190
2191         my $chopped = chop_str(@_);
2192         $str = to_utf8($str);
2193         if ($chopped eq $str) {
2194                 return email_obfuscate($chopped);
2195         } else {
2196                 use bytes;
2197                 $str =~ s/[[:cntrl:]]/?/g;
2198                 return $cgi->span({-title=>$str}, email_obfuscate($chopped));
2199         }
2200 }
2201
2202 # Highlight selected fragments of string, using given CSS class,
2203 # and escape HTML.  It is assumed that fragments do not overlap.
2204 # Regions are passed as list of pairs (array references).
2205 #
2206 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
2207 # '<span class="mark">foo</span>bar'
2208 sub esc_html_hl_regions {
2209         my ($str, $css_class, @sel) = @_;
2210         my %opts = grep { ref($_) ne 'ARRAY' } @sel;
2211         @sel     = grep { ref($_) eq 'ARRAY' } @sel;
2212         return esc_html($str, %opts) unless @sel;
2213
2214         my $out = '';
2215         my $pos = 0;
2216
2217         for my $s (@sel) {
2218                 my ($begin, $end) = @$s;
2219
2220                 # Don't create empty <span> elements.
2221                 next if $end <= $begin;
2222
2223                 my $escaped = esc_html(substr($str, $begin, $end - $begin),
2224                                        %opts);
2225
2226                 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
2227                         if ($begin - $pos > 0);
2228                 $out .= $cgi->span({-class => $css_class}, $escaped);
2229
2230                 $pos = $end;
2231         }
2232         $out .= esc_html(substr($str, $pos), %opts)
2233                 if ($pos < length($str));
2234
2235         return $out;
2236 }
2237
2238 # return positions of beginning and end of each match
2239 sub matchpos_list {
2240         my ($str, $regexp) = @_;
2241         return unless (defined $str && defined $regexp);
2242
2243         my @matches;
2244         while ($str =~ /$regexp/g) {
2245                 push @matches, [$-[0], $+[0]];
2246         }
2247         return @matches;
2248 }
2249
2250 # highlight match (if any), and escape HTML
2251 sub esc_html_match_hl {
2252         my ($str, $regexp) = @_;
2253         return esc_html($str) unless defined $regexp;
2254
2255         my @matches = matchpos_list($str, $regexp);
2256         return esc_html($str) unless @matches;
2257
2258         return esc_html_hl_regions($str, 'match', @matches);
2259 }
2260
2261
2262 # highlight match (if any) of shortened string, and escape HTML
2263 sub esc_html_match_hl_chopped {
2264         my ($str, $chopped, $regexp) = @_;
2265         return esc_html_match_hl($str, $regexp) unless defined $chopped;
2266
2267         my @matches = matchpos_list($str, $regexp);
2268         return esc_html($chopped) unless @matches;
2269
2270         # filter matches so that we mark chopped string
2271         my $tail = "... "; # see chop_str
2272         unless ($chopped =~ s/\Q$tail\E$//) {
2273                 $tail = '';
2274         }
2275         my $chop_len = length($chopped);
2276         my $tail_len = length($tail);
2277         my @filtered;
2278
2279         for my $m (@matches) {
2280                 if ($m->[0] > $chop_len) {
2281                         push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
2282                         last;
2283                 } elsif ($m->[1] > $chop_len) {
2284                         push @filtered, [ $m->[0], $chop_len + $tail_len ];
2285                         last;
2286                 }
2287                 push @filtered, $m;
2288         }
2289
2290         return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
2291 }
2292
2293 ## ----------------------------------------------------------------------
2294 ## functions returning short strings
2295
2296 # CSS class for given age value (in seconds)
2297 sub age_class {
2298         my $age = shift;
2299
2300         if (!defined $age) {
2301                 return "noage";
2302         } elsif ($age < 60*60*2) {
2303                 return "age0";
2304         } elsif ($age < 60*60*24*2) {
2305                 return "age1";
2306         } else {
2307                 return "age2";
2308         }
2309 }
2310
2311 # convert age in seconds to "nn units ago" string
2312 sub age_string {
2313         my $age = shift;
2314         my $age_str;
2315
2316         if ($age > 60*60*24*365*2) {
2317                 $age_str = (int $age/60/60/24/365);
2318                 $age_str .= " years ago";
2319         } elsif ($age > 60*60*24*(365/12)*2) {
2320                 $age_str = int $age/60/60/24/(365/12);
2321                 $age_str .= " months ago";
2322         } elsif ($age > 60*60*24*7*2) {
2323                 $age_str = int $age/60/60/24/7;
2324                 $age_str .= " weeks ago";
2325         } elsif ($age > 60*60*24*2) {
2326                 $age_str = int $age/60/60/24;
2327                 $age_str .= " days ago";
2328         } elsif ($age > 60*60*2) {
2329                 $age_str = int $age/60/60;
2330                 $age_str .= " hours ago";
2331         } elsif ($age > 60*2) {
2332                 $age_str = int $age/60;
2333                 $age_str .= " min ago";
2334         } elsif ($age > 2) {
2335                 $age_str = int $age;
2336                 $age_str .= " sec ago";
2337         } else {
2338                 $age_str .= " right now";
2339         }
2340         return $age_str;
2341 }
2342
2343 use constant {
2344         S_IFINVALID => 0030000,
2345         S_IFGITLINK => 0160000,
2346 };
2347
2348 # submodule/subproject, a commit object reference
2349 sub S_ISGITLINK {
2350         my $mode = shift;
2351
2352         return (($mode & S_IFMT) == S_IFGITLINK)
2353 }
2354
2355 # convert file mode in octal to symbolic file mode string
2356 sub mode_str {
2357         my $mode = oct shift;
2358
2359         if (S_ISGITLINK($mode)) {
2360                 return 'm---------';
2361         } elsif (S_ISDIR($mode & S_IFMT)) {
2362                 return 'drwxr-xr-x';
2363         } elsif (S_ISLNK($mode)) {
2364                 return 'lrwxrwxrwx';
2365         } elsif (S_ISREG($mode)) {
2366                 # git cares only about the executable bit
2367                 if ($mode & S_IXUSR) {
2368                         return '-rwxr-xr-x';
2369                 } else {
2370                         return '-rw-r--r--';
2371                 };
2372         } else {
2373                 return '----------';
2374         }
2375 }
2376
2377 # convert file mode in octal to file type string
2378 sub file_type {
2379         my $mode = shift;
2380
2381         if ($mode !~ m/^[0-7]+$/) {
2382                 return $mode;
2383         } else {
2384                 $mode = oct $mode;
2385         }
2386
2387         if (S_ISGITLINK($mode)) {
2388                 return "submodule";
2389         } elsif (S_ISDIR($mode & S_IFMT)) {
2390                 return "directory";
2391         } elsif (S_ISLNK($mode)) {
2392                 return "symlink";
2393         } elsif (S_ISREG($mode)) {
2394                 return "file";
2395         } else {
2396                 return "unknown";
2397         }
2398 }
2399
2400 # convert file mode in octal to file type description string
2401 sub file_type_long {
2402         my $mode = shift;
2403
2404         if ($mode !~ m/^[0-7]+$/) {
2405                 return $mode;
2406         } else {
2407                 $mode = oct $mode;
2408         }
2409
2410         if (S_ISGITLINK($mode)) {
2411                 return "submodule";
2412         } elsif (S_ISDIR($mode & S_IFMT)) {
2413                 return "directory";
2414         } elsif (S_ISLNK($mode)) {
2415                 return "symlink";
2416         } elsif (S_ISREG($mode)) {
2417                 if ($mode & S_IXUSR) {
2418                         return "executable";
2419                 } else {
2420                         return "file";
2421                 };
2422         } else {
2423                 return "unknown";
2424         }
2425 }
2426
2427
2428 ## ----------------------------------------------------------------------
2429 ## functions returning short HTML fragments, or transforming HTML fragments
2430 ## which don't belong to other sections
2431
2432 # format line of commit message.
2433 sub format_log_line_html {
2434         my $line = shift;
2435
2436         $line = esc_html($line, -nbsp=>1);
2437         $line =~ s{\b([0-9a-fA-F]{8,40})\b}{
2438                 $cgi->a({-href => href(action=>"object", hash=>$1),
2439                                         -class => "text"}, $1);
2440         }eg unless $line =~ /^\s*git-svn-id:/;
2441
2442         return $line;
2443 }
2444
2445 # format marker of refs pointing to given object
2446
2447 # the destination action is chosen based on object type and current context:
2448 # - for annotated tags, we choose the tag view unless it's the current view
2449 #   already, in which case we go to shortlog view
2450 # - for other refs, we keep the current view if we're in history, shortlog or
2451 #   log view, and select shortlog otherwise
2452 sub format_ref_marker {
2453         my ($refs, $id) = @_;
2454         my $markers = '';
2455
2456         if (defined $refs->{$id}) {
2457                 foreach my $ref (@{$refs->{$id}}) {
2458                         # this code exploits the fact that non-lightweight tags are the
2459                         # only indirect objects, and that they are the only objects for which
2460                         # we want to use tag instead of shortlog as action
2461                         my ($type, $name) = qw();
2462                         my $indirect = ($ref =~ s/\^\{\}$//);
2463                         # e.g. tags/v2.6.11 or heads/next
2464                         if ($ref =~ m!^(.*?)s?/(.*)$!) {
2465                                 $type = $1;
2466                                 $name = $2;
2467                         } else {
2468                                 $type = "ref";
2469                                 $name = $ref;
2470                         }
2471
2472                         my $class = $type;
2473                         $class .= " indirect" if $indirect;
2474
2475                         my $dest_action = "shortlog";
2476
2477                         if ($indirect) {
2478                                 $dest_action = "tag" unless $action eq "tag";
2479                         } elsif ($action =~ /^(history|(short)?log)$/) {
2480                                 $dest_action = $action;
2481                         }
2482
2483                         my $dest = "";
2484                         $dest .= "refs/" unless $ref =~ m!^refs/!;
2485                         $dest .= $ref;
2486
2487                         my $link = $cgi->a({
2488                                 -href => href(
2489                                         action=>$dest_action,
2490                                         hash=>$dest
2491                                 )}, $name);
2492
2493                         $markers .= "<span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2494                                 $link . "</span>";
2495                 }
2496         }
2497
2498         if ($markers) {
2499                 return '<span class="refs">'. $markers . '</span>';
2500         } else {
2501                 return "";
2502         }
2503 }
2504
2505 # format, perhaps shortened and with markers, title line
2506 sub format_subject_html {
2507         my ($long, $short, $href, $extra) = @_;
2508         $extra = '' unless defined($extra);
2509
2510         if (length($short) < length($long)) {
2511                 use bytes;
2512                 $long =~ s/[[:cntrl:]]/?/g;
2513                 return $cgi->a({-href => $href, -class => "list subject",
2514                                 -title => to_utf8($long)},
2515                        esc_html($short)) . $extra;
2516         } else {
2517                 return $cgi->a({-href => $href, -class => "list subject"},
2518                        esc_html($long)) . $extra;
2519         }
2520 }
2521
2522 # Rather than recomputing the url for an email multiple times, we cache it
2523 # after the first hit. This gives a visible benefit in views where the avatar
2524 # for the same email is used repeatedly (e.g. shortlog).
2525 # The cache is shared by all avatar engines (currently gravatar only), which
2526 # are free to use it as preferred. Since only one avatar engine is used for any
2527 # given page, there's no risk for cache conflicts.
2528 our %avatar_cache = ();
2529
2530 # Compute the picon url for a given email, by using the picon search service over at
2531 # http://www.cs.indiana.edu/picons/search.html
2532 sub picon_url {
2533         my $email = lc shift;
2534         if (!$avatar_cache{$email}) {
2535                 my ($user, $domain) = split('@', $email);
2536                 $avatar_cache{$email} =
2537                         "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2538                         "$domain/$user/" .
2539                         "users+domains+unknown/up/single";
2540         }
2541         return $avatar_cache{$email};
2542 }
2543
2544 # Compute the gravatar url for a given email, if it's not in the cache already.
2545 # Gravatar stores only the part of the URL before the size, since that's the
2546 # one computationally more expensive. This also allows reuse of the cache for
2547 # different sizes (for this particular engine).
2548 sub gravatar_url {
2549         my $email = lc shift;
2550         my $size = shift;
2551         $avatar_cache{$email} ||=
2552                 "//www.gravatar.com/avatar/" .
2553                         Digest::MD5::md5_hex($email) . "?s=";
2554         return $avatar_cache{$email} . $size;
2555 }
2556
2557 # Insert an avatar for the given $email at the given $size if the feature
2558 # is enabled.
2559 sub git_get_avatar {
2560         my ($email, %opts) = @_;
2561         my $pre_white  = ($opts{-pad_before} ? "&#160;" : "");
2562         my $post_white = ($opts{-pad_after}  ? "&#160;" : "");
2563         $opts{-size} ||= 'default';
2564         my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2565         my $url = "";
2566         if ($git_avatar eq 'gravatar') {
2567                 $url = gravatar_url($email, $size);
2568         } elsif ($git_avatar eq 'picon') {
2569                 $url = picon_url($email);
2570         }
2571         # Other providers can be added by extending the if chain, defining $url
2572         # as needed. If no variant puts something in $url, we assume avatars
2573         # are completely disabled/unavailable.
2574         if ($url) {
2575                 return $pre_white .
2576                        "<img width=\"$size\" " .
2577                             "class=\"avatar\" " .
2578                             "src=\"".esc_url($url)."\" " .
2579                             "alt=\"\" " .
2580                        "/>" . $post_white;
2581         } else {
2582                 return "";
2583         }
2584 }
2585
2586 sub format_search_author {
2587         my ($author, $searchtype, $displaytext) = @_;
2588         my $have_search = gitweb_check_feature('search');
2589
2590         if ($have_search) {
2591                 my $performed = "";
2592                 if ($searchtype eq 'author') {
2593                         $performed = "authored";
2594                 } elsif ($searchtype eq 'committer') {
2595                         $performed = "committed";
2596                 }
2597
2598                 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2599                                 searchtext=>$author,
2600                                 searchtype=>$searchtype), class=>"list",
2601                                 title=>"Search for commits $performed by $author"},
2602                                 $displaytext);
2603
2604         } else {
2605                 return $displaytext;
2606         }
2607 }
2608
2609 # format the author name of the given commit with the given tag
2610 # the author name is chopped and escaped according to the other
2611 # optional parameters (see chop_str).
2612 sub format_author_html {
2613         my $tag = shift;
2614         my $co = shift;
2615         my $author = chop_and_escape_str($co->{'author_name'}, @_);
2616         return "<$tag class=\"author\">" .
2617                format_search_author($co->{'author_name'}, "author",
2618                        git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2619                        $author) .
2620                "</$tag>";
2621 }
2622
2623 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
2624 sub format_git_diff_header_line {
2625         my $line = shift;
2626         my $diffinfo = shift;
2627         my ($from, $to) = @_;
2628
2629         if ($diffinfo->{'nparents'}) {
2630                 # combined diff
2631                 $line =~ s!^(diff (.*?) )"?.*$!$1!;
2632                 if ($to->{'href'}) {
2633                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2634                                          esc_path($to->{'file'}));
2635                 } else { # file was deleted (no href)
2636                         $line .= esc_path($to->{'file'});
2637                 }
2638         } else {
2639                 # "ordinary" diff
2640                 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
2641                 if ($from->{'href'}) {
2642                         $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
2643                                          'a/' . esc_path($from->{'file'}));
2644                 } else { # file was added (no href)
2645                         $line .= 'a/' . esc_path($from->{'file'});
2646                 }
2647                 $line .= ' ';
2648                 if ($to->{'href'}) {
2649                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2650                                          'b/' . esc_path($to->{'file'}));
2651                 } else { # file was deleted
2652                         $line .= 'b/' . esc_path($to->{'file'});
2653                 }
2654         }
2655
2656         return "<div class=\"diff header\">$line</div>\n";
2657 }
2658
2659 # format extended diff header line, before patch itself
2660 sub format_extended_diff_header_line {
2661         my $line = shift;
2662         my $diffinfo = shift;
2663         my ($from, $to) = @_;
2664
2665         # match <path>
2666         if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
2667                 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2668                                        esc_path($from->{'file'}));
2669         }
2670         if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
2671                 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2672                                  esc_path($to->{'file'}));
2673         }
2674         # match single <mode>
2675         if ($line =~ m/\s(\d{6})$/) {
2676                 $line .= '<span class="info"> (' .
2677                          file_type_long($1) .
2678                          ')</span>';
2679         }
2680         # match <hash>
2681         if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
2682                 # can match only for combined diff
2683                 $line = 'index ';
2684                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2685                         if ($from->{'href'}[$i]) {
2686                                 $line .= $cgi->a({-href=>$from->{'href'}[$i],
2687                                                   -class=>"hash"},
2688                                                  substr($diffinfo->{'from_id'}[$i],0,7));
2689                         } else {
2690                                 $line .= '0' x 7;
2691                         }
2692                         # separator
2693                         $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
2694                 }
2695                 $line .= '..';
2696                 if ($to->{'href'}) {
2697                         $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2698                                          substr($diffinfo->{'to_id'},0,7));
2699                 } else {
2700                         $line .= '0' x 7;
2701                 }
2702
2703         } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
2704                 # can match only for ordinary diff
2705                 my ($from_link, $to_link);
2706                 if ($from->{'href'}) {
2707                         $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
2708                                              substr($diffinfo->{'from_id'},0,7));
2709                 } else {
2710                         $from_link = '0' x 7;
2711                 }
2712                 if ($to->{'href'}) {
2713                         $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2714                                            substr($diffinfo->{'to_id'},0,7));
2715                 } else {
2716                         $to_link = '0' x 7;
2717                 }
2718                 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
2719                 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
2720         }
2721
2722         return $line . "<br/>\n";
2723 }
2724
2725 # format from-file/to-file diff header
2726 sub format_diff_from_to_header {
2727         my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
2728         my $line;
2729         my $result = '';
2730
2731         $line = $from_line;
2732         #assert($line =~ m/^---/) if DEBUG;
2733         # no extra formatting for "^--- /dev/null"
2734         if (! $diffinfo->{'nparents'}) {
2735                 # ordinary (single parent) diff
2736                 if ($line =~ m!^--- "?a/!) {
2737                         if ($from->{'href'}) {
2738                                 $line = '--- a/' .
2739                                         $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2740                                                 esc_path($from->{'file'}));
2741                         } else {
2742                                 $line = '--- a/' .
2743                                         esc_path($from->{'file'});
2744                         }
2745                 }
2746                 $result .= qq!<div class="diff from_file">$line</div>\n!;
2747
2748         } else {
2749                 # combined diff (merge commit)
2750                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2751                         if ($from->{'href'}[$i]) {
2752                                 $line = '--- ' .
2753                                         $cgi->a({-href=>href(action=>"blobdiff",
2754                                                              hash_parent=>$diffinfo->{'from_id'}[$i],
2755                                                              hash_parent_base=>$parents[$i],
2756                                                              file_parent=>$from->{'file'}[$i],
2757                                                              hash=>$diffinfo->{'to_id'},
2758                                                              hash_base=>$hash,
2759                                                              file_name=>$to->{'file'}),
2760                                                  -class=>"path",
2761                                                  -title=>"diff" . ($i+1)},
2762                                                 $i+1) .
2763                                         '/' .
2764                                         $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
2765                                                 esc_path($from->{'file'}[$i]));
2766                         } else {
2767                                 $line = '--- /dev/null';
2768                         }
2769                         $result .= qq!<div class="diff from_file">$line</div>\n!;
2770                 }
2771         }
2772
2773         $line = $to_line;
2774         #assert($line =~ m/^\+\+\+/) if DEBUG;
2775         # no extra formatting for "^+++ /dev/null"
2776         if ($line =~ m!^\+\+\+ "?b/!) {
2777                 if ($to->{'href'}) {
2778                         $line = '+++ b/' .
2779                                 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2780                                         esc_path($to->{'file'}));
2781                 } else {
2782                         $line = '+++ b/' .
2783                                 esc_path($to->{'file'});
2784                 }
2785         }
2786         $result .= qq!<div class="diff to_file">$line</div>\n!;
2787
2788         return $result;
2789 }
2790
2791 # create note for patch simplified by combined diff
2792 sub format_diff_cc_simplified {
2793         my ($diffinfo, @parents) = @_;
2794         my $result = '';
2795
2796         $result .= "<div class=\"diff header\">" .
2797                    "diff --cc ";
2798         if (!is_deleted($diffinfo)) {
2799                 $result .= $cgi->a({-href => href(action=>"blob",
2800                                                   hash_base=>$hash,
2801                                                   hash=>$diffinfo->{'to_id'},
2802                                                   file_name=>$diffinfo->{'to_file'}),
2803                                     -class => "path"},
2804                                    esc_path($diffinfo->{'to_file'}));
2805         } else {
2806                 $result .= esc_path($diffinfo->{'to_file'});
2807         }
2808         $result .= "</div>\n" . # class="diff header"
2809                    "<div class=\"diff nodifferences\">" .
2810                    "Simple merge" .
2811                    "</div>\n"; # class="diff nodifferences"
2812
2813         return $result;
2814 }
2815
2816 sub diff_line_class {
2817         my ($line, $from, $to) = @_;
2818
2819         # ordinary diff
2820         my $num_sign = 1;
2821         # combined diff
2822         if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
2823                 $num_sign = scalar @{$from->{'href'}};
2824         }
2825
2826         my @diff_line_classifier = (
2827                 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
2828                 { regexp => qr/^\\/,               class => "incomplete"  },
2829                 { regexp => qr/^ {$num_sign}/,     class => "ctx" },
2830                 # classifier for context must come before classifier add/rem,
2831                 # or we would have to use more complicated regexp, for example
2832                 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
2833                 { regexp => qr/^[+ ]{$num_sign}/,   class => "add" },
2834                 { regexp => qr/^[- ]{$num_sign}/,   class => "rem" },
2835         );
2836         for my $clsfy (@diff_line_classifier) {
2837                 return $clsfy->{'class'}
2838                         if ($line =~ $clsfy->{'regexp'});
2839         }
2840
2841         # fallback
2842         return "";
2843 }
2844
2845 # assumes that $from and $to are defined and correctly filled,
2846 # and that $line holds a line of chunk header for unified diff
2847 sub format_unidiff_chunk_header {
2848         my ($line, $from, $to) = @_;
2849
2850         my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
2851                 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
2852
2853         $from_lines = 0 unless defined $from_lines;
2854         $to_lines   = 0 unless defined $to_lines;
2855
2856         if ($from->{'href'}) {
2857                 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
2858                                      -class=>"list"}, $from_text);
2859         }
2860         if ($to->{'href'}) {
2861                 $to_text   = $cgi->a({-href=>"$to->{'href'}#l$to_start",
2862                                      -class=>"list"}, $to_text);
2863         }
2864         $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
2865                 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
2866         return $line;
2867 }
2868
2869 # assumes that $from and $to are defined and correctly filled,
2870 # and that $line holds a line of chunk header for combined diff
2871 sub format_cc_diff_chunk_header {
2872         my ($line, $from, $to) = @_;
2873
2874         my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
2875         my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
2876
2877         @from_text = split(' ', $ranges);
2878         for (my $i = 0; $i < @from_text; ++$i) {
2879                 ($from_start[$i], $from_nlines[$i]) =
2880                         (split(',', substr($from_text[$i], 1)), 0);
2881         }
2882
2883         $to_text   = pop @from_text;
2884         $to_start  = pop @from_start;
2885         $to_nlines = pop @from_nlines;
2886
2887         $line = "<span class=\"chunk_info\">$prefix ";
2888         for (my $i = 0; $i < @from_text; ++$i) {
2889                 if ($from->{'href'}[$i]) {
2890                         $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
2891                                           -class=>"list"}, $from_text[$i]);
2892                 } else {
2893                         $line .= $from_text[$i];
2894                 }
2895                 $line .= " ";
2896         }
2897         if ($to->{'href'}) {
2898                 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
2899                                   -class=>"list"}, $to_text);
2900         } else {
2901                 $line .= $to_text;
2902         }
2903         $line .= " $prefix</span>" .
2904                  "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
2905         return $line;
2906 }
2907
2908 # process patch (diff) line (not to be used for diff headers),
2909 # returning HTML-formatted (but not wrapped) line.
2910 # If the line is passed as a reference, it is treated as HTML and not
2911 # esc_html()'ed.
2912 sub format_diff_line {
2913         my ($line, $diff_class, $from, $to) = @_;
2914
2915         if (ref($line)) {
2916                 $line = $$line;
2917         } else {
2918                 chomp $line;
2919                 $line = untabify($line);
2920
2921                 if ($from && $to && $line =~ m/^\@{2} /) {
2922                         $line = format_unidiff_chunk_header($line, $from, $to);
2923                 } elsif ($from && $to && $line =~ m/^\@{3}/) {
2924                         $line = format_cc_diff_chunk_header($line, $from, $to);
2925                 } else {
2926                         $line = esc_html($line, -nbsp=>1);
2927                 }
2928         }
2929
2930         my $diff_classes = "diff diff_body";
2931         $diff_classes .= " $diff_class" if ($diff_class);
2932         $line = "<div class=\"$diff_classes\">$line</div>\n";
2933
2934         return $line;
2935 }
2936
2937 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
2938 # linked.  Pass the hash of the tree/commit to snapshot.
2939 sub format_snapshot_links {
2940         my ($hash) = @_;
2941         my $num_fmts = @snapshot_fmts;
2942         if ($num_fmts > 1) {
2943                 # A parenthesized list of links bearing format names.
2944                 # e.g. "snapshot (_tar.gz_ _zip_)"
2945                 return "snapshot (" . join(' ', map
2946                         $cgi->a({
2947                                 -href => href(
2948                                         action=>"snapshot",
2949                                         hash=>$hash,
2950                                         snapshot_format=>$_
2951                                 )
2952                         }, $known_snapshot_formats{$_}{'display'})
2953                 , @snapshot_fmts) . ")";
2954         } elsif ($num_fmts == 1) {
2955                 # A single "snapshot" link whose tooltip bears the format name.
2956                 # i.e. "_snapshot_"
2957                 my ($fmt) = @snapshot_fmts;
2958                 return
2959                         $cgi->a({
2960                                 -href => href(
2961                                         action=>"snapshot",
2962                                         hash=>$hash,
2963                                         snapshot_format=>$fmt
2964                                 ),
2965                                 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
2966                         }, "snapshot");
2967         } else { # $num_fmts == 0
2968                 return undef;
2969         }
2970 }
2971
2972 ## ......................................................................
2973 ## functions returning values to be passed, perhaps after some
2974 ## transformation, to other functions; e.g. returning arguments to href()
2975
2976 # returns hash to be passed to href to generate gitweb URL
2977 # in -title key it returns description of link
2978 sub get_feed_info {
2979         my $format = shift || 'Atom';
2980         my %res = (action => lc($format));
2981         my $matched_ref = 0;
2982
2983         # feed links are possible only for project views
2984         return unless (defined $project);
2985         # some views should link to OPML, or to generic project feed,
2986         # or don't have specific feed yet (so they should use generic)
2987         return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
2988
2989         my $branch = undef;
2990         # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
2991         # (fullname) to differentiate from tag links; this also makes
2992         # possible to detect branch links
2993         for my $ref (get_branch_refs()) {
2994                 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
2995                     (defined $hash      && $hash      =~ m!^refs/\Q$ref\E/(.*)$!)) {
2996                         $branch = $1;
2997                         $matched_ref = $ref;
2998                         last;
2999                 }
3000         }
3001         # find log type for feed description (title)
3002         my $type = 'log';
3003         if (defined $file_name) {
3004                 $type  = "history of $file_name";
3005                 $type .= "/" if ($action eq 'tree');
3006                 $type .= " on '$branch'" if (defined $branch);
3007         } else {
3008                 $type = "log of $branch" if (defined $branch);
3009         }
3010
3011         $res{-title} = $type;
3012         $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
3013         $res{'file_name'} = $file_name;
3014
3015         return %res;
3016 }
3017
3018 ## ----------------------------------------------------------------------
3019 ## git utility subroutines, invoking git commands
3020
3021 # returns path to the core git executable and the --git-dir parameter as list
3022 sub git_cmd {
3023         $number_of_git_cmds++;
3024         return $GIT, '--git-dir='.$git_dir;
3025 }
3026
3027 # opens a "-|" cmd pipe handle with 2>/dev/null and returns it
3028 sub cmd_pipe {
3029
3030         # In order to be compatible with FCGI mode we must use POSIX
3031         # and access the STDERR_FILENO file descriptor directly
3032
3033         use POSIX qw(STDERR_FILENO dup dup2);
3034
3035         open(my $null, '>', File::Spec->devnull) or die "couldn't open devnull: $!";
3036         (my $saveerr = dup(STDERR_FILENO)) or die "couldn't dup STDERR: $!";
3037         my $dup2ok = dup2(fileno($null), STDERR_FILENO);
3038         close($null) or !$dup2ok or die "couldn't close NULL: $!";
3039         $dup2ok or POSIX::close($saveerr), die "couldn't dup NULL to STDERR: $!";
3040         my $result = open(my $fd, "-|", @_);
3041         $dup2ok = dup2($saveerr, STDERR_FILENO);
3042         POSIX::close($saveerr) or !$dup2ok or die "couldn't close SAVEERR: $!";
3043         $dup2ok or die "couldn't dup SAVERR to STDERR: $!";
3044
3045         return $result ? $fd : undef;
3046 }
3047
3048 # opens a "-|" git_cmd pipe handle with 2>/dev/null and returns it
3049 sub git_cmd_pipe {
3050         return cmd_pipe git_cmd(), @_;
3051 }
3052
3053 # quote the given arguments for passing them to the shell
3054 # quote_command("command", "arg 1", "arg with ' and ! characters")
3055 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
3056 # Try to avoid using this function wherever possible.
3057 sub quote_command {
3058         return join(' ',
3059                 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
3060 }
3061
3062 # get HEAD ref of given project as hash
3063 sub git_get_head_hash {
3064         return git_get_full_hash(shift, 'HEAD');
3065 }
3066
3067 sub git_get_full_hash {
3068         return git_get_hash(@_);
3069 }
3070
3071 sub git_get_short_hash {
3072         return git_get_hash(@_, '--short=7');
3073 }
3074
3075 sub git_get_hash {
3076         my ($project, $hash, @options) = @_;
3077         my $o_git_dir = $git_dir;
3078         my $retval = undef;
3079         $git_dir = "$projectroot/$project";
3080         if (defined(my $fd = git_cmd_pipe 'rev-parse',
3081             '--verify', '-q', @options, $hash)) {
3082                 $retval = <$fd>;
3083                 chomp $retval if defined $retval;
3084                 close $fd;
3085         }
3086         if (defined $o_git_dir) {
3087                 $git_dir = $o_git_dir;
3088         }
3089         return $retval;
3090 }
3091
3092 # get type of given object
3093 sub git_get_type {
3094         my $hash = shift;
3095
3096         defined(my $fd = git_cmd_pipe "cat-file", '-t', $hash) or return;
3097         my $type = <$fd>;
3098         close $fd or return;
3099         chomp $type;
3100         return $type;
3101 }
3102
3103 # repository configuration
3104 our $config_file = '';
3105 our %config;
3106
3107 # store multiple values for single key as anonymous array reference
3108 # single values stored directly in the hash, not as [ <value> ]
3109 sub hash_set_multi {
3110         my ($hash, $key, $value) = @_;
3111
3112         if (!exists $hash->{$key}) {
3113                 $hash->{$key} = $value;
3114         } elsif (!ref $hash->{$key}) {
3115                 $hash->{$key} = [ $hash->{$key}, $value ];
3116         } else {
3117                 push @{$hash->{$key}}, $value;
3118         }
3119 }
3120
3121 # return hash of git project configuration
3122 # optionally limited to some section, e.g. 'gitweb'
3123 sub git_parse_project_config {
3124         my $section_regexp = shift;
3125         my %config;
3126
3127         local $/ = "\0";
3128
3129         defined(my $fh = git_cmd_pipe "config", '-z', '-l')
3130                 or return;
3131
3132         while (my $keyval = to_utf8(scalar <$fh>)) {
3133                 chomp $keyval;
3134                 my ($key, $value) = split(/\n/, $keyval, 2);
3135
3136                 hash_set_multi(\%config, $key, $value)
3137                         if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
3138         }
3139         close $fh;
3140
3141         return %config;
3142 }
3143
3144 # convert config value to boolean: 'true' or 'false'
3145 # no value, number > 0, 'true' and 'yes' values are true
3146 # rest of values are treated as false (never as error)
3147 sub config_to_bool {
3148         my $val = shift;
3149
3150         return 1 if !defined $val;             # section.key
3151
3152         # strip leading and trailing whitespace
3153         $val =~ s/^\s+//;
3154         $val =~ s/\s+$//;
3155
3156         return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
3157                 ($val =~ /^(?:true|yes)$/i));  # section.key = true
3158 }
3159
3160 # convert config value to simple decimal number
3161 # an optional value suffix of 'k', 'm', or 'g' will cause the value
3162 # to be multiplied by 1024, 1048576, or 1073741824
3163 sub config_to_int {
3164         my $val = shift;
3165
3166         # strip leading and trailing whitespace
3167         $val =~ s/^\s+//;
3168         $val =~ s/\s+$//;
3169
3170         if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
3171                 $unit = lc($unit);
3172                 # unknown unit is treated as 1
3173                 return $num * ($unit eq 'g' ? 1073741824 :
3174                                $unit eq 'm' ?    1048576 :
3175                                $unit eq 'k' ?       1024 : 1);
3176         }
3177         return $val;
3178 }
3179
3180 # convert config value to array reference, if needed
3181 sub config_to_multi {
3182         my $val = shift;
3183
3184         return ref($val) ? $val : (defined($val) ? [ $val ] : []);
3185 }
3186
3187 sub git_get_project_config {
3188         my ($key, $type) = @_;
3189
3190         return unless defined $git_dir;
3191
3192         # key sanity check
3193         return unless ($key);
3194         # only subsection, if exists, is case sensitive,
3195         # and not lowercased by 'git config -z -l'
3196         if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
3197                 $lo =~ s/_//g;
3198                 $key = join(".", lc($hi), $mi, lc($lo));
3199                 return if ($lo =~ /\W/ || $hi =~ /\W/);
3200         } else {
3201                 $key = lc($key);
3202                 $key =~ s/_//g;
3203                 return if ($key =~ /\W/);
3204         }
3205         $key =~ s/^gitweb\.//;
3206
3207         # type sanity check
3208         if (defined $type) {
3209                 $type =~ s/^--//;
3210                 $type = undef
3211                         unless ($type eq 'bool' || $type eq 'int');
3212         }
3213
3214         # get config
3215         if (!defined $config_file ||
3216             $config_file ne "$git_dir/config") {
3217                 %config = git_parse_project_config('gitweb');
3218                 $config_file = "$git_dir/config";
3219         }
3220
3221         # check if config variable (key) exists
3222         return unless exists $config{"gitweb.$key"};
3223
3224         # ensure given type
3225         if (!defined $type) {
3226                 return $config{"gitweb.$key"};
3227         } elsif ($type eq 'bool') {
3228                 # backward compatibility: 'git config --bool' returns true/false
3229                 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
3230         } elsif ($type eq 'int') {
3231                 return config_to_int($config{"gitweb.$key"});
3232         }
3233         return $config{"gitweb.$key"};
3234 }
3235
3236 # get hash of given path at given ref
3237 sub git_get_hash_by_path {
3238         my $base = shift;
3239         my $path = shift || return undef;
3240         my $type = shift;
3241
3242         $path =~ s,/+$,,;
3243
3244         defined(my $fd = git_cmd_pipe "ls-tree", $base, "--", $path)
3245                 or die_error(500, "Open git-ls-tree failed");
3246         my $line = to_utf8(scalar <$fd>);
3247         close $fd or return undef;
3248
3249         if (!defined $line) {
3250                 # there is no tree or hash given by $path at $base
3251                 return undef;
3252         }
3253
3254         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3255         $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
3256         if (defined $type && $type ne $2) {
3257                 # type doesn't match
3258                 return undef;
3259         }
3260         return $3;
3261 }
3262
3263 # get path of entry with given hash at given tree-ish (ref)
3264 # used to get 'from' filename for combined diff (merge commit) for renames
3265 sub git_get_path_by_hash {
3266         my $base = shift || return;
3267         my $hash = shift || return;
3268
3269         local $/ = "\0";
3270
3271         defined(my $fd = git_cmd_pipe "ls-tree", '-r', '-t', '-z', $base)
3272                 or return undef;
3273         while (my $line = to_utf8(scalar <$fd>)) {
3274                 chomp $line;
3275
3276                 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423  gitweb'
3277                 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f  gitweb/README'
3278                 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
3279                         close $fd;
3280                         return $1;
3281                 }
3282         }
3283         close $fd;
3284         return undef;
3285 }
3286
3287 ## ......................................................................
3288 ## git utility functions, directly accessing git repository
3289
3290 # get the value of config variable either from file named as the variable
3291 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
3292 # configuration variable in the repository config file.
3293 sub git_get_file_or_project_config {
3294         my ($path, $name) = @_;
3295
3296         $git_dir = "$projectroot/$path";
3297         open my $fd, '<', "$git_dir/$name"
3298                 or return git_get_project_config($name);
3299         my $conf = to_utf8(scalar <$fd>);
3300         close $fd;
3301         if (defined $conf) {
3302                 chomp $conf;
3303         }
3304         return $conf;
3305 }
3306
3307 sub git_get_project_description {
3308         my $path = shift;
3309         return git_get_file_or_project_config($path, 'description');
3310 }
3311
3312 sub git_get_project_category {
3313         my $path = shift;
3314         return git_get_file_or_project_config($path, 'category');
3315 }
3316
3317
3318 # supported formats:
3319 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
3320 #   - if its contents is a number, use it as tag weight,
3321 #   - otherwise add a tag with weight 1
3322 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
3323 #   the same value multiple times increases tag weight
3324 # * `gitweb.ctag' multi-valued repo config variable
3325 sub git_get_project_ctags {
3326         my $project = shift;
3327         my $ctags = {};
3328
3329         $git_dir = "$projectroot/$project";
3330         if (opendir my $dh, "$git_dir/ctags") {
3331                 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
3332                 foreach my $tagfile (@files) {
3333                         open my $ct, '<', $tagfile
3334                                 or next;
3335                         my $val = <$ct>;
3336                         chomp $val if $val;
3337                         close $ct;
3338
3339                         (my $ctag = $tagfile) =~ s#.*/##;
3340                         $ctag = to_utf8($ctag);
3341                         if ($val =~ /^\d+$/) {
3342                                 $ctags->{$ctag} = $val;
3343                         } else {
3344                                 $ctags->{$ctag} = 1;
3345                         }
3346                 }
3347                 closedir $dh;
3348
3349         } elsif (open my $fh, '<', "$git_dir/ctags") {
3350                 while (my $line = to_utf8(scalar <$fh>)) {
3351                         chomp $line;
3352                         $ctags->{$line}++ if $line;
3353                 }
3354                 close $fh;
3355
3356         } else {
3357                 my $taglist = config_to_multi(git_get_project_config('ctag'));
3358                 foreach my $tag (@$taglist) {
3359                         $ctags->{$tag}++;
3360                 }
3361         }
3362
3363         return $ctags;
3364 }
3365
3366 # return hash, where keys are content tags ('ctags'),
3367 # and values are sum of weights of given tag in every project
3368 sub git_gather_all_ctags {
3369         my $projects = shift;
3370         my $ctags = {};
3371
3372         foreach my $p (@$projects) {
3373                 foreach my $ct (keys %{$p->{'ctags'}}) {
3374                         $ctags->{$ct} += $p->{'ctags'}->{$ct};
3375                 }
3376         }
3377
3378         return $ctags;
3379 }
3380
3381 sub git_populate_project_tagcloud {
3382         my ($ctags, $action) = @_;
3383
3384         # First, merge different-cased tags; tags vote on casing
3385         my %ctags_lc;
3386         foreach (keys %$ctags) {
3387                 $ctags_lc{lc $_}->{count} += $ctags->{$_};
3388                 if (not $ctags_lc{lc $_}->{topcount}
3389                     or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
3390                         $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
3391                         $ctags_lc{lc $_}->{topname} = $_;
3392                 }
3393         }
3394
3395         my $cloud;
3396         my $matched = $input_params{'ctag_filter'};
3397         if (eval { require HTML::TagCloud; 1; }) {
3398                 $cloud = HTML::TagCloud->new;
3399                 foreach my $ctag (sort keys %ctags_lc) {
3400                         # Pad the title with spaces so that the cloud looks
3401                         # less crammed.
3402                         my $title = esc_html($ctags_lc{$ctag}->{topname});
3403                         $title =~ s/ /&#160;/g;
3404                         $title =~ s/^/&#160;/g;
3405                         $title =~ s/$/&#160;/g;
3406                         if (defined $matched && $matched eq $ctag) {
3407                                 $title = qq(<span class="match">$title</span>);
3408                         }
3409                         $cloud->add($title, href(-replay=>1, action=>$action, ctag_filter=>$ctag),
3410                                     $ctags_lc{$ctag}->{count});
3411                 }
3412         } else {
3413                 $cloud = {};
3414                 foreach my $ctag (keys %ctags_lc) {
3415                         my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3416                         if (defined $matched && $matched eq $ctag) {
3417                                 $title = qq(<span class="match">$title</span>);
3418                         }
3419                         $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3420                         $cloud->{$ctag}{ctag} =
3421                                 $cgi->a({-href=>href(-replay=>1, action=>$action, ctag_filter=>$ctag)}, $title);
3422                 }
3423         }
3424         return $cloud;
3425 }
3426
3427 sub git_show_project_tagcloud {
3428         my ($cloud, $count) = @_;
3429         if (ref $cloud eq 'HTML::TagCloud') {
3430                 return $cloud->html_and_css($count);
3431         } else {
3432                 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3433                 return
3434                         '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3435                         join (', ', map {
3436                                 $cloud->{$_}->{'ctag'}
3437                         } splice(@tags, 0, $count)) .
3438                         '</div>';
3439         }
3440 }
3441
3442 sub git_get_project_url_list {
3443         my $path = shift;
3444
3445         $git_dir = "$projectroot/$path";
3446         open my $fd, '<', "$git_dir/cloneurl"
3447                 or return wantarray ?
3448                 @{ config_to_multi(git_get_project_config('url')) } :
3449                    config_to_multi(git_get_project_config('url'));
3450         my @git_project_url_list = map { chomp; to_utf8($_) } <$fd>;
3451         close $fd;
3452
3453         return wantarray ? @git_project_url_list : \@git_project_url_list;
3454 }
3455
3456 sub git_get_projects_list {
3457         my $filter = shift || '';
3458         my $paranoid = shift;
3459         my @list;
3460
3461         if (-d $projects_list) {
3462                 # search in directory
3463                 my $dir = $projects_list;
3464                 # remove the trailing "/"
3465                 $dir =~ s!/+$!!;
3466                 my $pfxlen = length("$dir");
3467                 my $pfxdepth = ($dir =~ tr!/!!);
3468                 # when filtering, search only given subdirectory
3469                 if ($filter && !$paranoid) {
3470                         $dir .= "/$filter";
3471                         $dir =~ s!/+$!!;
3472                 }
3473
3474                 File::Find::find({
3475                         follow_fast => 1, # follow symbolic links
3476                         follow_skip => 2, # ignore duplicates
3477                         dangling_symlinks => 0, # ignore dangling symlinks, silently
3478                         wanted => sub {
3479                                 # global variables
3480                                 our $project_maxdepth;
3481                                 our $projectroot;
3482                                 # skip project-list toplevel, if we get it.
3483                                 return if (m!^[/.]$!);
3484                                 # only directories can be git repositories
3485                                 return unless (-d $_);
3486                                 # don't traverse too deep (Find is super slow on os x)
3487                                 # $project_maxdepth excludes depth of $projectroot
3488                                 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3489                                         $File::Find::prune = 1;
3490                                         return;
3491                                 }
3492
3493                                 my $path = substr($File::Find::name, $pfxlen + 1);
3494                                 # paranoidly only filter here
3495                                 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3496                                         next;
3497                                 }
3498                                 # we check related file in $projectroot
3499                                 if (check_export_ok("$projectroot/$path")) {
3500                                         push @list, { path => $path };
3501                                         $File::Find::prune = 1;
3502                                 }
3503                         },
3504                 }, "$dir");
3505
3506         } elsif (-f $projects_list) {
3507                 # read from file(url-encoded):
3508                 # 'git%2Fgit.git Linus+Torvalds'
3509                 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3510                 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3511                 open my $fd, '<', $projects_list or return;
3512         PROJECT:
3513                 while (my $line = <$fd>) {
3514                         chomp $line;
3515                         my ($path, $owner) = split ' ', $line;
3516                         $path = unescape($path);
3517                         $owner = unescape($owner);
3518                         if (!defined $path) {
3519                                 next;
3520                         }
3521                         # if $filter is rpovided, check if $path begins with $filter
3522                         if ($filter && $path !~ m!^\Q$filter\E/!) {
3523                                 next;
3524                         }
3525                         if (check_export_ok("$projectroot/$path")) {
3526                                 my $pr = {
3527                                         path => $path
3528                                 };
3529                                 if ($owner) {
3530                                         $pr->{'owner'} = to_utf8($owner);
3531                                 }
3532                                 push @list, $pr;
3533                         }
3534                 }
3535                 close $fd;
3536         }
3537         return @list;
3538 }
3539
3540 # written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
3541 # as side effects it sets 'forks' field to list of forks for forked projects
3542 sub filter_forks_from_projects_list {
3543         my $projects = shift;
3544
3545         my %trie; # prefix tree of directories (path components)
3546         # generate trie out of those directories that might contain forks
3547         foreach my $pr (@$projects) {
3548                 my $path = $pr->{'path'};
3549                 $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
3550                 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3551                 next unless ($path);      # skip '.git' repository: tests, git-instaweb
3552                 next unless (-d "$projectroot/$path"); # containing directory exists
3553                 $pr->{'forks'} = [];      # there can be 0 or more forks of project
3554
3555                 # add to trie
3556                 my @dirs = split('/', $path);
3557                 # walk the trie, until either runs out of components or out of trie
3558                 my $ref = \%trie;
3559                 while (scalar @dirs &&
3560                        exists($ref->{$dirs[0]})) {
3561                         $ref = $ref->{shift @dirs};
3562                 }
3563                 # create rest of trie structure from rest of components
3564                 foreach my $dir (@dirs) {
3565                         $ref = $ref->{$dir} = {};
3566                 }
3567                 # create end marker, store $pr as a data
3568                 $ref->{''} = $pr if (!exists $ref->{''});
3569         }
3570
3571         # filter out forks, by finding shortest prefix match for paths
3572         my @filtered;
3573  PROJECT:
3574         foreach my $pr (@$projects) {
3575                 # trie lookup
3576                 my $ref = \%trie;
3577         DIR:
3578                 foreach my $dir (split('/', $pr->{'path'})) {
3579                         if (exists $ref->{''}) {
3580                                 # found [shortest] prefix, is a fork - skip it
3581                                 push @{$ref->{''}{'forks'}}, $pr;
3582                                 next PROJECT;
3583                         }
3584                         if (!exists $ref->{$dir}) {
3585                                 # not in trie, cannot have prefix, not a fork
3586                                 push @filtered, $pr;
3587                                 next PROJECT;
3588                         }
3589                         # If the dir is there, we just walk one step down the trie.
3590                         $ref = $ref->{$dir};
3591                 }
3592                 # we ran out of trie
3593                 # (shouldn't happen: it's either no match, or end marker)
3594                 push @filtered, $pr;
3595         }
3596
3597         return @filtered;
3598 }
3599
3600 # note: fill_project_list_info must be run first,
3601 # for 'descr_long' and 'ctags' to be filled
3602 sub search_projects_list {
3603         my ($projlist, %opts) = @_;
3604         my $tagfilter  = $opts{'tagfilter'};
3605         my $search_re = $opts{'search_regexp'};
3606
3607         return @$projlist
3608                 unless ($tagfilter || $search_re);
3609
3610         # searching projects require filling to be run before it;
3611         fill_project_list_info($projlist,
3612                                $tagfilter  ? 'ctags' : (),
3613                                $search_re ? ('path', 'descr') : ());
3614         my @projects;
3615  PROJECT:
3616         foreach my $pr (@$projlist) {
3617
3618                 if ($tagfilter) {
3619                         next unless ref($pr->{'ctags'}) eq 'HASH';
3620                         next unless
3621                                 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3622                 }
3623
3624                 if ($search_re) {
3625                         my $path = $pr->{'path'};
3626                         $path =~ s/\.git$//; # should not be included in search
3627                         next unless
3628                                 $path =~ /$search_re/ ||
3629                                 $pr->{'descr_long'} =~ /$search_re/;
3630                 }
3631
3632                 push @projects, $pr;
3633         }
3634
3635         return @projects;
3636 }
3637
3638 our $gitweb_project_owner = undef;
3639 sub git_get_project_list_from_file {
3640
3641         return if (defined $gitweb_project_owner);
3642
3643         $gitweb_project_owner = {};
3644         # read from file (url-encoded):
3645         # 'git%2Fgit.git Linus+Torvalds'
3646         # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3647         # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3648         if (-f $projects_list) {
3649                 open(my $fd, '<', $projects_list);
3650                 while (my $line = <$fd>) {
3651                         chomp $line;
3652                         my ($pr, $ow) = split ' ', $line;
3653                         $pr = unescape($pr);
3654                         $ow = unescape($ow);
3655                         $gitweb_project_owner->{$pr} = to_utf8($ow);
3656                 }
3657                 close $fd;
3658         }
3659 }
3660
3661 sub git_get_project_owner {
3662         my $project = shift;
3663         my $owner;
3664
3665         return undef unless $project;
3666         $git_dir = "$projectroot/$project";
3667
3668         if (!defined $gitweb_project_owner) {
3669                 git_get_project_list_from_file();
3670         }
3671
3672         if (exists $gitweb_project_owner->{$project}) {
3673                 $owner = $gitweb_project_owner->{$project};
3674         }
3675         if (!defined $owner){
3676                 $owner = git_get_project_config('owner');
3677         }
3678         if (!defined $owner) {
3679                 $owner = get_file_owner("$git_dir");
3680         }
3681
3682         return $owner;
3683 }
3684
3685 sub parse_activity_date {
3686         my $dstr = shift;
3687
3688         use Time::Local;
3689
3690         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
3691                 # Unix timestamp
3692                 return 0 + $1;
3693         }
3694         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt _](\d{1,2}):(\d{2}):(\d{2})(?:[ _]?([Zz]|(?:[-+]\d{1,2}:?\d{2})))?\s*$/) {
3695                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
3696                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, $Y-1900);
3697                 defined($z) && $z ne '' or $z = 'Z';
3698                 $z =~ s/://;
3699                 substr($z,1,0) = '0' if length($z) == 4;
3700                 my $off = 0;
3701                 if (uc($z) ne 'Z') {
3702                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
3703                         $off = -$off if substr($z,0,1) eq '-';
3704                 }
3705                 return $seconds - $off;
3706         }
3707         return undef;
3708 }
3709
3710 sub git_get_last_activity {
3711         my ($path) = @_;
3712         my $fd;
3713
3714         $git_dir = "$projectroot/$path";
3715         if ($lastactivity_file && open($fd, "<", "$git_dir/$lastactivity_file")) {
3716                 my $activity = <$fd>;
3717                 close $fd;
3718                 if (defined $activity &&
3719                     (my $timestamp = parse_activity_date($activity))) {
3720                         return ($timestamp);
3721                 }
3722         }
3723         defined($fd = git_cmd_pipe 'for-each-ref',
3724              '--format=%(committer)',
3725              '--sort=-committerdate',
3726              '--count=1',
3727              map { "refs/$_" } get_branch_refs ()) or return;
3728         my $most_recent = <$fd>;
3729         close $fd or return (undef);
3730         if (defined $most_recent &&
3731             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
3732                 my $timestamp = $1;
3733                 return ($timestamp);
3734         }
3735         return (undef);
3736 }
3737
3738 # Implementation note: when a single remote is wanted, we cannot use 'git
3739 # remote show -n' because that command always work (assuming it's a remote URL
3740 # if it's not defined), and we cannot use 'git remote show' because that would
3741 # try to make a network roundtrip. So the only way to find if that particular
3742 # remote is defined is to walk the list provided by 'git remote -v' and stop if
3743 # and when we find what we want.
3744 sub git_get_remotes_list {
3745         my $wanted = shift;
3746         my %remotes = ();
3747
3748         my $fd = git_cmd_pipe 'remote', '-v';
3749         return unless $fd;
3750         while (my $remote = to_utf8(scalar <$fd>)) {
3751                 chomp $remote;
3752                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
3753                 next if $wanted and not $remote eq $wanted;
3754                 my ($url, $key) = ($1, $2);
3755
3756                 $remotes{$remote} ||= { 'heads' => [] };
3757                 $remotes{$remote}{$key} = $url;
3758         }
3759         close $fd or return;
3760         return wantarray ? %remotes : \%remotes;
3761 }
3762
3763 # Takes a hash of remotes as first parameter and fills it by adding the
3764 # available remote heads for each of the indicated remotes.
3765 sub fill_remote_heads {
3766         my $remotes = shift;
3767         my @heads = map { "remotes/$_" } keys %$remotes;
3768         my @remoteheads = git_get_heads_list(undef, @heads);
3769         foreach my $remote (keys %$remotes) {
3770                 $remotes->{$remote}{'heads'} = [ grep {
3771                         $_->{'name'} =~ s!^$remote/!!
3772                         } @remoteheads ];
3773         }
3774 }
3775
3776 sub git_get_references {
3777         my $type = shift || "";
3778         my %refs;
3779         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
3780         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
3781         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
3782                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
3783                 or return;
3784
3785         while (my $line = to_utf8(scalar <$fd>)) {
3786                 chomp $line;
3787                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
3788                         if (defined $refs{$1}) {
3789                                 push @{$refs{$1}}, $2;
3790                         } else {
3791                                 $refs{$1} = [ $2 ];
3792                         }
3793                 }
3794         }
3795         close $fd or return;
3796         return \%refs;
3797 }
3798
3799 sub git_get_rev_name_tags {
3800         my $hash = shift || return undef;
3801
3802         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
3803                 or return;
3804         my $name_rev = to_utf8(scalar <$fd>);
3805         close $fd;
3806
3807         if ($name_rev =~ m|^$hash tags/(.*)$|) {
3808                 return $1;
3809         } else {
3810                 # catches also '$hash undefined' output
3811                 return undef;
3812         }
3813 }
3814
3815 ## ----------------------------------------------------------------------
3816 ## parse to hash functions
3817
3818 sub parse_date {
3819         my $epoch = shift;
3820         my $tz = shift || "-0000";
3821
3822         my %date;
3823         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
3824         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
3825         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
3826         $date{'hour'} = $hour;
3827         $date{'minute'} = $min;
3828         $date{'mday'} = $mday;
3829         $date{'day'} = $days[$wday];
3830         $date{'month'} = $months[$mon];
3831         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
3832                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
3833         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
3834                              $mday, $months[$mon], $hour ,$min;
3835         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
3836                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
3837
3838         my ($tz_sign, $tz_hour, $tz_min) =
3839                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
3840         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
3841         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
3842         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
3843         $date{'hour_local'} = $hour;
3844         $date{'minute_local'} = $min;
3845         $date{'mday_local'} = $mday;
3846         $date{'tz_local'} = $tz;
3847         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
3848                                   1900+$year, $mon+1, $mday,
3849                                   $hour, $min, $sec, $tz);
3850         return %date;
3851 }
3852
3853 my %parse_date_rfc2822_month_names;
3854 BEGIN {
3855         %parse_date_rfc2822_month_names = (
3856                 jan => 0, feb => 1, mar => 2, apr => 3, may => 4, jun => 5,
3857                 jul => 6, aug => 7, sep => 8, oct => 9, nov => 10, dec => 11
3858         );
3859 }
3860
3861 sub parse_date_rfc2822 {
3862         my $datestr = shift;
3863         return () unless defined $datestr;
3864         $datestr = $1 if $datestr =~/^[^\s]+,\s*(.*)$/;
3865         return () unless $datestr =~
3866                 /^\s*(\d{1,2})\s+([A-Za-z]{3})\s+(\d{4})\s+(\d{1,2}):(\d{2}):(\d{2})\s+([+-]\d{4})\s*$/;
3867         my ($d,$b,$Y,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7);
3868         my $m = $parse_date_rfc2822_month_names{lc($b)};
3869         return () unless defined($m);
3870         my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, 0+$m, $Y-1900);
3871         my $tzoffset = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
3872         $tzoffset = -$tzoffset if substr($z,0,1) eq '-';
3873         my $tzstring;
3874         if ($tzoffset >= 0) {
3875                 $tzstring = sprintf('+%02d%02d', int($tzoffset / 3600), int(($tzoffset % 3600) / 60));
3876         } else {
3877                 $tzstring = sprintf('-%02d%02d', int(-$tzoffset / 3600), int((-$tzoffset % 3600) / 60));
3878         }
3879         return parse_date($seconds - $tzoffset, $tzstring);
3880 }
3881
3882 sub parse_tag {
3883         my $tag_id = shift;
3884         my %tag;
3885         my @comment;
3886
3887         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
3888         $tag{'id'} = $tag_id;
3889         while (my $line = to_utf8(scalar <$fd>)) {
3890                 chomp $line;
3891                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
3892                         $tag{'object'} = $1;
3893                 } elsif ($line =~ m/^type (.+)$/) {
3894                         $tag{'type'} = $1;
3895                 } elsif ($line =~ m/^tag (.+)$/) {
3896                         $tag{'name'} = $1;
3897                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
3898                         $tag{'author'} = $1;
3899                         $tag{'author_epoch'} = $2;
3900                         $tag{'author_tz'} = $3;
3901                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
3902                                 $tag{'author_name'}  = $1;
3903                                 $tag{'author_email'} = $2;
3904                         } else {
3905                                 $tag{'author_name'} = $tag{'author'};
3906                         }
3907                 } elsif ($line =~ m/--BEGIN/) {
3908                         push @comment, $line;
3909                         last;
3910                 } elsif ($line eq "") {
3911                         last;
3912                 }
3913         }
3914         push @comment, map(to_utf8($_), <$fd>);
3915         $tag{'comment'} = \@comment;
3916         close $fd or return;
3917         if (!defined $tag{'name'}) {
3918                 return
3919         };
3920         return %tag
3921 }
3922
3923 sub parse_commit_text {
3924         my ($commit_text, $withparents) = @_;
3925         my @commit_lines = split '\n', $commit_text;
3926         my %co;
3927
3928         pop @commit_lines; # Remove '\0'
3929
3930         if (! @commit_lines) {
3931                 return;
3932         }
3933
3934         my $header = shift @commit_lines;
3935         if ($header !~ m/^[0-9a-fA-F]{40}/) {
3936                 return;
3937         }
3938         ($co{'id'}, my @parents) = split ' ', $header;
3939         while (my $line = shift @commit_lines) {
3940                 last if $line eq "\n";
3941                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
3942                         $co{'tree'} = $1;
3943                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
3944                         push @parents, $1;
3945                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
3946                         $co{'author'} = to_utf8($1);
3947                         $co{'author_epoch'} = $2;
3948                         $co{'author_tz'} = $3;
3949                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
3950                                 $co{'author_name'}  = $1;
3951                                 $co{'author_email'} = $2;
3952                         } else {
3953                                 $co{'author_name'} = $co{'author'};
3954                         }
3955                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
3956                         $co{'committer'} = to_utf8($1);
3957                         $co{'committer_epoch'} = $2;
3958                         $co{'committer_tz'} = $3;
3959                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
3960                                 $co{'committer_name'}  = $1;
3961                                 $co{'committer_email'} = $2;
3962                         } else {
3963                                 $co{'committer_name'} = $co{'committer'};
3964                         }
3965                 }
3966         }
3967         if (!defined $co{'tree'}) {
3968                 return;
3969         };
3970         $co{'parents'} = \@parents;
3971         $co{'parent'} = $parents[0];
3972
3973         @commit_lines = map to_utf8($_), @commit_lines;
3974         foreach my $title (@commit_lines) {
3975                 $title =~ s/^    //;
3976                 if ($title ne "") {
3977                         $co{'title'} = chop_str($title, 80, 5);
3978                         # remove leading stuff of merges to make the interesting part visible
3979                         if (length($title) > 50) {
3980                                 $title =~ s/^Automatic //;
3981                                 $title =~ s/^merge (of|with) /Merge ... /i;
3982                                 if (length($title) > 50) {
3983                                         $title =~ s/(http|rsync):\/\///;
3984                                 }
3985                                 if (length($title) > 50) {
3986                                         $title =~ s/(master|www|rsync)\.//;
3987                                 }
3988                                 if (length($title) > 50) {
3989                                         $title =~ s/kernel.org:?//;
3990                                 }
3991                                 if (length($title) > 50) {
3992                                         $title =~ s/\/pub\/scm//;
3993                                 }
3994                         }
3995                         $co{'title_short'} = chop_str($title, 50, 5);
3996                         last;
3997                 }
3998         }
3999         if (! defined $co{'title'} || $co{'title'} eq "") {
4000                 $co{'title'} = $co{'title_short'} = '(no commit message)';
4001         }
4002         # remove added spaces
4003         foreach my $line (@commit_lines) {
4004                 $line =~ s/^    //;
4005         }
4006         $co{'comment'} = \@commit_lines;
4007
4008         my $age = time - $co{'committer_epoch'};
4009         $co{'age'} = $age;
4010         $co{'age_string'} = age_string($age);
4011         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($co{'committer_epoch'});
4012         if ($age > 60*60*24*7*2) {
4013                 $co{'age_string_date'} = sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
4014                 $co{'age_string_age'} = $co{'age_string'};
4015         } else {
4016                 $co{'age_string_date'} = $co{'age_string'};
4017                 $co{'age_string_age'} = sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
4018         }
4019         return %co;
4020 }
4021
4022 sub parse_commit {
4023         my ($commit_id) = @_;
4024         my %co;
4025
4026         local $/ = "\0";
4027
4028         defined(my $fd = git_cmd_pipe "rev-list",
4029                 "--parents",
4030                 "--header",
4031                 "--max-count=1",
4032                 $commit_id,
4033                 "--")
4034                 or die_error(500, "Open git-rev-list failed");
4035         %co = parse_commit_text(<$fd>, 1);
4036         close $fd;
4037
4038         return %co;
4039 }
4040
4041 sub parse_commits {
4042         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
4043         my @cos;
4044
4045         $maxcount ||= 1;
4046         $skip ||= 0;
4047
4048         local $/ = "\0";
4049
4050         defined(my $fd = git_cmd_pipe "rev-list",
4051                 "--header",
4052                 @args,
4053                 ("--max-count=" . $maxcount),
4054                 ("--skip=" . $skip),
4055                 @extra_options,
4056                 $commit_id,
4057                 "--",
4058                 ($filename ? ($filename) : ()))
4059                 or die_error(500, "Open git-rev-list failed");
4060         while (my $line = <$fd>) {
4061                 my %co = parse_commit_text($line);
4062                 push @cos, \%co;
4063         }
4064         close $fd;
4065
4066         return wantarray ? @cos : \@cos;
4067 }
4068
4069 # parse line of git-diff-tree "raw" output
4070 sub parse_difftree_raw_line {
4071         my $line = shift;
4072         my %res;
4073
4074         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
4075         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
4076         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
4077                 $res{'from_mode'} = $1;
4078                 $res{'to_mode'} = $2;
4079                 $res{'from_id'} = $3;
4080                 $res{'to_id'} = $4;
4081                 $res{'status'} = $5;
4082                 $res{'similarity'} = $6;
4083                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
4084                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
4085                 } else {
4086                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
4087                 }
4088         }
4089         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
4090         # combined diff (for merge commit)
4091         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
4092                 $res{'nparents'}  = length($1);
4093                 $res{'from_mode'} = [ split(' ', $2) ];
4094                 $res{'to_mode'} = pop @{$res{'from_mode'}};
4095                 $res{'from_id'} = [ split(' ', $3) ];
4096                 $res{'to_id'} = pop @{$res{'from_id'}};
4097                 $res{'status'} = [ split('', $4) ];
4098                 $res{'to_file'} = unquote($5);
4099         }
4100         # 'c512b523472485aef4fff9e57b229d9d243c967f'
4101         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
4102                 $res{'commit'} = $1;
4103         }
4104
4105         return wantarray ? %res : \%res;
4106 }
4107
4108 # wrapper: return parsed line of git-diff-tree "raw" output
4109 # (the argument might be raw line, or parsed info)
4110 sub parsed_difftree_line {
4111         my $line_or_ref = shift;
4112
4113         if (ref($line_or_ref) eq "HASH") {
4114                 # pre-parsed (or generated by hand)
4115                 return $line_or_ref;
4116         } else {
4117                 return parse_difftree_raw_line($line_or_ref);
4118         }
4119 }
4120
4121 # parse line of git-ls-tree output
4122 sub parse_ls_tree_line {
4123         my $line = shift;
4124         my %opts = @_;
4125         my %res;
4126
4127         if ($opts{'-l'}) {
4128                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
4129                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
4130
4131                 $res{'mode'} = $1;
4132                 $res{'type'} = $2;
4133                 $res{'hash'} = $3;
4134                 $res{'size'} = $4;
4135                 if ($opts{'-z'}) {
4136                         $res{'name'} = $5;
4137                 } else {
4138                         $res{'name'} = unquote($5);
4139                 }
4140         } else {
4141                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
4142                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
4143
4144                 $res{'mode'} = $1;
4145                 $res{'type'} = $2;
4146                 $res{'hash'} = $3;
4147                 if ($opts{'-z'}) {
4148                         $res{'name'} = $4;
4149                 } else {
4150                         $res{'name'} = unquote($4);
4151                 }
4152         }
4153
4154         return wantarray ? %res : \%res;
4155 }
4156
4157 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4158 sub parse_from_to_diffinfo {
4159         my ($diffinfo, $from, $to, @parents) = @_;
4160
4161         if ($diffinfo->{'nparents'}) {
4162                 # combined diff
4163                 $from->{'file'} = [];
4164                 $from->{'href'} = [];
4165                 fill_from_file_info($diffinfo, @parents)
4166                         unless exists $diffinfo->{'from_file'};
4167                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4168                         $from->{'file'}[$i] =
4169                                 defined $diffinfo->{'from_file'}[$i] ?
4170                                         $diffinfo->{'from_file'}[$i] :
4171                                         $diffinfo->{'to_file'};
4172                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4173                                 $from->{'href'}[$i] = href(action=>"blob",
4174                                                            hash_base=>$parents[$i],
4175                                                            hash=>$diffinfo->{'from_id'}[$i],
4176                                                            file_name=>$from->{'file'}[$i]);
4177                         } else {
4178                                 $from->{'href'}[$i] = undef;
4179                         }
4180                 }
4181         } else {
4182                 # ordinary (not combined) diff
4183                 $from->{'file'} = $diffinfo->{'from_file'};
4184                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4185                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4186                                                hash=>$diffinfo->{'from_id'},
4187                                                file_name=>$from->{'file'});
4188                 } else {
4189                         delete $from->{'href'};
4190                 }
4191         }
4192
4193         $to->{'file'} = $diffinfo->{'to_file'};
4194         if (!is_deleted($diffinfo)) { # file exists in result
4195                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4196                                      hash=>$diffinfo->{'to_id'},
4197                                      file_name=>$to->{'file'});
4198         } else {
4199                 delete $to->{'href'};
4200         }
4201 }
4202
4203 ## ......................................................................
4204 ## parse to array of hashes functions
4205
4206 sub git_get_heads_list {
4207         my ($limit, @classes) = @_;
4208         @classes = get_branch_refs() unless @classes;
4209         my @patterns = map { "refs/$_" } @classes;
4210         my @headslist;
4211
4212         defined(my $fd = git_cmd_pipe 'for-each-ref',
4213                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4214                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4215                 @patterns)
4216                 or return;
4217         while (my $line = to_utf8(scalar <$fd>)) {
4218                 my %ref_item;
4219
4220                 chomp $line;
4221                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4222                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4223                 my ($committer, $epoch, $tz) =
4224                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4225                 $ref_item{'fullname'}  = $name;
4226                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4227                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4228                 $ref_item{'name'} = $name;
4229                 # for refs neither in 'heads' nor 'remotes' we want to
4230                 # show their ref dir
4231                 my $ref_dir = (defined $1) ? $1 : '';
4232                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4233                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4234                 }
4235
4236                 $ref_item{'id'}    = $hash;
4237                 $ref_item{'title'} = $title || '(no commit message)';
4238                 $ref_item{'epoch'} = $epoch;
4239                 if ($epoch) {
4240                         $ref_item{'age'} = age_string(time - $ref_item{'epoch'});
4241                 } else {
4242                         $ref_item{'age'} = "unknown";
4243                 }
4244
4245                 push @headslist, \%ref_item;
4246         }
4247         close $fd;
4248
4249         return wantarray ? @headslist : \@headslist;
4250 }
4251
4252 sub git_get_tags_list {
4253         my $limit = shift;
4254         my @tagslist;
4255         my $all = shift || 0;
4256         my $order = shift || $default_refs_order;
4257         my $sortkey = $all && $order eq 'name' ? 'refname' : '-creatordate';
4258
4259         defined(my $fd = git_cmd_pipe 'for-each-ref',
4260                 ($limit ? '--count='.($limit+1) : ()), "--sort=$sortkey",
4261                 '--format=%(objectname) %(objecttype) %(refname) '.
4262                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4263                 ($all ? 'refs' : 'refs/tags'))
4264                 or return;
4265         while (my $line = to_utf8(scalar <$fd>)) {
4266                 my %ref_item;
4267
4268                 chomp $line;
4269                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4270                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4271                 my ($creator, $epoch, $tz) =
4272                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4273                 $ref_item{'fullname'} = $name;
4274                 $name =~ s!^refs/!! if $all;
4275                 $name =~ s!^refs/tags/!! unless $all;
4276
4277                 $ref_item{'type'} = $type;
4278                 $ref_item{'id'} = $id;
4279                 $ref_item{'name'} = $name;
4280                 if ($type eq "tag") {
4281                         $ref_item{'subject'} = $title;
4282                         $ref_item{'reftype'} = $reftype;
4283                         $ref_item{'refid'}   = $refid;
4284                 } else {
4285                         $ref_item{'reftype'} = $type;
4286                         $ref_item{'refid'}   = $id;
4287                 }
4288
4289                 if ($type eq "tag" || $type eq "commit") {
4290                         $ref_item{'epoch'} = $epoch;
4291                         if ($epoch) {
4292                                 $ref_item{'age'} = age_string(time - $ref_item{'epoch'});
4293                         } else {
4294                                 $ref_item{'age'} = "unknown";
4295                         }
4296                 }
4297
4298                 push @tagslist, \%ref_item;
4299         }
4300         close $fd;
4301
4302         return wantarray ? @tagslist : \@tagslist;
4303 }
4304
4305 ## ----------------------------------------------------------------------
4306 ## filesystem-related functions
4307
4308 sub get_file_owner {
4309         my $path = shift;
4310
4311         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4312         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4313         if (!defined $gcos) {
4314                 return undef;
4315         }
4316         my $owner = $gcos;
4317         $owner =~ s/[,;].*$//;
4318         return to_utf8($owner);
4319 }
4320
4321 # assume that file exists
4322 sub insert_file {
4323         my $filename = shift;
4324
4325         open my $fd, '<', $filename;
4326         while (<$fd>) {
4327                 print to_utf8($_);
4328         }
4329         close $fd;
4330 }
4331
4332 ## ......................................................................
4333 ## mimetype related functions
4334
4335 sub mimetype_guess_file {
4336         my $filename = shift;
4337         my $mimemap = shift;
4338         my $rawmode = shift;
4339         -r $mimemap or return undef;
4340
4341         my %mimemap;
4342         open(my $mh, '<', $mimemap) or return undef;
4343         while (<$mh>) {
4344                 next if m/^#/; # skip comments
4345                 my ($mimetype, @exts) = split(/\s+/);
4346                 foreach my $ext (@exts) {
4347                         $mimemap{$ext} = $mimetype;
4348                 }
4349         }
4350         close($mh);
4351
4352         my ($ext, $ans);
4353         $ext = $1 if $filename =~ /\.([^.]*)$/;
4354         $ans = $mimemap{$ext} if $ext;
4355         if (defined $ans) {
4356                 my $l = lc($ans);
4357                 $ans = 'text/html' if $l eq 'application/xhtml+xml';
4358                 if (!$rawmode) {
4359                         $ans = 'text/xml' if $l =~ m!^application/[^\s:;,=]+\+xml$! ||
4360                                              $l eq 'image/svg+xml' ||
4361                                              $l eq 'application/xml-dtd' ||
4362                                              $l eq 'application/xml-external-parsed-entity';
4363                 }
4364         }
4365         return $ans;
4366 }
4367
4368 sub mimetype_guess {
4369         my $filename = shift;
4370         my $rawmode = shift;
4371         my $mime;
4372         $filename =~ /\./ or return undef;
4373
4374         if ($mimetypes_file) {
4375                 my $file = $mimetypes_file;
4376                 if ($file !~ m!^/!) { # if it is relative path
4377                         # it is relative to project
4378                         $file = "$projectroot/$project/$file";
4379                 }
4380                 $mime = mimetype_guess_file($filename, $file, $rawmode);
4381         }
4382         $mime ||= mimetype_guess_file($filename, '/etc/mime.types', $rawmode);
4383         return $mime;
4384 }
4385
4386 sub blob_mimetype {
4387         my $fd = shift;
4388         my $filename = shift;
4389         my $rawmode = shift;
4390         my $mime;
4391
4392         # The -T/-B file operators produce the wrong result unless a perlio
4393         # layer is present when the file handle is a pipe that delivers less
4394         # than 512 bytes of data before reaching EOF.
4395         #
4396         # If we are running in a Perl that uses the stdio layer rather than the
4397         # unix+perlio layers we will end up adding a perlio layer on top of the
4398         # stdio layer and get a second level of buffering.  This is harmless
4399         # and it makes the -T/-B file operators work properly in all cases.
4400
4401         binmode $fd, ":perlio" or die_error(500, "Adding perlio layer failed")
4402                 unless grep /^perlio$/, PerlIO::get_layers($fd);
4403
4404         $mime = mimetype_guess($filename, $rawmode) if defined $filename;
4405
4406         if (!$mime && $filename) {
4407                 if ($filename =~ m/\.html?$/i) {
4408                         $mime = 'text/html';
4409                 } elsif ($filename =~ m/\.xht(?:ml)?$/i) {
4410                         $mime = 'text/html';
4411                 } elsif ($filename =~ m/\.te?xt?$/i) {
4412                         $mime = 'text/plain';
4413                 } elsif ($filename =~ m/\.(?:markdown|md)$/i) {
4414                         $mime = 'text/plain';
4415                 } elsif ($filename =~ m/\.png$/i) {
4416                         $mime = 'image/png';
4417                 } elsif ($filename =~ m/\.gif$/i) {
4418                         $mime = 'image/gif';
4419                 } elsif ($filename =~ m/\.jpe?g$/i) {
4420                         $mime = 'image/jpeg';
4421                 } elsif ($filename =~ m/\.svgz?$/i) {
4422                         $mime = 'image/svg+xml';
4423                 }
4424         }
4425
4426         # just in case
4427         return $default_blob_plain_mimetype || 'application/octet-stream' unless $fd || $mime;
4428
4429         $mime = -T $fd ? 'text/plain' : 'application/octet-stream' unless $mime;
4430
4431         return $mime;
4432 }
4433
4434 sub is_ascii {
4435         use bytes;
4436         my $data = shift;
4437         return scalar($data =~ /^[\x00-\x7f]*$/);
4438 }
4439
4440 sub is_valid_utf8 {
4441         my $data = shift;
4442         return utf8::decode($data);
4443 }
4444
4445 sub extract_html_charset {
4446         return undef unless $_[0] && "$_[0]</head>" =~ m#<head(?:\s+[^>]*)?(?<!/)>(.*?)</head\s*>#is;
4447         my $head = $1;
4448         return $2 if $head =~ m#<meta\s+charset\s*=\s*(['"])\s*([a-z0-9(:)_.+-]+)\s*\1\s*/?>#is;
4449         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) {
4450                 my %kv = (lc($1) => $3, lc($4) => $6);
4451                 my ($he, $c) = (lc($kv{'http-equiv'}), $kv{'content'});
4452                 return $1 if $he && $c && $he eq 'content-type' &&
4453                         $c =~ m!\s*text/html\s*;\s*charset\s*=\s*([a-z0-9(:)_.+-]+)\s*$!is;
4454         }
4455         return undef;
4456 }
4457
4458 sub blob_contenttype {
4459         my ($fd, $file_name, $type) = @_;
4460
4461         $type ||= blob_mimetype($fd, $file_name, 1);
4462         return $type unless $type =~ m!^text/.+!i;
4463         my ($leader, $charset, $htmlcharset);
4464         if ($fd && read($fd, $leader, 32768)) {{
4465                 $charset='US-ASCII' if is_ascii($leader);
4466                 return ("$type; charset=UTF-8", $leader) if !$charset && is_valid_utf8($leader);
4467                 $charset='ISO-8859-1' unless $charset;
4468                 $htmlcharset = extract_html_charset($leader) if $type eq 'text/html';
4469                 if ($htmlcharset && $charset ne 'US-ASCII') {
4470                         $htmlcharset = undef if $htmlcharset =~ /^(?:utf-8|us-ascii)$/i
4471                 }
4472         }}
4473         return ("$type; charset=$htmlcharset", $leader) if $htmlcharset;
4474         my $defcharset = $default_text_plain_charset || '';
4475         $defcharset =~ s/^\s+//;
4476         $defcharset =~ s/\s+$//;
4477         $defcharset = '' if $charset && $charset ne 'US-ASCII' && $defcharset =~ /^(?:utf-8|us-ascii)$/i;
4478         return ("$type; charset=" . ($defcharset || 'ISO-8859-1'), $leader);
4479 }
4480
4481 # peek the first upto 128 bytes off a file handle
4482 sub peek128bytes {
4483         my $fd = shift;
4484
4485         use IO::Handle;
4486         use bytes;
4487
4488         my $prefix128;
4489         return '' unless $fd && read($fd, $prefix128, 128);
4490
4491         # In the general case, we're guaranteed only to be able to ungetc one
4492         # character (provided, of course, we actually got a character first).
4493         #
4494         # However, we know:
4495         #
4496         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4497         #    already been called at least once on the file handle before us
4498         #
4499         # 2) we have an $fd positioned at the start of the input stream and
4500         #    therefore know we were positioned at a buffer boundary before
4501         #    reading the initial upto 128 bytes
4502         #
4503         # 3) the buffer size is at least 512 bytes
4504         #
4505         # 4) we are careful to only unget raw bytes
4506         #
4507         # 5) we are attempting to unget exactly the same number of bytes we got
4508         #
4509         # Given the above conditions we will ALWAYS be able to safely unget
4510         # the $prefix128 value we just got.
4511         #
4512         # In fact, we could read up to 511 bytes and still be sure.
4513         # (Reading 512 might pop us into the next internal buffer, but probably
4514         # not since that could break the always able to unget at least the one
4515         # you just got guarantee.)
4516
4517         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4518
4519         return $prefix128;
4520 }
4521
4522 # guess file syntax for syntax highlighting; return undef if no highlighting
4523 # the name of syntax can (in the future) depend on syntax highlighter used
4524 sub guess_file_syntax {
4525         my ($fd, $mimetype, $file_name) = @_;
4526         return undef unless $fd && defined $file_name &&
4527                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4528         my $basename = basename($file_name, '.in');
4529         return $highlight_basename{$basename}
4530                 if exists $highlight_basename{$basename};
4531
4532         # Peek to see if there's a shebang or xml line.
4533         # We always operate on bytes when testing this.
4534         {
4535                 use bytes;
4536                 my $shebang = peek128bytes($fd);
4537                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4538                         foreach my $key (keys %highlight_shebang) {
4539                                 my $ar = ref($highlight_shebang{$key}) ?
4540                                         $highlight_shebang{$key} :
4541                                         [$highlight_shebang{key}];
4542                                 map {return $key if $shebang =~ /$_/} @$ar;
4543                         }
4544                 }
4545                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4546         }
4547
4548         $basename =~ /\.([^.]*)$/;
4549         my $ext = $1 or return undef;
4550         return $highlight_ext{$ext}
4551                 if exists $highlight_ext{$ext};
4552
4553         return undef;
4554 }
4555
4556 # run highlighter and return FD of its output,
4557 # or return original FD if no highlighting
4558 sub run_highlighter {
4559         my ($fd, $syntax) = @_;
4560         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4561
4562         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4563                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4564                 quote_command($highlight_bin).
4565                 " --replace-tabs=8 --fragment --syntax $syntax")
4566                 or die_error(500, "Couldn't open file or run syntax highlighter");
4567         if (eof $hifd) {
4568                 # just in case, should not happen as we tested !eof($fd) above
4569                 return $fd if close($hifd);
4570
4571                 # should not happen
4572                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4573
4574                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4575                 # instead of dying horribly on this, just skip the highlighting
4576                 # but do output a message about it to STDERR that will end up in the log
4577                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4578                         sprintf("child exit status 0x%x\n", $?);
4579                 return $fd
4580         }
4581         close $fd;
4582         return ($hifd, 1);
4583 }
4584
4585 ## ======================================================================
4586 ## functions printing HTML: header, footer, error page
4587
4588 sub get_page_title {
4589         my $title = to_utf8($site_name);
4590
4591         unless (defined $project) {
4592                 if (defined $project_filter) {
4593                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4594                 }
4595                 return $title;
4596         }
4597         $title .= " - " . to_utf8($project);
4598
4599         return $title unless (defined $action);
4600         my $action_print = $action eq 'blame_incremental' ? 'blame' : $action;
4601         $title .= "/$action_print"; # $action is US-ASCII (7bit ASCII)
4602
4603         return $title unless (defined $file_name);
4604         $title .= " - " . esc_path($file_name);
4605         if ($action eq "tree" && $file_name !~ m|/$|) {
4606                 $title .= "/";
4607         }
4608
4609         return $title;
4610 }
4611
4612 sub get_content_type_html {
4613         # We do not ever emit application/xhtml+xml since that gives us
4614         # no benefits and it makes many browsers (e.g. Firefox) exceedingly
4615         # strict, which is troublesome for example when showing user-supplied
4616         # README.html files.
4617         return 'text/html';
4618 }
4619
4620 sub print_feed_meta {
4621         if (defined $project) {
4622                 my %href_params = get_feed_info();
4623                 if (!exists $href_params{'-title'}) {
4624                         $href_params{'-title'} = 'log';
4625                 }
4626
4627                 foreach my $format (qw(RSS Atom)) {
4628                         my $type = lc($format);
4629                         my %link_attr = (
4630                                 '-rel' => 'alternate',
4631                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
4632                                 '-type' => "application/$type+xml"
4633                         );
4634
4635                         $href_params{'extra_options'} = undef;
4636                         $href_params{'action'} = $type;
4637                         $link_attr{'-href'} = href(%href_params);
4638                         print "<link ".
4639                               "rel=\"$link_attr{'-rel'}\" ".
4640                               "title=\"$link_attr{'-title'}\" ".
4641                               "href=\"$link_attr{'-href'}\" ".
4642                               "type=\"$link_attr{'-type'}\" ".
4643                               "/>\n";
4644
4645                         $href_params{'extra_options'} = '--no-merges';
4646                         $link_attr{'-href'} = href(%href_params);
4647                         $link_attr{'-title'} .= ' (no merges)';
4648                         print "<link ".
4649                               "rel=\"$link_attr{'-rel'}\" ".
4650                               "title=\"$link_attr{'-title'}\" ".
4651                               "href=\"$link_attr{'-href'}\" ".
4652                               "type=\"$link_attr{'-type'}\" ".
4653                               "/>\n";
4654                 }
4655
4656         } else {
4657                 printf('<link rel="alternate" title="%s projects list" '.
4658                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
4659                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
4660                 printf('<link rel="alternate" title="%s projects feeds" '.
4661                        'href="%s" type="text/x-opml" />'."\n",
4662                        esc_attr($site_name), href(project=>undef, action=>"opml"));
4663         }
4664 }
4665
4666 sub print_header_links {
4667         my $status = shift;
4668
4669         # print out each stylesheet that exist, providing backwards capability
4670         # for those people who defined $stylesheet in a config file
4671         if (defined $stylesheet) {
4672                 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4673         } else {
4674                 foreach my $stylesheet (@stylesheets) {
4675                         next unless $stylesheet;
4676                         print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4677                 }
4678         }
4679         print_feed_meta()
4680                 if ($status eq '200 OK');
4681         if (defined $favicon) {
4682                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
4683         }
4684 }
4685
4686 sub print_nav_breadcrumbs_path {
4687         my $dirprefix = undef;
4688         while (my $part = shift) {
4689                 $dirprefix .= "/" if defined $dirprefix;
4690                 $dirprefix .= $part;
4691                 print $cgi->a({-href => href(project => undef,
4692                                              project_filter => $dirprefix,
4693                                              action => "project_list")},
4694                               esc_html($part)) . " / ";
4695         }
4696 }
4697
4698 sub print_nav_breadcrumbs {
4699         my %opts = @_;
4700
4701         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
4702                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
4703         }
4704         if (defined $project) {
4705                 my @dirname = split '/', $project;
4706                 my $projectbasename = pop @dirname;
4707                 print_nav_breadcrumbs_path(@dirname);
4708                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
4709                 if (defined $action) {
4710                         my $action_print = $action ;
4711                         $action_print = 'blame' if $action_print eq 'blame_incremental';
4712                         if (defined $opts{-action_extra}) {
4713                                 $action_print = $cgi->a({-href => href(action=>$action)},
4714                                         $action);
4715                         }
4716                         print " / $action_print";
4717                 }
4718                 if (defined $opts{-action_extra}) {
4719                         print " / $opts{-action_extra}";
4720                 }
4721                 print "\n";
4722         } elsif (defined $project_filter) {
4723                 print_nav_breadcrumbs_path(split '/', $project_filter);
4724         }
4725 }
4726
4727 sub print_search_form {
4728         if (!defined $searchtext) {
4729                 $searchtext = "";
4730         }
4731         my $search_hash;
4732         if (defined $hash_base) {
4733                 $search_hash = $hash_base;
4734         } elsif (defined $hash) {
4735                 $search_hash = $hash;
4736         } else {
4737                 $search_hash = "HEAD";
4738         }
4739         # We can't use href() here because we need to encode the
4740         # URL parameters into the form, not into the action link.
4741         my $action = $my_uri;
4742         my $use_pathinfo = gitweb_check_feature('pathinfo');
4743         if ($use_pathinfo) {
4744                 # See notes about doubled / in href()
4745                 $action =~ s,/$,,;
4746                 $action .= "/".esc_path_info($project);
4747         }
4748         print $cgi->start_form(-method => "get", -action => $action) .
4749               "<div class=\"search\">\n" .
4750               (!$use_pathinfo &&
4751               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
4752               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
4753               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
4754               $cgi->popup_menu(-name => 'st', -default => 'commit',
4755                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
4756               " " . $cgi->a({-href => href(action=>"search_help"),
4757                              -title => "search help" }, "?") . " search:\n",
4758               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
4759               "<span title=\"Extended regular expression\">" .
4760               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
4761                              -checked => $search_use_regexp) .
4762               "</span>" .
4763               "</div>" .
4764               $cgi->end_form() . "\n";
4765 }
4766
4767 sub git_header_html {
4768         my $status = shift || "200 OK";
4769         my $expires = shift;
4770         my %opts = @_;
4771
4772         my $title = get_page_title();
4773         my $content_type = get_content_type_html();
4774         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
4775                            -status=> $status, -expires => $expires)
4776                 unless ($opts{'-no_http_header'});
4777         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
4778         print <<EOF;
4779 <?xml version="1.0" encoding="utf-8"?>
4780 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
4781 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
4782 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
4783 <!-- git core binaries version $git_version -->
4784 <head>
4785 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
4786 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
4787 <meta name="robots" content="index, nofollow"/>
4788 <title>$title</title>
4789 <script type="text/javascript">/* <![CDATA[ */
4790 function fixBlameLinks() {
4791         var allLinks = document.getElementsByTagName("a");
4792         for (var i = 0; i < allLinks.length; i++) {
4793                 var link = allLinks.item(i);
4794                 if (link.className == 'blamelink')
4795                         link.href = link.href.replace("/blame/", "/blame_incremental/");
4796         }
4797 }
4798 /* ]]> */</script>
4799 EOF
4800         # the stylesheet, favicon etc urls won't work correctly with path_info
4801         # unless we set the appropriate base URL
4802         if ($ENV{'PATH_INFO'}) {
4803                 print "<base href=\"".esc_url($base_url)."\" />\n";
4804         }
4805         print_header_links($status);
4806
4807         if (defined $site_html_head_string) {
4808                 print to_utf8($site_html_head_string);
4809         }
4810
4811         print "</head>\n" .
4812               "<body>\n";
4813
4814         if (defined $site_header && -f $site_header) {
4815                 insert_file($site_header);
4816         }
4817
4818         print "<div class=\"page_header\">\n";
4819         if (defined $logo) {
4820                 print $cgi->a({-href => esc_url($logo_url),
4821                                -title => $logo_label},
4822                               $cgi->img({-src => esc_url($logo),
4823                                          -width => 72, -height => 27,
4824                                          -alt => "git",
4825                                          -class => "logo"}));
4826         }
4827         print_nav_breadcrumbs(%opts);
4828         print "</div>\n";
4829
4830         my $have_search = gitweb_check_feature('search');
4831         if (defined $project && $have_search) {
4832                 print_search_form();
4833         }
4834 }
4835
4836 sub git_footer_html {
4837         my $feed_class = 'rss_logo';
4838
4839         print "<div class=\"page_footer\">\n";
4840         if (defined $project) {
4841                 my $descr = git_get_project_description($project);
4842                 if (defined $descr) {
4843                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
4844                 }
4845
4846                 my %href_params = get_feed_info();
4847                 if (!%href_params) {
4848                         $feed_class .= ' generic';
4849                 }
4850                 $href_params{'-title'} ||= 'log';
4851
4852                 foreach my $format (qw(RSS Atom)) {
4853                         $href_params{'action'} = lc($format);
4854                         print $cgi->a({-href => href(%href_params),
4855                                       -title => "$href_params{'-title'} $format feed",
4856                                       -class => $feed_class}, $format)."\n";
4857                 }
4858
4859         } else {
4860                 print $cgi->a({-href => href(project=>undef, action=>"opml",
4861                                              project_filter => $project_filter),
4862                               -class => $feed_class}, "OPML") . " ";
4863                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
4864                                              project_filter => $project_filter),
4865                               -class => $feed_class}, "TXT") . "\n";
4866         }
4867         print "</div>\n"; # class="page_footer"
4868
4869         if (defined $t0 && gitweb_check_feature('timed')) {
4870                 print "<div id=\"generating_info\">\n";
4871                 print 'This page took '.
4872                       '<span id="generating_time" class="time_span">'.
4873                       tv_interval($t0, [ gettimeofday() ]).
4874                       ' seconds </span>'.
4875                       ' and '.
4876                       '<span id="generating_cmd">'.
4877                       $number_of_git_cmds.
4878                       '</span> git commands '.
4879                       " to generate.\n";
4880                 print "</div>\n"; # class="page_footer"
4881         }
4882
4883         if (defined $site_footer && -f $site_footer) {
4884                 insert_file($site_footer);
4885         }
4886
4887         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
4888         if (defined $action &&
4889             $action eq 'blame_incremental') {
4890                 print qq!<script type="text/javascript">\n!.
4891                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
4892                       qq!           "!. href() .qq!");\n!.
4893                       qq!</script>\n!;
4894         } else {
4895                 my ($jstimezone, $tz_cookie, $datetime_class) =
4896                         gitweb_get_feature('javascript-timezone');
4897
4898                 print qq!<script type="text/javascript">\n!.
4899                       qq!window.onload = function () {\n!;
4900                 if (gitweb_check_feature('blame_incremental')) {
4901                         print qq!       fixBlameLinks();\n!;
4902                 }
4903                 if (gitweb_check_feature('javascript-actions')) {
4904                         print qq!       fixLinks();\n!;
4905                 }
4906                 if ($jstimezone && $tz_cookie && $datetime_class) {
4907                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
4908                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
4909                 }
4910                 print qq!};\n!.
4911                       qq!</script>\n!;
4912         }
4913
4914         print "</body>\n" .
4915               "</html>";
4916 }
4917
4918 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
4919 # Example: die_error(404, 'Hash not found')
4920 # By convention, use the following status codes (as defined in RFC 2616):
4921 # 400: Invalid or missing CGI parameters, or
4922 #      requested object exists but has wrong type.
4923 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
4924 #      this server or project.
4925 # 404: Requested object/revision/project doesn't exist.
4926 # 500: The server isn't configured properly, or
4927 #      an internal error occurred (e.g. failed assertions caused by bugs), or
4928 #      an unknown error occurred (e.g. the git binary died unexpectedly).
4929 # 503: The server is currently unavailable (because it is overloaded,
4930 #      or down for maintenance).  Generally, this is a temporary state.
4931 sub die_error {
4932         my $status = shift || 500;
4933         my $error = esc_html(shift) || "Internal Server Error";
4934         my $extra = shift;
4935         my %opts = @_;
4936
4937         my %http_responses = (
4938                 400 => '400 Bad Request',
4939                 403 => '403 Forbidden',
4940                 404 => '404 Not Found',
4941                 500 => '500 Internal Server Error',
4942                 503 => '503 Service Unavailable',
4943         );
4944         git_header_html($http_responses{$status}, undef, %opts);
4945         print <<EOF;
4946 <div class="page_body">
4947 <br /><br />
4948 $status - $error
4949 <br />
4950 EOF
4951         if (defined $extra) {
4952                 print "<hr />\n" .
4953                       "$extra\n";
4954         }
4955         print "</div>\n";
4956
4957         git_footer_html();
4958         goto DONE_GITWEB
4959                 unless ($opts{'-error_handler'});
4960 }
4961
4962 ## ----------------------------------------------------------------------
4963 ## functions printing or outputting HTML: navigation
4964
4965 sub git_print_page_nav {
4966         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
4967         $extra = '' if !defined $extra; # pager or formats
4968
4969         my @navs = qw(summary log commit commitdiff tree refs);
4970         if ($suppress) {
4971                 @navs = grep { $_ ne $suppress } @navs;
4972         }
4973
4974         my %arg = map { $_ => {action=>$_} } @navs;
4975         if (defined $head) {
4976                 for (qw(commit commitdiff)) {
4977                         $arg{$_}{'hash'} = $head;
4978                 }
4979                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
4980                         $arg{'log'}{'hash'} = $head;
4981                 }
4982         }
4983
4984         $arg{'log'}{'action'} = 'shortlog';
4985         if ($current eq 'log') {
4986                 $current = 'shortlog';
4987         } elsif ($current eq 'shortlog') {
4988                 $current = 'log';
4989         }
4990         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
4991         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
4992
4993         my @actions = gitweb_get_feature('actions');
4994         my $escname = $project;
4995         $escname =~ s/[+]/%2B/g;
4996         my %repl = (
4997                 '%' => '%',
4998                 'n' => $project,         # project name
4999                 'f' => $git_dir,         # project path within filesystem
5000                 'h' => $treehead || '',  # current hash ('h' parameter)
5001                 'b' => $treebase || '',  # hash base ('hb' parameter)
5002                 'e' => $escname,         # project name with '+' escaped
5003         );
5004         while (@actions) {
5005                 my ($label, $link, $pos) = splice(@actions,0,3);
5006                 # insert
5007                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
5008                 # munch munch
5009                 $link =~ s/%([%nfhbe])/$repl{$1}/g;
5010                 $arg{$label}{'_href'} = $link;
5011         }
5012
5013         print "<div class=\"page_nav\">\n" .
5014                 (join " | ",
5015                  map { $_ eq $current ?
5016                        $_ : $cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_")
5017                  } @navs);
5018         print "<br/>\n$extra<br/>\n" .
5019               "</div>\n";
5020 }
5021
5022 # returns a submenu for the nagivation of the refs views (tags, heads,
5023 # remotes) with the current view disabled and the remotes view only
5024 # available if the feature is enabled
5025 sub format_ref_views {
5026         my ($current) = @_;
5027         my @ref_views = qw{tags heads};
5028         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
5029         return join " | ", map {
5030                 $_ eq $current ? $_ :
5031                 $cgi->a({-href => href(action=>$_)}, $_)
5032         } @ref_views
5033 }
5034
5035 sub format_paging_nav {
5036         my ($action, $page, $has_next_link) = @_;
5037         my $paging_nav;
5038
5039
5040         if ($page > 0) {
5041                 $paging_nav .=
5042                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first") .
5043                         " &#183; " .
5044                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
5045                                  -accesskey => "p", -title => "Alt-p"}, "prev");
5046         } else {
5047                 $paging_nav .= "first &#183; prev";
5048         }
5049
5050         if ($has_next_link) {
5051                 $paging_nav .= " &#183; " .
5052                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
5053                                  -accesskey => "n", -title => "Alt-n"}, "next");
5054         } else {
5055                 $paging_nav .= " &#183; next";
5056         }
5057
5058         return $paging_nav;
5059 }
5060
5061 sub format_log_nav {
5062         my ($action, $page, $has_next_link) = @_;
5063         my $paging_nav;
5064
5065         if ($action eq 'shortlog') {
5066                 $paging_nav .= 'shortlog';
5067         } else {
5068                 $paging_nav .= $cgi->a({-href => href(action=>'shortlog', -replay=>1)}, 'shortlog');
5069         }
5070         $paging_nav .= ' | ';
5071         if ($action eq 'log') {
5072                 $paging_nav .= 'fulllog';
5073         } else {
5074                 $paging_nav .= $cgi->a({-href => href(action=>'log', -replay=>1)}, 'fulllog');
5075         }
5076
5077         $paging_nav .= " | " . format_paging_nav($action, $page, $has_next_link);
5078         return $paging_nav;
5079 }
5080
5081 ## ......................................................................
5082 ## functions printing or outputting HTML: div
5083
5084 sub git_print_header_div {
5085         my ($action, $title, $hash, $hash_base, $extra) = @_;
5086         my %args = ();
5087         defined $extra or $extra = '';
5088
5089         $args{'action'} = $action;
5090         $args{'hash'} = $hash if $hash;
5091         $args{'hash_base'} = $hash_base if $hash_base;
5092
5093         my $link1 = $cgi->a({-href => href(%args), -class => "title"},
5094                             $title ? $title : $action);
5095         my $link2 = $cgi->a({-href => href(%args), -class => "cover"}, "");
5096         print "<div class=\"header\">\n" . '<span class="title">' .
5097               $link1 . $extra . $link2 . '</span>' . "\n</div>\n";
5098 }
5099
5100 sub format_repo_url {
5101         my ($name, $url) = @_;
5102         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
5103 }
5104
5105 # Group output by placing it in a DIV element and adding a header.
5106 # Options for start_div() can be provided by passing a hash reference as the
5107 # first parameter to the function.
5108 # Options to git_print_header_div() can be provided by passing an array
5109 # reference. This must follow the options to start_div if they are present.
5110 # The content can be a scalar, which is output as-is, a scalar reference, which
5111 # is output after html escaping, an IO handle passed either as *handle or
5112 # *handle{IO}, or a function reference. In the latter case all following
5113 # parameters will be taken as argument to the content function call.
5114 sub git_print_section {
5115         my ($div_args, $header_args, $content);
5116         my $arg = shift;
5117         if (ref($arg) eq 'HASH') {
5118                 $div_args = $arg;
5119                 $arg = shift;
5120         }
5121         if (ref($arg) eq 'ARRAY') {
5122                 $header_args = $arg;
5123                 $arg = shift;
5124         }
5125         $content = $arg;
5126
5127         print $cgi->start_div($div_args);
5128         git_print_header_div(@$header_args);
5129
5130         if (ref($content) eq 'CODE') {
5131                 $content->(@_);
5132         } elsif (ref($content) eq 'SCALAR') {
5133                 print esc_html($$content);
5134         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
5135                 while (<$content>) {
5136                         print to_utf8($_);
5137                 }
5138         } elsif (!ref($content) && defined($content)) {
5139                 print $content;
5140         }
5141
5142         print $cgi->end_div;
5143 }
5144
5145 sub format_timestamp_html {
5146         my $date = shift;
5147         my $strtime = $date->{'rfc2822'};
5148
5149         my (undef, undef, $datetime_class) =
5150                 gitweb_get_feature('javascript-timezone');
5151         if ($datetime_class) {
5152                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
5153         }
5154
5155         my $localtime_format = '(%d %02d:%02d %s)';
5156         if ($date->{'hour_local'} < 6) {
5157                 $localtime_format = '(<span class="atnight">%d %02d:%02d</span> %s)';
5158         }
5159         $strtime .= ' ' .
5160                     sprintf($localtime_format, $date->{'mday_local'},
5161                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
5162
5163         return $strtime;
5164 }
5165
5166 # Outputs the author name and date in long form
5167 sub git_print_authorship {
5168         my $co = shift;
5169         my %opts = @_;
5170         my $tag = $opts{-tag} || 'div';
5171         my $author = $co->{'author_name'};
5172
5173         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
5174         print "<$tag class=\"author_date\">" .
5175               format_search_author($author, "author", esc_html($author)) .
5176               " [".format_timestamp_html(\%ad)."]".
5177               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
5178               "</$tag>\n";
5179 }
5180
5181 # Outputs table rows containing the full author or committer information,
5182 # in the format expected for 'commit' view (& similar).
5183 # Parameters are a commit hash reference, followed by the list of people
5184 # to output information for. If the list is empty it defaults to both
5185 # author and committer.
5186 sub git_print_authorship_rows {
5187         my $co = shift;
5188         # too bad we can't use @people = @_ || ('author', 'committer')
5189         my @people = @_;
5190         @people = ('author', 'committer') unless @people;
5191         foreach my $who (@people) {
5192                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
5193                 print "<tr><td>$who</td><td>" .
5194                       format_search_author($co->{"${who}_name"}, $who,
5195                                            esc_html($co->{"${who}_name"})) . " " .
5196                       format_search_author($co->{"${who}_email"}, $who,
5197                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
5198                       "</td><td rowspan=\"2\">" .
5199                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
5200                       "</td></tr>\n" .
5201                       "<tr>" .
5202                       "<td></td><td>" .
5203                       format_timestamp_html(\%wd) .
5204                       "</td>" .
5205                       "</tr>\n";
5206         }
5207 }
5208
5209 sub git_print_page_path {
5210         my $name = shift;
5211         my $type = shift;
5212         my $hb = shift;
5213
5214
5215         print "<div class=\"page_path\">";
5216         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
5217                       -title => 'tree root'}, to_utf8("[$project]"));
5218         print " / ";
5219         if (defined $name) {
5220                 my @dirname = split '/', $name;
5221                 my $basename = pop @dirname;
5222                 my $fullname = '';
5223
5224                 foreach my $dir (@dirname) {
5225                         $fullname .= ($fullname ? '/' : '') . $dir;
5226                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
5227                                                      hash_base=>$hb),
5228                                       -title => $fullname}, esc_path($dir));
5229                         print " / ";
5230                 }
5231                 if (defined $type && $type eq 'blob') {
5232                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
5233                                                      hash_base=>$hb),
5234                                       -title => $name}, esc_path($basename));
5235                 } elsif (defined $type && $type eq 'tree') {
5236                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
5237                                                      hash_base=>$hb),
5238                                       -title => $name}, esc_path($basename));
5239                         print " / ";
5240                 } else {
5241                         print esc_path($basename);
5242                 }
5243         }
5244         print "<br/></div>\n";
5245 }
5246
5247 sub git_print_log {
5248         my $log = shift;
5249         my %opts = @_;
5250
5251         if ($opts{'-remove_title'}) {
5252                 # remove title, i.e. first line of log
5253                 shift @$log;
5254         }
5255         # remove leading empty lines
5256         while (defined $log->[0] && $log->[0] eq "") {
5257                 shift @$log;
5258         }
5259
5260         # print log
5261         my $skip_blank_line = 0;
5262         foreach my $line (@$log) {
5263                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5264                         if (! $opts{'-remove_signoff'}) {
5265                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5266                                 $skip_blank_line = 1;
5267                         }
5268                         next;
5269                 }
5270
5271                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5272                         if (! $opts{'-remove_signoff'}) {
5273                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5274                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5275                                         "</span><br/>\n";
5276                                 $skip_blank_line = 1;
5277                         }
5278                         next;
5279                 }
5280
5281                 # print only one empty line
5282                 # do not print empty line after signoff
5283                 if ($line eq "") {
5284                         next if ($skip_blank_line);
5285                         $skip_blank_line = 1;
5286                 } else {
5287                         $skip_blank_line = 0;
5288                 }
5289
5290                 print format_log_line_html($line) . "<br/>\n";
5291         }
5292
5293         if ($opts{'-final_empty_line'}) {
5294                 # end with single empty line
5295                 print "<br/>\n" unless $skip_blank_line;
5296         }
5297 }
5298
5299 # return link target (what link points to)
5300 sub git_get_link_target {
5301         my $hash = shift;
5302         my $link_target;
5303
5304         # read link
5305         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5306                 or return;
5307         {
5308                 local $/ = undef;
5309                 $link_target = to_utf8(scalar <$fd>);
5310         }
5311         close $fd
5312                 or return;
5313
5314         return $link_target;
5315 }
5316
5317 # given link target, and the directory (basedir) the link is in,
5318 # return target of link relative to top directory (top tree);
5319 # return undef if it is not possible (including absolute links).
5320 sub normalize_link_target {
5321         my ($link_target, $basedir) = @_;
5322
5323         # absolute symlinks (beginning with '/') cannot be normalized
5324         return if (substr($link_target, 0, 1) eq '/');
5325
5326         # normalize link target to path from top (root) tree (dir)
5327         my $path;
5328         if ($basedir) {
5329                 $path = $basedir . '/' . $link_target;
5330         } else {
5331                 # we are in top (root) tree (dir)
5332                 $path = $link_target;
5333         }
5334
5335         # remove //, /./, and /../
5336         my @path_parts;
5337         foreach my $part (split('/', $path)) {
5338                 # discard '.' and ''
5339                 next if (!$part || $part eq '.');
5340                 # handle '..'
5341                 if ($part eq '..') {
5342                         if (@path_parts) {
5343                                 pop @path_parts;
5344                         } else {
5345                                 # link leads outside repository (outside top dir)
5346                                 return;
5347                         }
5348                 } else {
5349                         push @path_parts, $part;
5350                 }
5351         }
5352         $path = join('/', @path_parts);
5353
5354         return $path;
5355 }
5356
5357 # print tree entry (row of git_tree), but without encompassing <tr> element
5358 sub git_print_tree_entry {
5359         my ($t, $basedir, $hash_base, $have_blame) = @_;
5360
5361         my %base_key = ();
5362         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5363
5364         # The format of a table row is: mode list link.  Where mode is
5365         # the mode of the entry, list is the name of the entry, an href,
5366         # and link is the action links of the entry.
5367
5368         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5369         if (exists $t->{'size'}) {
5370                 print "<td class=\"size\">$t->{'size'}</td>\n";
5371         }
5372         if ($t->{'type'} eq "blob") {
5373                 print "<td class=\"list\">" .
5374                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5375                                                file_name=>"$basedir$t->{'name'}", %base_key),
5376                                 -class => "list"}, esc_path($t->{'name'}));
5377                 if (S_ISLNK(oct $t->{'mode'})) {
5378                         my $link_target = git_get_link_target($t->{'hash'});
5379                         if ($link_target) {
5380                                 my $norm_target = normalize_link_target($link_target, $basedir);
5381                                 if (defined $norm_target) {
5382                                         print " -> " .
5383                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5384                                                                      file_name=>$norm_target),
5385                                                        -title => $norm_target}, esc_path($link_target));
5386                                 } else {
5387                                         print " -> " . esc_path($link_target);
5388                                 }
5389                         }
5390                 }
5391                 print "</td>\n";
5392                 print "<td class=\"link\">";
5393                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5394                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5395                               "blob");
5396                 if ($have_blame) {
5397                         print " | " .
5398                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5399                                                      file_name=>"$basedir$t->{'name'}", %base_key),
5400                                       -class => "blamelink"},
5401                                       "blame");
5402                 }
5403                 if (defined $hash_base) {
5404                         print " | " .
5405                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5406                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5407                                       "history");
5408                 }
5409                 print " | " .
5410                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5411                                                file_name=>"$basedir$t->{'name'}")},
5412                                 "raw");
5413                 print "</td>\n";
5414
5415         } elsif ($t->{'type'} eq "tree") {
5416                 print "<td class=\"list\">";
5417                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5418                                              file_name=>"$basedir$t->{'name'}",
5419                                              %base_key)},
5420                               esc_path($t->{'name'}));
5421                 print "</td>\n";
5422                 print "<td class=\"link\">";
5423                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5424                                              file_name=>"$basedir$t->{'name'}",
5425                                              %base_key)},
5426                               "tree");
5427                 if (defined $hash_base) {
5428                         print " | " .
5429                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5430                                                      file_name=>"$basedir$t->{'name'}")},
5431                                       "history");
5432                 }
5433                 print "</td>\n";
5434         } else {
5435                 # unknown object: we can only present history for it
5436                 # (this includes 'commit' object, i.e. submodule support)
5437                 print "<td class=\"list\">" .
5438                       esc_path($t->{'name'}) .
5439                       "</td>\n";
5440                 print "<td class=\"link\">";
5441                 if (defined $hash_base) {
5442                         print $cgi->a({-href => href(action=>"history",
5443                                                      hash_base=>$hash_base,
5444                                                      file_name=>"$basedir$t->{'name'}")},
5445                                       "history");
5446                 }
5447                 print "</td>\n";
5448         }
5449 }
5450
5451 ## ......................................................................
5452 ## functions printing large fragments of HTML
5453
5454 # get pre-image filenames for merge (combined) diff
5455 sub fill_from_file_info {
5456         my ($diff, @parents) = @_;
5457
5458         $diff->{'from_file'} = [ ];
5459         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5460         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5461                 if ($diff->{'status'}[$i] eq 'R' ||
5462                     $diff->{'status'}[$i] eq 'C') {
5463                         $diff->{'from_file'}[$i] =
5464                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5465                 }
5466         }
5467
5468         return $diff;
5469 }
5470
5471 # is current raw difftree line of file deletion
5472 sub is_deleted {
5473         my $diffinfo = shift;
5474
5475         return $diffinfo->{'to_id'} eq ('0' x 40);
5476 }
5477
5478 # does patch correspond to [previous] difftree raw line
5479 # $diffinfo  - hashref of parsed raw diff format
5480 # $patchinfo - hashref of parsed patch diff format
5481 #              (the same keys as in $diffinfo)
5482 sub is_patch_split {
5483         my ($diffinfo, $patchinfo) = @_;
5484
5485         return defined $diffinfo && defined $patchinfo
5486                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5487 }
5488
5489
5490 sub git_difftree_body {
5491         my ($difftree, $hash, @parents) = @_;
5492         my ($parent) = $parents[0];
5493         my $have_blame = gitweb_check_feature('blame');
5494         print "<div class=\"list_head\">\n";
5495         if ($#{$difftree} > 10) {
5496                 print(($#{$difftree} + 1) . " files changed:\n");
5497         }
5498         print "</div>\n";
5499
5500         print "<table class=\"" .
5501               (@parents > 1 ? "combined " : "") .
5502               "diff_tree\">\n";
5503
5504         # header only for combined diff in 'commitdiff' view
5505         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5506         if ($has_header) {
5507                 # table header
5508                 print "<thead><tr>\n" .
5509                        "<th></th><th></th>\n"; # filename, patchN link
5510                 for (my $i = 0; $i < @parents; $i++) {
5511                         my $par = $parents[$i];
5512                         print "<th>" .
5513                               $cgi->a({-href => href(action=>"commitdiff",
5514                                                      hash=>$hash, hash_parent=>$par),
5515                                        -title => 'commitdiff to parent number ' .
5516                                                   ($i+1) . ': ' . substr($par,0,7)},
5517                                       $i+1) .
5518                               "&#160;</th>\n";
5519                 }
5520                 print "</tr></thead>\n<tbody>\n";
5521         }
5522
5523         my $alternate = 1;
5524         my $patchno = 0;
5525         foreach my $line (@{$difftree}) {
5526                 my $diff = parsed_difftree_line($line);
5527
5528                 if ($alternate) {
5529                         print "<tr class=\"dark\">\n";
5530                 } else {
5531                         print "<tr class=\"light\">\n";
5532                 }
5533                 $alternate ^= 1;
5534
5535                 if (exists $diff->{'nparents'}) { # combined diff
5536
5537                         fill_from_file_info($diff, @parents)
5538                                 unless exists $diff->{'from_file'};
5539
5540                         if (!is_deleted($diff)) {
5541                                 # file exists in the result (child) commit
5542                                 print "<td>" .
5543                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5544                                                              file_name=>$diff->{'to_file'},
5545                                                              hash_base=>$hash),
5546                                               -class => "list"}, esc_path($diff->{'to_file'})) .
5547                                       "</td>\n";
5548                         } else {
5549                                 print "<td>" .
5550                                       esc_path($diff->{'to_file'}) .
5551                                       "</td>\n";
5552                         }
5553
5554                         if ($action eq 'commitdiff') {
5555                                 # link to patch
5556                                 $patchno++;
5557                                 print "<td class=\"link\">" .
5558                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
5559                                               "patch") .
5560                                       " | " .
5561                                       "</td>\n";
5562                         }
5563
5564                         my $has_history = 0;
5565                         my $not_deleted = 0;
5566                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5567                                 my $hash_parent = $parents[$i];
5568                                 my $from_hash = $diff->{'from_id'}[$i];
5569                                 my $from_path = $diff->{'from_file'}[$i];
5570                                 my $status = $diff->{'status'}[$i];
5571
5572                                 $has_history ||= ($status ne 'A');
5573                                 $not_deleted ||= ($status ne 'D');
5574
5575                                 if ($status eq 'A') {
5576                                         print "<td  class=\"link\" align=\"right\"> | </td>\n";
5577                                 } elsif ($status eq 'D') {
5578                                         print "<td class=\"link\">" .
5579                                               $cgi->a({-href => href(action=>"blob",
5580                                                                      hash_base=>$hash,
5581                                                                      hash=>$from_hash,
5582                                                                      file_name=>$from_path)},
5583                                                       "blob" . ($i+1)) .
5584                                               " | </td>\n";
5585                                 } else {
5586                                         if ($diff->{'to_id'} eq $from_hash) {
5587                                                 print "<td class=\"link nochange\">";
5588                                         } else {
5589                                                 print "<td class=\"link\">";
5590                                         }
5591                                         print $cgi->a({-href => href(action=>"blobdiff",
5592                                                                      hash=>$diff->{'to_id'},
5593                                                                      hash_parent=>$from_hash,
5594                                                                      hash_base=>$hash,
5595                                                                      hash_parent_base=>$hash_parent,
5596                                                                      file_name=>$diff->{'to_file'},
5597                                                                      file_parent=>$from_path)},
5598                                                       "diff" . ($i+1)) .
5599                                               " | </td>\n";
5600                                 }
5601                         }
5602
5603                         print "<td class=\"link\">";
5604                         if ($not_deleted) {
5605                                 print $cgi->a({-href => href(action=>"blob",
5606                                                              hash=>$diff->{'to_id'},
5607                                                              file_name=>$diff->{'to_file'},
5608                                                              hash_base=>$hash)},
5609                                               "blob");
5610                                 print " | " if ($has_history);
5611                         }
5612                         if ($has_history) {
5613                                 print $cgi->a({-href => href(action=>"history",
5614                                                              file_name=>$diff->{'to_file'},
5615                                                              hash_base=>$hash)},
5616                                               "history");
5617                         }
5618                         print "</td>\n";
5619
5620                         print "</tr>\n";
5621                         next; # instead of 'else' clause, to avoid extra indent
5622                 }
5623                 # else ordinary diff
5624
5625                 my ($to_mode_oct, $to_mode_str, $to_file_type);
5626                 my ($from_mode_oct, $from_mode_str, $from_file_type);
5627                 if ($diff->{'to_mode'} ne ('0' x 6)) {
5628                         $to_mode_oct = oct $diff->{'to_mode'};
5629                         if (S_ISREG($to_mode_oct)) { # only for regular file
5630                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
5631                         }
5632                         $to_file_type = file_type($diff->{'to_mode'});
5633                 }
5634                 if ($diff->{'from_mode'} ne ('0' x 6)) {
5635                         $from_mode_oct = oct $diff->{'from_mode'};
5636                         if (S_ISREG($from_mode_oct)) { # only for regular file
5637                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
5638                         }
5639                         $from_file_type = file_type($diff->{'from_mode'});
5640                 }
5641
5642                 if ($diff->{'status'} eq "A") { # created
5643                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
5644                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
5645                         $mode_chng   .= "]</span>";
5646                         print "<td>";
5647                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5648                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5649                                       -class => "list"}, esc_path($diff->{'file'}));
5650                         print "</td>\n";
5651                         print "<td>$mode_chng</td>\n";
5652                         print "<td class=\"link\">";
5653                         if ($action eq 'commitdiff') {
5654                                 # link to patch
5655                                 $patchno++;
5656                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5657                                               "patch") .
5658                                       " | ";
5659                         }
5660                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5661                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5662                                       "blob");
5663                         print "</td>\n";
5664
5665                 } elsif ($diff->{'status'} eq "D") { # deleted
5666                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
5667                         print "<td>";
5668                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5669                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
5670                                        -class => "list"}, esc_path($diff->{'file'}));
5671                         print "</td>\n";
5672                         print "<td>$mode_chng</td>\n";
5673                         print "<td class=\"link\">";
5674                         if ($action eq 'commitdiff') {
5675                                 # link to patch
5676                                 $patchno++;
5677                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5678                                               "patch") .
5679                                       " | ";
5680                         }
5681                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5682                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
5683                                       "blob") . " | ";
5684                         if ($have_blame) {
5685                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
5686                                                              file_name=>$diff->{'file'}),
5687                                               -class => "blamelink"},
5688                                               "blame") . " | ";
5689                         }
5690                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
5691                                                      file_name=>$diff->{'file'})},
5692                                       "history");
5693                         print "</td>\n";
5694
5695                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
5696                         my $mode_chnge = "";
5697                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5698                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
5699                                 if ($from_file_type ne $to_file_type) {
5700                                         $mode_chnge .= " from $from_file_type to $to_file_type";
5701                                 }
5702                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
5703                                         if ($from_mode_str && $to_mode_str) {
5704                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
5705                                         } elsif ($to_mode_str) {
5706                                                 $mode_chnge .= " mode: $to_mode_str";
5707                                         }
5708                                 }
5709                                 $mode_chnge .= "]</span>\n";
5710                         }
5711                         print "<td>";
5712                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5713                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5714                                       -class => "list"}, esc_path($diff->{'file'}));
5715                         print "</td>\n";
5716                         print "<td>$mode_chnge</td>\n";
5717                         print "<td class=\"link\">";
5718                         if ($action eq 'commitdiff') {
5719                                 # link to patch
5720                                 $patchno++;
5721                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5722                                               "patch") .
5723                                       " | ";
5724                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5725                                 # "commit" view and modified file (not onlu mode changed)
5726                                 print $cgi->a({-href => href(action=>"blobdiff",
5727                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5728                                                              hash_base=>$hash, hash_parent_base=>$parent,
5729                                                              file_name=>$diff->{'file'})},
5730                                               "diff") .
5731                                       " | ";
5732                         }
5733                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5734                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5735                                        "blob") . " | ";
5736                         if ($have_blame) {
5737                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
5738                                                              file_name=>$diff->{'file'}),
5739                                               -class => "blamelink"},
5740                                               "blame") . " | ";
5741                         }
5742                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
5743                                                      file_name=>$diff->{'file'})},
5744                                       "history");
5745                         print "</td>\n";
5746
5747                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
5748                         my %status_name = ('R' => 'moved', 'C' => 'copied');
5749                         my $nstatus = $status_name{$diff->{'status'}};
5750                         my $mode_chng = "";
5751                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5752                                 # mode also for directories, so we cannot use $to_mode_str
5753                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
5754                         }
5755                         print "<td>" .
5756                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
5757                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
5758                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
5759                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
5760                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
5761                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
5762                                       -class => "list"}, esc_path($diff->{'from_file'})) .
5763                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
5764                               "<td class=\"link\">";
5765                         if ($action eq 'commitdiff') {
5766                                 # link to patch
5767                                 $patchno++;
5768                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5769                                               "patch") .
5770                                       " | ";
5771                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5772                                 # "commit" view and modified file (not only pure rename or copy)
5773                                 print $cgi->a({-href => href(action=>"blobdiff",
5774                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5775                                                              hash_base=>$hash, hash_parent_base=>$parent,
5776                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
5777                                               "diff") .
5778                                       " | ";
5779                         }
5780                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5781                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
5782                                       "blob") . " | ";
5783                         if ($have_blame) {
5784                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
5785                                                              file_name=>$diff->{'to_file'}),
5786                                               -class => "blamelink"},
5787                                               "blame") . " | ";
5788                         }
5789                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
5790                                                     file_name=>$diff->{'to_file'})},
5791                                       "history");
5792                         print "</td>\n";
5793
5794                 } # we should not encounter Unmerged (U) or Unknown (X) status
5795                 print "</tr>\n";
5796         }
5797         print "</tbody>" if $has_header;
5798         print "</table>\n";
5799 }
5800
5801 # Print context lines and then rem/add lines in a side-by-side manner.
5802 sub print_sidebyside_diff_lines {
5803         my ($ctx, $rem, $add) = @_;
5804
5805         # print context block before add/rem block
5806         if (@$ctx) {
5807                 print join '',
5808                         '<div class="chunk_block ctx">',
5809                                 '<div class="old">',
5810                                 @$ctx,
5811                                 '</div>',
5812                                 '<div class="new">',
5813                                 @$ctx,
5814                                 '</div>',
5815                         '</div>';
5816         }
5817
5818         if (!@$add) {
5819                 # pure removal
5820                 print join '',
5821                         '<div class="chunk_block rem">',
5822                                 '<div class="old">',
5823                                 @$rem,
5824                                 '</div>',
5825                         '</div>';
5826         } elsif (!@$rem) {
5827                 # pure addition
5828                 print join '',
5829                         '<div class="chunk_block add">',
5830                                 '<div class="new">',
5831                                 @$add,
5832                                 '</div>',
5833                         '</div>';
5834         } else {
5835                 print join '',
5836                         '<div class="chunk_block chg">',
5837                                 '<div class="old">',
5838                                 @$rem,
5839                                 '</div>',
5840                                 '<div class="new">',
5841                                 @$add,
5842                                 '</div>',
5843                         '</div>';
5844         }
5845 }
5846
5847 # Print context lines and then rem/add lines in inline manner.
5848 sub print_inline_diff_lines {
5849         my ($ctx, $rem, $add) = @_;
5850
5851         print @$ctx, @$rem, @$add;
5852 }
5853
5854 # Format removed and added line, mark changed part and HTML-format them.
5855 # Implementation is based on contrib/diff-highlight
5856 sub format_rem_add_lines_pair {
5857         my ($rem, $add, $num_parents) = @_;
5858
5859         # We need to untabify lines before split()'ing them;
5860         # otherwise offsets would be invalid.
5861         chomp $rem;
5862         chomp $add;
5863         $rem = untabify($rem);
5864         $add = untabify($add);
5865
5866         my @rem = split(//, $rem);
5867         my @add = split(//, $add);
5868         my ($esc_rem, $esc_add);
5869         # Ignore leading +/- characters for each parent.
5870         my ($prefix_len, $suffix_len) = ($num_parents, 0);
5871         my ($prefix_has_nonspace, $suffix_has_nonspace);
5872
5873         my $shorter = (@rem < @add) ? @rem : @add;
5874         while ($prefix_len < $shorter) {
5875                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
5876
5877                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
5878                 $prefix_len++;
5879         }
5880
5881         while ($prefix_len + $suffix_len < $shorter) {
5882                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
5883
5884                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
5885                 $suffix_len++;
5886         }
5887
5888         # Mark lines that are different from each other, but have some common
5889         # part that isn't whitespace.  If lines are completely different, don't
5890         # mark them because that would make output unreadable, especially if
5891         # diff consists of multiple lines.
5892         if ($prefix_has_nonspace || $suffix_has_nonspace) {
5893                 $esc_rem = esc_html_hl_regions($rem, 'marked',
5894                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
5895                 $esc_add = esc_html_hl_regions($add, 'marked',
5896                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
5897         } else {
5898                 $esc_rem = esc_html($rem, -nbsp=>1);
5899                 $esc_add = esc_html($add, -nbsp=>1);
5900         }
5901
5902         return format_diff_line(\$esc_rem, 'rem'),
5903                format_diff_line(\$esc_add, 'add');
5904 }
5905
5906 # HTML-format diff context, removed and added lines.
5907 sub format_ctx_rem_add_lines {
5908         my ($ctx, $rem, $add, $num_parents) = @_;
5909         my (@new_ctx, @new_rem, @new_add);
5910         my $can_highlight = 0;
5911         my $is_combined = ($num_parents > 1);
5912
5913         # Highlight if every removed line has a corresponding added line.
5914         if (@$add > 0 && @$add == @$rem) {
5915                 $can_highlight = 1;
5916
5917                 # Highlight lines in combined diff only if the chunk contains
5918                 # diff between the same version, e.g.
5919                 #
5920                 #    - a
5921                 #   -  b
5922                 #    + c
5923                 #   +  d
5924                 #
5925                 # Otherwise the highlightling would be confusing.
5926                 if ($is_combined) {
5927                         for (my $i = 0; $i < @$add; $i++) {
5928                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
5929                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
5930
5931                                 $prefix_rem =~ s/-/+/g;
5932
5933                                 if ($prefix_rem ne $prefix_add) {
5934                                         $can_highlight = 0;
5935                                         last;
5936                                 }
5937                         }
5938                 }
5939         }
5940
5941         if ($can_highlight) {
5942                 for (my $i = 0; $i < @$add; $i++) {
5943                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
5944                                 $rem->[$i], $add->[$i], $num_parents);
5945                         push @new_rem, $line_rem;
5946                         push @new_add, $line_add;
5947                 }
5948         } else {
5949                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
5950                 @new_add = map { format_diff_line($_, 'add') } @$add;
5951         }
5952
5953         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
5954
5955         return (\@new_ctx, \@new_rem, \@new_add);
5956 }
5957
5958 # Print context lines and then rem/add lines.
5959 sub print_diff_lines {
5960         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
5961         my $is_combined = $num_parents > 1;
5962
5963         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
5964                 $num_parents);
5965
5966         if ($diff_style eq 'sidebyside' && !$is_combined) {
5967                 print_sidebyside_diff_lines($ctx, $rem, $add);
5968         } else {
5969                 # default 'inline' style and unknown styles
5970                 print_inline_diff_lines($ctx, $rem, $add);
5971         }
5972 }
5973
5974 sub print_diff_chunk {
5975         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
5976         my (@ctx, @rem, @add);
5977
5978         # The class of the previous line.
5979         my $prev_class = '';
5980
5981         return unless @chunk;
5982
5983         # incomplete last line might be among removed or added lines,
5984         # or both, or among context lines: find which
5985         for (my $i = 1; $i < @chunk; $i++) {
5986                 if ($chunk[$i][0] eq 'incomplete') {
5987                         $chunk[$i][0] = $chunk[$i-1][0];
5988                 }
5989         }
5990
5991         # guardian
5992         push @chunk, ["", ""];
5993
5994         foreach my $line_info (@chunk) {
5995                 my ($class, $line) = @$line_info;
5996
5997                 # print chunk headers
5998                 if ($class && $class eq 'chunk_header') {
5999                         print format_diff_line($line, $class, $from, $to);
6000                         next;
6001                 }
6002
6003                 ## print from accumulator when have some add/rem lines or end
6004                 # of chunk (flush context lines), or when have add and rem
6005                 # lines and new block is reached (otherwise add/rem lines could
6006                 # be reordered)
6007                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
6008                     (@rem && @add && $class ne $prev_class)) {
6009                         print_diff_lines(\@ctx, \@rem, \@add,
6010                                          $diff_style, $num_parents);
6011                         @ctx = @rem = @add = ();
6012                 }
6013
6014                 ## adding lines to accumulator
6015                 # guardian value
6016                 last unless $line;
6017                 # rem, add or change
6018                 if ($class eq 'rem') {
6019                         push @rem, $line;
6020                 } elsif ($class eq 'add') {
6021                         push @add, $line;
6022                 }
6023                 # context line
6024                 if ($class eq 'ctx') {
6025                         push @ctx, $line;
6026                 }
6027
6028                 $prev_class = $class;
6029         }
6030 }
6031
6032 sub git_patchset_body {
6033         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
6034         my ($hash_parent) = $hash_parents[0];
6035
6036         my $is_combined = (@hash_parents > 1);
6037         my $patch_idx = 0;
6038         my $patch_number = 0;
6039         my $patch_line;
6040         my $diffinfo;
6041         my $to_name;
6042         my (%from, %to);
6043         my @chunk; # for side-by-side diff
6044
6045         print "<div class=\"patchset\">\n";
6046
6047         # skip to first patch
6048         while ($patch_line = to_utf8(scalar <$fd>)) {
6049                 chomp $patch_line;
6050
6051                 last if ($patch_line =~ m/^diff /);
6052         }
6053
6054  PATCH:
6055         while ($patch_line) {
6056
6057                 # parse "git diff" header line
6058                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
6059                         # $1 is from_name, which we do not use
6060                         $to_name = unquote($2);
6061                         $to_name =~ s!^b/!!;
6062                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
6063                         # $1 is 'cc' or 'combined', which we do not use
6064                         $to_name = unquote($2);
6065                 } else {
6066                         $to_name = undef;
6067                 }
6068
6069                 # check if current patch belong to current raw line
6070                 # and parse raw git-diff line if needed
6071                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
6072                         # this is continuation of a split patch
6073                         print "<div class=\"patch cont\">\n";
6074                 } else {
6075                         # advance raw git-diff output if needed
6076                         $patch_idx++ if defined $diffinfo;
6077
6078                         # read and prepare patch information
6079                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6080
6081                         # compact combined diff output can have some patches skipped
6082                         # find which patch (using pathname of result) we are at now;
6083                         if ($is_combined) {
6084                                 while ($to_name ne $diffinfo->{'to_file'}) {
6085                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6086                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
6087                                               "</div>\n";  # class="patch"
6088
6089                                         $patch_idx++;
6090                                         $patch_number++;
6091
6092                                         last if $patch_idx > $#$difftree;
6093                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6094                                 }
6095                         }
6096
6097                         # modifies %from, %to hashes
6098                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
6099
6100                         # this is first patch for raw difftree line with $patch_idx index
6101                         # we index @$difftree array from 0, but number patches from 1
6102                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
6103                 }
6104
6105                 # git diff header
6106                 #assert($patch_line =~ m/^diff /) if DEBUG;
6107                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
6108                 $patch_number++;
6109                 # print "git diff" header
6110                 print format_git_diff_header_line($patch_line, $diffinfo,
6111                                                   \%from, \%to);
6112
6113                 # print extended diff header
6114                 print "<div class=\"diff extended_header\">\n";
6115         EXTENDED_HEADER:
6116                 while ($patch_line = to_utf8(scalar<$fd>)) {
6117                         chomp $patch_line;
6118
6119                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
6120
6121                         print format_extended_diff_header_line($patch_line, $diffinfo,
6122                                                                \%from, \%to);
6123                 }
6124                 print "</div>\n"; # class="diff extended_header"
6125
6126                 # from-file/to-file diff header
6127                 if (! $patch_line) {
6128                         print "</div>\n"; # class="patch"
6129                         last PATCH;
6130                 }
6131                 next PATCH if ($patch_line =~ m/^diff /);
6132                 #assert($patch_line =~ m/^---/) if DEBUG;
6133
6134                 my $last_patch_line = $patch_line;
6135                 $patch_line = to_utf8(scalar <$fd>);
6136                 chomp $patch_line;
6137                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
6138
6139                 print format_diff_from_to_header($last_patch_line, $patch_line,
6140                                                  $diffinfo, \%from, \%to,
6141                                                  @hash_parents);
6142
6143                 # the patch itself
6144         LINE:
6145                 while ($patch_line = to_utf8(scalar <$fd>)) {
6146                         chomp $patch_line;
6147
6148                         next PATCH if ($patch_line =~ m/^diff /);
6149
6150                         my $class = diff_line_class($patch_line, \%from, \%to);
6151
6152                         if ($class eq 'chunk_header') {
6153                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6154                                 @chunk = ();
6155                         }
6156
6157                         push @chunk, [ $class, $patch_line ];
6158                 }
6159
6160         } continue {
6161                 if (@chunk) {
6162                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6163                         @chunk = ();
6164                 }
6165                 print "</div>\n"; # class="patch"
6166         }
6167
6168         # for compact combined (--cc) format, with chunk and patch simplification
6169         # the patchset might be empty, but there might be unprocessed raw lines
6170         for (++$patch_idx if $patch_number > 0;
6171              $patch_idx < @$difftree;
6172              ++$patch_idx) {
6173                 # read and prepare patch information
6174                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6175
6176                 # generate anchor for "patch" links in difftree / whatchanged part
6177                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6178                       format_diff_cc_simplified($diffinfo, @hash_parents) .
6179                       "</div>\n";  # class="patch"
6180
6181                 $patch_number++;
6182         }
6183
6184         if ($patch_number == 0) {
6185                 if (@hash_parents > 1) {
6186                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
6187                 } else {
6188                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
6189                 }
6190         }
6191
6192         print "</div>\n"; # class="patchset"
6193 }
6194
6195 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6196
6197 sub git_project_search_form {
6198         my ($searchtext, $search_use_regexp) = @_;
6199
6200         my $limit = '';
6201         if ($project_filter) {
6202                 $limit = " in '$project_filter'";
6203         }
6204
6205         print "<div class=\"projsearch\">\n";
6206         print $cgi->start_form(-method => 'get', -action => $my_uri) .
6207               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
6208         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
6209                 if (defined $project_filter);
6210         print $cgi->textfield(-name => 's', -value => $searchtext,
6211                               -title => "Search project by name and description$limit",
6212                               -size => 60) . "\n" .
6213               "<span title=\"Extended regular expression\">" .
6214               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
6215                              -checked => $search_use_regexp) .
6216               "</span>\n" .
6217               $cgi->submit(-name => 'btnS', -value => 'Search') .
6218               $cgi->end_form() . "\n" .
6219               "<span class=\"projectlist_link\">" .
6220               $cgi->a({-href => href(project => undef, searchtext => undef,
6221                                      action => 'project_list',
6222                                      project_filter => $project_filter)},
6223                       esc_html("List all projects$limit")) . "</span><br />\n";
6224         print "<span class=\"projectlist_link\">" .
6225               $cgi->a({-href => href(project => undef, searchtext => undef,
6226                                      action => 'project_list',
6227                                      project_filter => undef)},
6228                       esc_html("List all projects")) . "</span>\n" if $project_filter;
6229         print "</div>\n";
6230 }
6231
6232 # entry for given @keys needs filling if at least one of keys in list
6233 # is not present in %$project_info
6234 sub project_info_needs_filling {
6235         my ($project_info, @keys) = @_;
6236
6237         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
6238         foreach my $key (@keys) {
6239                 if (!exists $project_info->{$key}) {
6240                         return 1;
6241                 }
6242         }
6243         return;
6244 }
6245
6246 sub git_cache_file_format {
6247         return GITWEB_CACHE_FORMAT .
6248                 (gitweb_check_feature('forks') ? " (forks)" : "");
6249 }
6250
6251 sub git_retrieve_cache_file {
6252         my $cache_file = shift;
6253
6254         use Storable qw(retrieve);
6255
6256         if ((my $dump = eval { retrieve($cache_file) })) {
6257                 return $$dump[1] if
6258                         ref($dump) eq 'ARRAY' &&
6259                         @$dump == 2 &&
6260                         ref($$dump[1]) eq 'ARRAY' &&
6261                         @{$$dump[1]} == 2 &&
6262                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
6263                         ref(${$$dump[1]}[1]) eq 'HASH' &&
6264                         $$dump[0] eq git_cache_file_format();
6265         }
6266
6267         return undef;
6268 }
6269
6270 sub git_store_cache_file {
6271         my ($cache_file, $cachedata) = @_;
6272
6273         use File::Basename qw(dirname);
6274         use File::stat;
6275         use POSIX qw(:fcntl_h);
6276         use Storable qw(store_fd);
6277
6278         my $result = undef;
6279         my $cache_d = dirname($cache_file);
6280         my $mask = umask();
6281         umask($mask & ~0070) if $cache_grpshared;
6282         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6283             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6284                 store_fd([git_cache_file_format(), $cachedata], $fd);
6285                 close $fd;
6286                 rename "$cache_file.lock", $cache_file;
6287                 $result = stat($cache_file)->mtime;
6288         }
6289         umask($mask) if $cache_grpshared;
6290         return $result;
6291 }
6292
6293 sub git_filter_cached_projects {
6294         my ($cache, $projlist) = @_;
6295         return map {
6296                 my $c = ${$$cache[1]}{$_->{'path'}};
6297                 defined $c ? ($_ = $c) : ()
6298         } @$projlist;
6299 }
6300
6301 # fills project list info (age, description, owner, category, forks, etc.)
6302 # for each project in the list, removing invalid projects from
6303 # returned list, or fill only specified info.
6304 #
6305 # Invalid projects are removed from the returned list if and only if you
6306 # ask 'age_epoch' to be filled, because they are the only fields
6307 # that run unconditionally git command that requires repository, and
6308 # therefore do always check if project repository is invalid.
6309 #
6310 # USAGE:
6311 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6312 #   ensures that 'descr_long' and 'ctags' fields are filled
6313 # * @project_list = fill_project_list_info(\@project_list)
6314 #   ensures that all fields are filled (and invalid projects removed)
6315 #
6316 # NOTE: modifies $projlist, but does not remove entries from it
6317 sub fill_project_list_info {
6318         my ($projlist, @wanted_keys) = @_;
6319
6320         use File::stat;
6321
6322         my $cache_file = "$cache_dir/$projlist_cache_name";
6323         my $cache_lifetime = $projlist_cache_lifetime;
6324         $cache_lifetime = -1
6325                 if $cache_lifetime && @wanted_keys && $wanted_keys[0] eq 'rebuild-cache';
6326
6327         my @projects;
6328         my $stale = 0;
6329         my $now = time();
6330         my $cache_mtime;
6331         if ($cache_lifetime && -f $cache_file) {
6332                 $cache_mtime = stat($cache_file)->mtime;
6333                 $cache_dump = undef if $cache_mtime &&
6334                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6335         }
6336         if (defined $cache_mtime && # caching is on and $cache_file exists
6337             $cache_mtime + $cache_lifetime*60 > $now &&
6338             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6339                 # Cache hit.
6340                 $cache_dump_mtime = $cache_mtime;
6341                 $stale = $now - $cache_mtime;
6342                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6343
6344         } else { # Cache miss.
6345                 if (defined $cache_mtime) {
6346                         # Postpone timeout by two minutes so that we get
6347                         # enough time to do our job, or to be more exact
6348                         # make cache expire after two minutes from now.
6349                         my $time = $now - $cache_lifetime*60 + 120;
6350                         utime $time, $time, $cache_file;
6351                 }
6352                 if ($cache_lifetime) {
6353                         my @all_projects = git_get_projects_list();
6354                         my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6355                                 fill_project_list_info_uncached(\@all_projects);
6356                         map { $all_projects_filled{$_->{'path'}} = $_ }
6357                                 filter_forks_from_projects_list([values(%all_projects_filled)])
6358                                 if gitweb_check_feature('forks');
6359                         $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6360                                        \%all_projects_filled];
6361                         $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6362                         @projects = git_filter_cached_projects($cache_dump, $projlist);
6363                 } else {
6364                         @projects = fill_project_list_info_uncached($projlist, @wanted_keys);
6365                 }
6366         }
6367
6368         if ($cache_lifetime && $stale > 0) {
6369                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6370                         unless $shown_stale_message;
6371                 $shown_stale_message = 1;
6372         }
6373
6374         return @projects;
6375 }
6376
6377 sub fill_project_list_info_uncached {
6378         my ($projlist, @wanted_keys) = @_;
6379         my @projects;
6380         my $filter_set = sub { return @_; };
6381         if (@wanted_keys) {
6382                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6383                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6384         }
6385
6386         my $show_ctags = gitweb_check_feature('ctags');
6387  PROJECT:
6388         foreach my $pr (@$projlist) {
6389                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6390                         my (@activity) = git_get_last_activity($pr->{'path'});
6391                         unless (@activity) {
6392                                 next PROJECT;
6393                         }
6394                         ($pr->{'age_epoch'}) = @activity;
6395                 }
6396                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6397                         my $descr = git_get_project_description($pr->{'path'}) || "";
6398                         $descr = to_utf8($descr);
6399                         $pr->{'descr_long'} = $descr;
6400                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6401                 }
6402                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6403                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6404                 }
6405                 if ($show_ctags &&
6406                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6407                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6408                 }
6409                 if ($projects_list_group_categories &&
6410                     project_info_needs_filling($pr, $filter_set->('category'))) {
6411                         my $cat = git_get_project_category($pr->{'path'}) ||
6412                                                            $project_list_default_category;
6413                         $pr->{'category'} = to_utf8($cat);
6414                 }
6415
6416                 push @projects, $pr;
6417         }
6418
6419         return @projects;
6420 }
6421
6422 sub sort_projects_list {
6423         my ($projlist, $order) = @_;
6424
6425         sub order_str {
6426                 my $key = shift;
6427                 return sub { lc($a->{$key}) cmp lc($b->{$key}) };
6428         }
6429
6430         sub order_reverse_num_then_undef {
6431                 my $key = shift;
6432                 return sub {
6433                         defined $a->{$key} ?
6434                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6435                                 (defined $b->{$key} ? 1 : 0)
6436                 };
6437         }
6438
6439         my %orderings = (
6440                 project => order_str('path'),
6441                 descr => order_str('descr_long'),
6442                 owner => order_str('owner'),
6443                 age => order_reverse_num_then_undef('age_epoch'),
6444         );
6445
6446         my $ordering = $orderings{$order};
6447         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6448 }
6449
6450 # returns a hash of categories, containing the list of project
6451 # belonging to each category
6452 sub build_projlist_by_category {
6453         my ($projlist, $from, $to) = @_;
6454         my %categories;
6455
6456         $from = 0 unless defined $from;
6457         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6458
6459         for (my $i = $from; $i <= $to; $i++) {
6460                 my $pr = $projlist->[$i];
6461                 push @{$categories{ $pr->{'category'} }}, $pr;
6462         }
6463
6464         return wantarray ? %categories : \%categories;
6465 }
6466
6467 # print 'sort by' <th> element, generating 'sort by $name' replay link
6468 # if that order is not selected
6469 sub print_sort_th {
6470         print format_sort_th(@_);
6471 }
6472
6473 sub format_sort_th {
6474         my ($name, $order, $header) = @_;
6475         my $sort_th = "";
6476         $header ||= ucfirst($name);
6477
6478         if ($order eq $name) {
6479                 $sort_th .= "<th>$header</th>\n";
6480         } else {
6481                 $sort_th .= "<th>" .
6482                             $cgi->a({-href => href(-replay=>1, order=>$name),
6483                                      -class => "header"}, $header) .
6484                             "</th>\n";
6485         }
6486
6487         return $sort_th;
6488 }
6489
6490 sub git_project_list_rows {
6491         my ($projlist, $from, $to, $check_forks) = @_;
6492
6493         $from = 0 unless defined $from;
6494         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6495
6496         my $now = time;
6497         my $alternate = 1;
6498         for (my $i = $from; $i <= $to; $i++) {
6499                 my $pr = $projlist->[$i];
6500
6501                 if ($alternate) {
6502                         print "<tr class=\"dark\">\n";
6503                 } else {
6504                         print "<tr class=\"light\">\n";
6505                 }
6506                 $alternate ^= 1;
6507
6508                 if ($check_forks) {
6509                         print "<td>";
6510                         if ($pr->{'forks'}) {
6511                                 my $nforks = scalar @{$pr->{'forks'}};
6512                                 my $s = $nforks == 1 ? '' : 's';
6513                                 if ($nforks > 0) {
6514                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
6515                                                        -title => "$nforks fork$s"}, "+");
6516                                 } else {
6517                                         print $cgi->span({-title => "$nforks fork$s"}, "+");
6518                                 }
6519                         }
6520                         print "</td>\n";
6521                 }
6522                 my $path = $pr->{'path'};
6523                 my $dotgit = $path =~ s/\.git$// ? '.git' : '';
6524                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6525                                         -class => "list"},
6526                                        esc_html_match_hl($path, $search_regexp).$dotgit) .
6527                       "</td>\n" .
6528                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6529                                         -class => "list",
6530                                         -title => $pr->{'descr_long'}},
6531                                         $search_regexp
6532                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
6533                                                                     $pr->{'descr'}, $search_regexp)
6534                                         : esc_html($pr->{'descr'})) .
6535                       "</td>\n";
6536                 unless ($omit_owner) {
6537                         print "<td><i>" . ($owner_link_hook
6538                                           ? $cgi->a({-href => $owner_link_hook->($pr->{'owner'}), -class => "list"},
6539                                                     chop_and_escape_str($pr->{'owner'}, 15))
6540                                           : chop_and_escape_str($pr->{'owner'}, 15)) . "</i></td>\n";
6541                 }
6542                 unless ($omit_age_column) {
6543                         my ($age, $age_string, $age_epoch);
6544                         if (defined($age_epoch = $pr->{'age_epoch'})) {
6545                                 $age = $now - $age_epoch;
6546                                 $age_string = age_string($age);
6547                         } else {
6548                                 $age_string = "No commits";
6549                         }
6550                         print "<td class=\"". age_class($age) . "\">" . $age_string . "</td>\n";
6551                 }
6552                 print"<td class=\"link\">" .
6553                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . " | " .
6554                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "log") . " | " .
6555                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
6556                       ($pr->{'forks'} ? " | " . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
6557                       "</td>\n" .
6558                       "</tr>\n";
6559         }
6560 }
6561
6562 sub git_project_list_body {
6563         # actually uses global variable $project
6564         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action, $keep_top) = @_;
6565         my @projects = @$projlist;
6566
6567         my $check_forks = gitweb_check_feature('forks');
6568         my $show_ctags  = gitweb_check_feature('ctags');
6569         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
6570         $check_forks = undef
6571                 if ($tagfilter || $search_regexp);
6572
6573         # filtering out forks before filling info allows us to do less work
6574         if ($check_forks) {
6575                 @projects = filter_forks_from_projects_list(\@projects);
6576                 push @projects, { 'path' => "$project_filter.git" }
6577                         if $project_filter && $keep_top && is_valid_project("$project_filter.git");
6578         }
6579         # search_projects_list pre-fills required info
6580         @projects = search_projects_list(\@projects,
6581                                          'search_regexp' => $search_regexp,
6582                                          'tagfilter'  => $tagfilter)
6583                 if ($tagfilter || $search_regexp);
6584         # fill the rest
6585         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
6586         push @all_fields, 'age_epoch' unless($omit_age_column);
6587         push @all_fields, 'owner' unless($omit_owner);
6588         @projects = fill_project_list_info(\@projects, @all_fields);
6589
6590         $order ||= $default_projects_order;
6591         $from = 0 unless defined $from;
6592         $to = $#projects if (!defined $to || $#projects < $to);
6593
6594         # short circuit
6595         if ($from > $to) {
6596                 print "<center>\n".
6597                       "<b>No such projects found</b><br />\n".
6598                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
6599                       "</center>\n<br />\n";
6600                 return;
6601         }
6602
6603         @projects = sort_projects_list(\@projects, $order);
6604
6605         if ($show_ctags) {
6606                 my $ctags = git_gather_all_ctags(\@projects);
6607                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
6608                 print git_show_project_tagcloud($cloud, 64);
6609         }
6610
6611         print "<table class=\"project_list\">\n";
6612         unless ($no_header) {
6613                 print "<tr>\n";
6614                 if ($check_forks) {
6615                         print "<th></th>\n";
6616                 }
6617                 print_sort_th('project', $order, 'Project');
6618                 print_sort_th('descr', $order, 'Description');
6619                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
6620                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
6621                 print "<th></th>\n" . # for links
6622                       "</tr>\n";
6623         }
6624
6625         if ($projects_list_group_categories) {
6626                 # only display categories with projects in the $from-$to window
6627                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
6628                 my %categories = build_projlist_by_category(\@projects, $from, $to);
6629                 foreach my $cat (sort keys %categories) {
6630                         unless ($cat eq "") {
6631                                 print "<tr>\n";
6632                                 if ($check_forks) {
6633                                         print "<td></td>\n";
6634                                 }
6635                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
6636                                 print "</tr>\n";
6637                         }
6638
6639                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
6640                 }
6641         } else {
6642                 git_project_list_rows(\@projects, $from, $to, $check_forks);
6643         }
6644
6645         if (defined $extra) {
6646                 print "<tr>\n";
6647                 if ($check_forks) {
6648                         print "<td></td>\n";
6649                 }
6650                 print "<td colspan=\"5\">$extra</td>\n" .
6651                       "</tr>\n";
6652         }
6653         print "</table>\n";
6654 }
6655
6656 sub git_log_body {
6657         # uses global variable $project
6658         my ($commitlist, $from, $to, $refs, $extra) = @_;
6659
6660         $from = 0 unless defined $from;
6661         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6662
6663         for (my $i = 0; $i <= $to; $i++) {
6664                 my %co = %{$commitlist->[$i]};
6665                 next if !%co;
6666                 my $commit = $co{'id'};
6667                 my $ref = format_ref_marker($refs, $commit);
6668                 git_print_header_div('commit',
6669                                "<span class=\"age\">$co{'age_string'}</span>" .
6670                                esc_html($co{'title'}),
6671                                $commit, undef, $ref);
6672                 print "<div class=\"title_text\">\n" .
6673                       "<div class=\"log_link\">\n" .
6674                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
6675                       " | " .
6676                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
6677                       " | " .
6678                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
6679                       "<br/>\n" .
6680                       "</div>\n";
6681                       git_print_authorship(\%co, -tag => 'span');
6682                       print "<br/>\n</div>\n";
6683
6684                 print "<div class=\"log_body\">\n";
6685                 git_print_log($co{'comment'}, -final_empty_line=> 1);
6686                 print "</div>\n";
6687         }
6688         if ($extra) {
6689                 print "<div class=\"page_nav\">\n";
6690                 print "$extra\n";
6691                 print "</div>\n";
6692         }
6693 }
6694
6695 sub git_shortlog_body {
6696         # uses global variable $project
6697         my ($commitlist, $from, $to, $refs, $extra) = @_;
6698
6699         $from = 0 unless defined $from;
6700         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6701
6702         print "<table class=\"shortlog\">\n";
6703         my $alternate = 1;
6704         for (my $i = $from; $i <= $to; $i++) {
6705                 my %co = %{$commitlist->[$i]};
6706                 my $commit = $co{'id'};
6707                 my $ref = format_ref_marker($refs, $commit);
6708                 if ($alternate) {
6709                         print "<tr class=\"dark\">\n";
6710                 } else {
6711                         print "<tr class=\"light\">\n";
6712                 }
6713                 $alternate ^= 1;
6714                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
6715                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6716                       format_author_html('td', \%co, 10) . "<td>";
6717                 print format_subject_html($co{'title'}, $co{'title_short'},
6718                                           href(action=>"commit", hash=>$commit), $ref);
6719                 print "</td>\n" .
6720                       "<td class=\"link\">" .
6721                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . " | " .
6722                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . " | " .
6723                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
6724                 my $snapshot_links = format_snapshot_links($commit);
6725                 if (defined $snapshot_links) {
6726                         print " | " . $snapshot_links;
6727                 }
6728                 print "</td>\n" .
6729                       "</tr>\n";
6730         }
6731         if (defined $extra) {
6732                 print "<tr>\n" .
6733                       "<td colspan=\"4\">$extra</td>\n" .
6734                       "</tr>\n";
6735         }
6736         print "</table>\n";
6737 }
6738
6739 sub git_history_body {
6740         # Warning: assumes constant type (blob or tree) during history
6741         my ($commitlist, $from, $to, $refs, $extra,
6742             $file_name, $file_hash, $ftype) = @_;
6743
6744         $from = 0 unless defined $from;
6745         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
6746
6747         print "<table class=\"history\">\n";
6748         my $alternate = 1;
6749         for (my $i = $from; $i <= $to; $i++) {
6750                 my %co = %{$commitlist->[$i]};
6751                 if (!%co) {
6752                         next;
6753                 }
6754                 my $commit = $co{'id'};
6755
6756                 my $ref = format_ref_marker($refs, $commit);
6757
6758                 if ($alternate) {
6759                         print "<tr class=\"dark\">\n";
6760                 } else {
6761                         print "<tr class=\"light\">\n";
6762                 }
6763                 $alternate ^= 1;
6764                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6765         # shortlog:   format_author_html('td', \%co, 10)
6766                       format_author_html('td', \%co, 15, 3) . "<td>";
6767                 # originally git_history used chop_str($co{'title'}, 50)
6768                 print format_subject_html($co{'title'}, $co{'title_short'},
6769                                           href(action=>"commit", hash=>$commit), $ref);
6770                 print "</td>\n" .
6771                       "<td class=\"link\">" .
6772                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . " | " .
6773                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
6774
6775                 if ($ftype eq 'blob') {
6776                         my $blob_current = $file_hash;
6777                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
6778                         if (defined $blob_current && defined $blob_parent &&
6779                                         $blob_current ne $blob_parent) {
6780                                 print " | " .
6781                                         $cgi->a({-href => href(action=>"blobdiff",
6782                                                                hash=>$blob_current, hash_parent=>$blob_parent,
6783                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
6784                                                                file_name=>$file_name)},
6785                                                 "diff to current");
6786                         }
6787                 }
6788                 print "</td>\n" .
6789                       "</tr>\n";
6790         }
6791         if (defined $extra) {
6792                 print "<tr>\n" .
6793                       "<td colspan=\"4\">$extra</td>\n" .
6794                       "</tr>\n";
6795         }
6796         print "</table>\n";
6797 }
6798
6799 sub git_tags_body {
6800         # uses global variable $project
6801         my ($taglist, $from, $to, $extra, $head_at, $full, $order) = @_;
6802         $from = 0 unless defined $from;
6803         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
6804         $order ||= $default_refs_order;
6805
6806         print "<table class=\"tags\">\n";
6807         if ($full) {
6808                 print "<tr class=\"tags_header\">\n";
6809                 print_sort_th('age', $order, 'Last Change');
6810                 print_sort_th('name', $order, 'Name');
6811                 print "<th></th>\n" . # for comment
6812                       "<th></th>\n" . # for tag
6813                       "<th></th>\n" . # for links
6814                       "</tr>\n";
6815         }
6816         my $alternate = 1;
6817         for (my $i = $from; $i <= $to; $i++) {
6818                 my $entry = $taglist->[$i];
6819                 my %tag = %$entry;
6820                 my $comment = $tag{'subject'};
6821                 my $comment_short;
6822                 if (defined $comment) {
6823                         $comment_short = chop_str($comment, 30, 5);
6824                 }
6825                 my $curr = defined $head_at && $tag{'id'} eq $head_at;
6826                 if ($alternate) {
6827                         print "<tr class=\"dark\">\n";
6828                 } else {
6829                         print "<tr class=\"light\">\n";
6830                 }
6831                 $alternate ^= 1;
6832                 if (defined $tag{'age'}) {
6833                         print "<td><i>$tag{'age'}</i></td>\n";
6834                 } else {
6835                         print "<td></td>\n";
6836                 }
6837                 print(($curr ? "<td class=\"current_head\">" : "<td>") .
6838                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
6839                                -class => "list name"}, esc_html($tag{'name'})) .
6840                       "</td>\n" .
6841                       "<td>");
6842                 if (defined $comment) {
6843                         print format_subject_html($comment, $comment_short,
6844                                                   href(action=>"tag", hash=>$tag{'id'}));
6845                 }
6846                 print "</td>\n" .
6847                       "<td class=\"selflink\">";
6848                 if ($tag{'type'} eq "tag") {
6849                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
6850                 } else {
6851                         print "&#160;";
6852                 }
6853                 print "</td>\n" .
6854                       "<td class=\"link\">" . " | " .
6855                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
6856                 if ($tag{'reftype'} eq "commit") {
6857                         print " | " . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "log");
6858                         print " | " . $cgi->a({-href => href(action=>"tree", hash=>$tag{'fullname'})}, "tree") if $full;
6859                 } elsif ($tag{'reftype'} eq "blob") {
6860                         print " | " . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
6861                 }
6862                 print "</td>\n" .
6863                       "</tr>";
6864         }
6865         if (defined $extra) {
6866                 print "<tr>\n" .
6867                       "<td colspan=\"5\">$extra</td>\n" .
6868                       "</tr>\n";
6869         }
6870         print "</table>\n";
6871 }
6872
6873 sub git_heads_body {
6874         # uses global variable $project
6875         my ($headlist, $head_at, $from, $to, $extra) = @_;
6876         $from = 0 unless defined $from;
6877         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
6878
6879         print "<table class=\"heads\">\n";
6880         my $alternate = 1;
6881         for (my $i = $from; $i <= $to; $i++) {
6882                 my $entry = $headlist->[$i];
6883                 my %ref = %$entry;
6884                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
6885                 if ($alternate) {
6886                         print "<tr class=\"dark\">\n";
6887                 } else {
6888                         print "<tr class=\"light\">\n";
6889                 }
6890                 $alternate ^= 1;
6891                 print "<td><i>$ref{'age'}</i></td>\n" .
6892                       ($curr ? "<td class=\"current_head\">" : "<td>") .
6893                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
6894                                -class => "list name"},esc_html($ref{'name'})) .
6895                       "</td>\n" .
6896                       "<td class=\"link\">" .
6897                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "log") . " | " .
6898                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
6899                       "</td>\n" .
6900                       "</tr>";
6901         }
6902         if (defined $extra) {
6903                 print "<tr>\n" .
6904                       "<td colspan=\"3\">$extra</td>\n" .
6905                       "</tr>\n";
6906         }
6907         print "</table>\n";
6908 }
6909
6910 # Display a single remote block
6911 sub git_remote_block {
6912         my ($remote, $rdata, $limit, $head) = @_;
6913
6914         my $heads = $rdata->{'heads'};
6915         my $fetch = $rdata->{'fetch'};
6916         my $push = $rdata->{'push'};
6917
6918         my $urls_table = "<table class=\"projects_list\">\n" ;
6919
6920         if (defined $fetch) {
6921                 if ($fetch eq $push) {
6922                         $urls_table .= format_repo_url("URL", $fetch);
6923                 } else {
6924                         $urls_table .= format_repo_url("Fetch&#160;URL", $fetch);
6925                         $urls_table .= format_repo_url("Push&#160;URL", $push) if defined $push;
6926                 }
6927         } elsif (defined $push) {
6928                 $urls_table .= format_repo_url("Push&#160;URL", $push);
6929         } else {
6930                 $urls_table .= format_repo_url("", "No remote URL");
6931         }
6932
6933         $urls_table .= "</table>\n";
6934
6935         my $dots;
6936         if (defined $limit && $limit < @$heads) {
6937                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
6938         }
6939
6940         print $urls_table;
6941         git_heads_body($heads, $head, 0, $limit, $dots);
6942 }
6943
6944 # Display a list of remote names with the respective fetch and push URLs
6945 sub git_remotes_list {
6946         my ($remotedata, $limit) = @_;
6947         print "<table class=\"heads\">\n";
6948         my $alternate = 1;
6949         my @remotes = sort keys %$remotedata;
6950
6951         my $limited = $limit && $limit < @remotes;
6952
6953         $#remotes = $limit - 1 if $limited;
6954
6955         while (my $remote = shift @remotes) {
6956                 my $rdata = $remotedata->{$remote};
6957                 my $fetch = $rdata->{'fetch'};
6958                 my $push = $rdata->{'push'};
6959                 if ($alternate) {
6960                         print "<tr class=\"dark\">\n";
6961                 } else {
6962                         print "<tr class=\"light\">\n";
6963                 }
6964                 $alternate ^= 1;
6965                 print "<td>" .
6966                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
6967                                -class=> "list name"},esc_html($remote)) .
6968                       "</td>";
6969                 print "<td class=\"link\">" .
6970                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
6971                       " | " .
6972                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
6973                       "</td>";
6974
6975                 print "</tr>\n";
6976         }
6977
6978         if ($limited) {
6979                 print "<tr>\n" .
6980                       "<td colspan=\"3\">" .
6981                       $cgi->a({-href => href(action=>"remotes")}, "...") .
6982                       "</td>\n" . "</tr>\n";
6983         }
6984
6985         print "</table>";
6986 }
6987
6988 # Display remote heads grouped by remote, unless there are too many
6989 # remotes, in which case we only display the remote names
6990 sub git_remotes_body {
6991         my ($remotedata, $limit, $head) = @_;
6992         if ($limit and $limit < keys %$remotedata) {
6993                 git_remotes_list($remotedata, $limit);
6994         } else {
6995                 fill_remote_heads($remotedata);
6996                 while (my ($remote, $rdata) = each %$remotedata) {
6997                         git_print_section({-class=>"remote", -id=>$remote},
6998                                 ["remotes", $remote, $remote], sub {
6999                                         git_remote_block($remote, $rdata, $limit, $head);
7000                                 });
7001                 }
7002         }
7003 }
7004
7005 sub git_search_message {
7006         my %co = @_;
7007
7008         my $greptype;
7009         if ($searchtype eq 'commit') {
7010                 $greptype = "--grep=";
7011         } elsif ($searchtype eq 'author') {
7012                 $greptype = "--author=";
7013         } elsif ($searchtype eq 'committer') {
7014                 $greptype = "--committer=";
7015         }
7016         $greptype .= $searchtext;
7017         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
7018                                        $greptype, '--regexp-ignore-case',
7019                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
7020
7021         my $paging_nav = '';
7022         if ($page > 0) {
7023                 $paging_nav .=
7024                         $cgi->a({-href => href(-replay=>1, page=>undef)},
7025                                 "first") .
7026                         " &#183; " .
7027                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
7028                                  -accesskey => "p", -title => "Alt-p"}, "prev");
7029         } else {
7030                 $paging_nav .= "first &#183; prev";
7031         }
7032         my $next_link = '';
7033         if ($#commitlist >= 100) {
7034                 $next_link =
7035                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7036                                  -accesskey => "n", -title => "Alt-n"}, "next");
7037                 $paging_nav .= " &#183; $next_link";
7038         } else {
7039                 $paging_nav .= " &#183; next";
7040         }
7041
7042         git_header_html();
7043
7044         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav);
7045         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7046         if ($page == 0 && !@commitlist) {
7047                 print "<p>No match.</p>\n";
7048         } else {
7049                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
7050         }
7051
7052         git_footer_html();
7053 }
7054
7055 sub git_search_changes {
7056         my %co = @_;
7057
7058         local $/ = "\n";
7059         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
7060                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
7061                 ($search_use_regexp ? '--pickaxe-regex' : ()))
7062                         or die_error(500, "Open git-log failed");
7063
7064         git_header_html();
7065
7066         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7067         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7068
7069         print "<table class=\"pickaxe search\">\n";
7070         my $alternate = 1;
7071         undef %co;
7072         my @files;
7073         while (my $line = to_utf8(scalar <$fd>)) {
7074                 chomp $line;
7075                 next unless $line;
7076
7077                 my %set = parse_difftree_raw_line($line);
7078                 if (defined $set{'commit'}) {
7079                         # finish previous commit
7080                         if (%co) {
7081                                 print "</td>\n" .
7082                                       "<td class=\"link\">" .
7083                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7084                                               "commit") .
7085                                       " | " .
7086                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7087                                                              hash_base=>$co{'id'})},
7088                                               "tree") .
7089                                       "</td>\n" .
7090                                       "</tr>\n";
7091                         }
7092
7093                         if ($alternate) {
7094                                 print "<tr class=\"dark\">\n";
7095                         } else {
7096                                 print "<tr class=\"light\">\n";
7097                         }
7098                         $alternate ^= 1;
7099                         %co = parse_commit($set{'commit'});
7100                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
7101                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7102                               "<td><i>$author</i></td>\n" .
7103                               "<td>" .
7104                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7105                                       -class => "list subject"},
7106                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
7107                 } elsif (defined $set{'to_id'}) {
7108                         next if ($set{'to_id'} =~ m/^0{40}$/);
7109
7110                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
7111                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
7112                                       -class => "list"},
7113                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
7114                               "<br/>\n";
7115                 }
7116         }
7117         close $fd;
7118
7119         # finish last commit (warning: repetition!)
7120         if (%co) {
7121                 print "</td>\n" .
7122                       "<td class=\"link\">" .
7123                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7124                               "commit") .
7125                       " | " .
7126                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7127                                              hash_base=>$co{'id'})},
7128                               "tree") .
7129                       "</td>\n" .
7130                       "</tr>\n";
7131         }
7132
7133         print "</table>\n";
7134
7135         git_footer_html();
7136 }
7137
7138 sub git_search_files {
7139         my %co = @_;
7140
7141         local $/ = "\n";
7142         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
7143                 $search_use_regexp ? ('-E', '-i') : '-F',
7144                 $searchtext, $co{'tree'})
7145                         or die_error(500, "Open git-grep failed");
7146
7147         git_header_html();
7148
7149         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7150         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7151
7152         print "<table class=\"grep_search\">\n";
7153         my $alternate = 1;
7154         my $matches = 0;
7155         my $lastfile = '';
7156         my $file_href;
7157         while (my $line = to_utf8(scalar <$fd>)) {
7158                 chomp $line;
7159                 my ($file, $lno, $ltext, $binary);
7160                 last if ($matches++ > 1000);
7161                 if ($line =~ /^Binary file (.+) matches$/) {
7162                         $file = $1;
7163                         $binary = 1;
7164                 } else {
7165                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
7166                         $file =~ s/^$co{'tree'}://;
7167                 }
7168                 if ($file ne $lastfile) {
7169                         $lastfile and print "</td></tr>\n";
7170                         if ($alternate++) {
7171                                 print "<tr class=\"dark\">\n";
7172                         } else {
7173                                 print "<tr class=\"light\">\n";
7174                         }
7175                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
7176                                           file_name=>$file);
7177                         print "<td class=\"list\">".
7178                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
7179                         print "</td><td>\n";
7180                         $lastfile = $file;
7181                 }
7182                 if ($binary) {
7183                         print "<div class=\"binary\">Binary file</div>\n";
7184                 } else {
7185                         $ltext = untabify($ltext);
7186                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
7187                                 $ltext = esc_html($1, -nbsp=>1);
7188                                 $ltext .= '<span class="match">';
7189                                 $ltext .= esc_html($2, -nbsp=>1);
7190                                 $ltext .= '</span>';
7191                                 $ltext .= esc_html($3, -nbsp=>1);
7192                         } else {
7193                                 $ltext = esc_html($ltext, -nbsp=>1);
7194                         }
7195                         print "<div class=\"pre\">" .
7196                                 $cgi->a({-href => $file_href.'#l'.$lno,
7197                                         -class => "linenr"}, sprintf('%4i', $lno)) .
7198                                 ' ' .  $ltext . "</div>\n";
7199                 }
7200         }
7201         if ($lastfile) {
7202                 print "</td></tr>\n";
7203                 if ($matches > 1000) {
7204                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
7205                 }
7206         } else {
7207                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
7208         }
7209         close $fd;
7210
7211         print "</table>\n";
7212
7213         git_footer_html();
7214 }
7215
7216 sub git_search_grep_body {
7217         my ($commitlist, $from, $to, $extra) = @_;
7218         $from = 0 unless defined $from;
7219         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7220
7221         print "<table class=\"commit_search\">\n";
7222         my $alternate = 1;
7223         for (my $i = $from; $i <= $to; $i++) {
7224                 my %co = %{$commitlist->[$i]};
7225                 if (!%co) {
7226                         next;
7227                 }
7228                 my $commit = $co{'id'};
7229                 if ($alternate) {
7230                         print "<tr class=\"dark\">\n";
7231                 } else {
7232                         print "<tr class=\"light\">\n";
7233                 }
7234                 $alternate ^= 1;
7235                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7236                       format_author_html('td', \%co, 15, 5) .
7237                       "<td>" .
7238                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7239                                -class => "list subject"},
7240                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
7241                 my $comment = $co{'comment'};
7242                 foreach my $line (@$comment) {
7243                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
7244                                 my ($lead, $match, $trail) = ($1, $2, $3);
7245                                 $match = chop_str($match, 70, 5, 'center');
7246                                 my $contextlen = int((80 - length($match))/2);
7247                                 $contextlen = 30 if ($contextlen > 30);
7248                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
7249                                 $trail = chop_str($trail, $contextlen, 10, 'right');
7250
7251                                 $lead  = esc_html($lead);
7252                                 $match = esc_html($match);
7253                                 $trail = esc_html($trail);
7254
7255                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
7256                         }
7257                 }
7258                 print "</td>\n" .
7259                       "<td class=\"link\">" .
7260                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7261                       " | " .
7262                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7263                       " | " .
7264                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7265                 print "</td>\n" .
7266                       "</tr>\n";
7267         }
7268         if (defined $extra) {
7269                 print "<tr>\n" .
7270                       "<td colspan=\"3\">$extra</td>\n" .
7271                       "</tr>\n";
7272         }
7273         print "</table>\n";
7274 }
7275
7276 ## ======================================================================
7277 ## ======================================================================
7278 ## actions
7279
7280 sub git_project_list_load {
7281         my $empty_list_ok = shift;
7282         my $order = $input_params{'order'};
7283         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7284                 die_error(400, "Unknown order parameter");
7285         }
7286
7287         my @list = git_get_projects_list($project_filter, $strict_export);
7288         if ($project_filter && (!@list || !gitweb_check_feature('forks'))) {
7289                 push @list, { 'path' => "$project_filter.git" }
7290                         if is_valid_project("$project_filter.git");
7291         }
7292         if (!@list) {
7293                 die_error(404, "No projects found") unless $empty_list_ok;
7294         }
7295
7296         return (\@list, $order);
7297 }
7298
7299 sub git_frontpage {
7300         my ($projlist, $order);
7301
7302         if ($frontpage_no_project_list) {
7303                 $project = undef;
7304                 $project_filter = undef;
7305         } else {
7306                 ($projlist, $order) = git_project_list_load(1);
7307         }
7308         git_header_html();
7309         if (defined $home_text && -f $home_text) {
7310                 print "<div class=\"index_include\">\n";
7311                 insert_file($home_text);
7312                 print "</div>\n";
7313         }
7314         git_project_search_form($searchtext, $search_use_regexp);
7315         if ($frontpage_no_project_list) {
7316                 my $show_ctags = gitweb_check_feature('ctags');
7317                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7318                         my @projects = git_get_projects_list($project_filter, $strict_export);
7319                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7320                         @projects = fill_project_list_info(\@projects, 'ctags');
7321                         my $ctags = git_gather_all_ctags(\@projects);
7322                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7323                         print git_show_project_tagcloud($cloud, 64);
7324                 }
7325         } else {
7326                 git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7327         }
7328         git_footer_html();
7329 }
7330
7331 sub git_project_list {
7332         my ($projlist, $order) = git_project_list_load();
7333         git_header_html();
7334         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7335                 print "<div class=\"index_include\">\n";
7336                 insert_file($home_text);
7337                 print "</div>\n";
7338         }
7339         git_project_search_form();
7340         git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7341         git_footer_html();
7342 }
7343
7344 sub git_forks {
7345         my $order = $input_params{'order'};
7346         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7347                 die_error(400, "Unknown order parameter");
7348         }
7349
7350         my $filter = $project;
7351         $filter =~ s/\.git$//;
7352         my @list = git_get_projects_list($filter);
7353         if (!@list) {
7354                 die_error(404, "No forks found");
7355         }
7356
7357         git_header_html();
7358         git_print_page_nav('','');
7359         git_print_header_div('summary', "$project forks");
7360         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7361         git_footer_html();
7362 }
7363
7364 sub git_project_index {
7365         my @projects = git_get_projects_list($project_filter, $strict_export);
7366         if (!@projects) {
7367                 die_error(404, "No projects found");
7368         }
7369
7370         print $cgi->header(
7371                 -type => 'text/plain',
7372                 -charset => 'utf-8',
7373                 -content_disposition => 'inline; filename="index.aux"');
7374
7375         foreach my $pr (@projects) {
7376                 if (!exists $pr->{'owner'}) {
7377                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7378                 }
7379
7380                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7381                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7382                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7383                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7384                 $path  =~ s/ /\+/g;
7385                 $owner =~ s/ /\+/g;
7386
7387                 print "$path $owner\n";
7388         }
7389 }
7390
7391 sub git_summary {
7392         my $descr = git_get_project_description($project) || "none";
7393         my %co = parse_commit("HEAD");
7394         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7395         my $head = $co{'id'};
7396         my $remote_heads = gitweb_check_feature('remote_heads');
7397
7398         my $owner = git_get_project_owner($project);
7399         my $homepage = git_get_project_config('homepage');
7400         my $base_url = git_get_project_config('baseurl');
7401         my $last_refresh = git_get_project_config('lastrefresh');
7402
7403         my $refs = git_get_references();
7404         # These get_*_list functions return one more to allow us to see if
7405         # there are more ...
7406         my @taglist  = git_get_tags_list(16);
7407         my @headlist = git_get_heads_list(16);
7408         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7409         my @forklist;
7410         my $check_forks = gitweb_check_feature('forks');
7411
7412         if ($check_forks) {
7413                 # find forks of a project
7414                 my $filter = $project;
7415                 $filter =~ s/\.git$//;
7416                 @forklist = git_get_projects_list($filter);
7417                 # filter out forks of forks
7418                 @forklist = filter_forks_from_projects_list(\@forklist)
7419                         if (@forklist);
7420         }
7421
7422         git_header_html();
7423         git_print_page_nav('summary','', $head);
7424
7425         if ($check_forks and $project =~ m#/#) {
7426                 my $xproject = $project; $xproject =~ s#/[^/]+$#.git#; #
7427                 my $r = $cgi->a({-href=> href(project => $xproject, action => 'summary')}, $xproject);
7428                 print <<EOT;
7429 <div class="forkinfo">
7430 This project is a fork of the $r project. If you have that one
7431 already cloned locally, you can use
7432 <pre>git clone --reference /path/to/your/$xproject/incarnation mirror_URL</pre>
7433 to save bandwidth during cloning.
7434 </div>
7435 EOT
7436         }
7437
7438         print "<div class=\"title\">&#160;</div>\n";
7439         print "<table class=\"projects_list\">\n" .
7440               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7441         if ($homepage) {
7442                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7443         }
7444         if ($base_url) {
7445                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7446         }
7447         if ($owner and not $omit_owner) {
7448                 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . ($owner_link_hook
7449                         ? $cgi->a({-href => $owner_link_hook->($owner)}, email_obfuscate($owner))
7450                         : email_obfuscate($owner)) . "</td></tr>\n";
7451         }
7452         if (defined $cd{'rfc2822'}) {
7453                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7454                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7455         }
7456         if (defined $last_refresh) {
7457                 my %rd = parse_date_rfc2822($last_refresh);
7458                 print "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td>" .
7459                       "<td>".format_timestamp_html(\%rd)."</td></tr>\n"
7460                 if defined $rd{'rfc2822'};
7461         }
7462
7463         # use per project git URL list in $projectroot/$project/cloneurl
7464         # or make project git URL from git base URL and project name
7465         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7466         my @url_list = git_get_project_url_list($project);
7467         @url_list = map { "$_/$project" } @git_base_url_list unless @url_list;
7468         foreach my $git_url (@url_list) {
7469                 next unless $git_url;
7470                 print format_repo_url($url_tag, $git_url);
7471                 $url_tag = "";
7472         }
7473         @url_list = map { "$_/$project" } @git_base_push_urls;
7474         if (-f "$projectroot/$project/.nofetch") {
7475                 $url_tag = "Push&#160;URL";
7476                 foreach my $git_push_url (@url_list) {
7477                         next unless $git_push_url;
7478                         my $hint = $https_hint_html && $git_push_url =~ /^https:/i ?
7479                                 "&#160;$https_hint_html" : '';
7480                         print "<tr class=\"metadata_pushurl\"><td>$url_tag</td><td>$git_push_url$hint</td></tr>\n";
7481                         $url_tag = "";
7482                 }
7483         }
7484
7485         # Tag cloud
7486         my $show_ctags = gitweb_check_feature('ctags');
7487         if ($show_ctags) {
7488                 my $ctags = git_get_project_ctags($project);
7489                 if (%$ctags || $show_ctags !~ /^\d+$/) {
7490                         # without ability to add tags, don't show if there are none
7491                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7492                         print "<tr id=\"metadata_ctags\">" .
7493                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
7494                         print "</td>\n<td>" unless %$ctags;
7495                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
7496                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
7497                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
7498                               unless $show_ctags =~ /^\d+$/;
7499                         print "</td>\n<td>" if %$ctags;
7500                         print git_show_project_tagcloud($cloud, 48)."</td>" .
7501                               "</tr>\n";
7502                 }
7503         }
7504
7505         print "</table>\n";
7506
7507         # If XSS prevention is on, we don't include README.html.
7508         # TODO: Allow a readme in some safe format.
7509         if (!$prevent_xss && -s "$projectroot/$project/README.html") {
7510                 print "<div class=\"title\">readme</div>\n" .
7511                       "<div class=\"readme\">\n";
7512                 insert_file("$projectroot/$project/README.html");
7513                 print "\n</div>\n"; # class="readme"
7514         }
7515
7516         # we need to request one more than 16 (0..15) to check if
7517         # those 16 are all
7518         my @commitlist = $head ? parse_commits($head, 17) : ();
7519         if (@commitlist) {
7520                 git_print_header_div('shortlog');
7521                 git_shortlog_body(\@commitlist, 0, 15, $refs,
7522                                   $#commitlist <=  15 ? undef :
7523                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
7524         }
7525
7526         if (@taglist) {
7527                 git_print_header_div('tags');
7528                 git_tags_body(\@taglist, 0, 15,
7529                               $#taglist <=  15 ? undef :
7530                               $cgi->a({-href => href(action=>"tags")}, "..."));
7531         }
7532
7533         if (@headlist) {
7534                 git_print_header_div('heads');
7535                 git_heads_body(\@headlist, $head, 0, 15,
7536                                $#headlist <= 15 ? undef :
7537                                $cgi->a({-href => href(action=>"heads")}, "..."));
7538         }
7539
7540         if (%remotedata) {
7541                 git_print_header_div('remotes');
7542                 git_remotes_body(\%remotedata, 15, $head);
7543         }
7544
7545         if (@forklist) {
7546                 git_print_header_div('forks');
7547                 git_project_list_body(\@forklist, 'age', 0, 15,
7548                                       $#forklist <= 15 ? undef :
7549                                       $cgi->a({-href => href(action=>"forks")}, "..."),
7550                                       'no_header', 'forks');
7551         }
7552
7553         git_footer_html();
7554 }
7555
7556 sub git_tag {
7557         my %tag = parse_tag($hash);
7558
7559         if (! %tag) {
7560                 die_error(404, "Unknown tag object");
7561         }
7562
7563         my $fullhash;
7564         $fullhash = $hash if $hash =~ m/^[0-9a-fA-F]{40}$/;
7565         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
7566
7567         my $head = git_get_head_hash($project);
7568         git_header_html();
7569         git_print_page_nav('','', $head,undef,$head);
7570         git_print_header_div('commit', esc_html($tag{'name'}), $hash);
7571         print "<div class=\"title_text\">\n" .
7572               "<table class=\"object_header\">\n" .
7573               "<tr><td>tag</td><td class=\"sha1\">$fullhash</td></tr>\n" .
7574               "<tr>\n" .
7575               "<td>object</td>\n" .
7576               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7577                                $tag{'object'}) . "</td>\n" .
7578               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7579                                               $tag{'type'}) . "</td>\n" .
7580               "</tr>\n";
7581         if (defined($tag{'author'})) {
7582                 git_print_authorship_rows(\%tag, 'author');
7583         }
7584         print "</table>\n\n" .
7585               "</div>\n";
7586         print "<div class=\"page_body\">";
7587         my $comment = $tag{'comment'};
7588         foreach my $line (@$comment) {
7589                 chomp $line;
7590                 print esc_html($line, -nbsp=>1) . "<br/>\n";
7591         }
7592         print "</div>\n";
7593         git_footer_html();
7594 }
7595
7596 sub git_blame_common {
7597         my $format = shift || 'porcelain';
7598         if ($format eq 'porcelain' && $input_params{'javascript'}) {
7599                 $format = 'incremental';
7600                 $action = 'blame_incremental'; # for page title etc
7601         }
7602
7603         # permissions
7604         gitweb_check_feature('blame')
7605                 or die_error(403, "Blame view not allowed");
7606
7607         # error checking
7608         die_error(400, "No file name given") unless $file_name;
7609         $hash_base ||= git_get_head_hash($project);
7610         die_error(404, "Couldn't find base commit") unless $hash_base;
7611         my %co = parse_commit($hash_base)
7612                 or die_error(404, "Commit not found");
7613         my $ftype = "blob";
7614         if (!defined $hash) {
7615                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
7616                         or die_error(404, "Error looking up file");
7617         } else {
7618                 $ftype = git_get_type($hash);
7619                 if ($ftype !~ "blob") {
7620                         die_error(400, "Object is not a blob");
7621                 }
7622         }
7623
7624         my $fd;
7625         if ($format eq 'incremental') {
7626                 # get file contents (as base)
7627                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
7628                         or die_error(500, "Open git-cat-file failed");
7629         } elsif ($format eq 'data') {
7630                 # run git-blame --incremental
7631                 defined($fd = git_cmd_pipe "blame", "--incremental",
7632                         $hash_base, "--", $file_name)
7633                         or die_error(500, "Open git-blame --incremental failed");
7634         } else {
7635                 # run git-blame --porcelain
7636                 defined($fd = git_cmd_pipe "blame", '-p',
7637                         $hash_base, '--', $file_name)
7638                         or die_error(500, "Open git-blame --porcelain failed");
7639         }
7640
7641         # incremental blame data returns early
7642         if ($format eq 'data') {
7643                 print $cgi->header(
7644                         -type=>"text/plain", -charset => "utf-8",
7645                         -status=> "200 OK");
7646                 local $| = 1; # output autoflush
7647                 while (<$fd>) {
7648                         print to_utf8($_);
7649                 }
7650                 close $fd
7651                         or print "ERROR $!\n";
7652
7653                 print 'END';
7654                 if (defined $t0 && gitweb_check_feature('timed')) {
7655                         print ' '.
7656                               tv_interval($t0, [ gettimeofday() ]).
7657                               ' '.$number_of_git_cmds;
7658                 }
7659                 print "\n";
7660
7661                 return;
7662         }
7663
7664         # page header
7665         git_header_html();
7666         my $formats_nav =
7667                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
7668                         "blob");
7669         $formats_nav .=
7670                 " | " .
7671                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7672                         "history") .
7673                 " | " .
7674                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
7675                         "HEAD");
7676         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
7677         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
7678         git_print_page_path($file_name, $ftype, $hash_base);
7679
7680         # page body
7681         if ($format eq 'incremental') {
7682                 print "<noscript>\n<div class=\"error\"><center><b>\n".
7683                       "This page requires JavaScript to run.\n Use ".
7684                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
7685                               'this page').
7686                       " instead.\n".
7687                       "</b></center></div>\n</noscript>\n";
7688
7689                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
7690         }
7691
7692         print qq!<div class="page_body">\n!;
7693         print qq!<div id="progress_info">... / ...</div>\n!
7694                 if ($format eq 'incremental');
7695         print qq!<table id="blame_table" class="blame" width="100%">\n!.
7696               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
7697               qq!<thead>\n!.
7698               qq!<tr><th nowrap="nowrap" style="white-space:nowrap">!.
7699               qq!Commit&#160;<a href="javascript:extra_blame_columns()" id="columns_expander" !.
7700               qq!title="toggles blame author information display">[+]</a></th>!.
7701               qq!<th class="extra_column">Author</th><th class="extra_column">Date</th>!.
7702               qq!<th>Line</th><th width="100%">Data</th></tr>\n!.
7703               qq!</thead>\n!.
7704               qq!<tbody>\n!;
7705
7706         my @rev_color = qw(light dark);
7707         my $num_colors = scalar(@rev_color);
7708         my $current_color = 0;
7709
7710         if ($format eq 'incremental') {
7711                 my $color_class = $rev_color[$current_color];
7712
7713                 #contents of a file
7714                 my $linenr = 0;
7715         LINE:
7716                 while (my $line = to_utf8(scalar <$fd>)) {
7717                         chomp $line;
7718                         $linenr++;
7719
7720                         print qq!<tr id="l$linenr" class="$color_class">!.
7721                               qq!<td class="sha1"><a href=""> </a></td>!.
7722                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
7723                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
7724                               qq!<td class="linenr">!.
7725                               qq!<a class="linenr" href="">$linenr</a></td>!;
7726                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
7727                         print qq!</tr>\n!;
7728                 }
7729
7730         } else { # porcelain, i.e. ordinary blame
7731                 my %metainfo = (); # saves information about commits
7732
7733                 # blame data
7734         LINE:
7735                 while (my $line = to_utf8(scalar <$fd>)) {
7736                         chomp $line;
7737                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
7738                         # no <lines in group> for subsequent lines in group of lines
7739                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
7740                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
7741                         if (!exists $metainfo{$full_rev}) {
7742                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
7743                         }
7744                         my $meta = $metainfo{$full_rev};
7745                         my $data;
7746                         while ($data = to_utf8(scalar <$fd>)) {
7747                                 chomp $data;
7748                                 last if ($data =~ s/^\t//); # contents of line
7749                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
7750                                         $meta->{$1} = $2 unless exists $meta->{$1};
7751                                 }
7752                                 if ($data =~ /^previous /) {
7753                                         $meta->{'nprevious'}++;
7754                                 }
7755                         }
7756                         my $short_rev = substr($full_rev, 0, 8);
7757                         my $author = $meta->{'author'};
7758                         my %date =
7759                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
7760                         my $date = $date{'iso-tz'};
7761                         if ($group_size) {
7762                                 $current_color = ($current_color + 1) % $num_colors;
7763                         }
7764                         my $tr_class = $rev_color[$current_color];
7765                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
7766                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
7767                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
7768                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
7769                         if ($group_size) {
7770                                 my $rowspan = $group_size > 1 ? " rowspan=\"$group_size\"" : "";
7771                                 print "<td class=\"sha1\"";
7772                                 print " title=\"". esc_html($author) . ", $date\"";
7773                                 print "$rowspan>";
7774                                 print $cgi->a({-href => href(action=>"commit",
7775                                                              hash=>$full_rev,
7776                                                              file_name=>$file_name)},
7777                                               esc_html($short_rev));
7778                                 if ($group_size >= 2) {
7779                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
7780                                         if (@author_initials) {
7781                                                 print "<br />" .
7782                                                       esc_html(join('', @author_initials));
7783                                                 #           or join('.', ...)
7784                                         }
7785                                 }
7786                                 print "</td>\n";
7787                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". esc_html($author) . "</td>";
7788                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". $date . "</td>";
7789                         }
7790                         # 'previous' <sha1 of parent commit> <filename at commit>
7791                         if (exists $meta->{'previous'} &&
7792                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
7793                                 $meta->{'parent'} = $1;
7794                                 $meta->{'file_parent'} = unquote($2);
7795                         }
7796                         my $linenr_commit =
7797                                 exists($meta->{'parent'}) ?
7798                                 $meta->{'parent'} : $full_rev;
7799                         my $linenr_filename =
7800                                 exists($meta->{'file_parent'}) ?
7801                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
7802                         my $blamed = href(action => 'blame',
7803                                           file_name => $linenr_filename,
7804                                           hash_base => $linenr_commit);
7805                         print "<td class=\"linenr\">";
7806                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
7807                                         -class => "linenr" },
7808                                       esc_html($lineno));
7809                         print "</td>";
7810                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
7811                         print "</tr>\n";
7812                 } # end while
7813
7814         }
7815
7816         # footer
7817         print "</tbody>\n".
7818               "</table>\n"; # class="blame"
7819         print "</div>\n";   # class="blame_body"
7820         close $fd
7821                 or print "Reading blob failed\n";
7822
7823         git_footer_html();
7824 }
7825
7826 sub git_blame {
7827         git_blame_common();
7828 }
7829
7830 sub git_blame_incremental {
7831         git_blame_common('incremental');
7832 }
7833
7834 sub git_blame_data {
7835         git_blame_common('data');
7836 }
7837
7838 sub git_tags {
7839         my $head = git_get_head_hash($project);
7840         git_header_html();
7841         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
7842         git_print_header_div('summary', $project);
7843
7844         my @tagslist = git_get_tags_list();
7845         if (@tagslist) {
7846                 git_tags_body(\@tagslist);
7847         }
7848         git_footer_html();
7849 }
7850
7851 sub git_refs {
7852         my $order = $input_params{'order'};
7853         if (defined $order && $order !~ m/age|name/) {
7854                 die_error(400, "Unknown order parameter");
7855         }
7856
7857         my $head = git_get_head_hash($project);
7858         git_header_html();
7859         git_print_page_nav('','', $head,undef,$head,format_ref_views('refs'));
7860         git_print_header_div('summary', $project);
7861
7862         my @refslist = git_get_tags_list(undef, 1, $order);
7863         if (@refslist) {
7864                 git_tags_body(\@refslist, undef, undef, undef, $head, 1, $order);
7865         }
7866         git_footer_html();
7867 }
7868
7869 sub git_heads {
7870         my $head = git_get_head_hash($project);
7871         git_header_html();
7872         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
7873         git_print_header_div('summary', $project);
7874
7875         my @headslist = git_get_heads_list();
7876         if (@headslist) {
7877                 git_heads_body(\@headslist, $head);
7878         }
7879         git_footer_html();
7880 }
7881
7882 # used both for single remote view and for list of all the remotes
7883 sub git_remotes {
7884         gitweb_check_feature('remote_heads')
7885                 or die_error(403, "Remote heads view is disabled");
7886
7887         my $head = git_get_head_hash($project);
7888         my $remote = $input_params{'hash'};
7889
7890         my $remotedata = git_get_remotes_list($remote);
7891         die_error(500, "Unable to get remote information") unless defined $remotedata;
7892
7893         unless (%$remotedata) {
7894                 die_error(404, defined $remote ?
7895                         "Remote $remote not found" :
7896                         "No remotes found");
7897         }
7898
7899         git_header_html(undef, undef, -action_extra => $remote);
7900         git_print_page_nav('', '',  $head, undef, $head,
7901                 format_ref_views($remote ? '' : 'remotes'));
7902
7903         fill_remote_heads($remotedata);
7904         if (defined $remote) {
7905                 git_print_header_div('remotes', "$remote remote for $project");
7906                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
7907         } else {
7908                 git_print_header_div('summary', "$project remotes");
7909                 git_remotes_body($remotedata, undef, $head);
7910         }
7911
7912         git_footer_html();
7913 }
7914
7915 sub git_blob_plain {
7916         my $type = shift;
7917         my $expires;
7918
7919         if (!defined $hash) {
7920                 if (defined $file_name) {
7921                         my $base = $hash_base || git_get_head_hash($project);
7922                         $hash = git_get_hash_by_path($base, $file_name, "blob")
7923                                 or die_error(404, "Cannot find file");
7924                 } else {
7925                         die_error(400, "No file name defined");
7926                 }
7927         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
7928                 # blobs defined by non-textual hash id's can be cached
7929                 $expires = "+1d";
7930         }
7931
7932         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
7933                 or die_error(500, "Open git-cat-file blob '$hash' failed");
7934         binmode($fd);
7935
7936         # content-type (can include charset)
7937         my $leader;
7938         ($type, $leader) = blob_contenttype($fd, $file_name, $type);
7939
7940         # "save as" filename, even when no $file_name is given
7941         my $save_as = "$hash";
7942         if (defined $file_name) {
7943                 $save_as = $file_name;
7944         } elsif ($type =~ m/^text\//) {
7945                 $save_as .= '.txt';
7946         }
7947
7948         # With XSS prevention on, blobs of all types except a few known safe
7949         # ones are served with "Content-Disposition: attachment" to make sure
7950         # they don't run in our security domain.  For certain image types,
7951         # blob view writes an <img> tag referring to blob_plain view, and we
7952         # want to be sure not to break that by serving the image as an
7953         # attachment (though Firefox 3 doesn't seem to care).
7954         my $sandbox = $prevent_xss &&
7955                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
7956
7957         # serve text/* as text/plain
7958         if ($prevent_xss &&
7959             ($type =~ m!^text/[a-z]+\b(.*)$! ||
7960              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
7961                 my $rest = $1;
7962                 $rest = defined $rest ? $rest : '';
7963                 $type = "text/plain$rest";
7964         }
7965
7966         print $cgi->header(
7967                 -type => $type,
7968                 -expires => $expires,
7969                 -content_disposition =>
7970                         ($sandbox ? 'attachment' : 'inline')
7971                         . '; filename="' . $save_as . '"');
7972         binmode STDOUT, ':raw';
7973         $fcgi_raw_mode = 1;
7974         print $leader if defined $leader;
7975         my $buf;
7976         while (read($fd, $buf, 32768)) {
7977                 print $buf;
7978         }
7979         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
7980         $fcgi_raw_mode = 0;
7981         close $fd;
7982 }
7983
7984 sub git_blob {
7985         my $expires;
7986
7987         my $fullhash;
7988         if (!defined $hash) {
7989                 if (defined $file_name) {
7990                         my $base = $hash_base || git_get_head_hash($project);
7991                         $hash = git_get_hash_by_path($base, $file_name, "blob")
7992                                 or die_error(404, "Cannot find file");
7993                         $fullhash = $hash;
7994                 } else {
7995                         die_error(400, "No file name defined");
7996                 }
7997         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
7998                 # blobs defined by non-textual hash id's can be cached
7999                 $expires = "+1d";
8000                 $fullhash = $hash;
8001         }
8002         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8003
8004         my $have_blame = gitweb_check_feature('blame');
8005         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8006                 or die_error(500, "Couldn't cat $file_name, $hash");
8007         binmode($fd);
8008         my $mimetype = blob_mimetype($fd, $file_name);
8009         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
8010         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
8011                 close $fd;
8012                 return git_blob_plain($mimetype);
8013         }
8014         # we can have blame only for text/* mimetype
8015         $have_blame &&= ($mimetype =~ m!^text/!);
8016
8017         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
8018         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
8019         my $highlight_mode_active;
8020         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
8021
8022         git_header_html(undef, $expires);
8023         my $formats_nav = '';
8024         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8025                 if (defined $file_name) {
8026                         if ($have_blame) {
8027                                 $formats_nav .=
8028                                         $cgi->a({-href => href(action=>"blame", -replay=>1),
8029                                                 -class => "blamelink"},
8030                                                 "blame") .
8031                                         " | ";
8032                         }
8033                         $formats_nav .=
8034                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8035                                         "history") .
8036                                 " | " .
8037                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8038                                         "raw") .
8039                                 " | " .
8040                                 $cgi->a({-href => href(action=>"blob",
8041                                                        hash_base=>"HEAD", file_name=>$file_name)},
8042                                         "HEAD");
8043                 } else {
8044                         $formats_nav .=
8045                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8046                                         "raw");
8047                 }
8048                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8049                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8050         } else {
8051                 print "<div class=\"page_nav\">\n" .
8052                       "<br/><br/></div>\n" .
8053                       "<div class=\"title\">".esc_html($hash)."</div>\n";
8054         }
8055         git_print_page_path($file_name, "blob", $hash_base);
8056         print "<div class=\"title_text\">\n" .
8057               "<table class=\"object_header\">\n";
8058         print "<tr><td>blob</td><td class=\"sha1\">$fullhash</td></tr>\n";
8059         print "</table>".
8060               "</div>\n";
8061         print "<div class=\"page_body\">\n";
8062         if ($mimetype =~ m!^image/!) {
8063                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
8064                 if ($file_name) {
8065                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
8066                 }
8067                 print qq! src="! .
8068                       href(action=>"blob_plain", hash=>$hash,
8069                            hash_base=>$hash_base, file_name=>$file_name) .
8070                       qq!" />\n!;
8071         } else {
8072                 my $nr;
8073                 while (my $line = to_utf8(scalar <$fd>)) {
8074                         chomp $line;
8075                         $nr++;
8076                         $line = untabify($line);
8077                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i</a> %s</div>\n!,
8078                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
8079                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
8080                 }
8081         }
8082         close $fd
8083                 or print "Reading blob failed.\n";
8084         print "</div>";
8085         git_footer_html();
8086 }
8087
8088 sub git_tree {
8089         my $fullhash;
8090         if (!defined $hash_base) {
8091                 $hash_base = "HEAD";
8092         }
8093         if (!defined $hash) {
8094                 if (defined $file_name) {
8095                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
8096                         $fullhash = $hash;
8097                 } else {
8098                         $hash = $hash_base;
8099                 }
8100         }
8101         die_error(404, "No such tree") unless defined($hash);
8102         $fullhash = $hash if !$fullhash && $hash =~ m/^[0-9a-fA-F]{40}$/;
8103         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8104
8105         my $show_sizes = gitweb_check_feature('show-sizes');
8106         my $have_blame = gitweb_check_feature('blame');
8107
8108         my @entries = ();
8109         {
8110                 local $/ = "\0";
8111                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
8112                         ($show_sizes ? '-l' : ()), @extra_options, $hash)
8113                         or die_error(500, "Open git-ls-tree failed");
8114                 @entries = map { chomp; to_utf8($_) } <$fd>;
8115                 close $fd
8116                         or die_error(404, "Reading tree failed");
8117         }
8118
8119         git_header_html();
8120         my $basedir = '';
8121         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8122                 my $refs = git_get_references();
8123                 my $ref = format_ref_marker($refs, $co{'id'});
8124                 my @views_nav = ();
8125                 if (defined $file_name) {
8126                         push @views_nav,
8127                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8128                                         "history"),
8129                                 $cgi->a({-href => href(action=>"tree",
8130                                                        hash_base=>"HEAD", file_name=>$file_name)},
8131                                         "HEAD"),
8132                 }
8133                 my $snapshot_links = format_snapshot_links($hash);
8134                 if (defined $snapshot_links) {
8135                         # FIXME: Should be available when we have no hash base as well.
8136                         push @views_nav, $snapshot_links;
8137                 }
8138                 git_print_page_nav('tree','', $hash_base, undef, undef,
8139                                    join(' | ', @views_nav));
8140                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base, undef, $ref);
8141         } else {
8142                 undef $hash_base;
8143                 print "<div class=\"page_nav\">\n";
8144                 print "<br/><br/></div>\n";
8145                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8146         }
8147         if (defined $file_name) {
8148                 $basedir = $file_name;
8149                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
8150                         $basedir .= '/';
8151                 }
8152                 git_print_page_path($file_name, 'tree', $hash_base);
8153         }
8154         print "<div class=\"title_text\">\n" .
8155               "<table class=\"object_header\">\n";
8156         print "<tr><td>tree</td><td class=\"sha1\">$fullhash</td></tr>\n";
8157         print "</table>".
8158               "</div>\n";
8159         print "<div class=\"page_body\">\n";
8160         print "<table class=\"tree\">\n";
8161         my $alternate = 1;
8162         # '..' (top directory) link if possible
8163         if (defined $hash_base &&
8164             defined $file_name && $file_name =~ m![^/]+$!) {
8165                 if ($alternate) {
8166                         print "<tr class=\"dark\">\n";
8167                 } else {
8168                         print "<tr class=\"light\">\n";
8169                 }
8170                 $alternate ^= 1;
8171
8172                 my $up = $file_name;
8173                 $up =~ s!/?[^/]+$!!;
8174                 undef $up unless $up;
8175                 # based on git_print_tree_entry
8176                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
8177                 print '<td class="size">&#160;</td>'."\n" if $show_sizes;
8178                 print '<td class="list">';
8179                 print $cgi->a({-href => href(action=>"tree",
8180                                              hash_base=>$hash_base,
8181                                              file_name=>$up)},
8182                               "..");
8183                 print "</td>\n";
8184                 print "<td class=\"link\"></td>\n";
8185
8186                 print "</tr>\n";
8187         }
8188         foreach my $line (@entries) {
8189                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
8190
8191                 if ($alternate) {
8192                         print "<tr class=\"dark\">\n";
8193                 } else {
8194                         print "<tr class=\"light\">\n";
8195                 }
8196                 $alternate ^= 1;
8197
8198                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
8199
8200                 print "</tr>\n";
8201         }
8202         print "</table>\n" .
8203               "</div>";
8204         git_footer_html();
8205 }
8206
8207 sub sanitize_for_filename {
8208     my $name = shift;
8209
8210     $name =~ s!/!-!g;
8211     $name =~ s/[^[:alnum:]_.-]//g;
8212
8213     return $name;
8214 }
8215
8216 sub snapshot_name {
8217         my ($project, $hash) = @_;
8218
8219         # path/to/project.git  -> project
8220         # path/to/project/.git -> project
8221         my $name = to_utf8($project);
8222         $name =~ s,([^/])/*\.git$,$1,;
8223         $name = sanitize_for_filename(basename($name));
8224
8225         my $ver = $hash;
8226         if ($hash =~ /^[0-9a-fA-F]+$/) {
8227                 # shorten SHA-1 hash
8228                 my $full_hash = git_get_full_hash($project, $hash);
8229                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
8230                         $ver = git_get_short_hash($project, $hash);
8231                 }
8232         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
8233                 # tags don't need shortened SHA-1 hash
8234                 $ver = $1;
8235         } else {
8236                 # branches and other need shortened SHA-1 hash
8237                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
8238                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
8239                         my $ref_dir = (defined $1) ? $1 : '';
8240                         $ver = $2;
8241
8242                         $ref_dir = sanitize_for_filename($ref_dir);
8243                         # for refs neither in heads nor remotes we want to
8244                         # add a ref dir to archive name
8245                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
8246                                 $ver = $ref_dir . '-' . $ver;
8247                         }
8248                 }
8249                 $ver .= '-' . git_get_short_hash($project, $hash);
8250         }
8251         # special case of sanitization for filename - we change
8252         # slashes to dots instead of dashes
8253         # in case of hierarchical branch names
8254         $ver =~ s!/!.!g;
8255         $ver =~ s/[^[:alnum:]_.-]//g;
8256
8257         # name = project-version_string
8258         $name = "$name-$ver";
8259
8260         return wantarray ? ($name, $name) : $name;
8261 }
8262
8263 sub exit_if_unmodified_since {
8264         my ($latest_epoch) = @_;
8265         our $cgi;
8266
8267         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
8268         if (defined $if_modified) {
8269                 my $since;
8270                 if (eval { require HTTP::Date; 1; }) {
8271                         $since = HTTP::Date::str2time($if_modified);
8272                 } elsif (eval { require Time::ParseDate; 1; }) {
8273                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
8274                 }
8275                 if (defined $since && $latest_epoch <= $since) {
8276                         my %latest_date = parse_date($latest_epoch);
8277                         print $cgi->header(
8278                                 -last_modified => $latest_date{'rfc2822'},
8279                                 -status => '304 Not Modified');
8280                         goto DONE_GITWEB;
8281                 }
8282         }
8283 }
8284
8285 sub git_snapshot {
8286         my $format = $input_params{'snapshot_format'};
8287         if (!@snapshot_fmts) {
8288                 die_error(403, "Snapshots not allowed");
8289         }
8290         # default to first supported snapshot format
8291         $format ||= $snapshot_fmts[0];
8292         if ($format !~ m/^[a-z0-9]+$/) {
8293                 die_error(400, "Invalid snapshot format parameter");
8294         } elsif (!exists($known_snapshot_formats{$format})) {
8295                 die_error(400, "Unknown snapshot format");
8296         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
8297                 die_error(403, "Snapshot format not allowed");
8298         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
8299                 die_error(403, "Unsupported snapshot format");
8300         }
8301
8302         my $type = git_get_type("$hash^{}");
8303         if (!$type) {
8304                 die_error(404, 'Object does not exist');
8305         }  elsif ($type eq 'blob') {
8306                 die_error(400, 'Object is not a tree-ish');
8307         }
8308
8309         my ($name, $prefix) = snapshot_name($project, $hash);
8310         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
8311
8312         my %co = parse_commit($hash);
8313         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
8314
8315         my @cmd = (
8316                 git_cmd(), 'archive',
8317                 "--format=$known_snapshot_formats{$format}{'format'}",
8318                 "--prefix=$prefix/", $hash);
8319         if (exists $known_snapshot_formats{$format}{'compressor'}) {
8320                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
8321                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
8322         }
8323
8324         $filename =~ s/(["\\])/\\$1/g;
8325         my %latest_date;
8326         if (%co) {
8327                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
8328         }
8329
8330         print $cgi->header(
8331                 -type => $known_snapshot_formats{$format}{'type'},
8332                 -content_disposition => 'inline; filename="' . $filename . '"',
8333                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8334                 -status => '200 OK');
8335
8336         defined(my $fd = cmd_pipe @cmd)
8337                 or die_error(500, "Execute git-archive failed");
8338         binmode($fd);
8339         binmode STDOUT, ':raw';
8340         $fcgi_raw_mode = 1;
8341         my $buf;
8342         while (read($fd, $buf, 32768)) {
8343                 print $buf;
8344         }
8345         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8346         $fcgi_raw_mode = 0;
8347         close $fd;
8348 }
8349
8350 sub git_log_generic {
8351         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8352
8353         my $head = git_get_head_hash($project);
8354         if (!defined $base) {
8355                 $base = $head;
8356         }
8357         if (!defined $page) {
8358                 $page = 0;
8359         }
8360         my $refs = git_get_references();
8361
8362         my $commit_hash = $base;
8363         if (defined $parent) {
8364                 $commit_hash = "$parent..$base";
8365         }
8366         my @commitlist =
8367                 parse_commits($commit_hash, 101, (100 * $page),
8368                               defined $file_name ? ($file_name, "--full-history") : ());
8369
8370         my $ftype;
8371         if (!defined $file_hash && defined $file_name) {
8372                 # some commits could have deleted file in question,
8373                 # and not have it in tree, but one of them has to have it
8374                 for (my $i = 0; $i < @commitlist; $i++) {
8375                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8376                         last if defined $file_hash;
8377                 }
8378         }
8379         if (defined $file_hash) {
8380                 $ftype = git_get_type($file_hash);
8381         }
8382         if (defined $file_name && !defined $ftype) {
8383                 die_error(500, "Unknown type of object");
8384         }
8385         my %co;
8386         if (defined $file_name) {
8387                 %co = parse_commit($base)
8388                         or die_error(404, "Unknown commit object");
8389         }
8390
8391
8392         my $paging_nav = format_log_nav($fmt_name, $page, $#commitlist >= 100);
8393         my $next_link = '';
8394         if ($#commitlist >= 100) {
8395                 $next_link =
8396                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8397                                  -accesskey => "n", -title => "Alt-n"}, "next");
8398         }
8399         my ($patch_max) = gitweb_get_feature('patches');
8400         if ($patch_max && !defined $file_name) {
8401                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8402                         $paging_nav .= " &#183; " .
8403                                 $cgi->a({-href => href(action=>"patches", -replay=>1)},
8404                                         "patches");
8405                 }
8406         }
8407
8408         {
8409                 local $action = 'fulllog';
8410                 git_header_html();
8411         }
8412         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8413         if (defined $file_name) {
8414                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8415         } else {
8416                 git_print_header_div('summary', $project)
8417         }
8418         git_print_page_path($file_name, $ftype, $hash_base)
8419                 if (defined $file_name);
8420
8421         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8422                      $file_name, $file_hash, $ftype);
8423
8424         git_footer_html();
8425 }
8426
8427 sub git_log {
8428         git_log_generic('log', \&git_log_body,
8429                         $hash, $hash_parent);
8430 }
8431
8432 sub git_commit {
8433         $hash ||= $hash_base || "HEAD";
8434         my %co = parse_commit($hash)
8435             or die_error(404, "Unknown commit object");
8436
8437         my $parent  = $co{'parent'};
8438         my $parents = $co{'parents'}; # listref
8439
8440         # we need to prepare $formats_nav before any parameter munging
8441         my $formats_nav;
8442         if (!defined $parent) {
8443                 # --root commitdiff
8444                 $formats_nav .= '(initial)';
8445         } elsif (@$parents == 1) {
8446                 # single parent commit
8447                 $formats_nav .=
8448                         '(parent: ' .
8449                         $cgi->a({-href => href(action=>"commit",
8450                                                hash=>$parent)},
8451                                 esc_html(substr($parent, 0, 7))) .
8452                         ')';
8453         } else {
8454                 # merge commit
8455                 $formats_nav .=
8456                         '(merge: ' .
8457                         join(' ', map {
8458                                 $cgi->a({-href => href(action=>"commit",
8459                                                        hash=>$_)},
8460                                         esc_html(substr($_, 0, 7)));
8461                         } @$parents ) .
8462                         ')';
8463         }
8464         if (gitweb_check_feature('patches') && @$parents <= 1) {
8465                 $formats_nav .= " | " .
8466                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
8467                                 "patch");
8468         }
8469
8470         if (!defined $parent) {
8471                 $parent = "--root";
8472         }
8473         my @difftree;
8474         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
8475                 @diff_opts,
8476                 (@$parents <= 1 ? $parent : '-c'),
8477                 $hash, "--")
8478                 or die_error(500, "Open git-diff-tree failed");
8479         @difftree = map { chomp; to_utf8($_) } <$fd>;
8480         close $fd or die_error(404, "Reading git-diff-tree failed");
8481
8482         # non-textual hash id's can be cached
8483         my $expires;
8484         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8485                 $expires = "+1d";
8486         }
8487         my $refs = git_get_references();
8488         my $ref = format_ref_marker($refs, $co{'id'});
8489
8490         git_header_html(undef, $expires);
8491         git_print_page_nav('commit', '',
8492                            $hash, $co{'tree'}, $hash,
8493                            $formats_nav);
8494
8495         if (defined $co{'parent'}) {
8496                 git_print_header_div('commitdiff', esc_html($co{'title'}), $hash, undef, $ref);
8497         } else {
8498                 git_print_header_div('tree', esc_html($co{'title'}), $co{'tree'}, $hash, $ref);
8499         }
8500         print "<div class=\"title_text\">\n" .
8501               "<table class=\"object_header\">\n";
8502         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
8503         git_print_authorship_rows(\%co);
8504         print "<tr>" .
8505               "<td>tree</td>" .
8506               "<td class=\"sha1\">" .
8507               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
8508                        class => "list"}, $co{'tree'}) .
8509               "</td>" .
8510               "<td class=\"link\">" .
8511               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
8512                       "tree");
8513         my $snapshot_links = format_snapshot_links($hash);
8514         if (defined $snapshot_links) {
8515                 print " | " . $snapshot_links;
8516         }
8517         print "</td>" .
8518               "</tr>\n";
8519
8520         foreach my $par (@$parents) {
8521                 print "<tr>" .
8522                       "<td>parent</td>" .
8523                       "<td class=\"sha1\">" .
8524                       $cgi->a({-href => href(action=>"commit", hash=>$par),
8525                                class => "list"}, $par) .
8526                       "</td>" .
8527                       "<td class=\"link\">" .
8528                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
8529                       " | " .
8530                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
8531                       "</td>" .
8532                       "</tr>\n";
8533         }
8534         print "</table>".
8535               "</div>\n";
8536
8537         print "<div class=\"page_body\">\n";
8538         git_print_log($co{'comment'});
8539         print "</div>\n";
8540
8541         git_difftree_body(\@difftree, $hash, @$parents);
8542
8543         git_footer_html();
8544 }
8545
8546 sub git_object {
8547         # object is defined by:
8548         # - hash or hash_base alone
8549         # - hash_base and file_name
8550         my $type;
8551
8552         # - hash or hash_base alone
8553         if ($hash || ($hash_base && !defined $file_name)) {
8554                 my $object_id = $hash || $hash_base;
8555
8556                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
8557                         or die_error(404, "Object does not exist");
8558                 $type = <$fd>;
8559                 chomp $type;
8560                 close $fd
8561                         or die_error(404, "Object does not exist");
8562
8563         # - hash_base and file_name
8564         } elsif ($hash_base && defined $file_name) {
8565                 $file_name =~ s,/+$,,;
8566
8567                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
8568                         or die_error(404, "Base object does not exist");
8569
8570                 # here errors should not happen
8571                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
8572                         or die_error(500, "Open git-ls-tree failed");
8573                 my $line = to_utf8(scalar <$fd>);
8574                 close $fd;
8575
8576                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
8577                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
8578                         die_error(404, "File or directory for given base does not exist");
8579                 }
8580                 $type = $2;
8581                 $hash = $3;
8582         } else {
8583                 die_error(400, "Not enough information to find object");
8584         }
8585
8586         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
8587                                           hash=>$hash, hash_base=>$hash_base,
8588                                           file_name=>$file_name),
8589                              -status => '302 Found');
8590 }
8591
8592 sub git_blobdiff {
8593         my $format = shift || 'html';
8594         my $diff_style = $input_params{'diff_style'} || 'inline';
8595
8596         my $fd;
8597         my @difftree;
8598         my %diffinfo;
8599         my $expires;
8600
8601         # preparing $fd and %diffinfo for git_patchset_body
8602         # new style URI
8603         if (defined $hash_base && defined $hash_parent_base) {
8604                 if (defined $file_name) {
8605                         # read raw output
8606                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8607                                 $hash_parent_base, $hash_base,
8608                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
8609                                 or die_error(500, "Open git-diff-tree failed");
8610                         @difftree = map { chomp; to_utf8($_) } <$fd>;
8611                         close $fd
8612                                 or die_error(404, "Reading git-diff-tree failed");
8613                         @difftree
8614                                 or die_error(404, "Blob diff not found");
8615
8616                 } elsif (defined $hash &&
8617                          $hash =~ /[0-9a-fA-F]{40}/) {
8618                         # try to find filename from $hash
8619
8620                         # read filtered raw output
8621                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8622                                 $hash_parent_base, $hash_base, "--")
8623                                 or die_error(500, "Open git-diff-tree failed");
8624                         @difftree =
8625                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
8626                                 # $hash == to_id
8627                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
8628                                 map { chomp; to_utf8($_) } <$fd>;
8629                         close $fd
8630                                 or die_error(404, "Reading git-diff-tree failed");
8631                         @difftree
8632                                 or die_error(404, "Blob diff not found");
8633
8634                 } else {
8635                         die_error(400, "Missing one of the blob diff parameters");
8636                 }
8637
8638                 if (@difftree > 1) {
8639                         die_error(400, "Ambiguous blob diff specification");
8640                 }
8641
8642                 %diffinfo = parse_difftree_raw_line($difftree[0]);
8643                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
8644                 $file_name   ||= $diffinfo{'to_file'};
8645
8646                 $hash_parent ||= $diffinfo{'from_id'};
8647                 $hash        ||= $diffinfo{'to_id'};
8648
8649                 # non-textual hash id's can be cached
8650                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
8651                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
8652                         $expires = '+1d';
8653                 }
8654
8655                 # open patch output
8656                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8657                         '-p', ($format eq 'html' ? "--full-index" : ()),
8658                         $hash_parent_base, $hash_base,
8659                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
8660                         or die_error(500, "Open git-diff-tree failed");
8661         }
8662
8663         # old/legacy style URI -- not generated anymore since 1.4.3.
8664         if (!%diffinfo) {
8665                 die_error('404 Not Found', "Missing one of the blob diff parameters")
8666         }
8667
8668         # header
8669         if ($format eq 'html') {
8670                 my $formats_nav =
8671                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
8672                                 "raw");
8673                 $formats_nav .= diff_style_nav($diff_style);
8674                 git_header_html(undef, $expires);
8675                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8676                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8677                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8678                 } else {
8679                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
8680                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
8681                 }
8682                 if (defined $file_name) {
8683                         git_print_page_path($file_name, "blob", $hash_base);
8684                 } else {
8685                         print "<div class=\"page_path\"></div>\n";
8686                 }
8687
8688         } elsif ($format eq 'plain') {
8689                 print $cgi->header(
8690                         -type => 'text/plain',
8691                         -charset => 'utf-8',
8692                         -expires => $expires,
8693                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
8694
8695                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
8696
8697         } else {
8698                 die_error(400, "Unknown blobdiff format");
8699         }
8700
8701         # patch
8702         if ($format eq 'html') {
8703                 print "<div class=\"page_body\">\n";
8704
8705                 git_patchset_body($fd, $diff_style,
8706                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
8707                 close $fd;
8708
8709                 print "</div>\n"; # class="page_body"
8710                 git_footer_html();
8711
8712         } else {
8713                 while (my $line = to_utf8(scalar <$fd>)) {
8714                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
8715                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
8716
8717                         print $line;
8718
8719                         last if $line =~ m!^\+\+\+!;
8720                 }
8721                 while (<$fd>) {
8722                         print to_utf8($_);
8723                 }
8724                 close $fd;
8725         }
8726 }
8727
8728 sub git_blobdiff_plain {
8729         git_blobdiff('plain');
8730 }
8731
8732 # assumes that it is added as later part of already existing navigation,
8733 # so it returns "| foo | bar" rather than just "foo | bar"
8734 sub diff_style_nav {
8735         my ($diff_style, $is_combined) = @_;
8736         $diff_style ||= 'inline';
8737
8738         return "" if ($is_combined);
8739
8740         my @styles = (inline => 'inline', 'sidebyside' => 'side by side');
8741         my %styles = @styles;
8742         @styles =
8743                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
8744
8745         return join '',
8746                 map { " | ".$_ }
8747                 map {
8748                         $_ eq $diff_style ? $styles{$_} :
8749                         $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_})
8750                 } @styles;
8751 }
8752
8753 sub git_commitdiff {
8754         my %params = @_;
8755         my $format = $params{-format} || 'html';
8756         my $diff_style = $input_params{'diff_style'} || 'inline';
8757
8758         my ($patch_max) = gitweb_get_feature('patches');
8759         if ($format eq 'patch') {
8760                 die_error(403, "Patch view not allowed") unless $patch_max;
8761         }
8762
8763         $hash ||= $hash_base || "HEAD";
8764         my %co = parse_commit($hash)
8765             or die_error(404, "Unknown commit object");
8766
8767         # choose format for commitdiff for merge
8768         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
8769                 $hash_parent = '--cc';
8770         }
8771         # we need to prepare $formats_nav before almost any parameter munging
8772         my $formats_nav;
8773         if ($format eq 'html') {
8774                 $formats_nav =
8775                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
8776                                 "raw");
8777                 if ($patch_max && @{$co{'parents'}} <= 1) {
8778                         $formats_nav .= " | " .
8779                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
8780                                         "patch");
8781                 }
8782                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
8783
8784                 if (defined $hash_parent &&
8785                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
8786                         # commitdiff with two commits given
8787                         my $hash_parent_short = $hash_parent;
8788                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
8789                                 $hash_parent_short = substr($hash_parent, 0, 7);
8790                         }
8791                         $formats_nav .=
8792                                 ' (from';
8793                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
8794                                 if ($co{'parents'}[$i] eq $hash_parent) {
8795                                         $formats_nav .= ' parent ' . ($i+1);
8796                                         last;
8797                                 }
8798                         }
8799                         $formats_nav .= ': ' .
8800                                 $cgi->a({-href => href(-replay=>1,
8801                                                        hash=>$hash_parent, hash_base=>undef)},
8802                                         esc_html($hash_parent_short)) .
8803                                 ')';
8804                 } elsif (!$co{'parent'}) {
8805                         # --root commitdiff
8806                         $formats_nav .= ' (initial)';
8807                 } elsif (scalar @{$co{'parents'}} == 1) {
8808                         # single parent commit
8809                         $formats_nav .=
8810                                 ' (parent: ' .
8811                                 $cgi->a({-href => href(-replay=>1,
8812                                                        hash=>$co{'parent'}, hash_base=>undef)},
8813                                         esc_html(substr($co{'parent'}, 0, 7))) .
8814                                 ')';
8815                 } else {
8816                         # merge commit
8817                         if ($hash_parent eq '--cc') {
8818                                 $formats_nav .= ' | ' .
8819                                         $cgi->a({-href => href(-replay=>1,
8820                                                                hash=>$hash, hash_parent=>'-c')},
8821                                                 'combined');
8822                         } else { # $hash_parent eq '-c'
8823                                 $formats_nav .= ' | ' .
8824                                         $cgi->a({-href => href(-replay=>1,
8825                                                                hash=>$hash, hash_parent=>'--cc')},
8826                                                 'compact');
8827                         }
8828                         $formats_nav .=
8829                                 ' (merge: ' .
8830                                 join(' ', map {
8831                                         $cgi->a({-href => href(-replay=>1,
8832                                                                hash=>$_, hash_base=>undef)},
8833                                                 esc_html(substr($_, 0, 7)));
8834                                 } @{$co{'parents'}} ) .
8835                                 ')';
8836                 }
8837         }
8838
8839         my $hash_parent_param = $hash_parent;
8840         if (!defined $hash_parent_param) {
8841                 # --cc for multiple parents, --root for parentless
8842                 $hash_parent_param =
8843                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
8844         }
8845
8846         # read commitdiff
8847         my $fd;
8848         my @difftree;
8849         if ($format eq 'html') {
8850                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8851                         "--no-commit-id", "--patch-with-raw", "--full-index",
8852                         $hash_parent_param, $hash, "--")
8853                         or die_error(500, "Open git-diff-tree failed");
8854
8855                 while (my $line = to_utf8(scalar <$fd>)) {
8856                         chomp $line;
8857                         # empty line ends raw part of diff-tree output
8858                         last unless $line;
8859                         push @difftree, scalar parse_difftree_raw_line($line);
8860                 }
8861
8862         } elsif ($format eq 'plain') {
8863                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8864                         '-p', $hash_parent_param, $hash, "--")
8865                         or die_error(500, "Open git-diff-tree failed");
8866         } elsif ($format eq 'patch') {
8867                 # For commit ranges, we limit the output to the number of
8868                 # patches specified in the 'patches' feature.
8869                 # For single commits, we limit the output to a single patch,
8870                 # diverging from the git-format-patch default.
8871                 my @commit_spec = ();
8872                 if ($hash_parent) {
8873                         if ($patch_max > 0) {
8874                                 push @commit_spec, "-$patch_max";
8875                         }
8876                         push @commit_spec, '-n', "$hash_parent..$hash";
8877                 } else {
8878                         if ($params{-single}) {
8879                                 push @commit_spec, '-1';
8880                         } else {
8881                                 if ($patch_max > 0) {
8882                                         push @commit_spec, "-$patch_max";
8883                                 }
8884                                 push @commit_spec, "-n";
8885                         }
8886                         push @commit_spec, '--root', $hash;
8887                 }
8888                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
8889                         '--encoding=utf8', '--stdout', @commit_spec)
8890                         or die_error(500, "Open git-format-patch failed");
8891         } else {
8892                 die_error(400, "Unknown commitdiff format");
8893         }
8894
8895         # non-textual hash id's can be cached
8896         my $expires;
8897         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8898                 $expires = "+1d";
8899         }
8900
8901         # write commit message
8902         if ($format eq 'html') {
8903                 my $refs = git_get_references();
8904                 my $ref = format_ref_marker($refs, $co{'id'});
8905
8906                 git_header_html(undef, $expires);
8907                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
8908                 git_print_header_div('commit', esc_html($co{'title'}), $hash, undef, $ref);
8909                 print "<div class=\"title_text\">\n" .
8910                       "<table class=\"object_header\">\n";
8911                 git_print_authorship_rows(\%co);
8912                 print "</table>".
8913                       "</div>\n";
8914                 print "<div class=\"page_body\">\n";
8915                 if (@{$co{'comment'}} > 1) {
8916                         print "<div class=\"log\">\n";
8917                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
8918                         print "</div>\n"; # class="log"
8919                 }
8920
8921         } elsif ($format eq 'plain') {
8922                 my $refs = git_get_references("tags");
8923                 my $tagname = git_get_rev_name_tags($hash);
8924                 my $filename = basename($project) . "-$hash.patch";
8925
8926                 print $cgi->header(
8927                         -type => 'text/plain',
8928                         -charset => 'utf-8',
8929                         -expires => $expires,
8930                         -content_disposition => 'inline; filename="' . "$filename" . '"');
8931                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
8932                 print "From: " . to_utf8($co{'author'}) . "\n";
8933                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
8934                 print "Subject: " . to_utf8($co{'title'}) . "\n";
8935
8936                 print "X-Git-Tag: $tagname\n" if $tagname;
8937                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
8938
8939                 foreach my $line (@{$co{'comment'}}) {
8940                         print to_utf8($line) . "\n";
8941                 }
8942                 print "---\n\n";
8943         } elsif ($format eq 'patch') {
8944                 my $filename = basename($project) . "-$hash.patch";
8945
8946                 print $cgi->header(
8947                         -type => 'text/plain',
8948                         -charset => 'utf-8',
8949                         -expires => $expires,
8950                         -content_disposition => 'inline; filename="' . "$filename" . '"');
8951         }
8952
8953         # write patch
8954         if ($format eq 'html') {
8955                 my $use_parents = !defined $hash_parent ||
8956                         $hash_parent eq '-c' || $hash_parent eq '--cc';
8957                 git_difftree_body(\@difftree, $hash,
8958                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
8959                 print "<br/>\n";
8960
8961                 git_patchset_body($fd, $diff_style,
8962                                   \@difftree, $hash,
8963                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
8964                 close $fd;
8965                 print "</div>\n"; # class="page_body"
8966                 git_footer_html();
8967
8968         } elsif ($format eq 'plain') {
8969                 while (<$fd>) {
8970                         print to_utf8($_);
8971                 }
8972                 close $fd
8973                         or print "Reading git-diff-tree failed\n";
8974         } elsif ($format eq 'patch') {
8975                 while (<$fd>) {
8976                         print to_utf8($_);
8977                 }
8978                 close $fd
8979                         or print "Reading git-format-patch failed\n";
8980         }
8981 }
8982
8983 sub git_commitdiff_plain {
8984         git_commitdiff(-format => 'plain');
8985 }
8986
8987 # format-patch-style patches
8988 sub git_patch {
8989         git_commitdiff(-format => 'patch', -single => 1);
8990 }
8991
8992 sub git_patches {
8993         git_commitdiff(-format => 'patch');
8994 }
8995
8996 sub git_history {
8997         git_log_generic('history', \&git_history_body,
8998                         $hash_base, $hash_parent_base,
8999                         $file_name, $hash);
9000 }
9001
9002 sub git_search {
9003         $searchtype ||= 'commit';
9004
9005         # check if appropriate features are enabled
9006         gitweb_check_feature('search')
9007                 or die_error(403, "Search is disabled");
9008         if ($searchtype eq 'pickaxe') {
9009                 # pickaxe may take all resources of your box and run for several minutes
9010                 # with every query - so decide by yourself how public you make this feature
9011                 gitweb_check_feature('pickaxe')
9012                         or die_error(403, "Pickaxe search is disabled");
9013         }
9014         if ($searchtype eq 'grep') {
9015                 # grep search might be potentially CPU-intensive, too
9016                 gitweb_check_feature('grep')
9017                         or die_error(403, "Grep search is disabled");
9018         }
9019
9020         if (!defined $searchtext) {
9021                 die_error(400, "Text field is empty");
9022         }
9023         if (!defined $hash) {
9024                 $hash = git_get_head_hash($project);
9025         }
9026         my %co = parse_commit($hash);
9027         if (!%co) {
9028                 die_error(404, "Unknown commit object");
9029         }
9030         if (!defined $page) {
9031                 $page = 0;
9032         }
9033
9034         if ($searchtype eq 'commit' ||
9035             $searchtype eq 'author' ||
9036             $searchtype eq 'committer') {
9037                 git_search_message(%co);
9038         } elsif ($searchtype eq 'pickaxe') {
9039                 git_search_changes(%co);
9040         } elsif ($searchtype eq 'grep') {
9041                 git_search_files(%co);
9042         } else {
9043                 die_error(400, "Unknown search type");
9044         }
9045 }
9046
9047 sub git_search_help {
9048         git_header_html();
9049         git_print_page_nav('','', $hash,$hash,$hash);
9050         print <<EOT;
9051 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
9052 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
9053 the pattern entered is recognized as the POSIX extended
9054 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
9055 insensitive).</p>
9056 <dl>
9057 <dt><b>commit</b></dt>
9058 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
9059 EOT
9060         my $have_grep = gitweb_check_feature('grep');
9061         if ($have_grep) {
9062                 print <<EOT;
9063 <dt><b>grep</b></dt>
9064 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
9065     a different one) are searched for the given pattern. On large trees, this search can take
9066 a while and put some strain on the server, so please use it with some consideration. Note that
9067 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
9068 case-sensitive.</dd>
9069 EOT
9070         }
9071         print <<EOT;
9072 <dt><b>author</b></dt>
9073 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
9074 <dt><b>committer</b></dt>
9075 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
9076 EOT
9077         my $have_pickaxe = gitweb_check_feature('pickaxe');
9078         if ($have_pickaxe) {
9079                 print <<EOT;
9080 <dt><b>pickaxe</b></dt>
9081 <dd>All commits that caused the string to appear or disappear from any file (changes that
9082 added, removed or "modified" the string) will be listed. This search can take a while and
9083 takes a lot of strain on the server, so please use it wisely. Note that since you may be
9084 interested even in changes just changing the case as well, this search is case sensitive.</dd>
9085 EOT
9086         }
9087         print "</dl>\n";
9088         git_footer_html();
9089 }
9090
9091 sub git_shortlog {
9092         git_log_generic('shortlog', \&git_shortlog_body,
9093                         $hash, $hash_parent);
9094 }
9095
9096 ## ......................................................................
9097 ## feeds (RSS, Atom; OPML)
9098
9099 sub git_feed {
9100         my $format = shift || 'atom';
9101         my $have_blame = gitweb_check_feature('blame');
9102
9103         # Atom: http://www.atomenabled.org/developers/syndication/
9104         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
9105         if ($format ne 'rss' && $format ne 'atom') {
9106                 die_error(400, "Unknown web feed format");
9107         }
9108
9109         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
9110         my $head = $hash || 'HEAD';
9111         my @commitlist = parse_commits($head, 150, 0, $file_name);
9112
9113         my %latest_commit;
9114         my %latest_date;
9115         my $content_type = "application/$format+xml";
9116         if (defined $cgi->http('HTTP_ACCEPT') &&
9117                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
9118                 # browser (feed reader) prefers text/xml
9119                 $content_type = 'text/xml';
9120         }
9121         if (defined($commitlist[0])) {
9122                 %latest_commit = %{$commitlist[0]};
9123                 my $latest_epoch = $latest_commit{'committer_epoch'};
9124                 exit_if_unmodified_since($latest_epoch);
9125                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
9126         }
9127         print $cgi->header(
9128                 -type => $content_type,
9129                 -charset => 'utf-8',
9130                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
9131                 -status => '200 OK');
9132
9133         # Optimization: skip generating the body if client asks only
9134         # for Last-Modified date.
9135         return if ($cgi->request_method() eq 'HEAD');
9136
9137         # header variables
9138         my $title = "$site_name - $project/$action";
9139         my $feed_type = 'log';
9140         if (defined $hash) {
9141                 $title .= " - '$hash'";
9142                 $feed_type = 'branch log';
9143                 if (defined $file_name) {
9144                         $title .= " :: $file_name";
9145                         $feed_type = 'history';
9146                 }
9147         } elsif (defined $file_name) {
9148                 $title .= " - $file_name";
9149                 $feed_type = 'history';
9150         }
9151         $title .= " $feed_type";
9152         $title = esc_html($title);
9153         my $descr = git_get_project_description($project);
9154         if (defined $descr) {
9155                 $descr = esc_html($descr);
9156         } else {
9157                 $descr = "$project " .
9158                          ($format eq 'rss' ? 'RSS' : 'Atom') .
9159                          " feed";
9160         }
9161         my $owner = git_get_project_owner($project);
9162         $owner = esc_html($owner);
9163
9164         #header
9165         my $alt_url;
9166         if (defined $file_name) {
9167                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
9168         } elsif (defined $hash) {
9169                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
9170         } else {
9171                 $alt_url = href(-full=>1, action=>"summary");
9172         }
9173         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
9174         if ($format eq 'rss') {
9175                 print <<XML;
9176 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
9177 <channel>
9178 XML
9179                 print "<title>$title</title>\n" .
9180                       "<link>$alt_url</link>\n" .
9181                       "<description>$descr</description>\n" .
9182                       "<language>en</language>\n" .
9183                       # project owner is responsible for 'editorial' content
9184                       "<managingEditor>$owner</managingEditor>\n";
9185                 if (defined $logo || defined $favicon) {
9186                         # prefer the logo to the favicon, since RSS
9187                         # doesn't allow both
9188                         my $img = esc_url($logo || $favicon);
9189                         print "<image>\n" .
9190                               "<url>$img</url>\n" .
9191                               "<title>$title</title>\n" .
9192                               "<link>$alt_url</link>\n" .
9193                               "</image>\n";
9194                 }
9195                 if (%latest_date) {
9196                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
9197                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
9198                 }
9199                 print "<generator>gitweb v.$version/$git_version</generator>\n";
9200         } elsif ($format eq 'atom') {
9201                 print <<XML;
9202 <feed xmlns="http://www.w3.org/2005/Atom">
9203 XML
9204                 print "<title>$title</title>\n" .
9205                       "<subtitle>$descr</subtitle>\n" .
9206                       '<link rel="alternate" type="text/html" href="' .
9207                       $alt_url . '" />' . "\n" .
9208                       '<link rel="self" type="' . $content_type . '" href="' .
9209                       $cgi->self_url() . '" />' . "\n" .
9210                       "<id>" . href(-full=>1) . "</id>\n" .
9211                       # use project owner for feed author
9212                       '<author><name>'. email_obfuscate($owner) . '</name></author>\n';
9213                 if (defined $favicon) {
9214                         print "<icon>" . esc_url($favicon) . "</icon>\n";
9215                 }
9216                 if (defined $logo) {
9217                         # not twice as wide as tall: 72 x 27 pixels
9218                         print "<logo>" . esc_url($logo) . "</logo>\n";
9219                 }
9220                 if (! %latest_date) {
9221                         # dummy date to keep the feed valid until commits trickle in:
9222                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
9223                 } else {
9224                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
9225                 }
9226                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
9227         }
9228
9229         # contents
9230         for (my $i = 0; $i <= $#commitlist; $i++) {
9231                 my %co = %{$commitlist[$i]};
9232                 my $commit = $co{'id'};
9233                 # we read 150, we always show 30 and the ones more recent than 48 hours
9234                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
9235                         last;
9236                 }
9237                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
9238
9239                 # get list of changed files
9240                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9241                         $co{'parent'} || "--root",
9242                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
9243                         or next;
9244                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
9245                 close $fd
9246                         or next;
9247
9248                 # print element (entry, item)
9249                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
9250                 if ($format eq 'rss') {
9251                         print "<item>\n" .
9252                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
9253                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
9254                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
9255                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
9256                               "<link>$co_url</link>\n" .
9257                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
9258                               "<content:encoded>" .
9259                               "<![CDATA[\n";
9260                 } elsif ($format eq 'atom') {
9261                         print "<entry>\n" .
9262                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
9263                               "<updated>$cd{'iso-8601'}</updated>\n" .
9264                               "<author>\n" .
9265                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
9266                         if ($co{'author_email'}) {
9267                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
9268                         }
9269                         print "</author>\n" .
9270                               # use committer for contributor
9271                               "<contributor>\n" .
9272                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
9273                         if ($co{'committer_email'}) {
9274                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
9275                         }
9276                         print "</contributor>\n" .
9277                               "<published>$cd{'iso-8601'}</published>\n" .
9278                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
9279                               "<id>$co_url</id>\n" .
9280                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
9281                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
9282                 }
9283                 my $comment = $co{'comment'};
9284                 print "<pre>\n";
9285                 foreach my $line (@$comment) {
9286                         $line = esc_html($line);
9287                         print "$line\n";
9288                 }
9289                 print "</pre><ul>\n";
9290                 foreach my $difftree_line (@difftree) {
9291                         my %difftree = parse_difftree_raw_line($difftree_line);
9292                         next if !$difftree{'from_id'};
9293
9294                         my $file = $difftree{'file'} || $difftree{'to_file'};
9295
9296                         print "<li>" .
9297                               "[" .
9298                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
9299                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
9300                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
9301                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
9302                                       -title => "diff"}, 'D');
9303                         if ($have_blame) {
9304                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
9305                                                              file_name=>$file, hash_base=>$commit),
9306                                               -class => "blamelink",
9307                                               -title => "blame"}, 'B');
9308                         }
9309                         # if this is not a feed of a file history
9310                         if (!defined $file_name || $file_name ne $file) {
9311                                 print $cgi->a({-href => href(-full=>1, action=>"history",
9312                                                              file_name=>$file, hash=>$commit),
9313                                               -title => "history"}, 'H');
9314                         }
9315                         $file = esc_path($file);
9316                         print "] ".
9317                               "$file</li>\n";
9318                 }
9319                 if ($format eq 'rss') {
9320                         print "</ul>]]>\n" .
9321                               "</content:encoded>\n" .
9322                               "</item>\n";
9323                 } elsif ($format eq 'atom') {
9324                         print "</ul>\n</div>\n" .
9325                               "</content>\n" .
9326                               "</entry>\n";
9327                 }
9328         }
9329
9330         # end of feed
9331         if ($format eq 'rss') {
9332                 print "</channel>\n</rss>\n";
9333         } elsif ($format eq 'atom') {
9334                 print "</feed>\n";
9335         }
9336 }
9337
9338 sub git_rss {
9339         git_feed('rss');
9340 }
9341
9342 sub git_atom {
9343         git_feed('atom');
9344 }
9345
9346 sub git_opml {
9347         my @list = git_get_projects_list($project_filter, $strict_export);
9348         if (!@list) {
9349                 die_error(404, "No projects found");
9350         }
9351
9352         print $cgi->header(
9353                 -type => 'text/xml',
9354                 -charset => 'utf-8',
9355                 -content_disposition => 'inline; filename="opml.xml"');
9356
9357         my $title = esc_html($site_name);
9358         my $filter = " within subdirectory ";
9359         if (defined $project_filter) {
9360                 $filter .= esc_html($project_filter);
9361         } else {
9362                 $filter = "";
9363         }
9364         print <<XML;
9365 <?xml version="1.0" encoding="utf-8"?>
9366 <opml version="1.0">
9367 <head>
9368   <title>$title OPML Export$filter</title>
9369 </head>
9370 <body>
9371 <outline text="git RSS feeds">
9372 XML
9373
9374         foreach my $pr (@list) {
9375                 my %proj = %$pr;
9376                 my $head = git_get_head_hash($proj{'path'});
9377                 if (!defined $head) {
9378                         next;
9379                 }
9380                 $git_dir = "$projectroot/$proj{'path'}";
9381                 my %co = parse_commit($head);
9382                 if (!%co) {
9383                         next;
9384                 }
9385
9386                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9387                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9388                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9389                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9390         }
9391         print <<XML;
9392 </outline>
9393 </body>
9394 </opml>
9395 XML
9396 }